aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xchallenge-235/peter-meszaros/perl/ch-1.pl57
-rwxr-xr-xchallenge-235/peter-meszaros/perl/ch-2.pl50
2 files changed, 107 insertions, 0 deletions
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;