go ahead... be a heretic 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.

Create A New User
Node Status?
node history
Node Type: perlquestion [id://1007887]
Approved by 2teez
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (15)
As of 2017-09-26 20:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
During the recent solar eclipse, I:

Results (297 votes). Check out past polls.

Notices?