Your skill will accomplishwhat the force of many cannot PerlMonks

### I need help with some recursion

by ragnarokPP (Initiate)
 on Dec 08, 2012 at 10:44 UTC Need Help??
ragnarokPP has asked for the wisdom of the Perl Monks concerning the following question:

Hi, I need something like this. I have file with numbers for example:
1 2 4 25 39 48
1 2 3 4 39
2 3 48
1 2 4 8 12
5 10 11 12 13
6
7 9
...
and I need to read first line and take all numbers in the 1st line (1,2,4,25,39,48) and save all the numbers in the 1,2,4,25,39 and 48 line.
So i will have (1,2,4,25,39,48,2,3,4,39,4,8,12), then i need remove duplicate items so i will have (1,2,3,4,8,12,25,39,48) and read others numbers in lines (1,2,3,4,8,12,25,39,48) and so on until i read all numbers in refers lines.
Then i need read remaining lines like (5,10,11,12,13) and (7,9) and do the same recursion with other lines. I write something like this:

while(my \$line = <LIST>) { chomp \$line; push @array, \$line; } for (my \$i=0; \$i<396; \$i++) { @new_array=(); @numbers=(); if(exists \$hash{\$i}) { print OUT1 "\$i\n"; } else { @new_array=split('\s', \$array[\$i]); foreach my \$el(@new_array) { chomp \$el; push @numbers, split('\s+', \$array[\$el-1]); } @numbers= uniq(@numbers); @numbers= sort @numbers; \$new[\$i]=@numbers; foreach my \$arg(@numbers) { print OUT "\$arg\n"; \$hash{\$arg}=\$arg; } } } sub uniq { return keys %{{ map { \$_ => 1 } @_ }}; }

but i dont know how to set some recursion to do it right. Any idea? Thank you. Daniel

Replies are listed 'Best First'.
Re: I need help with some recursion
by tobyink (Abbot) on Dec 08, 2012 at 11:18 UTC

To do recursion you really need to do your work in a function. That way, the function can call itself - recurse.

Right now the only function you have is a small helper, uniq and you're not doing the bulk of your work in a function.

Anyway, here's how I'd do it...

use strict; use warnings; use Data::Dumper; # Read the data from the file... # my @lines = map { chomp; [split] } <DATA>; # Arrays are indexed from 0, but we want to count lines # from 1, so let's unshift a dummy 0 entry onto the array. # unshift @lines, undef; # This is a more usual way of implementing "uniq". It # preserves the original input order. # sub uniq { my %seen; grep { not \$seen{\$_}++ } @_; } # This is the function that does most of the work. It # calculates what graph theorists would call a "closure" # over the graph of line references. # sub line_closure { # We're given an input list, which is a set of # lines already in the closure. # my @input = @_; # Extend the list by looping through @input to # generate the output. # my @output = uniq map { # if the line referred to exists \$lines[\$_] # then add the numbers from that # line ? (\$_, @{\$lines[\$_]}) # otherwise, just keep the existing # number : (\$_) } @input; # If the two lists match (and because we're only # ever adding to the list, checking the list # lengths is sufficient), then we've found the # closure, so return it. # if (@output == @input) { return @output; } # Otherwise, calculate the closure on the expanded # list. # return line_closure(@output); } # Get the closure starting at line 1. # my @results = line_closure(1); print Dumper \@results; __DATA__ 1 2 4 2 3 4 3 7 4 6 5 10 11 12 13 6 7 1
perl -E'sub Monkey::do{say\$_,for@_,do{(\$monkey=[caller(0)]->[3])=~s{::}{ }and\$monkey}}"Monkey say"->Monkey::do'

It is perfect, simple. But if i applied it for all the lines the result will be:

1,2,4,3,6,7 2,3,4,7,6,1 3,7,1,2,4,6 4,6 5,10,11,12,13 6 7,1,2,4,3,6

