t/protgraph.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7     use lib '.';
   8     use Bio::Root::Test;
   9
  10         # note: modules have been deprecated for the 1.6 release. Use
  11         # bioperl-network instead
  12
  13     test_begin(-tests => 0);
  14 }
  15
  16 ################1st of all let's test the io.....
  17 ###############  test dip tab delimited  format  ###################
  18 ## test read...
  19
  20 my %ids;
  21 my $gr;
  22 ok my $io = Bio::Graph::IO->new(
  23   -format => 'dip',
  24   -file   => test_input_file('tab1part.mif'),
  25   -threshold => 0.6);
  26
  27 ok  $gr = $io->next_network();
  28
  29 ok my $node   = $gr->nodes_by_id('A64696');
  30 is $node->accession_number, 'A64696';
  31
  32 ##test write. to filehandle...
  33 my $out_file = test_output_file();
  34 ok my $out =  Bio::Graph::IO->new(
  35   -format => 'dip',
  36   -file   =>">$out_file");
  37 ok $out->write_network($gr);
  38
  39 ## get articulation_points.
  40 my @nodes = $gr->articulation_points();
  41
  42 ##now remove 2 nodes: this removes 4 edges and  3087 should be a new artic point
  43 is $gr->edge_count, 72;
  44 $gr->remove_nodes($gr->nodes_by_id('3082N'), $gr->nodes_by_id('3083N'));
  45 is $gr->edge_count, 68;
  46  my $nodes = $gr->articulation_points();
  47 ok grep {$_->object_id eq 'H64521'} @$nodes;
  48 is scalar @$nodes, 13;
  49 @nodes = @{$gr->articulation_points()};
  50 # <NOTE>
  51 # these were failing, I don't understand the module enough to know if
  52 # this is a bug. Richard needs to look at it
  53 TODO: {
  54         local $TODO = 'Possible bug!';
  55         ok grep {$_->object_id eq 'B64701'} @nodes;
  56         is scalar @nodes, 14;
  57 }
  58
  59 ok grep {$_->object_id eq 'B64528'} @nodes;
  60 is scalar @nodes, 13;
  61 # </NOTE>
  62
  63 ok $node   = $gr->nodes_by_id('A64696');
  64 is $node->accession_number, 'A64696';
  65
  66
  67 ## can we round trip, is out format same as original format?
  68 ok my $io2 = Bio::Graph::IO->new(
  69   -format    => 'dip',
  70   -file     => $out_file);
  71 ok      my $g2     = $io2->next_network();
  72 ok  $node      = $g2->nodes_by_id('A64696');
  73 is $node->accession_number, 'A64696';
  74
  75 ##### now lets test some graph properties.....##
  76 ## basic properties from SImpleGraph.
  77
  78 is sprintf("%.3f",$g2->density), "0.027";
  79 is $g2->is_connected, '';
  80 is $g2->is_forest, undef;
  81 is $g2->is_tree, '';
  82 is $g2->is_empty, '';
  83 is $g2->is_cyclic, 1;
  84
  85 ## get connected subgraphs
  86 my @components = $g2->components();
  87 is scalar @components, 5;
  88
  89 ## get nodes connected to parameter
  90 my $t       = $g2->traversal($g2->nodes_by_id('3079N'));
  91 my @dfnodes = $t->get_all;
  92 ##
  93
  94 ##before deleting 3048N,  3047N has 2 neighbours
  95 my @n1 = $g2->neighbors($g2->nodes_by_id('3047N'));
  96 is scalar @n1,2;
  97
  98 ok $g2->remove_nodes($g2->nodes_by_id('3048N'));
  99
 100 ## after deleting there is only 1 interactor
 101 @n1 = $g2->neighbors($g2->nodes_by_id('3047N'));
 102 is scalar @n1,1;
 103
 104 ##check no undefs left after node removal ##
 105
 106 ok map {$_->object_id}$g2->edges;
 107
 108 ## get an edge by its id
 109
 110 ok my $edge = $g2->edge_by_id('4368E');
 111 is $edge->object_id, '4368E';
 112
 113 ## count all edges
 114 my $count = 0;
 115 is $g2->edge_count, 71;
 116
 117 my @n = $g2->neighbors($g2->nodes_by_id('3075N'));
 118 is scalar @n, 13;
 119
 120 ok $g2->remove_nodes($g2->nodes_by_id('3075N'));
 121
 122 ## should be 13  less interactions in graph.
 123 is scalar $g2->edge_count, 58;
 124
 125 ## many more subgraphs now
 126 @components = $g2->components();
 127 #there were 5 subgraphs, now there are 10 unconnected nodes, total 15
 128 is scalar @components, 15;
 129
 130 ## how many unconnected nodes?
 131 my @ucnodes = $g2->unconnected_nodes;
 132 is scalar  @ucnodes, 10;
 133
 134 ##get CC using protein object..
 135 is  sprintf("%.3f", $g2->clustering_coefficient($g2->nodes_by_id('B64525'))), 0.022;
 136
 137 #.. and using id string (same as previous, for convenience      )
 138 is  sprintf("%.3f", $g2->clustering_coefficient('B64525')), 0.022;
 139
 140 ## test has_node() method
 141 is $g2->has_node('B64525'), 1;
 142 is $g2->has_node('B64'), 0;
 143
 144 ## remove a single duplicate edge
 145 ok $g2->remove_dup_edges($g2->nodes_by_id('3103N'));
 146
 147 ## remove  all duplicate edges
 148 ok $g2->remove_dup_edges();
 149
 150 ## should now be no duplicates
 151 my @dupids = map{$_->object_id()} $g2->dup_edges();
 152 is $dupids[0], undef;
 153
 154 ########### now we test the 'union()' method to see it conforms to
 155 ## the rules described in its documentation:
 156
 157 $io = Bio::Graph::IO->new(
 158    -format => 'dip',
 159    -file   => test_input_file('tab1part.mif'));
 160 $gr = $io->next_network();
 161 $io2 = Bio::Graph::IO->new(
 162    -format => 'dip',
 163    -file   => test_input_file('tab1part.mif'));
 164
 165 $g2 = $io2->next_network();
 166
 167 # First of all we put the same graph into both variables. After a union
 168 # graph 1 should be unaffected. Because all edge ids are the same,
 169 # all duplicates will be redundant.
 170 # therea re 3 duplicates in dataset.
 171 my @dups = $gr->dup_edges();
 172 is scalar @dups, 3;
 173 $gr->union($g2);
 174 @dups = $gr->dup_edges();
 175 is scalar @dups, 3;
 176 my @redundant = $gr->redundant_edge();
 177 is scalar @redundant, 72;
 178
 179 ## now lets do a union with a graph that has some new edges,
 180 ## using existing nodes
 181
 182 ##read in graph data
 183 $gr = undef;
 184 $g2 = undef;
 185 $io = Bio::Graph::IO->new(
 186    -format => 'dip',
 187    -file   => test_input_file('tab1part.mif'));
 188 $gr = $io->next_network();
 189 $io2 = Bio::Graph::IO->new(
 190     -format => 'dip',
 191     -file   => test_input_file('tab2part.mif'));
 192 $g2 = $io2->next_network();
 193 is $gr->edge_count, 72;
 194 is $gr->node_count, 74;
 195 $gr->union($g2);
 196 #there should be 1 more edge in the graph $gr now, with no new nodes.
 197 #$g2 is unaffected.
 198 is $gr->edge_count, 73;
 199 is $gr->node_count, 74;
 200
 201 ## now lets test a union that has new nodes in $g2
 202 $gr = undef;
 203 $g2 = undef;
 204 $io = Bio::Graph::IO->new
 205     (-format => 'dip',
 206      -file   => test_input_file('tab1part.mif'));
 207 $gr = $io->next_network();
 208 $io2 = Bio::Graph::IO->new
 209     (-format => 'dip',
 210      -file   => test_input_file('tab3part.mif'));
 211
 212 $g2 = $io2->next_network();
 213 is $gr->edge_count, 72;
 214 is $gr->node_count, 74;
 215 $gr->union($g2);
 216 # there should be 2 more edge in the graph $gr now and 2 more nodes.
 217 # $g2 is unaffected.
 218 is $gr->edge_count, 74;
 219 is $gr->node_count, 76;
 220
 221 # test IO/psi_xml if the required modules are present
 222 SKIP: {
 223     test_skip(-tests => 12, -requires_module => 'XML::Twig');
 224         # PSI XML from DIP
 225         ok $io = Bio::Graph::IO->new
 226           (-format => 'psi_xml',
 227                 -file   => test_input_file('psi_xml.dat'));
 228         ok my $g = $io->next_network();
 229         is $g->edge_count, 3;
 230         is $g->node_count, 4;
 231         #my @rts =$g->articulation_points();
 232         my $n = $g->nodes_by_id(207153);
 233         is $n->species->node_name,"Helicobacter pylori 26695";
 234         is $n->primary_seq->desc,"bogus-binding membrane protein (lepA) HP0355";
 235
 236         # PSI XML from IntAct
 237         ok my $io2 = Bio::Graph::IO->new
 238           (-format => 'psi_xml',
 239                 -file   => test_input_file('sv40_small.xml'));
 240         ok my $g3 = $io2->next_network();
 241         is $g3->edge_count, 3;
 242         is $g3->node_count, 5;
 243
 244         my @rts =$g->articulation_points();
 245         $n = $g->nodes_by_id(207153);
 246         TODO: {
 247                 local $TODO = 'Possible bug in binomial output';
 248                 is $n->species->binomial(),"Helicobacter pylori 26695";
 249         }
 250         is $n->primary_seq->desc,"bogus-binding membrane protein (lepA) HP0355";
 251 }