Merge pull request #8190 from pme/challenge-220

Challenge 220

2 files changed, 124 insertions, 0 deletions

diff --git a/challenge-220/peter-meszaros/perl/ch-1.pl b/challenge-220/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..8e96a72bd7
--- /dev/null
+++ b/challenge-220/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,47 @@
+#!/usr/bin/env perl
+# You are given a list of words.
+# 
+# Write a script to return the list of common characters (sorted alphabeticall) found in every word of the given list.
+# Example 1
+# 
+# Input: @words = ("Perl", "Rust", "Raku")
+# Output: ("r")
+# 
+# Example 2
+# 
+# Input: @words = ("love", "live", "leave")
+# Output: ("e", "l", "v")
+
+use strict;
+use warnings;
+use Test::More;
+use Data::Dumper;
+
+my $cases = [
+	["Perl", "Rust", "Raku"],
+	["love", "live", "leave"],
+];
+
+sub common_characters
+{
+	my $l = shift;
+
+    my %h;
+	for (@$l) {
+		++$h{$_} for (split('', lc));
+	}
+    my $len = @$l;
+	my @r;
+	for (keys %h) {
+		push @r, $_ if $h{$_} >= $len;
+	}
+	@r = sort @r;
+
+    return \@r;
+}
+
+is_deeply(common_characters($cases->[0]), ["r"],           '["Perl", "Rust", "Raku"]');
+is_deeply(common_characters($cases->[1]), ["e", "l", "v"], '["love", "live", "leave"]');
+done_testing();
+
+exit 0;
diff --git a/challenge-220/peter-meszaros/perl/ch-2.pl b/challenge-220/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..019fab7153
--- /dev/null
+++ b/challenge-220/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,77 @@
+#!/usr/bin/env perl
+# You are given an array of integers, @ints.
+# 
+#     An array is squareful if the sum of every pair of adjacent elements is a perfect square.
+# 
+# Write a script to find all the permutations of the given array that are squareful.
+# Example 1:
+# 
+# Input: @ints = (1, 17, 8)
+# Output: (1, 8, 17), (17, 8, 1)
+# 
+# (1, 8, 17) since 1 + 8 => 9, a perfect square and also 8 + 17 => 25 is perfect square too.
+# (17, 8, 1) since 17 + 8 => 25, a perfect square and also 8 + 1 => 9 is perfect square too.
+# 
+# Example 2:
+# 
+# Input: @ints = (2, 2, 2)
+# Output: (2, 2, 2)
+# 
+# There is only one permutation possible.
+
+use strict;
+use warnings;
+use Test::More;
+use Data::Dumper;
+use Math::Combinatorics qw/permute/;
+use Digest::SHA qw/sha1/;
+
+my $cases = [
+	[1, 17, 8],
+	[2, 2, 2],
+];
+
+sub uniq_perm
+{
+	my $p = shift;
+
+    my %h;
+    my @r;
+
+	for my $e (@$p) {
+		my $k = join('|', @$e);
+		++$h{$k};
+		push @r, $e if $h{$k} == 1;
+	}
+
+	return \@r;
+}
+
+sub squareful
+{
+	my $list = shift;
+
+	my @r;
+	my @p = permute(@$list);
+	my $p = uniq_perm(\@p);
+
+	for my $l (@$p) {
+		my $flag = 1;
+		for (my $i=1; $i<@$l; ++$i) {
+			my $sqrt = sqrt($l->[$i-1] + $l->[$i]);
+			if ($sqrt != int($sqrt)) {
+				$flag = 0;
+				last;
+			}
+		}
+		push @r, $l if $flag;
+	}
+
+    return \@r;
+}
+
+is_deeply(squareful($cases->[0]), [[1, 8, 17], [17, 8, 1]], '[1, 17, 8]');
+is_deeply(squareful($cases->[1]), [[2, 2, 2]],              '[2, 2, 2]');
+done_testing();
+
+exit 0;