[Bio] / FigWebServices / rae.cgi Repository:
ViewVC logotype

View of /FigWebServices/rae.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (download) (annotate)
Mon Dec 5 19:12:12 2005 UTC (13 years, 11 months ago) by olson
Branch: MAIN
CVS Tags: mgrast_dev_08112011, rast_rel_2009_05_18, mgrast_dev_08022011, rast_rel_2014_0912, rast_rel_2008_06_18, myrast_rel40, rast_rel_2008_06_16, mgrast_dev_05262011, rast_rel_2008_12_18, mgrast_dev_04082011, rast_rel_2008_07_21, rast_rel_2010_0928, rast_2008_0924, mgrast_version_3_2, mgrast_dev_12152011, rast_rel_2008_04_23, mgrast_dev_06072011, rast_rel_2008_09_30, rast_rel_2009_0925, rast_rel_2010_0526, rast_rel_2014_0729, mgrast_dev_02212011, rast_rel_2010_1206, caBIG-05Apr06-00, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2010_0118, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, rast_rel_2009_02_05, rast_rel_2011_0119, mgrast_rel_2008_0625, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_2, mgrast_release_3_1_1, mgrast_release_3_1_0, mgrast_dev_04132011, rast_rel_2008_10_09, mgrast_dev_04012011, rast_release_2008_09_29, mgrast_rel_2008_0806, mgrast_rel_2008_0923, mgrast_rel_2008_0919, rast_rel_2009_07_09, rast_rel_2010_0827, mgrast_rel_2008_1110, myrast_33, rast_rel_2011_0928, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, mgrast_dev_04052011, mgrast_dev_02222011, caBIG-13Feb06-00, rast_rel_2009_03_26, mgrast_dev_10262011, rast_rel_2008_11_24, rast_rel_2008_08_07, HEAD
Changes since 1.3: +17 -0 lines
add license words

# -*- perl -*-
#
# Copyright (c) 2003-2006 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
#
# This file is part of the SEED Toolkit.
# 
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License. 
#
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.
#


############# rae.cgi
#
# This is a web page written by Rob Edwards. It contains a bunch of stuff that is 
#	(a) experimental, 
#	(b) not guaranteed to work at any time on any browser,
#	(c) may or may not be supported
#	(d) may or may not make it into the SEED
#
# This code is free for use, but you should not rely on it as I will likely break much of it.

use HTML;
use CGI;
use strict;
my $fig=new FIG;
use raelib;
my $raelib=new raelib;
my $cgi=new CGI;
my $html=["<TITLE>Robs Experimental Code</TITLE>"];




# add a list of valid things here:
unless (
 $cgi->param('request') eq 'seqloc' ||
 $cgi->param('request') eq 'keyvals'
 ) {

 
 # nothing selected, print a blank page
 push @$html, <<EOF;

 <h1><center>Rob's experimental code</center></h1>
 <p>This is Rob's experimental code and is not guaranteed to do anything.</p>
 <p>People sometimes ask me for code that does specific genome things that are made easier using the SEED. This is just a place for those things.</P>
 <p>In general this script should be called with some options. These are some of the options that are available at the moment:</p>

 <ul>
 <li><a href="/FIG/rae.cgi?request=seqloc">Find the location of sequences on a contig</a>
 <li><a href="/FIG/rae.cgi?request=keyvals">Show Key/Value pairs for a selected key</a>
 </ul>

EOF

 &HTML::show_page($cgi, $html, 1);
 exit(0);
}


