Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

compute paths in Pascal's triangle (aka Tartaglia's one)

by Discipulus (Canon)
on Mar 22, 2018 at 09:03 UTC ( [id://1211497]=perlquestion: print w/replies, xml ) Need Help??

Discipulus has asked for the wisdom of the Perl Monks concerning the following question:

Hello wise monks and nuns,

I want to add a 17th fun experiment to my project: infact there is a properties I have still not shown: the number in a specific tile is also the number of different shortest path from the top tile (no backwards move nor lateral ones).

I want to show (colorizing them) all distinct paths in sequence and to do it I need a serie of coordinates: given the following structure

0-0 1-0 1-1 2-0 2-1 2-2 3-0 3-1 3-2 3-3 4-0 4-1 4-2 4-3 4-4 5-0 5-1 5-2 5-3 5-4 5-5

if the user click the node 3-1 i need to have back:

0-0 1-0 2-0 3-1 0-0 1-0 2-1 3-1 0-0 1-1 2-1 3-1

I have asked in the chatterbox some days ago and oiskuu, Eily and Lanx were so kind to suggest various approach, but franckly i was not able to implement a simple way: infact not all combinations are valid: 0-0 1-0 1-1 2-1 3-1 contains the illigal lateral move 1-0 1-1

Well I can produce all combinations and then throw away solutions with too much moves.. but for sure exists a simpler perlish way.

Squeezing my brain I only ended with naive method to highlight the area of such valid tiles:

sub enum_area{ my ($x,$y) = split '-', $_[0]; my $minus = $x - $y; print "$_ " for grep { my ($cx,$cy) = split '-',$_; $cy > $cx ? 0 : ( $cx-$cy < $minus + 1 ? 1 : 0) } glob '{'.(join ',',0..$x).'}-'. '{'.(join ',',0..$y).'}'; }

thanks in advance

L*

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: compute paths in Pascal's triangle (aka Tartaglia's one) (2 updates)
by LanX (Saint) on Mar 22, 2018 at 12:23 UTC
    The confusing "problem" is the coordinate system, it's trivial if you change it to left-down and right-down moves

    0-0 1-0 0-1 2-0 1-1 0-2 3-0 *2-1 1-2 0-3 4-0 3-1 2-2 1-3 0-4 5-0 4-1 3-2 2-3 1-4 0-5

    You see in your system:

    • the left coordinate is the "level", which is the sum of left-down and right-down moves
    • the right coordinate is the right-down move
    So your goal needs 2 left and 1 right move in any order, because this is just a distorted rectangle with 2 down and 1 right move

    0-0 0-1 0-2 0-3 0-4 0-5 1-0 1-1 1-2 1-3 1-4 2-0 *2-1 2-2 2-3 3-0 3-1 3-2 4-0 4-1 5-0

    This algorithm is fixing it by recalculating the remaining left-down moves

    use strict; use warnings; use Data::Dump qw/pp dd/; my $goal = [3,1]; my ($gl,$gr) = @$goal; my @results; pathfinder( [0,0,"start"] ); # start pp \@$_ for @results; sub pathfinder { my ( $last ) = @_; my ( $l, $r ) = @$last ; if ( $gl == $l ) { if ($gr == $r) { push @results,[ reverse @_]; } else { warn "wrong",pp [reverse @_]; return } } # left pathfinder( [$l+1,$r ,"left"], @_ ) if $l < $gl - ($gr - $r); # right pathfinder( [$l+1,$r+1,"right"], @_ ) if $r < $gr; }

    C:/Perl_64/bin\perl.exe d:/tmp/pascale_path.pl [ [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"], ] Compilation finished at Thu Mar 22 12:41:53

    update

    in hindsight it's probably better implemented in the new coordinate system and only the results are transformed back.

    The code is much easier then.

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

      > in hindsight it's probably better implemented in the new coordinate system and only the results are transformed back.

      > The code is much easier then.

      Yep!

      use strict; use warnings; use Data::Dump qw/pp dd/; my $goal = [3,1,'goal']; my $start = [0,0,'start']; pp "OLD: ",[$start,$goal]; ($start,$goal) = map old2new($_), ($start,$goal); pp "NEW: ",[$start,$goal]; my ($gl,$gr) = @$goal; my @results; pathfinder( $start ); pp \@$_ for @results; sub pathfinder { my ( $last ) = @_; 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; } # -------------------------------------------------- # 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; }

      Compilation started at Thu Mar 22 16:09:33 C:/Perl_64/bin\perl.exe d:/tmp/pascale_path.pl ("OLD: ", [[0, 0, "start"], [3, 1, "goal"]]) ("NEW: ", [[0, 0, "start"], [2, 1, "goal"]]) [ [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"], ] Compilation finished at Thu Mar 22 16:09:33

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

Re: compute paths in Pascal's triangle (aka Tartaglia's one)
by VinsWorldcom (Prior) on Mar 22, 2018 at 11:24 UTC

    I've recently been playing with Graph and it seems this may be a shortest path (specifically, All-Pairs Shortest Paths (APSP)) problem? The module uses the Floyd Warshall algorithm to calculate. The following creates the graph object and then calculates shortest path and prints it. Note, it only shows 1 path - have a look at the Graph perldoc on how to get all paths. (Note: I also used Graph::Convert and Graph::Easy to get the visual; it's not required to make this work.)

    UPDATE: Updated code to be more efficient

    #!perl use strict; use warnings; my $MAX = 5; # how big my $TO = '3-1'; # from 0-0, where to? use Graph; my $g = Graph->new(); my @from; for my $y ( 0 .. $MAX ) { my @to; for my $x ( 0 .. $y ) { push @to, "$y-$x"; } for my $f ( 0 .. $#from ) { for my $t ( $f .. $f + 1 ) { $g->add_edge( $from[$f], $to[$t] ); } } @from = @to; } # Comment next 3 if no install Graph::Convert and Graph::Easy use Graph::Convert; my $ge = Graph::Convert->as_graph_easy($g); print $ge->as_ascii . "\n"; my $apsp = $g->APSP_Floyd_Warshall(); my @v = $apsp->path_vertices('0-0', $TO); print join ( " ", @v ) . "\n";

    OUTPUT:

    +-----+     +-----+     +-----+     +-----+     +-----+     +-----+
    | 0-0 | --> | 1-0 | --> | 2-0 | --> | 3-0 | --> | 4-0 | --> | 5-0 |
    +-----+     +-----+     +-----+     +-----+     +-----+     +-----+
      |           |           |           |           |
      |           |           |           |           |
      v           v           v           v           v
    +-----+     +-----+     +-----+     +-----+     +-----+
    | 1-1 | --> | 2-1 | --> | 3-1 | --> | 4-1 | --> | 5-1 |
    +-----+     +-----+     +-----+     +-----+     +-----+
      |           |           |           |
      |           |           |           |
      v           v           v           v
    +-----+     +-----+     +-----+     +-----+
    | 2-2 | --> | 3-2 | --> | 4-2 | --> | 5-2 |
    +-----+     +-----+     +-----+     +-----+
      |           |           |
      |           |           |
      v           v           v
    +-----+     +-----+     +-----+
    | 3-3 | --> | 4-3 | --> | 5-3 |
    +-----+     +-----+     +-----+
      |           |
      |           |
      v           v
    +-----+     +-----+
    | 4-4 | --> | 5-4 |
    +-----+     +-----+
      |
      |
      v
    +-----+
    | 5-5 |
    +-----+
    
    0-0 1-0 2-0 3-1
    
Re: compute paths in Pascal's triangle (aka Tartaglia's one)
by vr (Curate) on Mar 22, 2018 at 12:55 UTC

    Started this before LanX' answer (trying to implement whatever I understood reading the HOP):

    use strict; use warnings; use 5.010; # defined-or use Data::Dump 'dd'; sub get_iterator { my ( $x_to, $y_to, $x_from, $y_from ) = @_; $x_from //= 0; $y_from //= 0; # store partial solutions to explore, to follow left or right # branches, respectively my @left_agenda = [[ $x_from, $y_from ]]; my @right_agenda = [[ $x_from, $y_from ]]; return sub { LOOP: { return undef unless @left_agenda || @right_agenda; my ( $ref, $right ); unless ( $ref = pop @left_agenda ) { $ref = pop @right_agenda; $right = 1 } my @path = @$ref; my ( $x, $y ) = @{ $path[ -1 ] }; $x ++; $y ++ if $right; if ( $x <= $x_to and $y <= $y_to ) { push @path, [ $x, $y ]; return \@path if $x == $x_to and $y == $y_to; push @left_agenda, \@path; push @right_agenda, \@path; } redo LOOP; } } } my $iter = get_iterator( 5, 2 ); my $solution; dd $solution while $solution = $iter-> ();

    Update. Slightly refactored version, eliminating "left agenda", i.e. pushing and immediately popping. Still, it's ugly because from initial point we can descend left and right, but from any partial solution from agenda - right only, left direction already exhausted. Hence, the "init" flag.

Re: compute paths in Pascal's triangle (aka Tartaglia's one)
by LanX (Saint) on Mar 22, 2018 at 09:39 UTC
      an hour later oO

      I don't like that there are still wrong moves possible*, probably because I din't follow my own concept...

      use strict; use warnings; use Data::Dump qw/pp dd/; my $goal = [3,1]; my ($nl,$nr) = @$goal; my @results; pathfinder( [0,0] ); # start pp \@$_ for @results; sub pathfinder { my ( $last )=@_; my ($l,$r) = @$last ; if ( $nl == $l ) { if ($nr == $r){ push @results,[ reverse @_]; } else { #warn "wrong",pp \@_; return } } # left pathfinder( [$l+1,$r ], @_ ) if $l != $nl; # right pathfinder( [$l+1,$r+1], @_ ) if $nr != $r; }

      [[0, 0], [1, 0], [2, 0], [3, 1]] [[0, 0], [1, 0], [2, 1], [3, 1]] [[0, 0], [1, 1], [2, 1], [3, 1]]

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

      *) i.e. the else branch with the warning should never be reached.

      update

      solution here

        Well, for any given target node you build a string of the correct number of left and right moves (or zeroes and ones) and then any permutation is one of the admissible solutions (and all of them).

        UPDATE: Just as illustration, using a module, and having to filter out duplicates in the permutations, it could work like this:

        use strict; use warnings; use Algorithm::Permute; my $node = '5-2'; my ($all, $right) = split /-/, $node; my @path = ((0) x ($all-$right),(1) x $right); my %pathes; Algorithm::Permute::permute { my $key = join '', @path; if( not exists $pathes{$key} ) { $pathes{$key} = 1; my ($l, $r) = (0,0); my $path = "($l-$r) ".join( " ", map{ "(".(++$l)."-".($r+=$_). +")" } @path); print "$path\n"; } } @path;
