#!/usr/bin/perl if ($#ARGV != 2) { print "Graph Merger for Cytoscape v2.1 or less.\n"; print "Developed by Junghwan Park , 2005/Aug/14\n\n"; print "Usage: merger networkfile1 networkfile2 outputnetfile\n"; } $input[0] = $ARGV[0]; $input[1] = $ARGV[1]; $output = $ARGV[2]; my $nets; # parse all the files for ($i=0;$i<=$#input;$i++) { $inputfile = $input[$i]; # determine the fileformat if ($inputfile =~ /\.gml$/) { $fileformat[$i] = 'gml'; } elsif ($inputfile =~ /\.sif$/) { $fileformat[$i] = 'sif'; } else { $fileformat[$i] = 'none'; } # file parsing if ($fileformat[$i] eq 'gml') { # gml file parsing &parsegml($inputfile, $nets, $i); } elsif ($fileformat[$i] eq 'sif') { &parsesif($inputfile, $nets, $i); } } # get net overview my $bds; foreach $netindex (keys(%{$nets})) { if ($fileformat[$netindex] eq 'gml') { $bds->{$netindex}->[0] = 0; # left $bds->{$netindex}->[1] = 0; # right $bds->{$netindex}->[2] = 0; # top $bds->{$netindex}->[3] = 0; # bottom foreach $nodeindex (@{$nets->{$netindex}->{'graph'}->[0]->{'node'}}) { $curnode = $nodeindex->{'graphics'}->[0]; $bd = $bds->{$netindex}; $bd->[0] = updateval1($bd->[0], $curnode->{'x'} - $curnode->{'w'}/2); $bd->[1] = updateval2($bd->[1], $curnode->{'x'} + $curnode->{'w'}/2); $bd->[2] = updateval1($bd->[2], $curnode->{'y'} - $curnode->{'h'}/2); $bd->[3] = updateval2($bd->[3], $curnode->{'y'} + $curnode->{'h'}/2); } $bds->{$netindex}->[4] = ($bds->{$netindex}->[1] + $bds->{$netindex}->[0])/2; # x $bds->{$netindex}->[5] = ($bds->{$netindex}->[3] + $bds->{$netindex}->[2])/2; # y $bds->{$netindex}->[6] = ($bds->{$netindex}->[1] - $bds->{$netindex}->[0]); # w $bds->{$netindex}->[7] = ($bds->{$netindex}->[2] - $bds->{$netindex}->[3]); # h } } # merge nodes my $newnodebank = {}; my %newnodeinfo; foreach $netindex (keys(%{$nets})) { foreach $curgraph (@{$nets->{$netindex}->{'graph'}}) { foreach $curnode (@{$curgraph->{'node'}}) { $newnodeindex = addnode($curnode->{'label'}, $newnodebank); $newnodeinfo[$newnodeindex] = $curnode; } } } # merge edges my @newedgebank; foreach $netindex (keys(%{$nets})) { foreach $curgraph (@{$nets->{$netindex}->{'graph'}}) { foreach $curedge (@{$curgraph->{'edge'}}) { $curnodeset = $curgraph->{'node'}; $csource = addnode(lookupname($curedge->{'source'},$curnodeset),$newnodebank); $ctarget = addnode(lookupname($curedge->{'target'},$curnodeset),$newnodebank); push(@newedgebank, [$csource, $ctarget, $curedge]); } } } # output files open (OUT, ">".$output); print OUT "Creator\t\"Merger v1.0\"\n"; print OUT "Version\t\"1.0\"\n"; print OUT "graph\t\[\n"; for ($i=0;$i<=$#newnodeinfo;$i++) { if (exists($newnodeinfo[$i]->{'graphics'})) { print OUT "\tnode\t[\n"; print OUT "\t\troot_index\t$i\n"; print OUT "\t\tid\t$i\n"; foreach $att (keys(%{$newnodeinfo[$i]})) { if ($att ne 'root_index' && $att ne 'mother' && $att ne 'id') { if ($att ne 'graphics') { if ($newnodeinfo[$i]->{$att} =~ /[^-0-9.]/) { print OUT "\t\t".$att."\t\"".$newnodeinfo[$i]->{$att}."\"\n"; } else { print OUT "\t\t".$att."\t".$newnodeinfo[$i]->{$att}."\n"; } } else { print OUT "\t\tgraphics\t[\n"; foreach $gatt (keys(%{$newnodeinfo[$i]->{'graphics'}->[0]})) { if ($gatt ne 'mother') { unless ($newnodeinfo[$i]->{'graphics'}->[0]->{$gatt} =~ /^[0-9\.\-]+$/) { print OUT "\t\t\t".$gatt."\t\"".$newnodeinfo[$i]->{'graphics'}->[0]->{$gatt}."\"\n"; } else { print OUT "\t\t\t".$gatt."\t".$newnodeinfo[$i]->{'graphics'}->[0]->{$gatt}."\n"; } } } print OUT "\t\t]\n"; } } } print OUT "\t]\n"; } } $newxbase = $bds->{0}->[1]; $newybase = $bds->{0}->[3]; $newxwidth = $bds->{0}->[6]*0.1; $newywidth = $bds->{0}->[7]*0.1; for ($i=0;$i<=$#newnodeinfo;$i++) { unless (exists($newnodeinfo[$i]->{'graphics'})) { print OUT "\tnode\t[\n"; print OUT "\t\troot_index\t$i\n"; print OUT "\t\tid\t$i\n"; foreach $att (keys(%{$newnodeinfo[$i]})) { if ($att ne 'id') { unless ($newnodeinfo[$i]->{$att} =~ /^[0-9\.\-]+$/) { print OUT "\t\t".$att."\t\"".$newnodeinfo[$i]->{$att}."\"\n"; } else { print OUT "\t\t".$att."\t".$newnodeinfo[$i]->{$att}."\n"; } } } print OUT "\t\tgraphics\t[\n"; $newx = $newxbase + $newxwidth*rand(1); $newy = $newybase - $newywidth*rand(1); print OUT "\t\t\tx\t$newx\n"; print OUT "\t\t\ty\t$newy\n"; print OUT "\t\t\tw\t30.0\n"; print OUT "\t\t\th\t30.0\n"; print OUT "\t\t\tfill\t\"#000000\"\n"; print OUT "\t\t\ttype\t\"ellipse\"\n"; print OUT "\t\t\toutline\t\"#000000\"\n"; print OUT "\t\t\toutline_width\t1.0\n"; print OUT "\t\t]\n"; print OUT "\t]\n"; } } for ($i=0;$i<=$#newedgebank;$i++) { print OUT "\tedge\t[\n"; print OUT "\t\tsource\t".$newedgebank[$i]->[0]."\n"; print OUT "\t\ttarget\t".$newedgebank[$i]->[1]."\n"; print OUT "\t\tlabel\t\"".$newedgebank[$i]->[2]->{'label'}."\"\n"; print OUT "\t]\n"; } print OUT "]"; print "\n"; sub lookupname { ($nodeid, $nodeset) = @_; foreach $curnodeid (@{$nodeset}) { if ($curnodeid->{'id'} eq $nodeid) { return $curnodeid->{'label'}; } } return ''; } sub updateval1 { ($old, $new) = @_; if ($old == 0) { return $new; } else { if ($old < $new) { return $old; } else { return $new; } } } sub updateval2 { ($old, $new) = @_; if ($old == 0) { return $new; } else { if ($old > $new) { return $old; } else { return $new; } } } sub getsifinfo { $line = $_[0]; @lineinfo = split(/\s/, $line); return @lineinfo; } sub addnode { ($sname, $nb) = @_; if (exists($nb->{'_li'})) { if (exists($nb->{$sname})) { return $nb->{$sname}; } else { $nb->{$sname} = $nb->{'_li'}; $nb->{'_li'}++; return $nb->{$sname}; } } else { $nb->{$sname} = 0; $nb->{'_li'} = 1; return $nb->{$sname}; } return -1; } sub parsesif { ($filename, $nets, $i) = @_; my $nodebank, @edgebank; $nodebank = {}; open (FH, $filename); $nets->{$i} = {}; $curnet = $nets->{$i}; $curnet->{'Creator'} = '"Y"'; $curnet->{'Version'} = '1.0'; $curnet->{'graph'}->[0] = {}; $curgraph = $curnet->{'graph'}->[0]; $nodeindex = 0; $edgeindex = 0; $curnet->{'label'} = '""'; while () { ($source, $label, @targets) = getsifinfo($_); if ($label ne '') { $sourceid = addnode($source, $nodebank); foreach $target (@targets) { $targetid = addnode($target, $nodebank); push(@edgebank, $sourceid."\t".$label."\t".$targetid); } } else { $sourceid = addnode($source, $nodebank); } } foreach $node (keys(%{$nodebank})) { if ($node ne '_li') { $curgraph->{'node'}->[$nodeindex]->{'label'} = $node; $curgraph->{'node'}->[$nodeindex]->{'id'} = $nodebank->{$node}; $nodeindex++; } } foreach $edge (@edgebank) { @edgeinfo = split(/\t/, $edge); $curgraph->{'edge'}->[$edgeindex]->{'source'} = $edgeinfo[0]; $curgraph->{'edge'}->[$edgeindex]->{'label'} = $edgeinfo[1]; $curgraph->{'edge'}->[$edgeindex]->{'target'} = $edgeinfo[2]; $edgeindex++; } $nets->{$i} = $curnet; } sub getval { $line = $_[0]; @lineinfo = split(/\s/, $line); return $lineinfo[1]; } sub getelem { $line = $_[0]; @lineinfo = split(/\s/, $line); return $lineinfo[0]; } sub parsegml { ($filename, $nets, $i) = @_; my $gmldata = {}; my $cur = $gmldata; my $lastkey = ''; my $status = 'keyword'; # keyword or value open (GML, $filename); while () { chomp; $line = $_; @words = split(/\t/, $line); foreach $word (@words) { $word =~ s/\"//g; $word =~ s/[^A-Za-z0-9\.\-\#\_\[\]]//g; if ($word =~ /\[/) { if ($status eq 'value') { # [ appeared. The space should be prepared to be an array storage if (ref($cur->{$lastkey}) eq 'HASH') { # space supposed to be used as value storage if (exists($cur->{$lastkey}->{'mother'})) { # already a single data is stored $temp = $cur->{$lastkey}; undef $cur->{$lastkey}; $cur->{$lastkey}->[0] = $temp; $status = 'keyword'; $cur = $cur->{$lastkey}->[1]; } else { $cur->{$lastkey}->{'mother'} = $cur; $status = 'keyword'; $cur = $cur->{$lastkey}; } } else { # space is already reserved as array storage $lastindex = @{$cur->{$lastkey}}; $cur->{$lastkey}->[$lastindex]->{'mother'} = $cur; $status = 'keyword'; $cur = $cur->{$lastkey}->[$lastindex]; $lastkey = ''; } } } elsif ($word =~ /\]/) { $cur = $cur->{'mother'}; } else { unless ($word =~ /\[/ || $word =~ /\]/ || $word eq '') { # keyword or value (normal string) if ($status eq 'keyword') { # keyword if (exists($cur->{$word})) { # $status = 'value'; $lastkey = $word; } else { $status = 'value'; $lastkey = $word; } } else { # value $cur->{$lastkey} = $word; $status = 'keyword'; $lastkey = ''; } } } } } $nets->{$i} = $gmldata; }