if ($cgi->param('request') eq 'seqloc') {

 # First, get the genome, and contig that we are interested in.
 unless ($cgi->param('korgs')) { 
  push @$html, "<h1><center>Find the location of a sequence on some contigs.</center></h1>",
  "<p><b>About this code:</b><br />This code was written for Anca Segall (<a href=\"http://www.segall-lab.com/\">lab website</a>) and identifies all ",
  "occurences of a specific sequence within a genome. The program will also limit the results to only those sequences that occur within a given region ",
  "or a given span.</p>",
  "<p>Please choose the organism that you want to look at:</p>", $cgi->start_form(),
  $cgi->hidden(-name=>'request', -value=>'seqloc'),
  $raelib->scrolling_org_list($cgi),
  $cgi->submit, $cgi->reset,
  $cgi->end_form, $cgi->end_html;
  &HTML::show_page($cgi, $html, 1);
  exit(0);
 }
 
 # now contig. I was going to try and do this with a complex java script, but I suspect it would
 # take too long to find all the contigs for all the genomes, and this is reasonable.
 my $org=$cgi->param('korgs');
 unless ($cgi->param('contig')) {
  my @contigs=sort {$a cmp $b} $fig->all_contigs($org);
  push @$html, "<h1><center>Find the location of a sequence on some contigs.</center></h1>", $cgi->start_form(), 
  $cgi->hidden(-name=>'request', -value=>'seqloc'),
  $cgi->hidden(-name=>'korgs', -value=>$org),
  "<p>Please choose the organism that you want to look at: &nbsp; ", $fig->genus_species($org), "</p>\n",
  "<p>Please choose the contig from that organism: &nbsp; ",
  $cgi->popup_menu(-name=>'contig', -values=>\@contigs), "</p>\n",
  $cgi->submit, $cgi->reset, $cgi->end_form(), $cgi->end_html();
  &HTML::show_page($cgi, $html, 1);
  exit(0);
 }
 
 my $contig=$cgi->param('contig');
 # now find the sequence information that we need.
 unless ($cgi->param('sequence')) {
  my $contigln=$fig->contig_ln($org, $contig);
  my $size=length($contigln)+1;
  push @$html, "<h1><center>Find the location of a sequence on some contigs.</center></h1>", $cgi->start_form(),
  $cgi->hidden(-name=>'request', -value=>'seqloc'),
  $cgi->hidden(-name=>'korgs', -value=>$org), $cgi->hidden(-name=>'contig', -value=>$contig),
  "<table>\n",
  "<tr><td>Please choose the organism that you want to look at: </td><td> ", $fig->genus_species($org), "</td></tr>\n",
  "<tr><td>Please choose the contig from that organism: </td><td>  $contig</td></tr>\n",
  "<tr><td>Please enter the sequence to find: </td><td> ", $cgi->textfield(-name=>'sequence', -size=>"20"), "</td></tr>\n",
  "<tr><td>The contig $contig is $contigln bp long.", $cgi->br, "Please enter a range to search between. </td><td>From: ",
  $cgi->textfield(-name=>'from', -default=>1, -size=>$size), " &nbsp; to &nbsp; ", $cgi->textfield(-name=>'to', -default=>$contigln, -size=>$size), "</td></tr>\n",
  "<tr><td>Please choose the strand to search: </td><td>", $cgi->radio_group(-name=>'strand', -values=>['forward', 'reverse'], -default=>'forward'), "</td></tr>\n",
  "<tr><td>Please enter the maximum distance between two sites to keep them.<br /> <span style=\"font-size: smaller\">Leave blank to report all sequences</span>: </td><td>", $cgi->textfield(-name=>'max', -size=>5), "</td></tr>\n",
  "</table>\n",
  $cgi->br, $cgi->submit, $cgi->reset, $cgi->end_form(), $cgi->end_html();
  &HTML::show_page($cgi, $html, 1);
  exit(0);
 }
  
 my ($sequence, $from, $to, $reverse, $max);
 $sequence   =  $cgi->param('sequence');
 $from       =  $cgi->param('from');
 $to         =  $cgi->param('to');
 $reverse    =  1 if ($cgi->param('strand') eq 'reverse');
 $max        =  $cgi->param('max') if ($cgi->param('max'));

 my $results=$raelib->locations_on_contig($org, $contig, $sequence, $from, $to, $reverse);
 
 my $difference;
 if ($max) {
  @$results=sort {$a <=> $b} @$results; # just make sure they are sorted
  my $keep; 
  for (my $i=0; $i<@$results; $i++) {
   my $test=$results->[$i];
   my $want;
   for (my $y=$i+1; $y < @$results; $y++) {
    last if ($results->[$y] > $test+$max);
    $want .= "\t$results->[$y]";
    $difference->{$results->[$y]-$test}++;
   }
   if ($want) {push @$keep, $test.$want}
  }
  $results=$keep;
 }

 my $dist=join "\n", map {"$_\t".$difference->{$_}} sort {$a <=> $b} keys %$difference;
 $dist = "\nDistribution of gaps:\n\n$dist" if ($dist);
 my $res=join "\n", @$results;
 push @$html, "<h1><center>Find the location of a sequence on some contigs.</center></h1>\n",
 "<p><h2>Results for $sequence on $contig in ", $fig->genus_species($org), "</h2>\n\n\n",
 "<pre>\n\n\n$res\n\n\n$dist\n\n</pre>";
 &HTML::show_page($cgi, $html, 1);
 exit(0);
}
elsif ($cgi->param('request') eq 'keyvals') {
 # find all the values for key value pairs
 unless ($cgi->param('kv')) {
  push @$html, "<h1><center>Find some key value data</center></h1>\n",
  "<p>", $cgi->start_form(), $cgi->hidden(-name=>'request', -value=>'keyvals'), $cgi->hidden(-name=>'kv', -value=>1);
  
  # find all the possible keys
  my $tags=$fig->get_tags();
  foreach my $type (keys %$tags) {
   my @choices=sort {$a cmp $b} keys %{$tags->{$type}};
   unshift @choices, '';
   push @$html, $cgi->div(
   		{class=>$type}, "\n<h2>Keys for $type</h2>", 
   		$cgi->popup_menu(-name=>"kv$type", -values=>\@choices), $cgi->hr,
		);
  }
  push @$html, $cgi->hidden(-name=>'types', -value=>[keys %$tags]);

  push @$html, $cgi->submit, $cgi->reset, $cgi->end_form, $cgi->end_html;
  &HTML::show_page($cgi, $html, 1);
  exit(0);
 }
 
 my $total=0;
 push @$html, "<table border=1><tr></tr>\n<th>Value</th><th>Occurences</th></tr>\n";
 foreach my $type ($cgi->param('types')) {
  my $kv=$cgi->param("kv$type");
  next unless ($kv);
  my $attr=$fig->get_values($type, $kv);
  foreach my $val (keys %$attr) {
   $total += $attr->{$val};
   push @$html, $cgi->div({class=>$val}, "<tr><td>$val</td><td>", $attr->{$val}, "</td></tr>\n");
  }
 }
 push @$html, "<tr><th>Total</th><th>$total</th></tr>\n</table>\n";
 &HTML::show_page($cgi, $html, 1);
 exit(0);
}
  
  

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3