in reply to Re: compute paths in Pascal's triangle (aka Tartaglia's one)
in thread compute paths in Pascal's triangle (aka Tartaglia's one)

..no one! infact the winner is whoever profited this thread, being me the first one.

I got back many interesting replies. For sure I was not there when recursive thinking was ditributed: infact I had a lot of trouble understanding your solutions, oh wise monks.

LanX: thanks! you was the first giving a working solution and also some variations around it. They are also almost easy to understand as, you said, you proceded by baby steps. Anyway, if I'm permitted, I find your approach convoluted: your sub needed the top tile to passed in and goal's coordinates are external global variables. I tried to use your solution in my program but, I must admit, I discarded it soon. You are a genial problem solver but I do not want to be the man who has to debug your code ;=)

hdb: I never had a doubt about you. Your is a scientific approach, where the use of Algorithm::Permute gives an idea of your stence to the problem, is clean and effective. I will not use your function just for the mere (somehow idiotic) motivation that I do not want to add a dependency to my program. I'd like to see your code explained by you. The only remark I can do to your code is that the plural form of path is paths and not pathes.. paté? ;=) I plan to use your spoken prove of the property in the help text of my project.

VinsWorldcom what to say? Intelligence is using his own schemas to understand the reality. You are using nowadays the Graph module and you immediately perceived a possibility to use it to solve my question. TIMTOWTDI

vr: thanks to you too; an iterative solution! I forgot to mention that I was not there also when iterative intelligence was distributed.. You were there, obviously.

roboticus: you built not only the answer but the entire frame where the problem lies: a package with six methods draw the whole context. Your code is easy to read and to expand. Thanks!

oiskuu you was the first to address me to a correct solution in the CB: your scientific approach using Algorithm::Combinatorics is what I suspected for the first moment it had to exists. Unfurtunately I have not a mind to imagine nor implement it

tybalt89 you are born in a golf field? your solutions are sharpened as a razor: clean and straight to the goal. As Eily anticipated in the chatter box, one good option is to recurse upward. You get involved in this fun little problem as you said and you produced this:

sub up { my ($row, $col) = split /-/, $_[0]; return $_[0] eq '0-0' ? "@_\n" : ($row * $col > 0 && up( ~-$row . '-' . ~-$col, @_ ) ) . ($row > $col && up( ~-$row . '-' . $col, @_ ) ); }

Apart for the cleverness of the overall structure, you recurse if $row * $col > 0 and if $row > $col can you explain why? I suppose you are checking you are still within the boudaries of the triangle. Right?

Anyway I tried to analize your code, just as a medieval jewish doctor dissecting a corpse watching what passed, and I arrived to:

