Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Re: Brute force vs algorithm (PWC # 100)

by johngg (Canon)
on Feb 16, 2021 at 14:11 UTC ( #11128444=note: print w/replies, xml ) Need Help??


in reply to Brute force vs algorithm (PWC # 100)

Project Euler had almost the same task in problems #18 and #67 except they were looking for the "Maximum Sum Path" where, for #67 with a 100 row triangle, brute force was not an option. I've adapted my PE solution for "Minimum" and it does work for the 100 row triangle, although I've removed that from the script for brevity. I used a leading zero with single digit values just so that things lined up nicely. It calculates the sum and path and, for triangles with three or more rows, shows the triangle using Term::ANSIColor to highlight the path.

use strict; use warnings; use 5.014; use Term::ANSIColor qw{ :constants }; open my $inFH, q{<}, \ <<EOD or die $!; 01 02 04 06 04 09 05 01 07 02 EOD =pod 06 ----- 12 03 09 ----- 01 02 04 06 04 09 05 01 07 02 ----- 75 95 64 17 47 82 18 35 87 10 20 04 82 47 65 19 01 23 75 03 34 88 02 77 73 07 63 67 99 65 04 28 06 16 70 92 41 41 26 56 83 40 80 70 33 41 48 72 33 47 32 37 16 94 29 53 71 44 65 25 43 91 52 97 51 14 70 11 33 28 77 73 17 78 39 68 17 57 91 71 52 38 17 14 91 43 58 50 27 29 48 63 66 04 68 89 53 67 30 73 16 69 87 40 31 04 62 98 27 23 09 70 98 73 93 38 53 60 04 23 =cut my @idxLR = ( 0, 0, 1 ); my @pathLR = qw{ L L R }; my @lines; while ( <$inFH> ) { chomp; push @lines, [ map { { val => $_, sum => undef } } split ]; } close $inFH or die $!; if ( scalar @lines == 1 ) { say qq{Minimum path sum is - $lines[ 0 ]->[ 0 ]->{ val }}; say q{ No path}; } elsif ( scalar @lines == 2 ) { my $compIdx = $lines[ 1 ]->[ 1 ]->{ val } <=> $lines[ 1 ]->[ 0 ]->{ val }; say qq{Minimum path sum is - }, $lines[ 0 ]->[ 0 ]->{ val } + $lines[ 1 ]->[ $idxLR[ $compIdx ] ]->{ val }; say qq{ Path is - $pathLR[ $compIdx ]}; } else { do { $_->{ sum } = $_->{ val }; $_->{ path } = []; } for @{ $lines[ -1 ] }; foreach my $lineIdx ( reverse 0 .. $#lines - 1 ) { my $raLine = $lines[ $lineIdx ]; foreach my $itemIdx ( 0 .. $#{ $raLine } ) { my $compIdx = $lines[ $lineIdx + 1 ]->[ $itemIdx + 1 ]->{ sum } <=> $lines[ $lineIdx + 1 ]->[ $itemIdx ]->{ sum }; $raLine->[ $itemIdx ]->{ sum } = $raLine->[ $itemIdx ]->{ val } + $lines[ $lineIdx + 1 ] ->[ $itemIdx + $idxLR[ $compIdx ] ] ->{ sum }; $raLine->[ $itemIdx ]->{ path } = [ $pathLR[ $compIdx ], @{ $lines[ $lineIdx + 1 ] ->[ $itemIdx + $idxLR[ $compIdx ] ] ->{ path } } ]; } } my @pathElems = ( 0 ); push @pathElems, m{L} ? $pathElems[ -1 ] : $pathElems[ -1 ] + 1 for @{ $lines[ 0 ]->[ 0 ]->{ path } };; say qq{Minimum path sum is - $lines[ 0 ]->[ 0 ]->{ sum }}; say q{ Path is - T-}, join q{-}, @{ $lines[ 0 ]->[ 0 ]->{ path } }; say q{ Elements are - }, join q{-}, @pathElems; say q{}; my $nElems = scalar( @lines ) * 2 - 1; my $fmt = q{%2s} x $nElems; $fmt .= qq{\n}; for my $lineIdx ( 0 .. $#lines ) { printf $fmt, ( q{ } ) x ( $#lines - $lineIdx ), sub { my @arr = map { $_ == $pathElems[ $lineIdx ] ? RED . $_[ $_ ] . RESET : $_[ $_ ] } 0 .. $#_; splice @arr, $_, 0, q{ } for reverse 1 .. $#arr; return @arr; }->( map { $_->{ val } } @{ $lines[ $lineIdx ] } ), ( q{ } ) x ( $#lines - $lineIdx ); } }

The output using the OP's data, sadly not showing the highlighted path here.

Minimum path sum is - 8 Path is - T-L-R-L Elements are - 0-0-1-1 01 02 04 06 04 09 05 01 07 02

The algorithm works from the bottom of the triangle up but I wrote the script long enough ago that I'm struggling to work out exactly what I did. I'll keep looking at it and maybe produce a version that does both minimum and maximum paths, moving code into subroutines as appropriate.

Cheers,

JohnGG

Replies are listed 'Best First'.
Re^2: Brute force vs algorithm (PWC # 100)
by LanX (Sage) on Feb 16, 2021 at 16:10 UTC

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11128444]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (1)
As of 2023-01-29 03:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?