Shell Programming and Scripting

#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)=join(induced(@{ $subgraphs[$d-1] }));
    print "induced=$qw";

}

----------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: cab
First connected component element: a



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

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

print "induced=$qw";

...
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)=join(induced(@{ $subgraphs[$d-1] }));
    print "induced=$qw";

}

$
$ perl -le '@x = qw(a b c); $y = join(@x); print $y'

$

$
$ perl -le '@x = qw(a b c); $y = join("~", @x); print $y'
a~b~c
$
$

component 2 = e d
induced=

component 1 = c a b
b c a
induced=

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

...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 = join " ", induced(@{ $subgraphs[$d-1] });
  print "induced = $qw\n";
}

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

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

---------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
$
$

#This program read the triplets from file named "data" and returns the
#supertree. 
# ___DATA(triplets)____
#b c a
#a c d
#d e b
#### NOTE ::: SuperTree part hasnt been incorporated yet.
use strict;
use warnings;
use Data::Dumper;
use Graph; 
use Data::Dump qw/ pp /;
####READ IN THE INPUT DATA ########
my @triplets; # Get all the triplets
 while (<>) {
        push @triplets, [ split ];
    }

#Make a deep copy of @triplets 
my @triplet_deep_copy = map { [@$_] } @triplets;


#####AUXILIARY GRAPH   G(L) #######
# In order to generate the G(L)  first of all extract first two columns of  @triplets #into another matrix
my @auxiliary_edges=@triplets;
splice(@$_, 2, 1)
foreach @auxiliary_edges;
print "----EDGE LIST TO BUILD AUXILIARY GRAPH-----\n";
print Dumper \@auxiliary_edges;


##### CONNECTED COMPONENTS ##########
my $auxiliary_graph = Graph->new( undirected => 1 );

my @from;
my @to;
for (my $p = 0; $p <= 2; $p++) {
        $from[$p]=$triplets[$p][0];
  }

for (my $q = 0; $q <= 2; $q++) {
        $to[$q]=$triplets[$q][1];
  }

for (my $r = 0; $r <= 2; $r++) {
     $auxiliary_graph->add_edge($from[$r], $to[$r]);
 }

my @subgraphs = $auxiliary_graph->connected_components; # Subgraphs
my $V = $auxiliary_graph->vertices; # Number of taxa
my $connected_components=scalar @subgraphs; #Get the number of #connected components

###### FINDING THE TRIPLETS WHICH ARE SUBSET(OR INDUCED BY) OF #EACH OF THE CONNECTED COMPONENTS######
Main(@auxiliary_edges);
exit(0);
sub induced {
  my $trip = shift;
  my @matches;
  for my $QT ( @_ ) {
         for my $triplet ( @$trip ) {
                my %seen;        # my %Pie;
                undef @seen{@$QT};
                delete @seen{@$triplet};
                if ( keys( %seen ) <= ( @$QT - @$triplet ) ) {
                     push @matches, $triplet;
      }
    } ## end for my $triplet ( @$trip )
  } ## end for my $QT ( @_ )
  return @matches;
}## end sub induced


sub Main {
  my $tree = Graph->new( undirected => 1 );
  my $dad='u';
  $tree->add_vertex($dad);
  for my $one (@subgraphs) {
      my @matches = induced( \@triplet_deep_copy, $one );
      print "\nTriplet induced by subgraph ", pp( $one => { MATCHES =>\@matches } ), "\n\n";
  }
}

___INPUT(set of triplets)____
b c a
a c d
d e b

b c
a c
d e

 a-c-b  d-e

TreeConstruct(S)
1. Let L be the set of species appear in S. Build G(L)
2. Let C1 , C2 , . . . , Cq be the set of connected components in G(L)
3. If q >1, then
• For i = 1, 2, . . . , q, let Si be the set of triplets in S labeled by the set
of leaves in Ci .
• Let Ti = TreeConstruct(Si )
• Let T be a tree formed by connecting all Ti with the same parent node.
Return T.
4. If q=1 and C1 contains exactly one leaf, return the leaf; else return fail.

1. Initially we have q=2 (a-c-b & d-e). So introduce an internal vertex (u) and make these connected components child of u. 
u=> a-c-b;
    d-e; 
2. Select component 1 = a-c-b. Check all lines from INPUT which are a subset of this component1.First line of INPUT i.e. "b c a" is a subset of component1.
3."b c a" now becomes the INPUT for the program and it is recursed again with this INPUT(Now for input "b c a" the auxiliary graph will be "b-c" & "a",i.e. 
two connected components,thus q=2 ...)

u  => u => d
        => e
   => u => a
        => u => b
             => c