Merge pull request #8199 from choroba/ech220

Add solutions to 220: Common Characters & Squareful by E. Choroba

2 files changed, 105 insertions, 0 deletions

diff --git a/challenge-220/e-choroba/perl/ch-1.pl b/challenge-220/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..b57db245f3
--- /dev/null
+++ b/challenge-220/e-choroba/perl/ch-1.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+use List::Util qw{ min };
+
+sub common_characters(@words) {
+    my %seen;
+    for my $i (0 .. $#words) {
+        ++$seen{$_}[$i] for split //, lc $words[$i];
+    }
+
+    return [map +(($_) x min(@{ $seen{$_} })),
+            sort
+            grep { @words == grep $_, @{ $seen{$_} } }
+            keys %seen]
+}
+
+use Test2::V0;
+plan 3;
+
+is common_characters(qw( Perl Rust Raku )), [qw[ r ]], 'Example 1';
+is common_characters(qw( love live leave )), [qw[ e l v ]], 'Example 2';
+is common_characters(qw( feel peel steel )), [qw[ e e l ]], 'Repetition';
diff --git a/challenge-220/e-choroba/perl/ch-2.pl b/challenge-220/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..b074ec47c8
--- /dev/null
+++ b/challenge-220/e-choroba/perl/ch-2.pl
@@ -0,0 +1,80 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+use Math::Combinatorics;
+
+sub squareful(@ints) {
+    my %results;
+    for my $i (0 .. $#ints) {
+        my @r = wrap([$ints[$i]], @ints[grep $_ != $i, 0 .. $#ints]);
+        @results{map "@$_", @r} = ();
+    }
+    return [map [split], keys %results]
+}
+
+sub wrap($done, @rest) {
+    return $done unless @rest;
+
+    my %results;
+    for my $i (0 .. $#rest) {
+        for my $edge (0, -1) {
+            my $sqrt = sqrt($rest[$i] + $done->[$edge]);
+            next unless int($sqrt) == $sqrt;
+
+            @results{ map "@$_",
+                      wrap($edge ? [@$done, $rest[$i]] : [$rest[$i], @$done],
+                           @rest[grep $_ != $i, 0 .. $#rest])
+                    } = ();
+
+        }
+    }
+    return map [split], keys %results
+}
+
+sub squareful_bruteforce(@ints) {
+    my $permutator = 'Math::Combinatorics'->new(data => \@ints);
+    my %results;
+  PERMUTATION:
+    while (my @permutation = $permutator->next_permutation) {
+        for my $i (1 .. $#permutation) {
+            my $sqrt = sqrt($permutation[$i] + $permutation[ $i - 1 ]);
+            next PERMUTATION unless int($sqrt) == $sqrt;
+        }
+        undef $results{"@permutation"};
+    }
+    return [map [split], keys %results]
+}
+
+use Test2::V0;
+plan 9;
+
+for my $s (*squareful{CODE}, *squareful_bruteforce{CODE}) {
+    is $s->(1, 17, 8), bag { item $_ for [1, 8, 17], [17, 8, 1] }, 'Example 1';
+    is $s->(2, 2, 2), [[2, 2, 2]], 'Example 2';
+
+    is $s->(1, 2, 3, 4, 5), [], 'Empty';
+    is $s->(3, 6, 3, 6, 30, 19), bag { item $_ for [3, 6, 3, 6, 30, 19],
+                                                   [19, 30, 6, 3, 6, 3],
+                                                   [30, 19, 6, 3, 6, 3],
+                                                   [3, 6, 3, 6, 19, 30],
+                                                   [3, 6, 30, 19, 6, 3],
+                                                   [3, 6, 19, 30, 6, 3];
+                                       end},
+        'Longer';
+}
+
+use Benchmark qw{ cmpthese };
+my @l = (1, 3, 9, 0, 16, 9, 27, 22, 14, 11);
+is squareful(@l), bag { item $_ for @{ squareful_bruteforce(@l) } }, 'same';
+
+cmpthese(5, {
+    bruteforce => sub { squareful_bruteforce(@l) },
+    optimised  => sub { squareful(@l) },
+});
+
+__END__
+           s/iter bruteforce  optimised
+bruteforce   19.0         --       -99%
+optimised   0.244      7667%         --