Merge branch 'master' of https://github.com/manwar/perlweeklychallenge-club

58 files changed, 2909 insertions, 1382 deletions

diff --git a/challenge-085/dave-jacoby/perl/ch-1.pl b/challenge-085/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..81b3d47945
--- /dev/null
+++ b/challenge-085/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental };
+
+use List::Util qw{ sum };
+
+my @list;
+push @list, [ 1.2, 0.4, 0.1, 2.5 ];
+push @list, [ 0.2, 1.5, 0.9, 1.1 ];
+push @list, [ 0.5, 1.1, 0.3, 0.7 ];
+
+for my $r (@list) {
+    triplet_sum( $r->@* );
+    say '';
+}
+
+sub triplet_sum ( @array ) {
+    say join ', ', @array;
+    my $arr->@* = @array;
+
+    for ( 0 .. scalar $arr->@* ) {
+        my $x   = shift $arr->@*;
+        my $out = _triplet_sum( [$x], $arr );
+        say 1 and return if $out;
+        push $arr->@*, $x;
+    }
+    say 0;
+}
+
+sub _triplet_sum ( $trip, $stash ) {
+    if ( 3 == scalar $trip->@* ) {
+        my $sum = sum $trip->@*;
+        if ( 1 < $sum && $sum < 2 ) {
+            say join ' + ', $trip->@*;
+            return 1;
+        }
+        return 0;
+    }
+    my $trip2->@*  = $trip->@*;
+    my $stash2->@* = $stash->@*;
+    for ( 0 .. scalar $stash2->@* ) {
+        my $x = shift $stash2->@*;
+        push $trip2->@*, $x;
+        my $out = _triplet_sum( $trip2, $stash2 );
+        return 1 if $out;
+        push $stash2->@*, pop $trip2->@*;
+    }
+}
diff --git a/challenge-085/dave-jacoby/perl/ch-2.pl b/challenge-085/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..7442e8b066
--- /dev/null
+++ b/challenge-085/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental };
+
+for my $n ( 8, 15, 125 ) {
+    say join "\t", $n, two_ints($n),"\n";
+}
+
+sub two_ints( $n ) {
+    for my $i ( 1 .. $n ) {
+        for my $j ( 2 .. $n ) {
+            my $exp = $i**$j;
+            next if $exp > $n;
+            if ( $exp == $n ) {
+                say qq{$i ** $j == $exp == $n};
+                return 1;
+            }
+        }
+    }
+    return 0;
+}
+
diff --git a/challenge-085/e-choroba/perl/ch-2.pl b/challenge-085/e-choroba/perl/ch-2.pl
index ee64b64f1c..3d16b4f68d 100755
--- a/challenge-085/e-choroba/perl/ch-2.pl
+++ b/challenge-085/e-choroba/perl/ch-2.pl
@@ -7,17 +7,19 @@ sub power_of_two_integers {
     for my $d (2 .. sqrt $n) {
         next unless $n % $d == 0;
 
-        $n /= $d while $n % $d == 0;
-        last
+        my $m = $n;
+        $m /= $d while $m % $d == 0;
+        return 1 if $m == 1;
     }
-    return $n == 1 ? 1 : 0
+    return 0
 }
 
-use Test::More tests => 6;
+use Test::More tests => 7;
 is power_of_two_integers(8),   1, 'Example 1';
 is power_of_two_integers(15),  0, 'Example 2';
 is power_of_two_integers(125), 1, 'Example 3';
 
+is power_of_two_integers(36), 1, 'Collin';
 is power_of_two_integers(43), 0, 'Prime';
 is power_of_two_integers(987654323), 0, 'Large prime';
 is power_of_two_integers(51185893014090757), 1, 'Large PoTI';
