Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

I need help with some recursion

by ragnarokPP (Initiate)
on Dec 08, 2012 at 10:44 UTC ( #1007887=perlquestion: print w/ replies, xml ) 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

Comment on I need help with some recursion
Download Code
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 (Abbot) 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?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (18)
As of 2015-07-30 13:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (271 votes), past polls