Merge pull request #9989 from pme/challenge-229

challenge-229

2 files changed, 129 insertions, 0 deletions

diff --git a/challenge-229/peter-meszaros/perl/ch-1.pl b/challenge-229/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..2aa272d938
--- /dev/null
+++ b/challenge-229/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,64 @@
+#!/usr/bin/env perl
+#
+=head1 Task 1: Lexicographic Order
+
+You are given an array of strings.
+Write a script to delete element which is not lexicographically sorted
+(forwards or backwards) and return the count of deletions.
+
+=head2 Example 1
+
+Input: @str = ("abc", "bce", "cae")
+
+Output: 1
+
+In the given array "cae" is the only element which is not lexicographically
+sorted.
+
+=head2 Example 2
+
+Input: @str = ("yxz", "cba", "mon")
+
+Output: 2
+
+In the given array "yxz" and "mon" are not lexicographically sorted.
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+	[["abc", "bce", "cae"], 1],
+	[["yxz", "cba", "mon"], 2],
+];
+
+sub lexicographic_order
+{
+	my $l = shift;
+
+	my $n = 0;
+	my @w;
+
+	for my $w (@$l) {
+		my $s = join '', sort split(//, $w);
+		my $sr = join '', sort {$b cmp $a} split(//, $w);
+		if ($w eq $s || $w eq $sr) {
+			push @w, $w;
+		} else {
+			++$n;
+		}
+	}
+	print join(',', @w), "\n";
+
+	return $n;
+}
+
+for (@$cases) {
+    is(lexicographic_order($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-229/peter-meszaros/perl/ch-2.pl b/challenge-229/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..5003e11d5b
--- /dev/null
+++ b/challenge-229/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/env perl
+#
+=head1 Task 2: Two out of Three
+
+You are given three array of integers.
+
+Write a script to return all the elements that are present in at least 2 out of
+3 given arrays.
+
+=head2 Example 1
+
+Input: @array1 = (1, 1, 2, 4)
+       @array2 = (2, 4)
+       @array3 = (4)
+
+Ouput: (2, 4)
+
+=head2 Example 2
+
+Input: @array1 = (4, 1)
+       @array2 = (2, 4)
+       @array3 = (1, 2)
+
+Ouput: (1, 2, 4)
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+	[[[1, 1, 2, 4], [2, 4], [4]   ], [2, 4]],
+	[[[4, 1],       [2, 4], [1, 2]], [1, 2, 4]],
+];
+
+sub two_out_of_three
+{
+	my $ls = $_[0];
+
+	my %h;
+	my $n = 0;
+	for my $l (@$ls) {
+		$h{$_}->[$n] = 1 for @$l;
+		++$n;
+	}
+
+	my @res;
+	for my $k (keys %h) {
+		my $n;
+		$n += ($_ // 0) for $h{$k}->@*;
+		push @res, $k if $n >= 2;
+	}
+	@res = sort {$a <=> $b} @res;
+	return \@res;
+}
+
+for (@$cases) {
+    is(two_out_of_three($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
+