Perl Monk, Perl Meditation PerlMonks

### to find inter connected items

by Janaki (Initiate)
 on Nov 04, 2012 at 07:57 UTC Need Help??
Janaki has asked for the wisdom of the Perl Monks concerning the following question:

Hi,I stuck with a problem.I have two arrays @a=(1,1,2,3,4,4,8,8); @b=(3,4,3,5,6,7,9,10); What I need is, 1 is related to 3(they have same index )again 1 is related 4.Now 3 is related to 2,3 is related to 5,4 related to 6,4 related to 7. Now the required result should be "1,2,3,4,5,6,7 have relation to each other". Again the program should be able to find the related numbers among the other elements in the array.Here next result is "8,9,10 have relation to each other". I have tried to use hash but keys having same value created problem.How can I solve this problem?

Replies are listed 'Best First'.
Re: to find inter connected items
by choroba (Chancellor) on Nov 04, 2012 at 08:26 UTC
Using a hash is a good solution. I used the following algorithm: If both the numbers to be made related already belong to different classes, the classes are "merged", i.e. all numbers belonging to the class with a greater index are re-classified to the other class.
```#!/usr/bin/perl
use warnings;
use strict;

use Data::Dumper;

my @a = (1, 1, 2, 3, 4, 4, 8, 8);
my @b = (3, 4, 3, 5, 6, 7, 9, 10);

print Dumper related(\@a, \@b);

sub related {
my @a = @{ +shift };
my @b = @{ +shift };
die "Different length.\n" if @a != @b;

my %r;
PAIR: for my \$i (0 .. \$#a) {
my @classes;
for my \$e (\$a[\$i], \$b[\$i]) {
push @classes, \$r{\$e} if exists \$r{\$e};
}

# Both numbers already classified. Merge their classes if diff
+erent.
if (@classes == 2) {
next PAIR if \$classes[0] == \$classes[1];
my (\$min, \$max) = sort { \$a <=> \$b } @r{\$a[\$i], \$b[\$i]};
\$r{\$_} = \$min for grep \$r{\$_} == \$max, keys %r;

# Just one number already classified. Classify the second one
+to the same class.
} elsif (@classes == 1) {
if (exists \$r{\$a[\$i]}) {
\$r{\$b[\$i]} = \$r{\$a[\$i]};
} else {
\$r{\$a[\$i]} = \$r{\$b[\$i]};
}

# Both numbers are seen for the first time.
} else { # @classes == 0
my \$min = \$a[\$i] < \$b[\$i] ? \$a[\$i] : \$b[\$i];
@r{\$a[\$i], \$b[\$i]} = (\$min) x 2;
}
}
return \%r;
}
لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
Re: to find inter-connected items
by Athanasius (Chancellor) on Nov 05, 2012 at 04:43 UTC

This is an interesting problem. choroba’s excellent solution can be simplified somewhat by using the Set::Scalar module:

```#! perl
use strict;
use warnings;
use Set::Scalar;

my @a = (1, 1, 2, 3, 4, 4, 8,  8);
my @b = (3, 4, 3, 5, 6, 7, 9, 10);
my @sets;
@a == @b or die "The arrays are of different lengths.\n";

for (0 .. \$#a)
{
my (\$ai, \$bi, \$found) = (\$a[\$_], \$b[\$_], 0);

for (@sets)
{
if (\$_->has(\$ai) || \$_->has(\$bi))
{
\$found = 1;
\$_->insert(\$ai, \$bi);
last;
}
}

push @sets, Set::Scalar->new(\$ai, \$bi) unless \$found;
}

OUTER: for my \$i (reverse 1 .. \$#sets)
{
for my \$j (reverse 0 .. \$i - 1)
{
unless (\$sets[\$i]->intersection(\$sets[\$j])->is_empty())
{
\$sets[\$j] = \$sets[\$j]->union(\$sets[\$i]);
splice(@sets, \$i, 1);
redo OUTER;
}
}
}

print "\$_\n" for @sets;

Update: Added block labelled OUTER to merge sets having common elements.

Output:

```14:35 >perl 366_SoPW.pl
(1 2 3 4 5 6 7)
(10 8 9)

14:36 >

Hope that helps,

Athanasius <°(((><contra mundum

Re: to find inter connected items
by BillKSmith (Priest) on Nov 04, 2012 at 15:52 UTC

This clearly can be viewed as a problem in graph theory. There is a good chance a solution can be found on CPAN. Even if you fail to find such module, the time spent looking is probably not wasted because you will learn standard terminology and learn not to wast time on promising approaches that do not work.

Bill
Re: to find inter connected items
by jaredor (Curate) on Nov 05, 2012 at 03:42 UTC

Node how to find combine common elements of an array? gives a few solutions to this problem. Your input set to those solutions would be a set of doubletons, each represented as a string of whitespace delimited elements, i.e., "\$a[i] \$b[i]".

Re: to find inter connected items
by remiah (Hermit) on Nov 05, 2012 at 11:27 UTC

Hello.

With hash of hash, for looking ups.

```#!/usr/bin/perl
use strict; use warnings; use Data::Dumper;
my @a=(1,1,2,3,4,4,8,8);
my @b=(3,4,3,5,6,7,9,10);
my \$hoh={};

for ( 0 .. \$#a){
\$hoh->{\$a[\$_]}->{\$b[\$_]}++;
\$hoh->{\$b[\$_]}->{\$a[\$_]}++;
}
sub recursive {
my (\$hoh, \$key, \$path, @vals) =@_;
for ( grep { \$_ ne \$key } @vals){
next if exists(\$path->{\$_});
\$hoh->{\$key}->{\$_}++;
\$path->{\$_}++;
recursive(\$hoh, \$key, \$path, keys %{\$hoh->{\$_}} );
}
}
for (sort {\$a <=> \$b}keys %\$hoh){
recursive(\$hoh, \$_, {}, keys %{\$hoh->{\$_}} );
}

#print Dumper \$hoh;
for (sort {\$a <=> \$b}keys %\$hoh){
print "\$_=" , join(",", keys %{\$hoh->{\$_}}), "\n";
}

__DATA__
this prints ...
1=6,4,3,7,2,5
2=6,4,1,3,7,5
3=6,4,1,7,2,5
4=6,1,3,7,2,5
5=6,1,4,3,7,2
6=1,4,3,7,2,5
7=6,1,4,3,2,5
8=10,9
9=8,10
10=8,9
And as BillKSmith points out, if you take this as a graph,
```#!/usr/bin/perl
#with graph
use strict; use warnings; use Data::Dumper;
use Graph;
my \$g =Graph::Undirected->new;

my @a=(1,1,2,3,4,4,8,8);
my @b=(3,4,3,5,6,7,9,10);

for ( 0 .. \$#a){
}
print Dumper \$g->connected_components;
__DATA__
this prints ...\$VAR1 = [
9,
8,
10
];
\$VAR2 = [
6,
4,
1,
3,
2,
5,
7
];
regards.

Re: to find inter connected items
by space_monk (Chaplain) on Nov 04, 2012 at 13:15 UTC
I'm not sure you've completely described the problem fully. In this "game", are you only allowed to start from numbers in the first array, or can you go from the numbers in either array?

I can go from the number in either array,or start with any element in any of the two arrays.Thank you all for considering my question.I will try today.I tried to write a for loop based on index and value but its not working as expected.

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

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (10)
As of 2017-06-26 12:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
How many monitors do you use while coding?

Results (580 votes). Check out past polls.