#This program read the triplets from file named "data" into 
#an array of array. 
use strict; 
use warnings; 
use Data::Dumper; 
use Graph;  
use Graph::Subgraph; 
 
my @S; 
 while (<>) { 
        push @S, [ split ]; 
    } 
print "-----TRIPLETS-------\n"; 
print Dumper \@S; 
#Make a copy of @S  
my @trip = map { [@$_] } @S; 
 
# Find the number of vertices 
my @L; 
for my $i ( 0 .. $#S ) { 
for my $j ( 0 .. $#{ $S[$i] } ) { 
push (@L,$S[$i][$j]); 
     } 
 } 
my %seen; 
@L = grep { ! $seen{ $_ }++ } @L; 
print " ----VERTICES------\n"; 
print Dumper \@L; 
 
 
# Now lets generate the G(L) 
# In order to generate the G(L) we'll extract first two columns of S into another matrix 
my @GL=@S; 
splice(@$_, 2, 1) 
   foreach @GL; 
print "----EDGE LIST TO BUILD G(L)-----\n"; 
print Dumper \@GL; 
 
#my %h = map { $_->[0] => $_->[1] } @S; 
#print Dumper(\%h); 
 
 
##### CONNECTED COMPONENTS ########## 
my $g = Graph->new( undirected => 1 ); 
 
my @a; 
my @b; 
for (my $p = 0; $p <= 2; $p++) { 
$a[$p]=$S[$p][0]; 
  } 
 
for (my $q = 0; $q <= 2; $q++) { 
$b[$q]=$S[$q][1]; 
  } 
 
for (my $r = 0; $r <= 2; $r++) { 
 	$g->add_edge($a[$r], $b[$r]); 
 } 
 
my @subgraphs = $g->connected_components; 
my @allgraphs; 
my $V = $g->vertices; 
print "Number of taxa=$V\n"; 
 
 
my $q=scalar @subgraphs; 
print "Number of connected components ", $q , "\n"; 
print "First connected component: ", @{ $subgraphs[0] }, "\n"; 
print "First connected component element: ", $subgraphs[0][1], "\n\n"; 
 
 
sub induced { 
my (@z)=@_; 
for my $QT (\@z ){ 
    #print Dumper $QT; 
    for my $triplet ( @trip ){ 
        my %Pie; 
        undef @Pie{@$QT}; 
        delete @Pie{ @$triplet }; 
        print "@$triplet\n" if keys(%Pie) <= ( @$QT - @$triplet ) ; 
        return (@$triplet); 
    } 
}} 
my @C; 
my $d; 
my $p=$#subgraphs+1; 
for ($d=$p; $d >=1; $d--) 
  {  
    print "component $d = @{ $subgraphs[$d-1] }\n"; 
    my $qw=induced(@{ $subgraphs[$d-1] }); 
print "induced=$qw\n"; 
 
}

-----------DATA---------- 
b c a 
a c d 
d e b

----TRIPLETS------- 
$VAR1 = [ 
          [ 
            'b', 
            'c', 
            'a' 
          ], 
          [ 
            'a', 
            'c', 
            'd' 
          ], 
          [ 
            'd', 
            'e', 
            'b' 
          ] 
        ]; 
 ----VERTICES------ 
$VAR1 = [ 
          'b', 
          'c', 
          'a', 
          'd', 
          'e' 
        ]; 
----EDGE LIST TO BUILD G(L)----- 
$VAR1 = [ 
          [ 
            'b', 
            'c' 
          ], 
          [ 
            'a', 
            'c' 
          ], 
          [ 
            'd', 
            'e' 
          ] 
        ]; 
Number of taxa=5 
Number of connected components 2 
First connected component: cba 
First connected component element: b 
 
component 2 = e d 
induced=3 
component 1 = c b a 
b c a 
induced=3

component 2 = e d 
component 1 = c b a 
induced=b c a

my $qw=induced(@{ $subgraphs[$d-1] });

 my @qw=induced(@{ $subgraphs[$d-1] }); 
    print Dumper @qw;

component 2 = e d 
b 
c 
a 
Induced==$VAR1 = 'b'; 
$VAR2 = 'c'; 
$VAR3 = 'a'; 
component 1 = c b a 
b c a 
b 
c 
a 
Induced==$VAR1 = 'b'; 
$VAR2 = 'c'; 
$VAR3 = 'a';

component 2 = e d 
component 1 = c b a 
induced=b c a

for ( $d = $p; $d >= 1; $d-- ) { 
    print "component $d = @{ $subgraphs[$d-1] }\n"; 
    my @qw = induced( @{ $subgraphs[ $d - 1 ] } ); 
    print Dumper \@qw; 
} 
print "induced=@qw\n";

component 2 = e d 
$VAR1 = [ 
          'b', 
          'c', 
          'a' 
        ]; 
component 1 = c b a 
b c a 
$VAR1 = [ 
          'b', 
          'c', 
          'a' 
        ]; 
induced=

print "induced=@qw\n";

#print Dumper @qw;

component 2 = e d 
component 1 = c a b 
b c a

component 3 = a c d e 
induced= a c d 
        d e b

component 2 = e d  
component 1 = c b a  
b c a  
$VAR1 = [  
          'b',  
          'c',  
          'a'  
        ];

---------DATA-------------- 
b c a 
a c d 
d e b 
e f g 
g d f 
h i g

component 2 = e d g f 
component 1 = c a b 
b c a

component 2 = e d g f 
e f g 
g d f 
component 1 = c a b 
b c a

perl -le '@x = qw(a b c d e f); 
            @y = qw(a d f); 
            $n = grep { $e = $_; not grep { $e =~ /\Q$_/i } @x } @y; 
            print "Count of elements in (@y) that are NOT present in (@x) = $n" 
           ' 
Count of elements in (a d f) that are NOT present in (a b c d e f) = 0

____DATA_____ 
b c a 
a c d 
d e b 
e f g 
g d f 
h i g

a b c 
a b d c 
e f d g

component 1 = a b c 
induced = b c a 
component = a b d c 
induced = b c a 
a c d 
component 3 = e f d g 
induced = e f g 
g d f

use strict; 
use warnings; 
my @components = ( 
    [qw(a b c)], 
    [qw(a b d c)], 
    [qw(e f d g)], 
    ); 
my @S; 
while (<DATA>) { 
    push @S, [split]; 
} 
 
foreach my $component (@components) { 
    print "component @$component\n"; 
    my @qw = induced ( $component, \@S  ); 
    print "Induced = @qw\n" if @qw; 
} 
 
sub induced { 
    my ($x, $yy) = @_; 
    foreach my $y (@$yy) { 
        my %seen; 
        @seen{@$x} = (); 
        my $n = grep {!exists $seen{$_}} @$y; 
#       print "Count of elements in (@$y) that are NOT present in (@$x) = $n\n"; 
        return @$y if !$n; 
    } 
    return (); 
} 
__DATA__ 
b c a 
a c d 
d e b 
e f g 
g d f 
h i g