From f9d6d80916eb4a64c9e5109367a272b3fddc36d7 Mon Sep 17 00:00:00 2001
From: pme <hauptadler@gmail.com>
Date: Tue, 19 Sep 2023 20:10:27 +0200
Subject: challenge-235

---
 challenge-235/peter-meszaros/perl/ch-1.pl | 57 +++++++++++++++++++++++++++++++
 challenge-235/peter-meszaros/perl/ch-2.pl | 50 +++++++++++++++++++++++++++
 2 files changed, 107 insertions(+)
 create mode 100755 challenge-235/peter-meszaros/perl/ch-1.pl
 create mode 100755 challenge-235/peter-meszaros/perl/ch-2.pl

diff --git a/challenge-235/peter-meszaros/perl/ch-1.pl b/challenge-235/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..c3ae133f57
--- /dev/null
+++ b/challenge-235/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,57 @@
+#!/usr/bin/env perl
+#
+# You are given an array of integers.
+# 
+# Write a script to find out if removing ONLY one integer makes it strictly
+# increasing order.
+# Example 1
+# 
+# Input: @ints = (0, 2, 9, 4, 6)
+# Output: true
+# 
+# Removing ONLY 9 in the given array makes it strictly increasing order.
+# 
+# Example 2
+# 
+# Input: @ints = (5, 1, 3, 2)
+# Output: false
+# 
+# Example 3
+# 
+# Input: @ints = (2, 2, 3)
+# Output: true
+# 
+
+use strict;
+use warnings;
+use Test::More;
+use Data::Dumper;
+
+my $cases = [
+    [0, 2, 9, 4, 6],
+    [5, 1, 3, 2],
+    [2, 2, 3],
+];
+
+sub remove_one
+{
+    my $l = shift;
+
+    my $e = shift @$l;
+	my $r;
+    while (my $n = shift @$l) {
+		if ($e >= $n) {
+			++$r;
+			return 0 if $r > 1;
+		}
+		$e = $n;
+    }
+	return 1;
+}
+
+is(remove_one($cases->[0]), 1, '[0, 2, 9, 4, 6]');
+is(remove_one($cases->[1]), 0, '[5, 1, 3, 2]');
+is(remove_one($cases->[2]), 1, '[2, 2, 3]');
+done_testing();
+
+exit 0;
diff --git a/challenge-235/peter-meszaros/perl/ch-2.pl b/challenge-235/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..5ff641cddc
--- /dev/null
+++ b/challenge-235/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,50 @@
+#!/usr/bin/env perl
+#
+# You are given an array of integers.
+# 
+# Write a script to duplicate each occurrence of ZERO in the given array and
+# shift the remaining to the right but make sure the size of array remain the
+# same.
+# Example 1
+# 
+# Input: @ints = (1, 0, 2, 3, 0, 4, 5, 0)
+# Ouput: (1, 0, 0, 2, 3, 0, 0, 4)
+# 
+# Example 2
+# 
+# Input: @ints = (1, 2, 3)
+# Ouput: (1, 2, 3)
+# 
+# Example 3
+# 
+# Input: @ints = (0, 3, 0, 4, 5)
+# Ouput: (0, 0, 3, 0, 0)
+# 
+
+use strict;
+use warnings;
+use Test::More;
+use Data::Dumper;
+
+my $cases = [
+    [1, 0, 2, 3, 0, 4, 5, 0],
+    [1, 2, 3],
+    [0, 3, 0, 4, 5],
+];
+
+sub duplicate_zeros
+{
+	my $l = shift;
+    
+    my $len = @$l - 1;
+    my @res = map { $_ == 0 ? qw/0 0/ : $_} @$l;
+	@res = @res[0 .. $len];
+	return \@res;
+}
+
+is_deeply(duplicate_zeros($cases->[0]), [1, 0, 0, 2, 3, 0, 0, 4], '[1, 0, 2, 3, 0, 4, 5, 0]');
+is_deeply(duplicate_zeros($cases->[1]), [1, 2, 3],                '[1, 2, 3]');
+is_deeply(duplicate_zeros($cases->[2]), [0, 0, 3, 0, 0],          '[0, 3, 0, 4, 5]');
+done_testing();
+
+exit 0;
-- 
cgit