Merge remote-tracking branch 'upstream/master'

12 files changed, 393 insertions, 10 deletions

diff --git a/challenge-086/feng-chang/raku/ch-1b.raku b/challenge-086/feng-chang/raku/ch-1b.raku
new file mode 100755
index 0000000000..7f2fa7676c
--- /dev/null
+++ b/challenge-086/feng-chang/raku/ch-1b.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-1b.raku 7   10 8 12 15 5
+            ./ch-1b.raku 6   1 5 2 9 7
+            ./ch-1b.raku 15  10 30 20 50 40
+    END
+}
+
+sub MAIN(Int:D $A, *@N) {
+    put + [or] @N.combinations(2).map({ abs($_[0] - $_[1]) == abs($A)});
+}
diff --git a/challenge-086/feng-chang/raku/ch-2.raku b/challenge-086/feng-chang/raku/ch-2.raku
index 3abf043233..679037fae0 100755
--- a/challenge-086/feng-chang/raku/ch-2.raku
+++ b/challenge-086/feng-chang/raku/ch-2.raku
@@ -51,7 +51,6 @@ sub solve(@sdk is copy, UInt:D $pos) {
         put @sdk[@rows-index[$_]] for ^9;
         return;
     }
-    
     return if contradict(@sdk);
 
     if @is-uncertain[$pos] {
@@ -66,15 +65,9 @@ sub solve(@sdk is copy, UInt:D $pos) {
 
 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;
-        }
-    }
+    @puzzle[$_] = 0 if @puzzle[$_] eq '_' for ^81;
+    @puzzle[$_] .= Int for ^81;
+    @is-uncertain[$_] = @puzzle[$_] == 0 for ^81;
 
     solve(@puzzle, 0);
 }
