https://theweeklychallenge.org/blog/perl-weekly-challenge-344/

2 files changed, 104 insertions, 0 deletions

diff --git a/challenge-344/kjetillll/perl/ch-1.pl b/challenge-344/kjetillll/perl/ch-1.pl
new file mode 100644
index 0000000000..fd5fd3d353
--- /dev/null
+++ b/challenge-344/kjetillll/perl/ch-1.pl
@@ -0,0 +1,8 @@
+sub f { split //, pop() + join('',@_) }
+
+use Test::More tests => 5;
+is_deeply [ 1, 2, 4, 6    ],  [ f( 1, 2, 3, 4    => 12   )], 'Example 1';
+is_deeply [ 4, 5, 5       ],  [ f( 2, 7, 4       => 181  )], 'Example 2';
+is_deeply [ 1, 0, 0, 0    ],  [ f( 9, 9, 9       => 1    )], 'Example 3';
+is_deeply [ 1, 9, 9, 9, 9 ],  [ f( 1, 0, 0, 0, 0 => 9999 )], 'Example 4';
+is_deeply [ 1, 0, 0, 0    ],  [ f( 0             => 1000 )], 'Example 5';
diff --git a/challenge-344/kjetillll/perl/ch-2.pl b/challenge-344/kjetillll/perl/ch-2.pl
new file mode 100644
index 0000000000..dfa3975af8
--- /dev/null
+++ b/challenge-344/kjetillll/perl/ch-2.pl
@@ -0,0 +1,96 @@
+=pod
+
+https://theweeklychallenge.org/blog/perl-weekly-challenge-344/
+
+Task 2 in the challenge provided tests with very short inputs.
+
+A simple brute force algorithm with permutations suffices for those tests.
+
+This test program however also includes larger tests that reveal the true
+complexity of this challenge. For those a more elaborate algorithm is needed.
+
+I tried even larger tests than those below, but found the limit to be around
+length 220 for the target list. More sophisticated algorithms might exist for
+input lengths in the thousands?
+
+Run:
+
+  time perl ch-2.pl          #mode faster, 1.53s
+  time perl ch-2.pl slow     #mode slow,   3.15s without the two large tests
+
+=cut
+
+use List::Util qw( any );
+
+my( $true, $false ) = ( 1, 0 );
+
+my $mode = $ARGV[0] // 'faster';
+
+sub f { $mode eq 'faster' ? f_faster(@_) : f_slow(@_) }
+
+
+#---- slow and simple brute force, works for short input lists
+
+sub f_slow {
+    my( $inp, $trg ) = @_;
+    sub permute { @_ ? map { my$i=$_; map [ $_[$i], @$_ ], permute( @_[0..$i-1,$i+1..$#_] ) } 0 .. $#_ : [] }
+    any { "@$_" eq "@$trg" } map [ map @$_, @$inp[@$_] ], permute( 0 .. $#$inp )
+}
+
+
+#---- works for much longer inputs, but will eventually hang at around target of 220+ elements
+
+sub f_faster {
+    my( $inp, $trg ) = @_;
+    my %seen;
+
+    return $true if not @$trg;
+
+    any { my $try = $_;
+          f_faster( [ grep $_ ne $try, @$inp ],
+                    [ @$trg[ @$try .. $#$trg ] ] ) }
+    grep !$seen{ join(',',@$_) }++,                     #grep for speedup
+    grep join(',',@$_) eq join(',',@$trg[0..$#$_]),
+    @$inp
+}
+
+
+#---- tests
+
+print f( [ [2,3], [1], [4]   ], [1, 2, 3, 4    ] ) == $true ? "ok\n" : "error\n";
+print f( [ [1,3], [2,4]      ], [1, 2, 3, 4    ] ) == $false? "ok\n" : "error\n";
+print f( [ [9,1], [5,8], [2] ], [5, 8, 2, 9, 1 ] ) == $true ? "ok\n" : "error\n";
+print f( [ [1], [3]          ], [1, 2, 3       ] ) == $false? "ok\n" : "error\n";
+print f( [ [7,4,6]           ], [7, 4, 6       ] ) == $true ? "ok\n" : "error\n";
+
+print f( [ [2,9,7,4],[2,6,2,8],[1,9],[6,1],[4,6,2],[1],[2,6,2],[6],[1,5,8,4] ],
+         [ 1,5,8,4,6,1,2,9,7,4,4,6,2,1,9,2,6,2,8,2,6,2,1,6 ] ) == $true ? "ok\n" : "error\n";
+
+exit if $mode eq 'slow';  # never finishes in mode slow for such long lists, O( n! )
+
+print f( [ [4,8],[4,9,6],[4,3,4],[7],[3,8,7,6],[5,7,3],[4],[2,6],[9,6],[5,6,9,2],[6,5],[9],[9,3,8,3],[7,4,9],
+           [6,9,6],[5,2,1,3],[6,5,6],[1,6],[9,3],[7],[3,6],[2,9,7],[8,4,6,1],[7,2,5],[7,4,6],[6,7],[4,7],[3],
+           [9,7,3],[9],[5],[5,5],[5],[9,6,6],[6,5,9],[8,4],[4,4],[7],[5,3],[6,1],[3,4],[9],[1,3,2,7],[8],
+           [7,7,1,3],[5],[2,6,2,8],[6,1,8,3],[3,7,4,3],[3],[5,6],[1,5],[9,3],[7,7,6,4],[1,3,9],[3,4],[6,3,1],
+           [9],[3,4,9],[5,9],[2,1,6],[9,5],[9,6,9,4],[2,2,9,8],[4],[8],[4,5,3,7],[7],[6,2,1,9],[6,2,2],
+           [9,4,9,6],[4,8,4,5],[6],[9,4,3],[3,9,7,8],[7,2,8],[1,1,8,2],[5,3],[8],[8,4,7],[2,5],[9],[1,5],
+           [8,6,1,2],[3,6,4,5],[2],[7,8,3],[6,3] ],
+         [ 1,5,8,4,6,1,2,9,7,4,4,6,2,1,9,2,6,2,8,2,6,2,1,6,9,4,9,6,4,9,7,3,9,1,1,8,2,7,3,6,4,5,3,4,6,7,7,8,3,
+           9,7,2,8,7,4,6,5,3,9,3,5,6,6,5,2,1,3,7,7,7,6,4,5,5,6,9,2,6,1,6,3,9,3,8,4,6,9,6,9,4,3,5,9,3,8,3,9,6,
+           9,4,2,5,9,6,6,9,4,9,6,8,6,1,2,2,2,9,8,6,1,8,3,7,4,9,2,3,9,7,8,4,3,4,6,5,9,7,7,1,3,5,5,1,5,8,4,7,3,
+           4,5,3,7,3,7,6,3,1,3,4,9,5,3,6,2,2,6,5,6,3,4,8,4,8,5,7,3,7,4,7,4,1,6,9,1,3,9,8,4,8,4,5,5,3,6,5,9,3,
+           7,4,3,3,8,7,6,7,2,5,1,3,2,7,9,6,9,5,8,6,5,9 ] ) == $true ? "ok\n" : "error\n";
+
+#-- only difference from above is that first elem in target is changed from 1 to 2:
+print f( [ [4,8],[4,9,6],[4,3,4],[7],[3,8,7,6],[5,7,3],[4],[2,6],[9,6],[5,6,9,2],[6,5],[9],[9,3,8,3],[7,4,9],
+           [6,9,6],[5,2,1,3],[6,5,6],[1,6],[9,3],[7],[3,6],[2,9,7],[8,4,6,1],[7,2,5],[7,4,6],[6,7],[4,7],[3],
+           [9,7,3],[9],[5],[5,5],[5],[9,6,6],[6,5,9],[8,4],[4,4],[7],[5,3],[6,1],[3,4],[9],[1,3,2,7],[8],
+           [7,7,1,3],[5],[2,6,2,8],[6,1,8,3],[3,7,4,3],[3],[5,6],[1,5],[9,3],[7,7,6,4],[1,3,9],[3,4],[6,3,1],
+           [9],[3,4,9],[5,9],[2,1,6],[9,5],[9,6,9,4],[2,2,9,8],[4],[8],[4,5,3,7],[7],[6,2,1,9],[6,2,2],
+           [9,4,9,6],[4,8,4,5],[6],[9,4,3],[3,9,7,8],[7,2,8],[1,1,8,2],[5,3],[8],[8,4,7],[2,5],[9],[1,5],
+           [8,6,1,2],[3,6,4,5],[2],[7,8,3],[6,3] ],
+         [ 2,5,8,4,6,1,2,9,7,4,4,6,2,1,9,2,6,2,8,2,6,2,1,6,9,4,9,6,4,9,7,3,9,1,1,8,2,7,3,6,4,5,3,4,6,7,7,8,3,
+           9,7,2,8,7,4,6,5,3,9,3,5,6,6,5,2,1,3,7,7,7,6,4,5,5,6,9,2,6,1,6,3,9,3,8,4,6,9,6,9,4,3,5,9,3,8,3,9,6,
+           9,4,2,5,9,6,6,9,4,9,6,8,6,1,2,2,2,9,8,6,1,8,3,7,4,9,2,3,9,7,8,4,3,4,6,5,9,7,7,1,3,5,5,1,5,8,4,7,3,
+           4,5,3,7,3,7,6,3,1,3,4,9,5,3,6,2,2,6,5,6,3,4,8,4,8,5,7,3,7,4,7,4,1,6,9,1,3,9,8,4,8,4,5,5,3,6,5,9,3,
+           7,4,3,3,8,7,6,7,2,5,1,3,2,7,9,6,9,5,8,6,5,9 ] ) == $false ? "ok\n" : "error\n";