Re: compute paths in Pascal's triangle (aka Tartaglia's one)
by tybalt89 (Monsignor) on Mar 22, 2018 at 15:47 UTC
    #!/usr/bin/perl # http://perlmonks.org/?node_id=1211497 use strict; use warnings; sub up { my ($x, $y) = split /-/, $_[0]; $x && $y and up( $x - 1 . '-' . ($y - 1), @_ ); $x and up( $x - 1 . "-$y", @_ ); $x || $y or print "@_\n"; } up( '3-1' );

        Here's the functional version Re: compute paths in Pascal's triangle (aka Tartaglia's one) modified to allow a top other than 0-0.

        #!/usr/bin/perl # http://perlmonks.org/?node_id=1211497 use strict; use warnings; sub up { my ($row, $col) = split /-/, $_[0]; my ($startrow, $startcol) = split /-/, $_[-1]; return $_[0] eq $_[-1] ? "@_[0..@_-2]\n" : ($row - $startrow > 0 && $col - $startcol > 0 && up( ~-$row . '-' . ~-$col, @_ ) ) . ($row - $startrow > $col - $startcol && up( ~-$row . '-' . $col, @_ ) ); } print up( '3-1', '1-0' ); # bottom, top

        That would be an entirely different problem altogether </Airplane joke>

Re: compute paths in Pascal's triangle (aka Tartaglia's one)
by roboticus (Chancellor) on Mar 22, 2018 at 17:16 UTC

    Discipulus:

    Looks like there are already a bunch of good solutions to your problem. But I did it anyway for a bit of diversion, so rather than throwing it away, I'll add it to the list:

    #!env perl # # ex_tartaglias_triangle.pl # # Find all paths any node R-C to the root (0-0), only moving upwards: # # 0-0 # 1-0 1-1 # 2-0 2-1 2-2 # 3-0 3-1 3-2 3-3 # 4-0 4-1 4-2 4-3 4-4 # 5-0 5-1 5-2 5-3 5-4 5-5 # use strict; use warnings; for my $r (0 .. 5) { for my $c (0 .. $r) { my $N = aNode->new($r, $c); print "\n*** ", $N->to_str, ", # paths to root: ", $N->cnt_pat +hs, " ***\n\n"; for my $rp ($N->paths) { print "\t", join(" -> ", map { $_->to_str } reverse @$rp), + "\n"; } print "\n"; } } { package aNode; sub new { my ($cl, $r, $c) = @_; my $t = bless { r=>$r, c=>$c, root=>$r==0 }, $cl; return $t; } sub is_root { return $_[0]->{root}; } sub moves { my $self = shift; my @rv; push @rv, aNode->new($self->{r}-1, $self->{c}-1) if $self->{r} + and $self->{c}; push @rv, aNode->new($self->{r}-1, $self->{c}) if $self->{c} + < $self->{r}; return @rv; } sub paths { my $self = shift; return [$self] if $self->is_root; my @rv; for my $m ($self->moves) { push @rv, [ $self, @$_ ] for $m->paths; } return @rv; } sub cnt_paths { my $self = shift; return 1 if $self->is_root; my $rv = 0; for my $n ($self->moves) { $rv += $n->cnt_paths; } return $rv; } sub to_str { my $self = shift; return "$self->{r}-$self->{c}"; } }

    Update: Rather than building the paths from the root to the specified node, I took advantage of the fact that there are only 1 or 2 moves upwards from any node. Then I recursively gathered the paths upwards. I then reversed the path before printing so it looks like a path from the root to the node, instead of the node to the root.

    ...roboticus

    When your only tool is a hammer, all problems look like your thumb.