diff --git a/challenge-086/jaldhar-h-vyas/blog.txt b/challenge-086/jaldhar-h-vyas/blog.txt
new file mode 100644
index 0000000000..8b4d12e36e
--- /dev/null
+++ b/challenge-086/jaldhar-h-vyas/blog.txt
@@ -0,0 +1 @@
+https://www.braincells.com/perl/2020/11/perl_weekly_challenge_week_86.html
diff --git a/challenge-086/jaldhar-h-vyas/perl/ch-1.pl b/challenge-086/jaldhar-h-vyas/perl/ch-1.pl
new file mode 100755
index 0000000000..dd7166103a
--- /dev/null
+++ b/challenge-086/jaldhar-h-vyas/perl/ch-1.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+use 5.020;
+use warnings;
+use English qw/ -no_match_vars /;
+
+sub usage {
+    print << "-USAGE-";
+Usage:
+  $PROGRAM_NAME <A> [<N> ...]
+  
+    <A>          difference between any pair from <N>
+    [<N> ...]    array of integers
+-USAGE-
+
+    exit(0);
+}
+
+sub combinations {
+    my @list = @{$_[0]};
+    my $length = $_[1];
+
+    if ($length <= 1) {
+        return map [$_], @list;
+    }
+
+    my @combos;
+
+    for (my $i = 0; $i + $length <= scalar @list; $i++) {
+        my $val  = $list[$i];
+        my @rest = @list[$i + 1 .. $#list];
+        for my $c (combinations(\@rest, $length - 1)) {
+            push @combos, [$val, @{$c}] ;
+        }
+    }
+
+    return @combos;
+}
+
+my $A = shift // usage();
+my @N = @ARGV || usage();
+
+say scalar(grep { abs($_->[0] - $_->[1]) == $A; } combinations(\@N, 2)) ? 1 : 0;
\ No newline at end of file
diff --git a/challenge-086/jaldhar-h-vyas/perl/ch-2.pl b/challenge-086/jaldhar-h-vyas/perl/ch-2.pl
new file mode 100755
index 0000000000..82b20e76e8
--- /dev/null
+++ b/challenge-086/jaldhar-h-vyas/perl/ch-2.pl
@@ -0,0 +1,103 @@
+#!/usr/bin/perl
+use 5.020;
+use warnings;
+use English qw/ -no_match_vars /;
+
+sub process {
+    my ($file) = @_;
+    my @puzzle;
+
+    open my $fn, '<', $file or die "$OS_ERROR\n";
+    local $RS = undef;
+    my $data = <$fn>;
+    close $fn;
+
+    $data =~ s/_/0/g;
+    my @lines = split /\n/, $data;
+    for my $line (@lines) {
+        push @puzzle, [ grep { /\d/ } split //, $line];
+    }
+
+    return @puzzle;
+}
+
+sub columns {
+    my ($puzzle) = @_;
+    my @columns;
+
+    for my $i (0 .. scalar @{$puzzle} - 1) {
+        for my $j (0 .. scalar @{$puzzle->[$i]} - 1) {
+            push @{$columns[$i]}, @{$puzzle->[$j]}[$i];
+        } 
+    } 
+
+    return @columns;
+}
+
+sub inBox {
+    my ($puzzle, $row, $col, $num) = @_;
+    my @box;
+
+    for my $i ($row .. $row + 2) {
+        push @box, @{$puzzle->[$i]}[$col .. $col + 2];
+    }
+
+    return scalar grep { $_ == $num; } @box;
+}
+
+sub inCol {
+    my ($columns, $col, $num) = @_;
+    return scalar grep { $_ == $num; } @{$columns->[$col]};
+}
+
+sub inRow {
+    my ($puzzle, $row, $num) = @_;
+    return scalar grep { $_ == $num; } @{$puzzle->[$row]};
+}
+
+sub isValid {
+    my ($puzzle, $row, $col, $num) = @_;
+    my @columns = columns($puzzle);
+
+    return
+        !inRow($puzzle, $row, $num) &&
+        !inCol(\@columns, $col, $num) &&
+        !inBox($puzzle, $row - $row % 3, $col - $col % 3, $num);
+}
+
+sub solve {
+    my ($puzzle) = @_;
+
+    for my $row (0 .. scalar @{$puzzle} - 1) {
+        for my $col (0 .. scalar @{$puzzle->[$row]} - 1) {
+            if ($puzzle->[$row][$col] == 0) {
+
+
+                for my $num (1 .. 9) {
+                    if (isValid($puzzle, $row, $col, $num)) {
+                        $puzzle->[$row][$col] = $num;
+                        if(solve($puzzle)) {
+                            return 1;
+                        }
+                        $puzzle->[$row][$col] = 0;
+                    }
+                }
+
+                return undef;
+            }
+        }
+    }
+
+    return 1;
+}
+
+my $sudoku = shift;
+my @puzzle = process($sudoku);
+
+if (solve(\@puzzle)) {
+    for my $row (@puzzle) {
+        say q{[ }, (join q{ }, @{$row}), q{ ]};
+    }
+} else {
+    say 'Unsolvable.';
+}
\ No newline at end of file
diff --git a/challenge-086/jaldhar-h-vyas/raku/ch-1.p6 b/challenge-086/jaldhar-h-vyas/raku/ch-1.p6
new file mode 100755
index 0000000000..af68ac3c82
--- /dev/null
+++ b/challenge-086/jaldhar-h-vyas/raku/ch-1.p6
@@ -0,0 +1,8 @@
+#!/usr/bin/perl6
+
+sub MAIN (
+    $A,  #= difference between any pair from <N>
+    *@N  #= array of integers
+) {
+    say @N.combinations(2).grep({ @_.max - @_.min == $A }).elems ?? 1 !! 0;
+}
\ No newline at end of file
diff --git a/challenge-086/jaldhar-h-vyas/raku/ch-2.p6 b/challenge-086/jaldhar-h-vyas/raku/ch-2.p6
new file mode 100755
index 0000000000..bcb5a43502
--- /dev/null
+++ b/challenge-086/jaldhar-h-vyas/raku/ch-2.p6
@@ -0,0 +1,74 @@
+#!/usr/bin/perl6
+
+sub process($file) {
+    return $file.IO.lines.map({
+        [ $_.subst(q{_}, 0, :g).comb.grep({ / \d /; }) ];
+    });
+}
+
+sub inBox(@puzzle, $row, $col, $num) {
+    my @box;
+
+    for $row .. $row + 2 -> $i {
+        @box.push(| @puzzle[$i][$col .. $col + 2]);
+    }
+
+    return $num == @box.any;
+}
+
+sub inCol(@columns, $col, $num) {
+    return $num == @columns[$col].any;
+}
+
+sub inRow(@puzzle, $row, $num) {
+    return $num == @puzzle[$row].any;
+}
+
+sub isValid(@puzzle, $row, $col, $num) {
+    my @columns = [Z] @puzzle;
+
+    return
+        !inRow(@puzzle, $row, $num) &&
+        !inCol(@columns, $col, $num) &&
+        !inBox(@puzzle, $row - $row % 3, $col - $col % 3, $num);
+}
+
+sub solve(@puzzle is copy) {
+
+    for 0 ..^ @puzzle.elems -> $row {
+        for 0 ..^ @puzzle[$row].elems -> $col {
+
+            if @puzzle[$row][$col] == 0 {
+
+                for (1 .. 9) -> $num {
+                    if isValid(@puzzle, $row, $col, $num) {
+                        @puzzle[$row][$col] = $num;
+
+                        if solve(@puzzle) {
+                            return True;
+                        }
+                        @puzzle[$row][$col] = 0;
+                    }
+                }
+
+                return False;
+            }
+        }
+    }
+
+    return True;
+}
+
+sub MAIN (
+    $sudoku,  #= file containing a sudoku puzzle
+) {
+    my @puzzle = process($sudoku);
+
+    if solve(@puzzle) {
+        for @puzzle -> @row {
+            say q{[ }, @row.join(q{ }), q{ ]};
+        }
+    } else {
+        say 'Unsolvable.';
+    }
+}
\ No newline at end of file
diff --git a/challenge-086/jaldhar-h-vyas/sudoku.txt b/challenge-086/jaldhar-h-vyas/sudoku.txt
new file mode 100644
index 0000000000..ff1add060c
--- /dev/null
+++ b/challenge-086/jaldhar-h-vyas/sudoku.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 _ _ _ ]
\ No newline at end of file
diff --git a/challenge-086/lubos-kolouch/blog.txt b/challenge-086/lubos-kolouch/blog.txt
new file mode 100644
index 0000000000..276a9e03c9
--- /dev/null
+++ b/challenge-086/lubos-kolouch/blog.txt
@@ -0,0 +1 @@
+https://egroup.kolouch.org/nextcloud/index.php/apps/cms_pico/pico/lubos/202021115_perl_weekly_086
diff --git a/challenge-086/pete-houston/perl/ch-1.pl b/challenge-086/pete-houston/perl/ch-1.pl
new file mode 100644
index 0000000000..d0c50d1b02
--- /dev/null
+++ b/challenge-086/pete-houston/perl/ch-1.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/env perl 
+#===============================================================================
+#
+#         FILE: 8601.pl
+#
+#        USAGE: ./8601.pl A N N [ ... ]
+#
+#  DESCRIPTION: Determine if any pair of N have a difference of A
+#
+#        NOTES: Displays the matching difference, if any
+#       AUTHOR: Pete Houston (pete), cpan@openstrike.co.uk
+# ORGANIZATION: Openstrike
+#      VERSION: 1.0
+#      CREATED: 09/11/20
+#===============================================================================
+
+use strict;
+use warnings;
+
+my $diff = shift @ARGV;
+my %lookup = map { $_ => 1 } @ARGV;
+
+my ($res) = grep { $lookup{$_ + $diff} } @ARGV;
+if (defined $res) {
+	print $res + $diff . " - $res = $diff\n1\n";
+} else {
+	print "0\n";
+}
diff --git a/challenge-086/pete-houston/perl/ch-2.pl b/challenge-086/pete-houston/perl/ch-2.pl
new file mode 100644
index 0000000000..b27e80c822
--- /dev/null
+++ b/challenge-086/pete-houston/perl/ch-2.pl
@@ -0,0 +1,95 @@
+#!/usr/bin/env perl 
+#===============================================================================
+#
+#         FILE: 8602.pl
+#
+#        USAGE: ./8602.pl [ infile ]
+#
+#  DESCRIPTION: Solve a sudoku puzzle
+#
+#      OPTIONS: Reads the input grid from STDIN if a filename isn't given
+# REQUIREMENTS: None, just perl!
+#        NOTES: The solver is a bit naive and will only find unique solutions
+#       AUTHOR: Pete Houston (pete), cpan@openstrike.co.uk
+# ORGANIZATION: Openstrike
+#      VERSION: 1.0
+#      CREATED: 11/11/20
+#===============================================================================
+
+use strict;
+use warnings;
+
+my $grid = load_grid ($ARGV[0]);
+solve ($grid);
+output ($grid);
+
+sub load_grid {
+	my $fh = \*STDIN;
+	if (defined $_[0]) {
+		open $fh, '<', $_[0] or die "Cannot open $_[0]: $!";
+	}
+
+	my @input;
+	while (my $line = <$fh>) {
+		$line =~ s/_/0/g;
+		my @digits = ($line =~ /([0-9])/g);
+		next unless $#digits == 8;
+		push @input, \@digits;
+	}
+	die "Only " . scalar @input . " lines successfully read" unless
+		$#input == 8;
+	return \@input;
+}
+
+sub solve {
+	my $grid = shift;
+	my $missing = 81;
+	while ($missing) {
+		for my $row (0 .. 8) {
+			my @missing_ids = grep { $grid->[$row][$_] < 1 } (0 .. 8);
+			for my $id (@missing_ids) {
+				find_one ($grid, $row, $id);
+			}
+		}
+		my $oldmissing = $missing;
+		$missing = grep { $_ < 1 } map { @$_ } @$grid;
+		die "Cannot be solved\n" if $missing == $oldmissing;
+	}
+}
+
+sub find_one {
+	my ($grid, $row, $col) = @_;
+	my %poss = map { $_ => 1 } 1 .. 9;
+
+	# Row
+	delete $poss{$_} for grep { $_ } @{$grid->[$row]}[0 .. 8];
+
+	# Column
+	for my $j (0 .. 8) {
+		my $n = $grid->[$j][$col];
+		delete $poss{$n} if $n;
+	}
+
+	# Square
+	my $y = int ($row / 3) * 3;
+	my $x = int ($col / 3) * 3;
+	for my $j ($y .. $y + 2) {
+		for my $i ($x .. $x + 2) {
+			my $n = $grid->[$j][$i];
+			delete $poss{$n} if $n;
+		}
+	}
+	my @possibles = keys %poss;
+	die "No options left for $row, $col\n" if 1 > @possibles;
+	if (2 > @possibles) {
+		($grid->[$row][$col]) = $possibles[0];
+		return;
+	}
+}
+
+sub output {
+	my $grid = shift;
+	for my $row (0 .. 8) {
+		print "@{$grid->[$row]}\n";
+	}
+}
diff --git a/challenge-086/pjdurai/raku/ch-1.p6 b/challenge-086/pjdurai/raku/ch-1.p6
new file mode 100644
index 0000000000..589694ef63
--- /dev/null
+++ b/challenge-086/pjdurai/raku/ch-1.p6
@@ -0,0 +1,14 @@
+use Test;
+
+sub solve(@N, $A){
+    for @N.combinations: 2 -> @pair {
+        return 1 if abs(@pair[0] - @pair[1]) == $A
+    }
+    return 0;
+}
+
+multi MAIN(){
+    ok solve((1, 5, 2, 9, 7), 6) == 1, "(1, 5, 2, 9, 7), 6) -> 1";
+    ok solve((10, 8, 12, 15, 5), 7 ) == 1, "(10, 8, 12, 15, 5), 7 ) -> 1";
+    ok solve((10, 30, 20, 50, 40), 15) == 0, "(10, 30, 20, 50, 40), 15) -> 0 ";
+}