diff --git a/challenge-086/ash/raku/ch-1.raku b/challenge-086/ash/raku/ch-1.raku
new file mode 100644
index 0000000000..287ecfab78
--- /dev/null
+++ b/challenge-086/ash/raku/ch-1.raku
@@ -0,0 +1,9 @@
+#!/usr/bin/env raku
+#
+# Task 2 from
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-086/
+
+my @n = 10, 8, 12, 15, 5;
+my $a = 7;
+
+say +so $a == any(@n.combinations(2).map: { abs(.[0] - .[1]) });
diff --git a/challenge-086/dave-jacoby/perl/ch-1.pl b/challenge-086/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..29c2e42e98
--- /dev/null
+++ b/challenge-086/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental };
+
+say pair_difference( 7,  ( 10, 8,  12, 15, 5 ) );
+say pair_difference( 6,  ( 1,  5,  2,  9,  7 ) );
+say pair_difference( 15, ( 10, 30, 20, 50, 40 ) );
+
+sub pair_difference ( $A, @N ) {
+    say join ' ', '     ', $A, '--', @N;
+    while (@N) {
+        my $n = shift @N;
+        for my $o (@N) {
+            return 1 if $A == $n - $o;
+            return 1 if $A == $o - $n;
+        }
+    }
+
+    return 0;
+}
diff --git a/challenge-086/dave-jacoby/perl/ch-2.pl b/challenge-086/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..020a20e6b5
--- /dev/null
+++ b/challenge-086/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,125 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say signatures state };
+no warnings qw{ experimental };
+
+use List::Util qw{ uniq };
+
+use JSON;
+my $json = JSON->new;
+
+my $puzzle = '
+ _ _ _ 2 6 _ 7 _ 1 
+ 6 8 _ _ 7 _ _ 9 _ 
+ 1 9 _ _ _ 4 5 _ _ 
+ 8 2 _ 1 _ _ _ 4 _ 
+ _ _ 4 6 _ 2 9 _ _ 
+ _ 5 _ _ _ 3 _ 2 8 
+ _ _ 9 3 _ _ _ 7 4 
+ _ 4 _ _ 5 _ _ 3 6 
+ 7 _ 3 _ 1 8 _ _ _ 
+';
+
+my @puzzle;
+for my $row ( grep { /\S/ } split /\s?\n\s?/, $puzzle ) {
+    my @row = split /\s/mx, $row;
+    push @puzzle, \@row;
+}
+
+say 'BEFORE';
+display_puzzle(@puzzle);
+solve_puzzle( 0, 0, \@puzzle );
+
+sub solve_puzzle ( $x, $y, $puzzle ) {
+    return unless $puzzle->[$x][$y];
+    my $n = $puzzle->[$x][$y];
+
+    my $nx = $x;
+    my $ny = $y;
+    $nx++;
+    if ( $nx > 8 ) {
+        $ny++;
+        $nx = 0;
+    }
+
+    if ( $n eq '_' ) {
+        for my $i ( 1 .. 9 ) {
+            $puzzle->[$x][$y] = $i;
+            next unless test_puzzle($puzzle);
+            if ( $x == 8 && $y == 8 ) {
+                say 'SOLVED';
+                display_puzzle($puzzle->@*);
+            }
+            else {
+                solve_puzzle( $nx, $ny, $puzzle );
+            }
+        }
+        $puzzle->[$x][$y] = '_';
+    }
+    else {
+        solve_puzzle( $nx, $ny, $puzzle );
+    }
+}
+
+sub test_puzzle( $puzzle) {
+    my @puzzle    = $puzzle->@*;
+    my $yardstick = join ' ', 1 .. 9;
+
+    # rows
+    for my $x ( 0 .. 8 ) {
+        my @row = $puzzle[$x]->@*;
+        for my $k ( 1 .. 9 ) {
+            my @c = grep { /$k/ } @row;
+            my $c = scalar @c;
+            return 0 if $c > 1;
+        }
+    }
+
+    # columns
+    for my $x ( 0 .. 8 ) {
+        my @col = map { $puzzle->[$_][$x] } 0 .. 8;
+        for my $k ( 1 .. 9 ) {
+            my @c = grep { /$k/ } @col;
+            my $c = scalar @c;
+            return 0 if $c > 1;
+        }
+    }
+
+    # blocks
+    for my $xa ( 0 .. 2 ) {
+        for my $ya ( 0 .. 2 ) {
+            my @block;
+            for my $xb ( 0 .. 2 ) {
+                for my $yb ( 0 .. 2 ) {
+                    my $x = $xa * 3 + $xb;
+                    my $y = $ya * 3 + $yb;
+                    push @block, $puzzle[$x][$y];
+                }
+            }
+            for my $k ( 1 .. 9 ) {
+                my @c = grep { /$k/ } @block;
+                my $c = scalar @c;
+                return 0 if $c > 1;
+            }
+        }
+    }
+    return 1;
+}
+
+sub display_puzzle ( @puzzle ) {
+    say '-' x 27;
+    for my $x ( 0 .. 8 ) {
+        if ( $x % 3 == 0 && $x ne 0 ) { say ''; }
+        for my $y ( 0 .. 8 ) {
+            print ' ' if $y % 3 == 0;
+            print $puzzle[$x][$y] || '=';
+            print ' ';
+        }
+        say '';
+    }
+    say '-' x 27;
+    say '';
+}
+
diff --git a/challenge-086/e-choroba/perl/ch-1.pl b/challenge-086/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..c967edd649
--- /dev/null
+++ b/challenge-086/e-choroba/perl/ch-1.pl
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+sub pair_difference {
+    my ($A, @N) = @_;
+    my %n;
+    ++$n{$_} for @N;
+    return grep $_ > 1, values %n if 0 == $A;
+
+    # See the performance of "Many duplicates" on why we iterate over
+    # keys instead of @N.
+    for my $x (keys %n) {
+        my $B = abs($A - $x);
+        return 1 if exists $n{$B} || exists $n{-$B};
+    }
+    return 0
+}
+
+use Test::More;
+
+is pair_difference(7, 10, 8, 12, 15, 5), 1, 'Example 1';
+is pair_difference(6, 1, 5, 2, 9, 7), 1, 'Example 2';
+is pair_difference(15, 10, 30, 20, 50, 40), 0, 'Example 3';
+
+is pair_difference(-7, 10, 8, 12, 15, 5), 1, 'Example 1 but negative';
+is pair_difference(0, 1, 2, 3), 0, 'Zero';
+is pair_difference(0, 1, 2, 2), 1, 'Zero with duplicate';
+is pair_difference(1, (1) x 10_000_000, (3) x 10_000_000, 2), 1, 'Many duplicates';
+done_testing();
diff --git a/challenge-086/e-choroba/perl/ch-2.pl b/challenge-086/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..6d2a9d2f59
--- /dev/null
+++ b/challenge-086/e-choroba/perl/ch-2.pl
@@ -0,0 +1,138 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+{   package Sudoku;
+    sub new {
+        my ($class, $sudoku) = @_;
+        $sudoku =~ s/\[ | \]//g;
+        $sudoku =~ s/_/0/g;
+        bless [map [split], split /\n/, $sudoku], $class;
+    }
+
+    sub solve {
+        my ($self) = @_;
+        for my $x (0 .. 8) {
+            for my $y (0 .. 8) {
+                next if $self->[$y][$x];
+
+                for my $try (1 .. 9) {
+                    if ($self->maybe($y, $x, $try)) {
+                        $self->[$y][$x] = $try;
+                        return 1 if $self->solve;
+                    }
+                }
+                $self->[$y][$x] = 0;
+                return
+            }
+        }
+        return 1
+    }
+
+    sub maybe {
+        my ($self, $y, $x, $try) = @_;
+        return 0 if grep $_ == $try, @{ $self->[$y] };
+        return 0 if grep $_ == $try, map $self->[$_][$x], 0 .. 8;
+        my $x_square = int($x / 3);
+        my $y_square = int($y / 3);
+        for my $y1 ($y_square * 3 .. $y_square * 3 + 2) {
+            for my $x1 ( $x_square * 3 .. $x_square * 3 + 2) {
+                return 0 if $self->[$y1][$x1] == $try;
+            }
+        }
+        return 1
+    }
+}
+
+use Test::More;
+
+my $s = 'Sudoku'->new(<<~ 'SUDOKU');
+    [ _ _ _ 2 6 _ 7 _ 1 ]
+    [ 6 8 _ _ 7 _ _ 9 _ ]
+    [ 1 9 _ _ _ 4 5 _ _ ]
+    [ 8 2 _ 1 _ _ _ 4 _ ]
+    [ _ _ 4 6 _ 2 9 _ _ ]
+    [ _ 5 _ _ _ 3 _ 2 8 ]
+    [ _ _ 9 3 _ _ _ 7 4 ]
+    [ _ 4 _ _ 5 _ _ 3 6 ]
+    [ 7 _ 3 _ 1 8 _ _ _ ]
+    SUDOKU
+
+ok $s->solve, 'solvable';
+is_deeply $s, [
+    [4, 3, 5, 2, 6, 9, 7, 8, 1],
+    [6, 8, 2, 5, 7, 1, 4, 9, 3],
+    [1, 9, 7, 8, 3, 4, 5, 6, 2],
+    [8, 2, 6, 1, 9, 5, 3, 4, 7],
+    [3, 7, 4, 6, 8, 2, 9, 1, 5],
+    [9, 5, 1, 7, 4, 3, 6, 2, 8],
+    [5, 1, 9, 3, 2, 6, 8, 7, 4],
+    [2, 4, 8, 9, 5, 7, 1, 3, 6],
+    [7, 6, 3, 4, 1, 8, 2, 5, 9]], 'correct';
+
+my $s2 = 'Sudoku'->new(<<~ 'SUDOKU');
+    [ 3 _ _ 2 6 _ 7 _ 1 ]
+    [ 6 8 _ _ 7 _ _ 9 _ ]
+    [ 1 9 _ _ _ 4 5 _ _ ]
+    [ 8 2 _ 1 _ _ _ 4 _ ]
+    [ _ _ 4 6 _ 2 9 _ _ ]
+    [ _ 5 _ _ _ 3 _ 2 8 ]
+    [ _ _ 9 3 _ _ _ 7 4 ]
+    [ _ 4 _ _ 5 _ _ 3 6 ]
+    [ 7 _ 3 _ 1 8 _ _ _ ]
+    SUDOKU
+
+ok ! $s2->solve, 'not solvable';
+
+# Additional examples taken from https://sudoku.com/.
+
+my $s3 = 'Sudoku'->new(<<~ 'SUDOKU');
+    [ 4 _ _ _ _ 8 _ _ 2 ]
+    [ _ _ _ 7 _ _ _ _ _ ]
+    [ _ _ _ _ 9 1 _ 7 _ ]
+    [ _ 1 _ 5 _ 6 _ _ _ ]
+    [ 6 _ _ _ _ 4 _ 9 _ ]
+    [ _ 5 _ _ _ _ 8 _ _ ]
+    [ 3 4 _ _ _ 2 _ _ 1 ]
+    [ 8 _ _ _ 3 _ _ _ 6 ]
+    [ _ 2 _ 8 1 _ _ _ _ ]
+    SUDOKU
+ok $s3->solve, 'hard solvable';
+is_deeply $s3, [
+    [4, 7, 9, 6, 5, 8, 3, 1, 2],
+    [1, 6, 2, 7, 4, 3, 9, 5, 8],
+    [5, 3, 8, 2, 9, 1, 6, 7, 4],
+    [9, 1, 3, 5, 8, 6, 2, 4, 7],
+    [6, 8, 7, 3, 2, 4, 1, 9, 5],
+    [2, 5, 4, 1, 7, 9, 8, 6, 3],
+    [3, 4, 5, 9, 6, 2, 7, 8, 1],
+    [8, 9, 1, 4, 3, 7, 5, 2, 6],
+    [7, 2, 6, 8, 1, 5, 4, 3, 9],
+], 'hard correct';
+
+my $s4 = 'Sudoku'->new(<<~ 'SUDOKU');
+    [ 7 6 _ _ _ _ _ _ _ ]
+    [ _ 5 _ _ _ _ 8 2 _ ]
+    [ _ _ _ 2 _ 7 _ 4 _ ]
+    [ _ _ _ _ 9 6 7 _ _ ]
+    [ _ 3 _ _ _ _ _ 1 _ ]
+    [ _ _ _ 8 _ _ _ _ _ ]
+    [ 2 _ _ _ _ 1 3 _ _ ]
+    [ 1 _ _ _ _ _ 9 6 _ ]
+    [ _ 7 _ _ _ 9 _ _ 5 ]
+    SUDOKU
+ok $s4->solve, 'expert solvable';
+is_deeply $s4, [
+    [7, 6, 2, 9, 8, 4, 5, 3, 1],
+    [4, 5, 9, 6, 1, 3, 8, 2, 7],
+    [3, 8, 1, 2, 5, 7, 6, 4, 9],
+    [8, 2, 4, 1, 9, 6, 7, 5, 3],
+    [9, 3, 6, 7, 4, 5, 2, 1, 8],
+    [5, 1, 7, 8, 3, 2, 4, 9, 6],
+    [2, 9, 8, 5, 6, 1, 3, 7, 4],
+    [1, 4, 5, 3, 7, 8, 9, 6, 2],
+    [6, 7, 3, 4, 2, 9, 1, 8, 5],
+], 'expert correct';
+
+done_testing();
diff --git a/challenge-086/feng-chang/raku/ch-1.raku b/challenge-086/feng-chang/raku/ch-1.raku
new file mode 100755
index 0000000000..48812c101d
--- /dev/null
+++ b/challenge-086/feng-chang/raku/ch-1.raku
@@ -0,0 +1,15 @@
+#!/bin/env raku
+
+sub USAGE() {
+print Q:c:to/END/; 
+    Usage: {$*PROGRAM-NAME} <number A> <array N>
+        e.g.:
+            ./ch-1.raku 7   10 8 12 15 5
+            ./ch-1.raku 6   1 5 2 9 7
+            ./ch-1.raku 15  10 30 20 50 40
+    END
+}
+
+sub MAIN(Int:D $A, *@N) {
+    put any(@N.combinations(2)).grep({ abs($^a - $^b) == abs($A) }).elems > 0 ?? 1 !! 0;
+}
diff --git a/challenge-086/feng-chang/raku/ch-2.raku b/challenge-086/feng-chang/raku/ch-2.raku
new file mode 100755
index 0000000000..3abf043233
--- /dev/null
+++ b/challenge-086/feng-chang/raku/ch-2.raku
@@ -0,0 +1,80 @@
+#!/bin/env raku
+
+constant @rows-index =
+	0..8,    9..17, 18..26,
+	27..35, 36..44, 45..53,
+	54..62, 63..71, 72..80;
+constant @cols-index =
+	[0,9,18,27,36,45,54,63,72],
+	[1,10,19,28,37,46,55,64,73],
+	[2,11,20,29,38,47,56,65,74],
+	[3,12,21,30,39,48,57,66,75],
+	[4,13,22,31,40,49,58,67,76],
+	[5,14,23,32,41,50,59,68,77],
+	[6,15,24,33,42,51,60,69,78],
+	[7,16,25,34,43,52,61,70,79],
+	[8,17,26,35,44,53,62,71,80];
+constant @squares-index =
+	[0,1,2, 9,10,11, 18,19,20],
+	[3,4,5, 12,13,14, 21,22,23],
+	[6,7,8, 15,16,17, 24,25,26],
+	[27,28,29, 36,37,38, 45,46,47],
+	[30,31,32, 39,40,41, 48,49,50],
+	[33,34,35, 42,43,44, 51,52,53],
+	[54,55,56, 63,64,65, 72,73,74],
+	[57,58,59, 66,67,68, 75,76,77],
+	[60,61,62, 69,70,71, 78,79,80];
+my @is-uncertain;
+
+sub is-done(@a where *.elems == 9 --> Bool) { @a.sort eqv (1...9) }
+
+sub is-complete(@sdk where *.elems == 81 --> Bool) {
+    ([and] (^9)».&{ is-done(@sdk[@rows-index[$_]]) })   and
+    ([and] (^9)».&{ is-done(@sdk[@cols-index[$_]]) })   and
+    ([and] (^9)».&{ is-done(@sdk[@squares-index[$_]]) });
+}
+
+sub is-wrong(@cells where *.elems == 9 --> Bool) {
+    my @c = @cells.grep(* > 0);
+    @c.unique.elems != @c.elems;
+}
+
+sub contradict(@sdk where *.elems == 81 --> Bool) {
+    ([or] (^9)».&{ is-wrong(@sdk[@rows-index[$_]]) })   or
+    ([or] (^9)».&{ is-wrong(@sdk[@cols-index[$_]]) })   or
+    ([or] (^9)».&{ is-wrong(@sdk[@squares-index[$_]]) });
+}
+
+sub solve(@sdk is copy, UInt:D $pos) {
+    if is-complete(@sdk) {
+        put '=' x 17;
+        put @sdk[@rows-index[$_]] for ^9;
+        return;
+    }
+    
+    return if contradict(@sdk);
+
+    if @is-uncertain[$pos] {
+        for 1..9 -> $i {
+            @sdk[$pos] = $i;
+            solve(@sdk, $pos + 1);
+        }
+    } else {
+        solve(@sdk, $pos + 1);
+    }
+}
+
+multi MAIN($data-file) {
+    my @puzzle = $data-file.IO.words;
+    for ^81 -> $i {
+        if @puzzle[$i] eq '_' {
+            @puzzle[$i] = 0;
+            @is-uncertain[$i] = True;
+        } else {
+            @puzzle[$i] .= Int;
+            @is-uncertain[$i] = False;
+        }
+    }
+
+    solve(@puzzle, 0);
+}
diff --git a/challenge-086/feng-chang/raku/data.txt b/challenge-086/feng-chang/raku/data.txt
new file mode 100644
index 0000000000..02091beb64
--- /dev/null
+++ b/challenge-086/feng-chang/raku/data.txt
@@ -0,0 +1,9 @@
+_ _ _ 2 6 _ 7 _ 1
+6 8 _ _ 7 _ _ 9 _
+1 9 _ _ _ 4 5 _ _
+8 2 _ 1 _ _ _ 4 _
+_ _ 4 6 _ 2 9 _ _
+_ 5 _ _ _ 3 _ 2 8
+_ _ 9 3 _ _ _ 7 4
+_ 4 _ _ 5 _ _ 3 6
+7 _ 3 _ 1 8 _ _ _ 
diff --git a/challenge-086/mark-anderson/raku/ch-1.p6 b/challenge-086/mark-anderson/raku/ch-1.p6
new file mode 100644
index 0000000000..a67b3ce555
--- /dev/null
+++ b/challenge-086/mark-anderson/raku/ch-1.p6
@@ -0,0 +1,30 @@
+#
+# from a hint at https://www.geeksforgeeks.org/find-a-pair-with-the-given-difference/
+#
+
+multi MAIN($A where * ~~ Int, *@N where .all ~~ Int) {
+    say pair-diff(+$A, @N.map(+*));
+}
+
+multi MAIN {
+    use Test;
+    plan 3;
+
+    ok  pair-diff(7,  [10, 8, 12, 15, 5]),   "Example 1";
+    ok  pair-diff(6,  [1, 5, 2, 9, 7]),      "Example 2";
+    nok pair-diff(15, [10, 30, 20, 50, 40]), "Example 3";
+}
+
+sub pair-diff($A, @N) {
+    my $b = bag @N;
+
+    if $A == 0 {
+        return +$b.values.first(* > 1).so;
+    }
+
+    for $b.keys -> $k {
+        return 1 if $b{$A+$k};
+    }
+
+    return 0;
+}
diff --git a/challenge-086/mark-anderson/raku/ch-2.p6 b/challenge-086/mark-anderson/raku/ch-2.p6
new file mode 10