diff options
74 files changed, 4196 insertions, 1843 deletions
diff --git a/challenge-086/juliodcs/raku/ch-2.raku b/challenge-086/juliodcs/raku/ch-2.raku index 194eab6a9e..44ac907224 100644 --- a/challenge-086/juliodcs/raku/ch-2.raku +++ b/challenge-086/juliodcs/raku/ch-2.raku @@ -1,9 +1,9 @@ #! /usr/bin/raku
sub solve-sudoku(@sudoku) {
- my @indexes := get-indexes(@sudoku);
+ my @indexes := get-indexes @sudoku;
- my $backtrack = 0;
+ my $backtrack = False;
my $index = 0;
while $index < @indexes.elems {
die 'No solution possible' if $index < 0;
@@ -11,22 +11,11 @@ sub solve-sudoku(@sudoku) { my ($y, $x) = get-position @indexes[$index];
my $guess = make-guess @sudoku, $y, $x, $backtrack;
- if $guess == 0 && !$backtrack {
- # not valid guess, We will try with next guess for same index
- $backtrack = 1;
- }
- elsif $guess == 0 && $backtrack {
- # not valid guess and no more guesses to test
- # We give up with this position (we decrement index)
- @sudoku[$y;$x] = 0;
- $index--;
- }
- else {
- # valid guess (for now), increase index
- @sudoku[$y;$x] = $guess;
- $backtrack = 0;
- $index++;
- }
+ # If there's a guess, We set it and increase the index
+ # if there's no guess, We clean the box and decrement the index
+ @sudoku[$y;$x] = $guess ?? $guess !! 0;
+ $backtrack = not so $guess;
+ $index += $guess ?? 1 !! -1;
}
@sudoku
diff --git a/challenge-087/juliodcs/raku/ch-2.raku b/challenge-087/juliodcs/raku/ch-2.raku index 04e9390855..86e9f9f6cb 100644 --- a/challenge-087/juliodcs/raku/ch-2.raku +++ b/challenge-087/juliodcs/raku/ch-2.raku @@ -16,7 +16,7 @@ sub largest-rectangle-v1($matrix) { my $max-offset = $matrix.split(/\s+/).head.chars.pred; for 0 .. $max-offset -> $offset { my $ones = ''; - for $matrix ~~ m:g/^^ \d**{$offset} (1+) {$ones=$0} (\d*\s+) <?before \d**{$offset} $ones> / { + for $matrix ~~ m:g/^^ \d**{$offset} (1+) {$ones=$0} \d*\s+ <?before \d**{$offset} $ones> / { $max = $_[0].chars if $max < $_[0].chars } } diff --git a/challenge-088/ash/raku/ch-1.raku b/challenge-088/ash/raku/ch-1.raku new file mode 100644 index 0000000000..d070ad47a4 --- /dev/null +++ b/challenge-088/ash/raku/ch-1.raku @@ -0,0 +1,13 @@ +#!/usr/bin/env raku +# +# Task 1 from +# https://perlweeklychallenge.org/blog/perl-weekly-challenge-088/ + +my @n = 5, 2, 1, 4, 3; + +# Output: 24, 60, 120, 30, 40 + +my $prod = [*] @n; +my @r = @n.map: $prod / *; + +put @r.join(', '); diff --git a/challenge-088/dave-jacoby/perl/ch-1.pl b/challenge-088/dave-jacoby/perl/ch-1.pl new file mode 100644 index 0000000000..87e37c0613 --- /dev/null +++ b/challenge-088/dave-jacoby/perl/ch-1.pl @@ -0,0 +1,36 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature qw{ say signatures state }; +no warnings qw{ experimental }; + +use JSON; +use List::Util qw{ product }; + +my $json = JSON->new; +my @examples; +push @examples, [ 5, 2, 1, 4, 3 ]; +push @examples, [ 2, 1, 4, 3 ]; + +if (@ARGV) { + @examples = (); + push @examples, [ map { int $_ } @ARGV ]; +} + +for my $example (@examples) { + my $output->@* = array_of_products($example); + say $json->encode($example); + say $json->encode($output); + say ''; +} + +sub array_of_products( $arrayref ) { + my $end = -1 + scalar $arrayref->@*; + my @output; + for my $i ( 0 .. $end ) { + push @output, + product map { $arrayref->[$_] } grep { $_ != $i } 0 .. $end; + } + return @output; +} diff --git a/challenge-088/dave-jacoby/perl/ch-2.pl b/challenge-088/dave-jacoby/perl/ch-2.pl new file mode 100644 index 0000000000..3eb437f1e2 --- /dev/null +++ b/challenge-088/dave-jacoby/perl/ch-2.pl @@ -0,0 +1,67 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature qw{ say signatures state }; +no warnings qw{ experimental }; + +use JSON; +my $json = JSON->new->space_after; + +my @examples; +push @examples, [ [ 1, 2, 3 ], [ 4, 5, 6 ], [ 7, 8, 9 ], ]; + +push @examples, + [ [ 1, 2, 3, 4 ], [ 5, 6, 7, 8 ], [ 9, 10, 11, 12 ], + [ 13, 14, 15, 16 ], ]; + +for my $example (@examples) { + my $out->@* = spiral_matrix($example); + say $json->encode($out); + say ''; +} + +sub spiral_matrix( $example ) { + my @output; + my $mask = []; + for my $row ( $example->@* ) { + push $mask->@*, [ map { 0 } $row->@* ]; + } + my $i = 0; + my $x = 0; + my $y = 0; + my @move; + push @move, sub { $y++ }; + push @move, sub { $x++ }; + push @move, sub { $y-- }; + push @move, sub { $x-- }; + my @back; + push @back, sub { $y-- }; + push @back, sub { $x-- }; + push @back, sub { $y++ }; + push @back, sub { $x++ }; + + while (1) { + push @output, $example->[$x][$y]; + $mask->[$x][$y] = 1; + my $m = $json->encode($mask); + my $s = $m =~ /0/ ? 1 : 0; + last unless $s; + $move[$i]->(); + if ( !$example->[$x][$y] || $mask->[$x][$y] ) { + $back[$i]->(); + $i = ( $i + 1 ) % 4; + $move[$i]->(); + } + } + return @output; +} + +sub check_mask( $mask ) { + for my $i ( $mask->@* ) { + my @z = grep { /0/ } $i->@*; + return 0 unless scalar @z; + } + return 1; +} + diff --git a/challenge-088/duane-powell/perl/ch-1.pl b/challenge-088/duane-powell/perl/ch-1.pl new file mode 100644 index 0000000000..3ac1fa776d --- /dev/null +++ b/challenge-088/duane-powell/perl/ch-1.pl @@ -0,0 +1,69 @@ +#!/usr/bin/perl +use warnings; +use strict; +use feature 'say'; + +# Problem: https://perlweeklychallenge.org/blog/perl-weekly-challenge-088/ TASK #1 +# You are given an array of positive integers @N. +# Write a script to return an array @M where $M[i] is the product of all elements of @N except the index $N[i]. + +my @N = @ARGV; + +my @M; +my $i = 0; +foreach ( @N ) { + my @temp = @N; + splice @temp, $i, 1; + push @M, \@temp; + $i++; +} + +my @total; +foreach my $array_ref ( @M ) { + my $total = 1; + $total *= $_ foreach (@{$array_ref}); + push @total, $total; +} + +my $out; +say "Input:"; +$out = join(', ',@N); +say "\t\@N = ($out)"; + +say "Output:"; +$out = join(', ',@total); +say "\t\@M = ($out)\n"; + +$i = 0; +foreach my $array_ref ( @M ) { + $out = "\t\$M[$i] = " . join(' x ', @{$array_ref}) . " = " . $total[$i]; + say $out; + $i++; +} + + +__END__ + +./ch-1.pl 5 2 1 4 3 +Input: + @N = (5, 2, 1, 4, 3) +Output: + @M = (24, 60, 120, 30, 40) + + $M[0] = 2 x 1 x 4 x 3 = 24 + $M[1] = 5 x 1 x 4 x 3 = 60 + $M[2] = 5 x 2 x 4 x 3 = 120 + $M[3] = 5 x 2 x 1 x 3 = 30 + $M[4] = 5 x 2 x 1 x 4 = 40 + + +./ch-1.pl 2 1 4 3 +Input: + @N = (2, 1, 4, 3) +Output: + @M = (12, 24, 6, 8) + + $M[0] = 1 x 4 x 3 = 12 + $M[1] = 2 x 4 x 3 = 24 + $M[2] = 2 x 1 x 3 = 6 + $M[3] = 2 x 1 x 4 = 8 diff --git a/challenge-088/duane-powell/perl/ch-2.pl b/challenge-088/duane-powell/perl/ch-2.pl new file mode 100644 index 0000000000..6e9f9229ea --- /dev/null +++ b/challenge-088/duane-powell/perl/ch-2.pl @@ -0,0 +1,215 @@ +#!/usr/bin/perl +use warnings; +use strict; +use feature 'say'; + +=pod + +=head1 DESCRIPTION + + Problem: https://perlweeklychallenge.org/blog/perl-weekly-challenge-088/ TASK #2 + You are given m x n matrix of positive integers. + Write a script to print spiral matrix as list. + + The verts in our rectangle will be represented as posiitve (x,y) coordinates. + (a,b) = lower left and (c,d) = upper right + + | (c,d) = (m-1,n-1) + | + | + | + | (a,b) = (0,0) + + Initially (a,b) = (0,0) and (c,d) = the user supplied (m-1,n-1) +=cut + +# user supplied dimensions +my ($m, $n) = @ARGV; + +# Default to 6 x 6 matrix if dimension not supplied +# We are zero indexed, so deduct 1 from matrix dimensions +$m ||= 6; $m--; +$n ||= 6; $n--; + +sub matrix_init { + my $value = shift; # init a matrix of size (c,d) and set values to $value or random + my ($c, $d) = @_; + + my $matrix_ref = []; + for my $y (0 .. $d) { + for my $x (0 .. $c) { + $matrix_ref->[$y][$x] = ($value eq 'rand') ? int(rand(99)) + 1 : $value; + } + } + return $matrix_ref; +} +sub matrix_print { + my $matrix = shift; + + # determine dimensions of this matrix + my ($a, $b, $c, $d) = (0, 0, scalar( @{$matrix} )-1, scalar( @{$matrix->[0]} )-1); + + my $out; # output string + my @y = reverse ($b .. $d); + for my $y (@y) { + $out .= "\t[ "; + foreach my $x ($a .. $c) { + my $o = $matrix->[$y][$x] . ", "; + $o = ' ' x ( 4 - length( $o ) ) . $o; + $out .= $o; + } + $out .= "]\n"; + } + say $out; +} +sub matrix_get { + my $matrix_id = shift || 1; + + # a utility sub so we can cut and paste interesting matrices + my $mat; + if ($matrix_id == 1) { + $mat = <<'EOF_MATRIX'; +[ 1, 2, 3 ] +[ 4, 5, 6 ] +[ 7, 8, 9 ] +EOF_MATRIX + } + if ($matrix_id == 2) { + $mat = <<'EOF_MATRIX'; +[ 1, 2, 3, 4 ] +[ 5, 6, 7, 8 ] +[ 9, 10, 11, 12 ] +[ 13, 14, 15, 16 ] +EOF_MATRIX + } + if ($matrix_id == 3) { + $mat = <<'EOF_MATRIX'; +[ P, E, R, L ] +[ E, D, A, R ] +[ H, !, Y, U ] +[ T, S, E, L ] +EOF_MATRIX + } + my $matrix_ref = []; + $mat =~ s/\[//g; + $mat =~ s/\]//g; + $mat =~ s/ //g; + my @rows = (split(/\n/,$mat)); + foreach (@rows) { + my @cols = (split(/,/, $_)); + unshift @{$matrix_ref}, [@cols]; + } + return $matrix_ref; +} +sub matrix_spiral { + my $matrix = shift; + + # Spiral around the matrix by traversing: east, south, west and then north. + # We will contract the bounding box when we turn north. + # Determine dimensions of this matrix and its bounding box. + my ($a, $b, $c, $d) = (0, 0, scalar( @{$matrix} )-1, scalar( @{$matrix->[0]} )-1); + + my $out; # printed output + my $element_max = ($c + 1) * ($d + 1); # total possible element of the spiral + my $element_count = 0; + + # (x,y) are the current element. + # Start traversing from just outside the matrix at north-west corner (-1, d+1) + my ($x, $y) = (-1, $d+1); + LAST: while (1) { + # traverse east + ($x, $y) = ($x+1, $y-1); # (x,y) = (0,d) if this is the very first element + while ($x <= $c) { + $out .= $matrix->[$y][$x] . ","; + last LAST if (++$element_count == $element_max); + $x++; + } + # traverse south + ($x, $y) = ($c, $y-1); + while ($y >= $b) { + $out .= $matrix->[$y][$x] . ","; + last LAST if (++$element_count == $element_max); + $y--; + } + # traverse west + ($x, $y) = ($x-1, $y+1); + while ($x >= $a) { + $out .= $matrix->[$y][$x] . ","; + last LAST if (++$element_count == $element_max); + $x--; + } + + # tighten the spiral's bounding box + $a++; $b++, $c--; $d--; + + # traverse north + ($x, $y) = ($x+1, $y+1); + while ($y <= $d) { + $out .= $matrix->[$y][$x] . ","; + last LAST if (++$element_count == $element_max); + $y++; + } + } + $out = join(', ',split(/,/,$out)); + say "\t[$out]"; +} + +my $matrix; +foreach (1 .. 3) { + $matrix = matrix_get($_); + say "\n\nInput:"; + matrix_print($matrix); + say "Output:"; + matrix_spiral($matrix); +} + +$matrix = matrix_init('rand', $m, $n); + say "\n\nInput:"; + matrix_print($matrix); + say "Output:"; + matrix_spiral($matrix); + +__END__ + +./ch-2.pl + + +Input: + [ 1, 2, 3, ] + [ 4, 5, 6, ] + [ 7, 8, 9, ] + +Output: + [1, 2, 3, 6, 9, 8, 7, 4, 5] + + +Input: + [ 1, 2, 3, 4, ] + [ 5, 6, 7, 8, ] + [ 9, 10, 11, 12, ] + [ 13, 14, 15, 16, ] + +Output: + [1, 2, 3, 4, 8, 12, 16, 15, 14, 13, 9, 5, 6, 7, 11, 10] + + +Input: + [ P, E, R, L, ] + [ E, D, A, R, ] + [ H, !, Y, U, ] + [ T, S, E, L, ] + +Output: + [P, E, R, L, R, U, L, E, S, T, H, E, D, A, Y, !] + + +Input: + [ 91, 3, 38, 80, 14, 58, ] + [ 96, 78, 18, 87, 64, 85, ] + [ 88, 50, 61, 59, 67, 89, ] + [ 16, 46, 34, 1, 77, 80, ] + [ 6, 14, 82, 71, 73, 3, ] + [ 10, 75, 60, 81, 78, 52, ] + +Output: + [91, 3, 38, 80, 14, 58, 85, 89, 80, 3, 52, 78, 81, 60, 75, 10, 6, 16, 88, 96, 78, 18, 87, 64, 67, 77, 73, 71, 82, 14, 46, 50, 61, 59, 1, 34] diff --git a/challenge-088/e-choroba/perl/ch-1.pl b/challenge-088/e-choroba/perl/ch-1.pl new file mode 100755 index 0000000000..75cbd39967 --- /dev/null +++ b/challenge-088/e-choroba/perl/ch-1.pl @@ -0,0 +1,17 @@ +#!/usr/bin/perl +use warnings; +use strict; + +use List::Util qw{ product }; + +sub array_of_product { + my (@n) = @_; + return [map { local $n[$_] = 1; product(@n) } 0 .. $#n] +} + +use Test::More tests => 3; + +is_deeply array_of_product(5, 2, 1, 4, 3), [24, 60, 120, 30, 40], 'Example 1'; +is_deeply array_of_product(2, 1, 4, 3), [12, 24, 6, 8], 'Example 2'; + +is_deeply array_of_product(1, 2, 3, 0), [0, 0, 0, 6], 'Zero'; diff --git a/challenge-088/e-choroba/perl/ch-2.pl b/challenge-088/e-choroba/perl/ch-2.pl new file mode 100755 index 0000000000..6dfe414659 --- /dev/null +++ b/challenge-088/e-choroba/perl/ch-2.pl @@ -0,0 +1,85 @@ +#!/usr/bin/perl +use warnings; +use strict; + +my @DIRECTIONS = ([1, 0], [0, 1], [-1, 0], [0, -1]); +sub spiral_matrix { + my @m = @_; + + my @list; + my ($x, $y) = (-1, 0); + my $direction = 0; + my @border = (scalar @{ $m[0] }, scalar @m, -1, -1); + my $did_turn; + while (1) { + my ($x2, $y2) = ($x + $DIRECTIONS[$direction][0], + $y + $DIRECTIONS[$direction][1]); + if ( $x2 == $border[0] || $x2 == $border[2] + || $y2 == $border[1] || $y2 == $border[3] + ) { + last if $did_turn; + + $border[($direction + 3) % 4] = ($x, $y |