From 0fb63a08b1a38243ba113aeb760f6130376cd069 Mon Sep 17 00:00:00 2001 From: Shawn Wagner Date: Mon, 9 Nov 2020 03:34:39 -0800 Subject: Challenge 086, both parts in perl --- challenge-086/shawn-wagner/perl/ch-1.pl | 26 ++++++ challenge-086/shawn-wagner/perl/ch-2.pl | 145 ++++++++++++++++++++++++++++++++ 2 files changed, 171 insertions(+) create mode 100755 challenge-086/shawn-wagner/perl/ch-1.pl create mode 100755 challenge-086/shawn-wagner/perl/ch-2.pl diff --git a/challenge-086/shawn-wagner/perl/ch-1.pl b/challenge-086/shawn-wagner/perl/ch-1.pl new file mode 100755 index 0000000000..2979ddf210 --- /dev/null +++ b/challenge-086/shawn-wagner/perl/ch-1.pl @@ -0,0 +1,26 @@ +#!/usr/bin/env perl +use warnings; +use strict; +use feature qw/say/; + +sub task1 :prototype(\@$) { + my ($N, $A) = @_; + my $len = @$N; + for (my $m = 0; $m < $len; $m += 1) { + for (my $n = 0; $n < $len; $n += 1) { + next if $m == $n; + if ($N->[$m] - $N->[$n] == $A) { + say "1 as $N->[$m] - $N->[$n] = $A"; + return; + } + } + } + say 0; +} + +my @N = (10, 8, 12, 15, 5); +task1 @N, 7; +@N = (1, 5, 2, 9, 7); +task1 @N, 6; +@N = (10, 30, 20, 50, 40); +task1 @N, 15; diff --git a/challenge-086/shawn-wagner/perl/ch-2.pl b/challenge-086/shawn-wagner/perl/ch-2.pl new file mode 100755 index 0000000000..97b62c8368 --- /dev/null +++ b/challenge-086/shawn-wagner/perl/ch-2.pl @@ -0,0 +1,145 @@ +#!/usr/bin/env perl +use warnings; +use strict; +use feature qw/say/; +use experimental qw/postderef/; + +sub read_board { + my $fh = shift; + my @board; + while (<$fh>) { + s/^\[\s*|\s*\]$//g; + push @board, [ map { $_ eq "_" ? undef : $_ } split ]; + } + return @board; +} + +sub print_board { + for my $row (@_) { + print '[ '; + printf "%s ", $_ // '_' for @$row; + print "]\n"; + } +} + +sub valid_row { + my %nums; + for my $cell ($_[0]->@*) { + if (defined $cell && ++$nums{$cell} > 1) { + return 0; + } + } + return 1; +} + +sub valid_column :prototype(\@$) { + my %nums; + my ($board, $col) = @_; + for my $row (0 .. 8) { + if (defined $board->[$row][$col] && ++$nums{$board->[$row][$col]} > 1) { + return 0; + } + } + return 1; +} + +my @quadrants = + ( + [[0, 0], [0, 1], [0, 2], [1, 0], [1, 1], [1, 2], [2, 0], [2, 1], [2, 2]], + [[0, 3], [0, 4], [0, 5], [1, 3], [1, 4], [1, 5], [2, 3], [2, 4], [2, 5]], + [[0, 6], [0, 7], [0, 8], [1, 6], [1, 7], [1, 8], [2, 6], [2, 7], [2, 8]], + + [[3, 0], [3, 1], [3, 2], [4, 0], [4, 1], [4, 2], [5, 0], [5, 1], [5, 2]], + [[3, 3], [3, 4], [3, 5], [4, 3], [4, 4], [4, 5], [5, 3], [5, 4], [5, 5]], + [[3, 6], [3, 7], [3, 8], [4, 6], [4, 7], [4, 8], [5, 6], [5, 7], [5, 8]], + + [[6, 0], [6, 1], [6, 2], [7, 0], [7, 1], [7, 2], [8, 0], [8, 1], [8, 2]], + [[6, 3], [6, 4], [6, 5], [7, 3], [7, 4], [7, 5], [8, 3], [8, 4], [8, 5]], + [[6, 6], [6, 7], [6, 8], [7, 6], [7, 7], [7, 8], [8, 6], [8, 7], [8, 8]] +); + +sub valid_quadrant :prototype(\@$) { + my %nums; + my ($board, $coords) = @_; + for my $cell (@$coords) { + my ($row, $col) = @$cell; + if (defined $board->[$row][$col] && ++$nums{$board->[$row][$col]} > 1) { + return 0; + } + } + return 1; +} + +sub valid_board :prototype(\@) { + my $board = shift; + for my $row (@$board) { + return 0 unless valid_row $row; + } + for my $col (0 .. 8) { + return 0 unless valid_column @$board, $col; + } + for my $quad (@quadrants) { + return 0 unless valid_quadrant @$board, $quad; + } + return 1; +} + +sub all_filled :prototype(\@) { + my $board = shift; + for my $row (@$board) { + for my $cell (@$row) { + return 0 unless defined $cell; + } + } + return 1; +} + +sub solve_board { + my $board = shift; + + for my $row (0 .. 8) { + for my $col (0 .. 8) { + if (!defined $board->[$row][$col]) { + for my $num (1 .. 9) { + my $copy = [ @$board ]; + $copy->[$row] = [ $copy->[$row]->@* ]; + $copy->[$row][$col] = $num; + next unless valid_board @$copy; + return $copy if all_filled @$copy; + $copy = solve_board($copy); + return $copy if defined $copy; + } + return undef; + } + } + } + if (valid_board @$board && all_filled @$board) { + return $board; + } else { + return undef; + } +} + +sub task2 { + my $fh = shift; + my @board = read_board $fh; + my $solved = solve_board \@board; + if (defined $solved) { + print_board @$solved; + } else { + say "No solution found."; + } +} + +task2 \*DATA; + +__DATA__ +[ _ _ _ 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 _ _ _ ] -- cgit From 434f0f0dd0259e347fa5b930c557d69404dc491b Mon Sep 17 00:00:00 2001 From: Shawn Wagner Date: Sat, 14 Nov 2020 23:28:11 -0800 Subject: Challenge 086, part 1 solution in tcl --- challenge-086/shawn-wagner/tcl/ch-1.tcl | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) create mode 100755 challenge-086/shawn-wagner/tcl/ch-1.tcl diff --git a/challenge-086/shawn-wagner/tcl/ch-1.tcl b/challenge-086/shawn-wagner/tcl/ch-1.tcl new file mode 100755 index 0000000000..43c6ab5ea1 --- /dev/null +++ b/challenge-086/shawn-wagner/tcl/ch-1.tcl @@ -0,0 +1,30 @@ +#!/usr/bin/env tclsh +package require generator ;# From tcllib + +generator define genpairs {list} { + for {set m 0} {$m < [llength $list]} {incr m} { + for {set n 0} {$n < [llength $list]} {incr n} { + if {$m != $n} { + generator yield [::list [lindex $list $m] [lindex $list $n]] + } + } + } +} + +proc diffne {total pair} { + lassign $pair a b + expr {$a - $b != $total} +} + +proc task1 {N A} { + generator foreach match [generator dropWhile [list diffne $A] [genpairs $N]] { + lassign $match a b + puts "1 as $a - $b = $A" + return + } + puts 0 +} + +task1 {10 8 12 15 5} 7 +task1 {1 5 2 9 7} 6 +task1 {10 30 20 50 40} 15 -- cgit