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..
Re: Iterating elements at different level
by BrowserUk (Patriarch) on Jan 12, 2016 at 16:34 UTC
|
#! 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.
In the absence of evidence, opinion is indistinguishable from prejudice.
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
| [reply] [Watch: Dir/Any] |
Re: Iterating elements at different level
by choroba (Cardinal) on Jan 12, 2016 at 18:58 UTC
|
#!/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,
| [reply] [Watch: Dir/Any] [d/l] [select] |
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.
| [reply] [Watch: Dir/Any] [d/l] [select] |
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"
| [reply] [Watch: Dir/Any] [d/l] |
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,
| [reply] [Watch: Dir/Any] [d/l] [select] |
Re: Iterating elements at different level
by clueless newbie (Curate) on Jan 12, 2016 at 20:38 UTC
|
#!/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
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
$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.
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
|