Re: compute paths in Pascal's triangle (aka Tartaglia's one)
by oiskuu (Hermit) on Mar 22, 2018 at 20:23 UTC

    My suggestion was to modify the recursive formula (function) to return not the sum value, but the paths themselves. Perhaps the more practical alternative is to construct an iterator. I've included both in the code below. Note that the @path have only column numbers. If you need Row-Column coordinates, zip/pairwise them with [0 .. $n] as appropriate.

    #! /usr/bin/perl use Algorithm::Combinatorics q(:all); use Data::Dump; use strict; use warnings; push @ARGV, (6, 4); # default (n, k) # recursive formula # sub choose { my ($n, $k) = @_; !$n ? ([$k]) x !$k : map [@$_, $k], choose($n-1, $k), choose($n-1, + $k-1) } dd choose(@ARGV); # iterator version # sub pinball_iter { my ($n, $k) = @_; my $iter = combinations([1 .. $n], $k); sub { my @path = (0); $path[$_]++ for @{ $iter->next() // return }; $path[$_]+=$path[$_-1] for (1 .. $n); return \@path; } } my $it = pinball_iter(@ARGV); while (my $x = $it->()) { dd $x; }

    The recursive formula is rather simple, and can be trivially adjusted for Row-Col pairs as well:

    sub choose { my ($n, $k) = @_; !$n ? (["$n-$k"]) x !$k : map [@$_, "$n-$k"], choose($n-1, $k), choose($n-1, $k-1) }

