http://www.perlmonks.org?node_id=714927


in reply to results from pairs combination

Also a re-invention of the wheel and thus inferior to Graph and its ilk (and also lacking the directed-ness, if I correctly understand that term, of jdporter's solution), but perhaps more terse...

use warnings; use strict; sub is_conjoint (); my @pairs = ('1,7', '2,6', '2,7', '5,4', '6,7', 'a,b', 'foo,7', '8,bar'); my $name = qr{ \w+ }xms; # node name my (@conjoint, @disjoint); push @{ is_conjoint ? \@conjoint : \@disjoint }, $_->[0] for adumbrated(@pairs); print qq{output: \n}; print qq{conjoint: @conjoint \n}; print qq{disjoint: @disjoint \n}; { # begin closure my %census; # hash private to functions sub is_conjoint () { scalar grep $_ > 1, @census{ @{$_->[1]}[0,1] } } sub adumbrated { map [ $_, [ map { $census{$_}++; $_ } /$name/g ] ], @_ } } # end closure
Output:
conjoint: 1,7 2,6 2,7 6,7 foo,7 disjoint: 5,4 a,b 8,bar