diff options
Diffstat (limited to 'challenge-088')
58 files changed, 2046 insertions, 18 deletions
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)[($direction + 1) % 2]; + ++$direction; + $direction %= 4; + $did_turn = 1; + + } else { + undef $did_turn; + push @list, $m[$y = $y2][$x = $x2]; + } + } + return \@list +} + +use Test::More; + +is_deeply spiral_matrix( + [1, 2, 3], + [4, 5, 6], + [7, 8, 9] +), [1, 2, 3, 6, 9, 8, 7, 4, 5], 'Example 1'; + +is_deeply spiral_matrix( + [ 1, 2, 3, 4], + [ 5, 6, 7, 8], + [ 9, 10, 11, 12], + [13, 14, 15, 16] +), [1, 2, 3, 4, 8, 12, 16, 15, 14, 13, 9, 5, 6, 7, 11, 10], 'Example 2'; + +is_deeply spiral_matrix( + [ 1, 2, 3, 4, 5], + [12, 13, 14, 15, 6], + [11, 10, 9, 8, 7] +), [1 .. 15], 'm != n'; + +is_deeply spiral_matrix([1]), [1], 'minimal'; +is_deeply spiral_matrix([1], [2]), [1, 2], 'two lines'; +is_deeply spiral_matrix([1, 2], [4, 3]), [1 .. 4], '2x2'; +is_deeply spiral_matrix([1, 2, 3], [8, 9, 4], [7, 6, 5]), [1 .. 9], '3x3'; +is_deeply spiral_matrix([1, 2], [6, 3], [5, 4]), [1 .. 6], 'narrow'; + +is_deeply spiral_matrix( + [ 1, 2, 3, 4, 5, 6], + [20, 21, 22, 23, 24, 7], + [19, 32, 33, 34, 25, 8], + [18, 31, 36, 35, 26, 9], + [17, 30, 29, 28, 27, 10], + [16, 15, 14, 13, 12, 11], +), [1 .. 36], '6x6'; + +is_deeply spiral_matrix( + [ 1, 2, 3, 4, 5, 6, 7, 8, 9], + [36, 37, 38, 39, 40, 41, 42, 43, 10], + [35, 64, 65, 66, 67, 68, 69, 44, 11], + [34, 63, 84, 85, 86, 87, 70, 45, 12], + [33, 62, 83, 96, 97, 88, 71, 46, 13], + [32, 61, 82, 95, 98, 89, 72, 47, 14], + [31, 60, 81, 94, 99, 90, 73, 48, 15], + [30, 59, 80, 93, 92, 91, 74, 49, 16], + [29, 58, 79, 78, 77, 76, 75, 50, 17], + [28, 57, 56, 55, 54, 53, 52, 51, 18], + [27, 26, 25, 24, 23, 22, 21, 20, 19], +), [1 .. 99], '9x11'; + +done_testing(); diff --git a/challenge-088/james-smith/perl/ch-1.pl b/challenge-088/james-smith/perl/ch-1.pl new file mode 100644 index 0000000000..117fff074d --- /dev/null +++ b/challenge-088/james-smith/perl/ch-1.pl @@ -0,0 +1,19 @@ +#!/usr/local/bin/perl + +use strict; + +use warnings; +use feature qw(say); +use Test::More; + +is( "@{[ prod_list( qw(5 2 1 4 3) ) ]}", '24 60 120 30 40' ); +is( "@{[ prod_list( qw(2 1 4 3) ) ]}", '12 24 6 8' ); + +done_testing(); + +sub prod_list { + my $N = 1; + $N *= $_ foreach @_; + return map { $N/$_} @_; +} + diff --git a/challenge-088/james-smith/perl/ch-2.pl b/challenge-088/james-smith/perl/ch-2.pl new file mode 100644 index 0000000000..3ea3d71715 --- /dev/null +++ b/challenge-088/james-smith/perl/ch-2.pl @@ -0,0 +1,25 @@ +#!/usr/local/bin/perl + +use strict; + +use warnings; +use feature qw(say); +use Test::More; + +is( "@{ spiral_matrix([1,2,3],[4,5,6],[7,8,9]) }", '1 2 3 6 9 8 7 4 5' ); +is( "@{ spiral_matrix([1,2,3,4],[5,6,7,8],[9,10,11,12],[13,14,15,16]) }", '1 2 3 4 8 12 16 15 14 13 9 5 6 7 11 10' ); + +done_testing(); + +sub spiral_matrix { + my @rows = @_; + my @res; + while(@rows) { + push @res, @{shift @rows}; + push @res, pop @{$_} foreach grep { @{$_} } @rows; + push @res, reverse @{ pop @rows } if @rows; ## Make sure we have data! + push @res, shift @{$_} foreach grep { @{$_} } reverse @rows; + } + return \@res; +} + diff --git a/challenge-088/mark-anderson/raku/ch-1.p6 b/challenge-088/mark-anderson/raku/ch-1.p6 new file mode 100644 index 0000000000..64036b5b28 --- /dev/null +++ b/challenge-088/mark-anderson/raku/ch-1.p6 @@ -0,0 +1,18 @@ +multi MAIN(*@n where .all ~~ Int) { + say array-of-product(@n).raku; +} + +multi MAIN { + use Test; + plan 2; + + my @n = [5, 2, 1, 4, 3]; + cmp-ok array-of-product(@n), &[eqv], [24, 60, 120, 30, 40], "Example 1"; + + @n = [2, 1, 4, 3]; + cmp-ok array-of-product(@n), &[eqv], [12, 24, 6, 8], "Example 2"; +} + +sub array-of-product(@n) { + @n.keys.map(-> $i { [*] @n[^$i, $i+1..@n.end].flat }).Array; +} diff --git a/challenge-088/mark-anderson/raku/ch-2.p6 b/challenge-088/mark-anderson/raku/ch-2.p6 new file mode 100644 index 0000000000..000716f7a2 --- /dev/null +++ b/challenge-088/mark-anderson/raku/ch-2.p6 @@ -0,0 +1,54 @@ +use Test; +plan 4; + +my @matrix = [ 1, 2, 3 ], + [ 4, 5, 6 ], + [ 7, 8, 9 ]; + +cmp-ok spiral(@matrix), &[eqv], [1, 2, 3, 6, 9, 8, 7, 4, 5], "Example 1"; + +@matrix = [ 1 .. 4 ], + [ 5 .. 8 ], + [ 9 .. 12 ], + [ 13 .. 16 ]; + +cmp-ok spiral(@matrix), &[eqv], + [1, 2, 3, 4, 8, 12, 16, 15, 14, 13, 9, 5, 6, 7, 11, 10], "Example 2"; + +@matrix = [ 1, 2 ], + [ 3, 4 ], + [ 5, 6 ], + [ 7, 8 ]; + +cmp-ok spiral(@matrix), &[eqv], [1, 2, 4, 6, 8, 7, 5, 3], "Rows > Cols"; + +@matrix = [ 1, 2, 3, 4 ], + [ 5, 6, 7, 8 ]; + +cmp-ok spiral(@matrix), &[eqv], [1, 2, 3, 4, 8, 7, 6, 5], "Cols > Rows"; + +sub spiral(@step1) { + my @step2 = ([Z] @step1).reverse; + my @step3 = ([Z] @step2).reverse; + my @step4 = ([Z] @step3).reverse; + my @trips = [Z] @step1, @step2, @step3, @step4; + my $elems = @step1.elems * @step1[0].elems; + my @result; + + for @trips.kv -> $k, @t { + for @t -> @step { + @result.push: @step[$k..*-$k-2]; + } + } + + @result = (@result>>.Array).flat[^$elems]; + + # handle the case when matrix is 3 X 3, 5 X 5, 7 X 7 + # etc. where I can't seem to get the center element :( + unless @result[*-1] { + my $i = @step1 / 2; + @result[*-1] = @step1[$i][$i]; + } + + @result; +} diff --git a/challenge-088/perlboy1967/perl/ch-1.pl b/challenge-088/perlboy1967/perl/ch-1.pl new file mode 100755 index 0000000000..c074ad77b8 --- /dev/null +++ b/challenge-088/perlboy1967/perl/ch-1.pl @@ -0,0 +1,32 @@ +#!/usr/bin/perl |