but i am looking for something like this:

1,2,4,3,6,7 5,10,11,12,13

So don't apply it to all the lines. This seems to produce something close to your desired output:

my %seen; for (my \$i = 1; \$i < @lines; \$i++) { next if \$seen{\$i}; my @results = line_closure(\$i); print Dumper \@results; \$seen{\$_}++ for @results; }
perl -E'sub Monkey::do{say\$_,for@_,do{(\$monkey=[caller(0)]->[3])=~s{::}{ }and\$monkey}}"Monkey say"->Monkey::do'
Re: I need help with some recursion
by Athanasius (Chancellor) on Dec 08, 2012 at 15:42 UTC

Hello ragnarokPP, and welcome to the Monastery!

tobyink has shown you how to solve the problem with recursion, as you requested. Here is a non-recursive solution using the CPAN module Set::Scalar:

#! perl use Modern::Perl; use Set::Scalar; my \$class_callback = sub { join(' ', sort { \$a <=> \$b } \$_[0]->element +s) }; Set::Scalar->as_string_callback(\$class_callback); my @sets; for (my \$i = 0; <DATA>;) { chomp; my \$new_set = Set::Scalar->new(split /\s+/); my \$merged = 0; for my \$j (0 .. \$i - 1) { if (\$new_set->intersection(\$sets[\$j])) { \$sets[\$j] = \$sets[\$j]->union(\$new_set); \$merged = 1; last; } } \$sets[\$i++] = \$new_set unless \$merged; } print '(', \$_, ")\n" for @sets; __DATA__ 1 2 4 2 3 4 3 7 4 6 5 10 11 12 13 6 7 1

Output:

1:30 >perl 424_SoPW.pl (1 2 3 4 6 7) (5 10 11 12 13) 1:34 >

Remember, the Perl motto is TMTOWTDI (There’s More Than One Way To Do It)!

Update: The above code doesn’t merge fully on certain types of input. The following code fixes this:

#! perl use Modern::Perl; use Set::Scalar; my \$class_callback = sub { join(' ', sort { \$a <=> \$b } \$_[0]->element +s) }; Set::Scalar->as_string_callback(\$class_callback); my @sets; for (my \$i = 0; <DATA>; ++\$i) { chomp; \$sets[\$i] = Set::Scalar->new(split /\s+/); } print "Before merging:\n"; print '(', \$_, ")\n" for @sets; print "\n"; for my \$i (reverse 1 .. \$#sets) { for my \$j (0 .. \$i - 1) { if (defined \$sets[\$i] && defined \$sets[\$j] && \$sets[\$i]->intersection(\$sets[\$j])) { \$sets[\$j] = \$sets[\$i]->union(\$sets[\$j]); \$sets[\$i] = undef; } } } @sets = grep { defined } @sets; print "After merging:\n"; print '(', \$_, ")\n" for @sets; __DATA__ 1 2 4 7 13 3 5 6 7 8 10 11 12 1 5

Output:

11:24 >perl 424_SoPW.pl Before merging: (1 2 4) (7 13) (3 5 6) (7 8) (10 11 12) (1 5) After merging: (1 2 3 4 5 6) (7 8 13) (10 11 12) 12:17 >

Hope that helps,

 Athanasius <°(((>< contra mundum Iustus alius egestas vitae, eros Piratica,

Thank you Athanasius. I tested it and works great. But previous code was a little bit faster in computation :). I learned something new today. Thank you guys.

Log In?
 Username: Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1007887]
Approved by 2teez
help
Chatterbox?
 [LanX]: But reu germans have no humor, better to refrain from this site till the troll is gone... [LanX]: true [shmem]: I disagree [LanX]: sure you are German [shmem]: germans do have humour. Open debate is what germans, and what humour. There. :-) [LanX]: :-P

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (10)
As of 2017-04-27 19:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
I'm a fool:

Results (513 votes). Check out past polls.