#!/usr/bin/perl use strict; use CGI qw(:standard); use GD; print "Content-type: text/html\n\n"; my $cgi=new CGI; my $new_inter = $cgi->param('inter_new'); my $new_categ = $cgi->param('categ_new'); my $task_id = time; ### generate the task id for this calculation ### my ($screen_width, $screen_height) = (800,400); my ($x_boarder, $y_boarder) = (50,50); my $orf1 = $cgi->param('ORF_name_1'); $orf1 =~ s/\-//g; $orf1 =~ tr/[a-z]/[A-Z]/; my $orf2 = $cgi->param('ORF_name_2'); $orf2 =~ s/\-//g; $orf2 =~ tr/[a-z]/[A-Z]/; my $l_thresh = $cgi->param('threshold'); ### checking the input ### my ($factor1, $factor2, $factor3, $factor4); $factor1 = $factor2 = $factor3 = $factor4 = 1;; if (!$l_thresh) { $factor1 = 0; print " Did you forget to input the path length threshold?
"; } if (!$orf1) { $factor2 = 0; print " Did you forget to input the gene 1?
"; } if (!$orf2) { $factor3 = 0; print " Did you forget to input the gene 2?
"; } if ((!$cgi->param('bdm')) && (!$cgi->param('twohybrid')) && (!$cgi->param('coip')) && (!$cgi->param('inter_new_db'))) { $factor4 = 0; print " Did you forget to select any interaction datasets?
"; } if ((!$factor1) || (!$factor2) || (!$factor3) || (!$factor4)) { print "
Input error!
"; print ' Return to main menu '; exit; } my $NEW; my $infile; my @dataset_description; my $ds_description; my $trans_dataset=''; my $gnum=0, my $k=0; my $line; my @data; my ($MC, $BIND, $U_I, $M_C, $DATASET); my $dataset_file = '../dataset/ds_'.$task_id.'.txt'; my $i = 0; ### deal with the datasets ### (open(DATASET, ">$dataset_file")) || die "cannot open the file"; if ($cgi->param('bdm')) { $trans_dataset .= '&bdm=1'; $dataset_description[$k++]='BIND/DIP/MIPS'; (open(MC, "<../dataset/MC.txt")) || die "cannot open the file"; (open(BIND, "<../dataset/BIND_DIP_New.txt")) || die "cannot open the file"; while($line=) { chomp($line); @data=split("\t", $line); print DATASET "$data[0]\t$data[1]\n"; } while($line=) { chomp($line); @data=split("\t", $line); print DATASET "$data[0]\t$data[1]\n"; } } if ($cgi->param('twohybrid')) { $trans_dataset .= '&twohybrid=1'; $dataset_description[$k++]='Two Hybrid'; (open(U_I, "<../dataset/U_I.txt")) || die "cannot open the file"; while($line=) { chomp($line); @data=split("\t", $line); print DATASET "$data[0]\t$data[1]\n"; } } if ($cgi->param('coip')) { $trans_dataset .= '&coip=1'; $dataset_description[$k++]='CoIP'; (open(M_C, "<../dataset/M_C.txt")) || die "cannot open the file"; while($line=) { chomp($line); @data=split("\t", $line); print DATASET "$data[0]\t$data[1]\n"; } } if ($cgi->param('inter_new_db')) { $trans_dataset .= '&inter_new_db=1'; $dataset_description[$k++]='New_dataset'; (open(NEW, "<$new_inter")) || die "cannot open the file"; while($line=) { chomp($line); @data=split("\t", $line); print DATASET "$data[0]\t$data[1]\n"; } } close(DATASET); ### Calculate the paths ### my %G = &all_paths($orf1, $orf2, $l_thresh, $dataset_file); my %coords = &pick_coords(\%G, $orf1, $orf2, [$y_boarder, $x_boarder], [$screen_height - 2*$y_boarder, $screen_width - 2*$x_boarder]); &print_path(\%G, \%coords); ### functions for calculating the paths ### ### function for printing the spots ### sub print_spots { my $orf = shift; my $x = shift; my $y = shift; my $im = shift; $x = sprintf("%.0f", $x); $y = sprintf("%.0f", $y); my $black = $im->colorAllocate(0,0,0); my $blue = $im->colorAllocate(0,0,255); $im ->arc($x, $y, 10, 10, 0, 360, $black); $im ->fillToBorder($x, $y, $black, $blue); $x-=15; $y+=7; $im ->string(gdSmallFont, $x, $y, $orf, $black); return ($im); } ### function for searching all paths ### sub all_paths { # $_[0] = Source node, $_[1] = Target node, $_[2] = Path length limit, # $_[3] = Data file my $source = shift; my $target = shift; my $length_limit = shift; my $file_name = shift; my %G; #The adjacency hash. Assuming undirected, SIMPLE graph. open(DATASET, $file_name); while () { chomp; s/\-//g; tr/[a-z]/[A-Z]/; my @data = split("\t", $_); #@data == 2 || die("Bad line in input file.\n"); # DEBUGGING: Remove later push(@{$G{$data[0]}}, $data[1]); push(@{$G{$data[1]}}, $data[0]); } close(DATASET); if ($source eq $target || !exists($G{$source}) || !exists($G{$target})) { return (); } my %s_dist = ($source => 0); # Minimum distance from the source. my @Q = ($source); my %used_nodes; while (@Q > 0) { my $node = shift(@Q); my $d = $s_dist{$node}; if ($d >= $length_limit) { last; } foreach (@{$G{$node}}) { if (!exists($s_dist{$_})) { $s_dist{$_} = $d+1; push(@Q, $_); } } } if (!exists($s_dist{$source})) { return (); } my %t_dist = ($target => 0); # Minimum distance from the source. @Q = ($target); while (@Q > 0) { my $node = shift(@Q); my $d = $t_dist{$node}; if ($d >= $length_limit) { last; } foreach (@{$G{$node}}) { if (!exists($t_dist{$_})) { $t_dist{$_} = $d+1; push(@Q, $_); } } } my %H; foreach (keys %G) { if (exists($s_dist{$_}) && exists($t_dist{$_}) && ($s_dist{$_}+$t_dist{$_} <= $length_limit)) { $H{$_} = []; } } my $node; foreach $node (keys %H) { if ($s_dist{$node} + $t_dist{$node} == $length_limit) { foreach (@{$G{$node}}) { if (exists($H{$_}) && ($s_dist{$node} != $s_dist{$_} || $t_dist{$node} != $t_dist{$_})) { push(@{$H{$node}}, $_); } } } else { foreach (@{$G{$node}}) { if (exists($H{$_})) { push(@{$H{$node}}, $_); } } } } my @arr = keys %H; foreach (@arr) { # Need to add the "each" function in elsewhere!!! $node = $_; my $adjlist_ref = $H{$node}; while ($node ne $target && $node ne $source && @$adjlist_ref==1) { my $n = $adjlist_ref->[-1]; my $i=0; while ($H{$n}[$i] ne $node) { $i < @{$H{$n}} || die("Problem with graph.\n"); $i++; } if ($i < @{$H{$n}}-1) { $H{$n}[$i] = $H{$n}[-1]; } pop(@{$H{$n}}); delete $H{$node}; $node = $n; $adjlist_ref = $H{$n}; } } return %H; } ### function for calculating coords ### sub pick_coords { # $_[0] = Ref. to graph. # $_[1] = Source # $_[2] = Target # $_[3] = (x,y) (upper left-hand corner) # $_[4] = (h/w) (height, width) my %G = %{$_[0]}; my $source = $_[1]; my $target = $_[2]; my ($x_c, $y_c) = @{$_[3]}; my ($height, $width) = @{$_[4]}; my %node_to_level = ($source => 0); my @nodes_on_level = ([$source]); my @Q = ($source); while (@Q > 0) { my $current = shift(@Q); my $level = $node_to_level{$current}; my $child; foreach $child (@{$G{$current}}) { if (!defined($node_to_level{$child})) { $node_to_level{$child} = $level + 1; push(@{$nodes_on_level[$level+1]}, $child); push(@Q, $child); } } } my $num_levels = @nodes_on_level; my %coords; my $x_increment = $width / ($num_levels-1); my $x = $x_c; for (my $i=0; $i < $num_levels; $i++) { my @level = @{$nodes_on_level[$i]}; if (@level == 1) { $coords{$level[0]} = [$x, $y_c + $height/2]; } else { my $y_increment = $height / (@level-1); for (my $j=0; $j < @level; $j++) { $coords{$level[$j]} = [$x, $y_c + $y_increment*$j]; } } $x += $x_increment; } return %coords; } ### function for printing the paths ### sub print_path { my %G = %{$_[0]}; my @coords = %{$_[1]}; my ($x_c, $y_c) = (0,0); my $im = new GD::Image ($screen_width, $screen_height); # my $out = "$ARGV[0]"; my $out='../png/path/'.$task_id.'_path'.'.png'; my $white = $im->colorAllocate(255,255,255); my $black = $im->colorAllocate(0,0,0); my $green = $im->colorAllocate(0,255,0); my $red = $im->colorAllocate(255,0,0); my $blue = $im->colorAllocate(0,0,255); # make the background transparent and interlaced $im->transparent($white); $im->interlaced('true'); open(OUT, ">$out") || die "cannot open the out file"; my $node; foreach $node (keys %G) { $im = &print_spots($node, $coords{$node}[0], $coords{$node}[1], $im); foreach (@{$G{$node}}) { if ($coords{$node}[0]==$coords{$_}[0]) { my $h = $coords{$node}[1]-$coords{$_}[1]; $h = $h >= 0 ? $h : -$h; my $y = sprintf("%.0f", ($coords{$node}[1]+$coords{$_}[1])/2); $im->arc($coords{$node}[0], $y, sprintf("%.0f", $h/5), $h, 270, 90, $black); } elsif ($coords{$node}[1]==$coords{$_}[1]) { my $w = $coords{$node}[0]-$coords{$_}[0]; $w = $w >= 0 ? $w : -$w; my $x = sprintf("%.0f", ($coords{$node}[0]+$coords{$_}[0])/2); $im->arc($x, $coords{$node}[1], $w, sprintf("%.0f", $w/5), 0, 180, $black); } else { $im->line($coords{$node}[0],$coords{$node}[1],$coords{$_}[0],$coords{$_}[1], $black); } } } binmode OUT; print OUT $im->png; close OUT; } ### Start to print the out interface ### print < Graph properties calculation
Yale Gerstein Lab
'; print ''; print ''; print ''; print ''; print ''; print ''; print ''; print ''; print ''; print ''; print < HTML2 exit;
 
 
Search result
 
HTML1 print ''; print ''; print ''; print ''; print ''; print ''; print ''; print ''; print ''; print ''; print ''; print ''; print ''; print ''; print '
Interaction Datasets: '; $ds_description = $dataset_description[0]; print "$dataset_description[0]"; for ($i=1; $i<$k; $i++) { print '&&'."$dataset_description[$i]"; $ds_description.=('&&'."$dataset_description[$i]"); } print '
'; print 'The first ORF:'; print ''; print $orf1; print '
'; print 'The second ORF:'; print ''; print $orf2; print '
'; print 'Maximum length of paths:'; print ''; print $l_thresh; print '
'; print '
 
 
'; print ''; print '