Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Iterating elements at different level

by punitpawar (Sexton)
on Jan 12, 2016 at 16:18 UTC ( [id://1152579]=perlquestion: print w/replies, xml ) Need Help??

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

Hello Guys,
I have a question that relates to finding the depth of each element in a multidimensional array. I am trying to struggle with this but not able to come up with a good solution.
Any help will be appreciated
Here is the problem statement

Given a nested list of integers, returns the sum of all integers in the list weighted by their depth
* For example, given the list {{1,1},2,{1,1}} the function should return 10 (four 1's at depth 2, one 2 at depth 1)
* Given the list {1,{4,{6}}} the function should return 27 (one 1 at depth 1, one 4 at depth 2, and one 6 at depth 3)
I tried to create a array reference
my $arrref = [ [1,1,1,1], [1,1, [2,2] ], [1, [2, [3,3] ] ] ];

But then I was stuck in the approach that I need to take for incrementing depth as I go deep one level and decrementing it when I go up one level..

Replies are listed 'Best First'.
Re: Iterating elements at different level
by BrowserUk (Patriarch) on Jan 12, 2016 at 16:34 UTC

    The easiest way to process data structures of variable depth and complexity is recursion:

    #! perl -slw use strict; sub weightedSum { my( $r, $weight ) = ( @_, 1 ); my $sum = 0; for ( @$r ) { if( ref ) { $sum += weightedSum( $_, $weight + 1 ); } else { $sum += $_ * $weight; } } return $sum; } my $arrref = [ [1,1,1,1], [1,1, [2,2] ], [1, [2, [3,3] ] ] ]; print weightedSum( $arrref );

    Produces:

    C:\test>1152751 56

    A variation:

    #! perl -slw use strict; use List::Util qw[ reduce ]; $a = $b; ## silence warning sub weightedSum { my( $r, $weight ) = ( @_, 1 ); return reduce{ $a += ( ref( $b ) ) ? weightedSum( $b, $weight + 1 ): $b * $we +ight } 0, @$r; } my $arrref = [ [1,1,1,1], [1,1, [2,2] ], [1, [2, [3,3] ] ] ]; print weightedSum( $arrref );

    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority". I knew I was on the right track :)
    In the absence of evidence, opinion is indistinguishable from prejudice.
      beautiful
Re: Iterating elements at different level
by choroba (Cardinal) on Jan 12, 2016 at 18:58 UTC
    Data::Walk can help you:
    #!/usr/bin/perl use warnings; use strict; use feature qw{ say }; use Data::Walk; for my $arr ([ [1, 1], 2, [1, 1] ], # 10 [ 1, [4, [6]]], # 27 ) { my $sum = 0; walk sub { ref $_ or $sum += $_ * ($Data::Walk::depth - 1) }, $arr +; say $sum; }
    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
Re: Iterating elements at different level -- evil eval approach (explained)
by Discipulus (Canon) on Jan 13, 2016 at 09:59 UTC
    Hello punitpawar
    this seems like an assignement to learn Perl by resolving problems.. anyway the challenge was accepted and you got good replies.
    Be sure to understand the clean and sharp BrowserUk's answer that seems to me the right Perl standard way to get job done. Note in the BrowserUk's answer the tecnique is called 'recursive' not 'iterative'. Be sure to understand the two concept.

    In Perl there are always more ways to get the job done: the tricky betterworld's attempt (that was my first thought too..) uses the stringification got from Data::Dumper to do the math.

    The wise monk choroba uses instead a powerfull tool to do the math: many modules on CPAN are powerfull and reliable tools. Take your time to learn a bounch of them to have always at your pocket: Look at Data::Walk to learn what it can do and compare with the choroba's solution.

    Other modules can be used for this task: Marpa::R2 recent examples by GrandFather and again choroba let me think is possible with this module too.

    Occasionally there is also the way you never have to choose for production code, but that can be useful while learning: the 'evil eval string' is one of my favourites...
    Notice that in the below code I use not the ArrayofArray but the strings as stated in your OP ('given nested list of integers')

    #!/usr/bin/perl use warnings; use strict; my @str = ('{{1,1},2,{1,1}}', # the function sho +uld return 10 '{1,{4,{6}}}', # the function sho +uld return 27 '{{1,1,1,1},{1,1,{2,2}},{1,{2,{3,3}}}}', # Buk 56 '{1,{{13}}}' # mine.. two digit + tests 40 ); my $w = 0; # weight or depth print "$_\t=>\t".( eval join ('', map{ /{/ ? ++$w && '(' : /\d/ ? $w.'*'.$_ : /,/ ? '+' : /}/ ? $w-- && ')' : $_ }($_=~/\d+|./g) ) )."\n" for @str; #OUTPUT {{1,1},2,{1,1}} => 10 {1,{4,{6}}} => 27 {{1,1,1,1},{1,1,{2,2}},{1,{2,{3,3}}}} => 56 {1,{{13}}} => 40
    The english version of the above code is something like:
    For each item in @str print it, print an arrow, print also the evaluation of the code resulting by joining strings obtained modifying every one or more number (\d+) or (|) any singular character (.) as follow: if the char is { then augment $w by one and return ( instead of {, else if is a number return instead of it the string current $w multiplying that number, else if the char is a ,return a + sign,else if the char is } lower $w by one and return the string ), in any other case return the original string. Print also a newline.

    Update: the assignement seems similar to Re: Parsing a Tree to a Table.

    HtH
    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.
Re: Iterating elements at different level
by betterworld (Curate) on Jan 12, 2016 at 17:53 UTC
    use Data::Dumper; my $arrref = [[1,1],2,[1,1]]; my $w = 0; my $sum = 0; my $text = Dumper($arrref); while ($text =~ /(\[)|(\])|(\d+)/g) { $w++ if $1; $w-- if $2; $sum += $w * $3 if $3; } print $sum, "\n"; # "10"
Re: Iterating elements at different level
by choroba (Cardinal) on Jan 13, 2016 at 11:48 UTC
    Discipulus teased me to try solving the problem using the Marpa parser. It took me a lot more time than I had thought: I didn't find a way how to retrieve the "depth" in a parse tree in order to multiply by it. You can attach 0 as the depth to each number, though, and increment it on each its inclusion into a list:
    #!/usr/bin/perl use warnings; use strict; use feature qw{ say }; use Marpa::R2; use List::Util qw{ sum }; my $dsl = << '__DSL__'; lexeme default = latm => 1 :default ::= action => ::first Top ::= List action => resolve List ::= ('{') Terms ('}') Terms ::= Term+ separator => comma action => include Term ::= num action => create | List num ~ [0-9]+ comma ~ ',' __DSL__ sub create { [ [ $_[1], 0 ] ] } sub include { shift; [ map { map [$_->[0], 1 + $_->[1]], @$_ } @_ ] } + # do you still love me? sub resolve { shift; sum map $_->[0] * $_->[1], @{ $_[0] } } my $grammar = 'Marpa::R2::Scanless::G'->new({ source => \$dsl }); my @strings = ( '{{1,1},2,{1,1}}', # the functio +n should return 10 '{1,{4,{6}}}', # the functio +n should return 27 '{{1,1,1,1},{1,1,{2,2}},{1,{2,{3,3}}}}' # Buk 56 ); for my $s (@strings) { my $v = $grammar->parse(\$s, 'main'); say $$v; }
    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
Re: Iterating elements at different level
by clueless newbie (Curate) on Jan 12, 2016 at 20:38 UTC
    This is close to right
    #!/usr/bin/env perl use Data::Dumper; use strict; use warnings; my $_aref = [[1,1],2,[1,1]]; my $_s=''.Data::Dumper->Dump([\$_aref],[qw(*_aref)]); substr($_s,0,10)=''; our ($w,$t)=(0,0); my $_re=qr{ (?: \s+ # blank space - ignore |[,] # comma - ignore |\[ # [ - increase weight (?{ local $w=$w+1; print "++w: $w\n"; }) |\] # ] - decrease weight (?{ local $w=$w-1; print "--w: $w\n"; }) |(\d+) # value - multiply by weight and add to $t (?{ print "value: $1\n"; $t+=$w*$1; print "\$t=$t\n"; } +) ) }x; if ($_s=~ m{(?{local $w=0;})^$_re*$}gms) { print "$t"; }; __END__
    returns
    ++w: 1 ++w: 2 value: 1 $t=2 value: 1 $t=4 --w: 1 value: 2 $t=6 ++w: 2 value: 1 $t=8 value: 1 $t=10 --w: 1 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 --w: 0 10

      $t+=$w*\1;
      Should be:
      $t+=$w*$1;
      edit: I see you already figured it out and changed your post.


      The way forward always starts with a minimal test.

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others lurking in the Monastery: (4)
As of 2024-03-29 09:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found