sub up{ # indent to evidentiate the recursive function level # using the last index of the arguments array my $ind = ' ' x $#_ x 4; print $ind."\@_ = [@_]\n"; my ($row, $col) = split /-/, $_[0]; # if the first argument is 0-0 we are arrived to # the upper edge: time to return the result if ($_[0] eq '0-0'){ print $ind."RETURNING: \@_ is a valid path [@_]\n"; return "@_\n" } else{ # check A if ($row * $col > 0){ # show what happens if check A pass print $ind."$row * $col > 0 ". "&& up(",$row-1,'-',$col-1,", ",(join ', ',@_) +, ') # decremented both row and column are passe +d plus original @_ ',"\n"; } else{ print $ind."$row * $col > 0 is FALSE...\n"; } # execute the code if check A pass as shown above ($row * $col > 0 && up( ~-$row . '-' . ~-$col, @_ ) ) . ( # check B eval{ # show what happens if check B pass if ($row > $col){ print $ind."$row > $col ". "&& up(",$row-1,'-',$col,", ",(join ', ',@ +_), ') # decremented row and original column a +re passed plus original @_ ',"\n"; } else{print $ind."$row > $col is FALSE...\n"} # the eval block return empty string # to not pollute the output of the function ''; } ). # execute the code if check B pass as shown above ($row > $col && up( ~-$row . '-' . $col, @_ ) ); } }

and if I run this sub calling using Data::Dump method dd as in dd up(3-1) it produces:

@_ = [3-1] 3 * 1 > 0 && up(2-0, 3-1) # decremented both row and column are passed + plus original @_ @_ = [2-0 3-1] 2 * 0 > 0 is FALSE... 2 > 0 && up(1-0, 2-0, 3-1) # decremented row and original column a +re passed plus original @_ @_ = [1-0 2-0 3-1] 1 * 0 > 0 is FALSE... 1 > 0 && up(0-0, 1-0, 2-0, 3-1) # decremented row and original + column are passed plus original @_ @_ = [0-0 1-0 2-0 3-1] RETURNING: @_ is a valid path [0-0 1-0 2-0 3-1] 3 > 1 && up(2-1, 3-1) # decremented row and original column are passed + plus original @_ @_ = [2-1 3-1] 2 * 1 > 0 && up(1-0, 2-1, 3-1) # decremented both row and column a +re passed plus original @_ @_ = [1-0 2-1 3-1] 1 * 0 > 0 is FALSE... 1 > 0 && up(0-0, 1-0, 2-1, 3-1) # decremented row and original + column are passed plus original @_ @_ = [0-0 1-0 2-1 3-1] RETURNING: @_ is a valid path [0-0 1-0 2-1 3-1] 2 > 1 && up(1-1, 2-1, 3-1) # decremented row and original column a +re passed plus original @_ @_ = [1-1 2-1 3-1] 1 * 1 > 0 && up(0-0, 1-1, 2-1, 3-1) # decremented both row and + column are passed plus original @_ @_ = [0-0 1-1 2-1 3-1] RETURNING: @_ is a valid path [0-0 1-1 2-1 3-1] 1 > 1 is FALSE... "0-0 1-0 2-0 3-1\n0-0 1-0 2-1 3-1\n0-0 1-1 2-1 3-1\n"

I hope the above shows well what is happening and the recursion level. What I can say? genial!

Now I plan (but see update below..) to use a modified version that uses AoA as input and output and not the stringy form 3-1 and, even if it is uglier to see it respect more my original intention:

# receives and returns aoa sub up_modified{ my $ind = ' ' x $#{$_[0]} x 4; print $ind."\@_ is "; dd @_; my ($row, $col) = ($_[0][0][0],$_[0][0][1]); print $ind."receiving row $row col $col \n"; if ($row == 0 and $col == 0){ print $ind."RETURNING: "; dd @_; return @_; } else{ ( $row * $col > 0 && up_modified( [[~-$row, ~-$col],map {@$_ +}@_] ) ). ( $row > $col && up_modified( [[~-$row, $col], map {@$_}@_] +) ); } }

The above modified version is uglier because it must to be called as up_modified ([[(3,1)]]); that is nothing good to see.. but it works returning AoA ie an array of coordinates pairs that is what I need in my project to colorize them. It produces, in this verbose version, the following output:

@_ is [[3, 1]] receiving row 3 col 1 @_ is [[2, 0], [3, 1]] receiving row 2 col 0 @_ is [[1, 0], [2, 0], [3, 1]] receiving row 1 col 0 @_ is [[0, 0], [1, 0], [2, 0], [3, 1]] receiving row 0 col 0 RETURNING: [[0, 0], [1, 0], [2, 0], [3, 1]] @_ is [[2, 1], [3, 1]] receiving row 2 col 1 @_ is [[1, 0], [2, 1], [3, 1]] receiving row 1 col 0 @_ is [[0, 0], [1, 0], [2, 1], [3, 1]] receiving row 0 col 0 RETURNING: [[0, 0], [1, 0], [2, 1], [3, 1]] @_ is [[1, 1], [2, 1], [3, 1]] receiving row 1 col 1 @_ is [[0, 0], [1, 1], [2, 1], [3, 1]] receiving row 0 col 0 RETURNING: [[0, 0], [1, 1], [2, 1], [3, 1]]

final words

thanks you all wise monks to have contributed to this thread: I'm speachless seeing how many different approaches were proposed, each one valid and intresting on it's own.

L*

update March 26 it was to late.. this is simpler in construct and in what receives/returns:

sub up_modified_bis{ my $ind = ' ' x $#_ x 4; print $ind."\@_ is "; dd @_; my ($row, $col) = ($_[0][0],$_[0][1]); print $ind."receiving row $row col $col \n"; if ($row == 0 and $col == 0){ print $ind."RETURNING: "; dd @_; return @_; } else{ ( $row * $col > 0 && up_modified_bis( [~-$row, ~-$col],map { +[@$_]}@_ ) ). ( $row > $col && up_modified_bis( [~-$row, $col], map {[@$_] +}@_ ) ); } } #output of called; up_modified_bis ([(3,1)]); @_ is [3, 1] receiving row 3 col 1 @_ is ([2, 0], [3, 1]) receiving row 2 col 0 @_ is ([1, 0], [2, 0], [3, 1]) receiving row 1 col 0 @_ is ([0, 0], [1, 0], [2, 0], [3, 1]) receiving row 0 col 0 RETURNING: ([0, 0], [1, 0], [2, 0], [3, 1]) @_ is ([2, 1], [3, 1]) receiving row 2 col 1 @_ is ([1, 0], [2, 1], [3, 1]) receiving row 1 col 0 @_ is ([0, 0], [1, 0], [2, 1], [3, 1]) receiving row 0 col 0 RETURNING: ([0, 0], [1, 0], [2, 1], [3, 1]) @_ is ([1, 1], [2, 1], [3, 1]) receiving row 1 col 1 @_ is ([0, 0], [1, 1], [2, 1], [3, 1]) receiving row 0 col 0 RETURNING: ([0, 0], [1, 1], [2, 1], [3, 1])

There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

Replies are listed 'Best First'.
Re^3: compute paths in Pascal's triangle (aka Tartaglia's one) -- the winner is..
by tybalt89 (Monsignor) on Mar 26, 2018 at 02:21 UTC

    AoA with a less ugly call

    #!/usr/bin/perl # http://perlmonks.org/?node_id=1211497 use strict; use warnings; use Data::Dump 'pp'; sub up { my ($row, $col) = $_[0]->@*; return $row == 0 && $col == 0 ? [ map [ @$_ ], @_ ] : (($row > 0 && $col > 0 ? up( [ ~-$row, ~-$col ], @_ ) : () ), ($row > $col ? up( [ ~-$row, $col ], @_ ) : () ) ); } pp up [ 3, 1 ];

    Outputs:

    ( [[0, 0], [1, 0], [2, 0], [3, 1]], [[0, 0], [1, 0], [2, 1], [3, 1]], [[0, 0], [1, 1], [2, 1], [3, 1]], )

    And yes, the row and col checks are to stay within the triangle.

    BTW, contrary to some opinions, this code is NOT golfed. If it were, it wouldn't be using three letter variable names, and certainly wouldn't have used a totally unnecessary 'return' statement. :)

