Perl: the Markov chain saw PerlMonks

### Re: to find inter connected items

by choroba (Bishop)
 on Nov 04, 2012 at 08:26 UTC ( #1002173=note: print w/replies, xml ) Need Help??

in reply to to find inter connected items

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;
}
لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ

Create A New User
Node Status?
node history
Node Type: note [id://1002173]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (4)
As of 2018-05-23 23:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
World peace can best be achieved by:

Results (174 votes). Check out past polls.

Notices?