diff options
| -rw-r--r-- | challenge-152/dave-jacoby/blog1.txt | 1 | ||||
| -rw-r--r-- | challenge-152/dave-jacoby/blog2.txt | 1 | ||||
| -rw-r--r-- | challenge-152/dave-jacoby/perl/ch-1.pl | 69 | ||||
| -rw-r--r-- | challenge-152/dave-jacoby/perl/ch-2.pl | 167 |
4 files changed, 238 insertions, 0 deletions
diff --git a/challenge-152/dave-jacoby/blog1.txt b/challenge-152/dave-jacoby/blog1.txt new file mode 100644 index 0000000000..5be5dd4d14 --- /dev/null +++ b/challenge-152/dave-jacoby/blog1.txt @@ -0,0 +1 @@ +https://jacoby.github.io/2022/02/15/functional-paths-weekly-challenge-152.html
\ No newline at end of file diff --git a/challenge-152/dave-jacoby/blog2.txt b/challenge-152/dave-jacoby/blog2.txt new file mode 100644 index 0000000000..f8dd4f91e4 --- /dev/null +++ b/challenge-152/dave-jacoby/blog2.txt @@ -0,0 +1 @@ +https://jacoby.github.io/2022/02/16/think-inside-the-box-weekly-challenge-152-pt-2.html
\ No newline at end of file diff --git a/challenge-152/dave-jacoby/perl/ch-1.pl b/challenge-152/dave-jacoby/perl/ch-1.pl new file mode 100644 index 0000000000..9ae0796fe6 --- /dev/null +++ b/challenge-152/dave-jacoby/perl/ch-1.pl @@ -0,0 +1,69 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature qw{ say postderef signatures state }; +no warnings qw{ experimental }; + +use List::Util qw{ min sum }; + +# This is inspired by a reading of the problem +# from Adam Russell, who notes that there's no +# direct down-left or down-right between 3 on +# the second level and 2 on the third in this +# triangle: +# +# 1 +# 5 3 +# 2 3 4 +# 7 1 0 2 +# 6 4 5 2 8 +# +# A similar problem occurs with the 0 on the +# fourth row of the second example: +# +# 5 +# 2 3 +# 4 1 5 +# 0 1 2 3 +# 7 2 4 1 9 +# +# If the problem requires a solution that's less +# using List::Util and more actual tree structures, +# that solution will be forthcoming. + +my @examples; +push @examples, '$triangle=[ [1], [5,3], [2,3,4], [7,1,0,2], [6,4,5,2,8] ]'; +push @examples, '$triangle=[ [5], [2,3], [4,1,5], [0,1,2,3], [7,2,4,1,9] ]'; + +for my $e (@examples) { + my $triangle; + eval($e); + + # let's do this the functional way? + my $path = join ' + ', map { min $_->@* } $triangle->@*; + my $sum = sum map { min $_->@* } $triangle->@*; + + my $tree = make_tree($triangle); + say <<"END"; + Input: $e + Output: $sum + Minimum Sum Path = $path => $sum +$tree +END +} + +sub make_tree ( $src ) { + my $output = ''; + my $n = 10; + my $i = 0; + while ( $src->[$i] ) { + my $line = join ' ', $src->[$i]->@*; + $output .= "\n"; + $output .= ' ' x ( $n - $i ); + $output .= $line; + $i++; + } + + return $output; +} diff --git a/challenge-152/dave-jacoby/perl/ch-2.pl b/challenge-152/dave-jacoby/perl/ch-2.pl new file mode 100644 index 0000000000..d980facf24 --- /dev/null +++ b/challenge-152/dave-jacoby/perl/ch-2.pl @@ -0,0 +1,167 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature qw{ say postderef signatures state }; +no warnings qw{ experimental }; + +use List::Util qw{ min max sum }; + +my @examples; +push @examples, [ [ [ -1, 0 ], [ 2, 2 ] ], [ [ 0, -1 ], [ 4, 4 ] ] ]; +push @examples, [ [ [ -3, -1 ], [ 1, 3 ] ], [ [ -1, -3 ], [ 2, 2 ] ] ]; +push @examples, [ [ [ 0, 0 ], [ 1, 1 ] ], [ [ 2, 2 ], [ 3, 3 ] ] ]; +push @examples, [ [ [ 0, 0 ], [ 1, 1 ] ], [ [ 1, 1 ], [ 3, 3 ] ] ]; +push @examples, [ [ [ 0, 1 ], [ 5, 2 ] ], [ [ 2, 0 ], [ 4, 4 ] ] ]; + +for my $e (@examples) { + my $area = find_area( $e->[0], $e->[1] ); + say <<"END"; + Input: Rectangle 1 => ($e->[0][0][0],$e->[0][0][1]), ($e->[0][1][0],$e->[0][1][1]) + Rectangle 2 => ($e->[1][0][0],$e->[1][0][1]), ($e->[1][1][0],$e->[1][1][1]) + Output: $area +END +} + +sub find_area ( @r ) { + my @ro = map { make_rectangle($_) } @r; + my $overlap = has_overlap(@ro); + my $area = 0; + + if ($overlap) { + my $overlap = find_overlap(@r); + $area = sum map { area($_) } @ro; + $area -= area($overlap); + } + else { + $area = sum map { area($_) } @ro; + } + return $area; +} + +sub area ( $r ) { + my $minx = min map { $_->[0] } $r->@*; + my $maxx = max map { $_->[0] } $r->@*; + my $miny = min map { $_->[1] } $r->@*; + my $maxy = max map { $_->[1] } $r->@*; + my $x = $maxx - $minx; + my $y = $maxy - $miny; + return $x * $y; +} + +sub find_overlap ( $r1, $r2 ) { + my $maxx1 = max map { $_->[0] } $r1->@*; + my $maxx2 = max map { $_->[0] } $r2->@*; + + my $maxy1 = max map { $_->[1] } $r1->@*; + my $maxy2 = max map { $_->[1] } $r2->@*; + + my $minx1 = min map { $_->[0] } $r1->@*; + my $minx2 = min map { $_->[0] } $r2->@*; + + my $miny1 = min map { $_->[1] } $r1->@*; + my $miny2 = min map { $_->[1] } $r2->@*; + + my $minx = max( $minx1, $minx2 ); + my $miny = max( $miny1, $miny2 ); + my $maxx = min( $maxx1, $maxx2 ); + my $maxy = min( $maxy1, $maxy2 ); + + return [ [ $minx, $miny ], [ $maxx, $maxy ] ]; +} + +sub has_overlap ( $r1, $r2 ) { + my $maxx1 = max map { $_->[0] } $r1->@*; + my $maxx2 = max map { $_->[0] } $r2->@*; + + my $maxy1 = max map { $_->[1] } $r1->@*; + my $maxy2 = max map { $_->[1] } $r2->@*; + + my $minx1 = min map { $_->[0] } $r1->@*; + my $minx2 = min map { $_->[0] } $r2->@*; + + my $miny1 = min map { $_->[1] } $r1->@*; + my $miny2 = min map { $_->[1] } $r2->@*; + + return max( $minx1, $minx2 ) < min( $maxx1, $maxx2 ) + && max( $miny1, $miny2 ) < min( $maxy1, $maxy2 ) ? 1 : 0; +} + +sub within ( $r1, $r2 ) { + my $within = 0; + my $minx = min map { $_->[0] } $r1->@*; + my $maxx = max map { $_->[0] } $r1->@*; + my $miny = min map { $_->[1] } $r1->@*; + my $maxy = max map { $_->[1] } $r1->@*; + for my $p ( $r2->@* ) { + my $x = $p->[0]; + my $y = $p->[1]; + if ( $x < $maxx + && $x > $minx + && $y < $maxy + && $y > $miny ) + { + $within++; + } + } + return $within; +} + +sub make_rectangle ( $r ) { + my @points; + my @x = map { $_->[0] } $r->@*; + my @y = map { $_->[1] } $r->@*; + for my $x (@x) { + for my $y (@y) { + push @points, [ $x, $y ]; + } + } + return \@points; +} + +sub draw_rectangles( @r ) { + my @x = map { $_->[0] } map { $_->@* } @r; + my @y = map { $_->[1] } map { $_->@* } @r; + + my $minx = min(@x); + my $maxx = max(@x); + my $miny = min(@y); + my $maxy = max(@y); + + my @xr = $minx - 1 .. $maxx + 1; + my @yr = reverse $miny - 1 .. $maxy + 1; + + my @r2; + for my $r (@r) { + my $rec; + my @x = map { $_->[0] } $r->@*; + my @y = map { $_->[1] } $r->@*; + for my $x (@x) { + for my $y (@y) { push $rec->@*, [ $x, $y ]; } + push @r2, $rec; + } + } + + my @graph; + for my $y (@yr) { + my $row = []; + for my $x (@xr) { + my $s = ' '; + $s = '.' if $x == 0; + $s = '.' if $y == 0; + $s = '+' if $x == 0 && $y == 0; + my $pp = 0; + for my $r (@r2) { + $pp++; + for my $p ( $r->@* ) { + if ( $p->[0] == $x ) { + if ( $p->[1] == $y ) { $s = $pp; } + } + } + } + push $row->@*, $s; + } + push @graph, $row; + } + say join "\n", '', ( map { join ' ', $_->@* } @graph ), ''; +} |