Re: compute paths in Pascal's triangle (aka Tartaglia's one)
by hdb (Monsignor) on Mar 22, 2018 at 13:58 UTC

    The property you mention is simple to prove: "the number in a specific tile is also the number of different shortest path from the top tile". In any path to a tile n-k, you have (n-k) (n minus k) moves left, and k moves right. Only the order of these moves determine the specific path. The number of possible permutations of (n-k) and k identical elements each is n! / k! / (n-k)! which is the number in the tile.

Re: compute paths in Pascal's triangle (aka Tartaglia's one)
by tybalt89 (Monsignor) on Mar 23, 2018 at 19:19 UTC

    I was playing with this a bit, since it's such a fun little problem. Here's a version that returns the answer as the value of the function.

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

    It's only a two statement function (of course one statement is very long :)

      ..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.

        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. :)

        > 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

        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

Re: compute paths in Pascal's triangle (aka Tartaglia's one)
by tybalt89 (Monsignor) on Mar 27, 2018 at 16:19 UTC

    Fun little regex exercise :)

    #!/usr/bin/perl # http://perlmonks.org/?node_id=1211497 use strict; use warnings; my $triangle = <<END; 0-0 1-0 1-1 2-0 2-1 2-2 3-0 3-1 3-2 3-3 4-0 4-1 4-2 4-3 4-4 5-0 5-1 5-2 5-3 5-4 5-5 END $^R = '3-1'; # clicked node "@{[ reverse split /\n/, $triangle ]}" =~ / $^R (?: .* ((??{ my ($row, $col) = split m{\D}, $^R; $row ? ($row - 1) . '-[' . ($col > 0 && $col - 1) . "$col]" : '( +*F)' })) (?{$1 eq '0-0' and print "$1 $^R\n"; "$1 $^R"}) )+ (*F) /x;

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1211497]
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others learning in the Monastery: (3)
As of 2024-03-28 16:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found