diff options
| -rw-r--r-- | challenge-085/dave-jacoby/perl/ch-1.pl | 51 | ||||
| -rw-r--r-- | challenge-085/dave-jacoby/perl/ch-2.pl | 25 | ||||
| -rw-r--r-- | challenge-086/dave-jacoby/perl/ch-1.pl | 23 | ||||
| -rw-r--r-- | challenge-086/dave-jacoby/perl/ch-2.pl | 125 |
4 files changed, 224 insertions, 0 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-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 ''; +} + |