in reply to I need help with some recursion
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 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, |
|
---|
Replies are listed 'Best First'. | |
---|---|
Re^2: I need help with some recursion
by ragnarokPP (Initiate) on Dec 08, 2012 at 18:38 UTC |
In Section
Seekers of Perl Wisdom