t/ProteinNet.t

   1 # This is -*-Perl-*- code#
   2 # Bioperl Test Harness Script for Modules
   3 # $Id: protgraph.t,v 1.1 2004/03/13 23:45:32 radams Exp
   4
   5 use vars qw($NUMTESTS $DEBUG $ERROR);
   6 use strict;
   7 $DEBUG = $ENV{'BIOPERLDEBUG'} || 0;
   8
   9 BEGIN {
  10         # to handle systems with no installed Test module
  11         # we include the t dir (where a copy of Test.pm is located)
  12         # as a fallback
  13         eval { require Test; };
  14         $ERROR = 0;
  15         if ( $@ ) {
  16                 use lib 't';
  17         }
  18         use Test;
  19         $NUMTESTS = 168;
  20         plan tests => $NUMTESTS;
  21         eval { require Graph; };
  22         if ($@) {
  23                 warn "Perl's Graph needed for the bioperl-network package, skipping tests";
  24                 $ERROR = 1;
  25         }
  26         eval { require XML::Twig; };
  27         if ($@) {
  28                 warn "XML::Twig needed for XML format parsing, skipping tests";
  29                 $ERROR = 1;
  30         }
  31 }
  32
  33 END {
  34         foreach ( $Test::ntest..$NUMTESTS) {
  35                 skip("Missing dependencies. Skipping tests",1);
  36         }
  37 }
  38
  39 exit 0 if $ERROR ==  1;
  40
  41 require Bio::Network::ProteinNet;
  42 require Bio::Network::IO;
  43 require Bio::Network::Interaction;
  44
  45 my $verbose = 0;
  46 $verbose = 1 if $DEBUG;
  47
  48 ok 1;
  49
  50 #
  51 # read old DIP format
  52 #
  53 my $io = Bio::Network::IO->new(
  54   -format => 'dip_tab',
  55   -file   => Bio::Root::IO->catfile("t","data","tab1part.tab"),
  56   -threshold => 0.6);
  57 ok(defined $io);
  58 ok my $g1 = $io->next_network();
  59 ok my $node = $g1->get_nodes_by_id('PIR:A64696');
  60 my @proteins = $node->proteins;
  61 ok $proteins[0]->accession_number, 'PIR:A64696';
  62 ok $node = $g1->nodes_by_id('PIR:A64696');
  63 @proteins = $node->proteins;
  64 ok $proteins[0]->accession_number, 'PIR:A64696';
  65 my %ids = $g1->get_ids_by_node($node);
  66 my $x = 0;
  67 my @ids = qw(A64696 2314583 3053N);
  68 for my $k (keys %ids) {
  69         ok $ids{$k},$ids[$x++];
  70 }
  71 #
  72 # test deleting nodes
  73 #
  74 ok $g1->edges, 79;
  75 ok $g1->vertices, 76;
  76 # now remove 2 nodes: this removes 4 edges
  77 my $g2 = $g1->delete_vertices($g1->get_nodes_by_id('DIP:3082N'),
  78                                                                            $g1->get_nodes_by_id('DIP:3083N') );
  79 ok $g2->edges, 75;
  80 ok $g2->vertices, 74;
  81 #
  82 # test for identifiers and Annotations
  83 #
  84 ok $node = $g1->get_nodes_by_id('PIR:A64696');
  85 @proteins = $node->proteins;
  86 ok $proteins[0]->accession_number,'PIR:A64696';
  87 my $ac = $proteins[0]->annotation;
  88 @ids = $ac->get_Annotations('dblink');
  89 ok $ids[0]->primary_id, "A64696";
  90 ok $ids[1]->primary_id, "3053N";
  91 ok $ids[2]->primary_id, "2314583";
  92 #
  93 # test some basic graph properties from Graph
  94 #
  95 ok sprintf("%.3f",$g2->density), "0.028";
  96 ok $g2->is_connected, "";
  97 ok $g2->is_forest, "";
  98 ok $g2->is_tree, "";
  99 ok $g2->is_empty, "";
 100 ok $g2->is_cyclic, 1;
 101 ok $g2->expect_undirected;
 102 #
 103 # get connected subgraphs
 104 #
 105 my @components = $g2->connected_components();
 106 ok scalar @components, 7;
 107 #
 108 # before deleting 3048N, 3047N has 2 neighbours
 109 #
 110 my @n1 = $g2->neighbors($g2->get_nodes_by_id('DIP:3047N'));
 111 ok scalar @n1,2;
 112
 113 ok $g2->delete_vertices($g2->get_nodes_by_id('DIP:3048N'));
 114 #
 115 # after deleting there is only 1 interactor
 116 #
 117 @n1 = $g2->neighbors($g2->get_nodes_by_id('DIP:3047N'));
 118 ok scalar @n1,1;
 119 my $ncount = $g2->neighbor_count($g2->get_nodes_by_id('DIP:3047N'));
 120 ok $ncount, 1;
 121 #
 122 # check no undefs left after node removal
 123 #
 124 my @edges = $g2->edges;
 125 for my $edgeref (@edges) {
 126         my %interactions = $g2->get_interactions(@$edgeref);
 127         for my $interaction (values %interactions) {
 128                 ok $interaction->primary_id;
 129         }
 130 }
 131 #
 132 # get an Interaction by its id
 133 #
 134 ok my $interx = $g2->get_interaction_by_id('DIP:4368E');
 135 ok $interx->primary_id, 'DIP:4368E';
 136 #
 137 # count all edges
 138 #
 139 my $count = 0;
 140 ok $g2->edges, 74;
 141
 142 my @n = $g2->neighbors($g2->get_nodes_by_id('DIP:3075N'));
 143 ok scalar @n, 12;
 144
 145 ok $g2->remove_nodes($g2->get_nodes_by_id('DIP:3075N'));
 146 ok scalar $g2->edges,62;
 147 #
 148 # test connected_components
 149 #
 150 @components = $g2->connected_components();
 151 ok scalar @components, 17;
 152 #
 153 # test isolated_vertices
 154 #
 155 my @ucnodes = $g2->isolated_vertices;
 156 ok scalar @ucnodes, 10;
 157 #
 158 # test clustering_coefficent
 159 #
 160 ok  sprintf("%.3f", $g2->clustering_coefficient($g2->get_nodes_by_id('PIR:B64525'))), 0.022;
 161 #
 162 # test get_nodes_by_id() method
 163 #
 164 ok defined $g2->get_nodes_by_id('PIR:B64525');
 165 ok $g2->get_nodes_by_id('B64'), undef;
 166 #
 167 # test subgraph
 168 #
 169 $io = Bio::Network::IO->new
 170 (-format => 'psi',
 171  -file   => Bio::Root::IO->catfile("t","data","bovin_small_intact.xml"));
 172 my $g = $io->next_network();
 173 ok $g->edges, 15;
 174 ok $g->nodes, 23;
 175
 176 @ids = qw(EBI-354674 EBI-444335 EBI-349968 EBI-354657
 177                          EBI-302230 EBI-640775 EBI-640793 EBI-79764);
 178 my @nodes = $g->get_nodes_by_id(@ids);
 179 ok scalar @nodes,8;
 180 my $sg = $g->subgraph(@nodes);
 181 ok $sg->edges, 5;
 182 ok $sg->nodes, 8;
 183
 184 @nodes = $g->get_nodes_by_id($ids[0]);
 185 $sg = $g->subgraph(@nodes);
 186 ok $sg->edges, 0;
 187 ok $sg->nodes, 1;
 188 #
 189 # test internal method _all_pairs
 190 #
 191 my @pairs = $g->_all_pairs(@ids);
 192 ok $#pairs, 27;
 193 @pairs = $g->_all_pairs("A","B");
 194 ok scalar @pairs, 1;
 195 #
 196 # test the add_interactions_from() method
 197 #
 198 $io = Bio::Network::IO->new
 199     (-format => 'dip_tab',
 200      -file   => Bio::Root::IO->catfile("t","data","tab4part.tab"));
 201 $g1 = $io->next_network();
 202
 203 my $io2 = Bio::Network::IO->new
 204     (-format => 'dip_tab',
 205      -file   => Bio::Root::IO->catfile("t","data","tab3part.tab"));
 206 $g2 = $io2->next_network();
 207
 208 ok $g1->edges, 5;
 209 ok $g1->nodes, 7;
 210 ok $g2->edges, 3;
 211 ok $g2->nodes, 5;
 212
 213 ok my $node1 = $g1->get_nodes_by_id("UniProt:Q09472");
 214 ok my $node2 =  $g1->get_nodes_by_id("UniProt:P04637");
 215 my %interx = $g1->get_interactions($node1,$node2);
 216 ok scalar keys %interx,1;
 217
 218 ok $node1 = $g1->get_nodes_by_id("UniProt:P10243");
 219 ok $node2 =     $g1->get_nodes_by_id("GenBank:2134877");
 220 %interx = $g1->get_interactions($node1,$node2);
 221 ok scalar keys %interx,1;
 222
 223 ok my $ix = $g1->get_interaction_by_id("DIP:16E"), undef;
 224 ok $ix = $g1->get_interaction_by_id("DIP:19E"), undef;
 225
 226 $g1->add_interactions_from($g2);
 227 #
 228 # $g1 should have 2 more Interactions with new interaction ids and
 229 # the same number of nodes and edges, $g2 should be unaffected
 230 #
 231 ok $g1->edges, 5;
 232 ok $g1->nodes, 7;
 233 ok $g2->edges, 3;
 234 ok $g2->nodes, 5;
 235
 236 ok $node1 = $g1->get_nodes_by_id("UniProt:Q09472");
 237 ok $node2 =     $g1->get_nodes_by_id("UniProt:P04637");
 238 %interx = $g1->get_interactions($node1,$node2);
 239 ok scalar keys %interx, 2;
 240
 241 ok $node1 = $g1->get_nodes_by_id("UniProt:P10243");
 242 ok $node2 =     $g1->get_nodes_by_id("GenBank:2134877");
 243 %interx = $g1->get_interactions($node1,$node2);
 244 ok scalar keys %interx, 2;
 245
 246 ok $ix = $g1->get_interaction_by_id("DIP:16E");
 247 ok $ix->weight, 3;
 248 ok $ix = $g1->get_interaction_by_id("DIP:19E");
 249 ok $ix->weight, 12;
 250 #
 251 # test that removing a node removes its edges correctly
 252 #
 253 ok $io = Bio::Network::IO->new
 254   (-format => 'psi',
 255         -file   => Bio::Root::IO->catfile("t", "data", "sv40_small.xml"));
 256 ok $g1 = $io->next_network();
 257 ok $g1->edge_count, 3;
 258 ok $g1->node_count, 5;
 259 ok $g1->is_connected, "";
 260 @components = $g1->connected_components;
 261 ok scalar @components, 2;
 262
 263 my $n = $g1->get_nodes_by_id("EBI-617321");
 264 my @ns = $g1->edges_at($n);
 265 ok scalar @ns, 2;
 266 $g1->remove_nodes($n);
 267 ok $g1->edge_count, 1;
 268 ok $g1->node_count, 4;
 269 @components = $g1->connected_components;
 270 ok scalar @components, 3;
 271 @ns = $g1->isolated_vertices;
 272 ok scalar @ns, 2;
 273 @ns = $g1->unconnected_nodes;
 274 ok scalar @ns, 2;
 275 @ns = $g1->self_loop_vertices;
 276 ok @ns, 0;
 277 #
 278 # test components
 279 #
 280 @components = $g1->components;
 281 ok scalar @components, 3;
 282
 283 __END__
 284
 285 Need to test:
 286
 287 _get_ids