Re^3: compute paths in Pascal's triangle (aka Tartaglia's one) -- the winner is..
by LanX (Saint) on Mar 25, 2018 at 22:08 UTC
    > I tried to use your solution in my program but, I must admit, I discarded it soon.

    Easy... ;-)

    use strict; use warnings; use Data::Dump qw/pp dd/; my @paths = find_paths ( [0,0,'start'], [3,1,'goal'] ); pp @paths; sub find_paths { my ($start,$goal)=@_; # --- transform to easier coordinates ($start,$goal) = map old2new($_), ($start,$goal); # --- define closure my @results; my ($gl,$gr) = @$goal; my $pathfinder; $pathfinder = sub { my ( $last ) = @_; # pp \@_ ;# track recursion path my ( $l, $r ) = @$last ; if ( $gl == $l and $gr == $r) { push @results, [ map new2old($_), reverse @_ ]; return; } $pathfinder->( [$l+1,$r ,"left" ], @_ ) if $l < $gl; $pathfinder->( [$l ,$r+1 ,"right"], @_ ) if $r < $gr; }; # --- init recursion $pathfinder->($start); return \@results; } # -------------------------------------------------- # coordinate transformations sub old2new { # left = level - right my ($a_old)=@_; my @new = @$a_old; $new[0] = $new[0] - $new[1]; return \@new; } sub new2old { # level = left + right my ($a_new)=@_; my @old = @$a_new; $old[0] = $old[0] + $old[1]; return \@old; }

    ( "Result:", [ [ [0, 0, "start"], [1, 0, "left"], [2, 0, "left"], [3, 1, "right"], ], [ [0, 0, "start"], [1, 0, "left"], [2, 1, "right"], [3, 1, "left"], ], [ [0, 0, "start"], [1, 1, "right"], [2, 1, "left"], [3, 1, "left"], ], ], )

    Please note, any recursion can be written as iteration. If speed matters this might be worth it.

    tybalt is using the same algorithm, just starting from the end (so he doesn't need to reverse the path) and more golfy.

    Cheers Rolf
    (addicted to the Perl Programming Language and ☆☆☆☆ :)
    Wikisyntax for the Monastery

      Other footnotes:
      • If speed matters: the recursive approach can be speed up by memoizing the tails of a path to the last point.
      • An easy iterative approach ( now Breadth-first_search) can be constructed from this code.

      Cheers Rolf
      (addicted to the Perl Programming Language and ☆☆☆☆ :)
      Wikisyntax for the Monastery

Re^3: compute paths in Pascal's triangle (aka Tartaglia's one) -- the winner is..
by LanX (Saint) on Mar 25, 2018 at 21:13 UTC
    LOL :)

    > you proceded by baby steps.

    I call this maintainable.

    > I find your approach convoluted: your sub needed the top tile to passed in

    I call this flexible, it allows differing starting points

    > and goal's coordinates are external global variables.

    no I used lexicals,

    > I do not want to be the man who has to debug your code

    My fault, I expected the use of closures to be elementary. xD

    Put a block around it or an extra sub ...

    > You are a genial problem solver

    I'm ... running out of arguments. ;-)

    Cheers Rolf
    (addicted to the Perl Programming Language and ☆☆☆☆ :)
    Wikisyntax for the Monastery