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

View of /FigWebServices/clust_ss.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (download) (annotate)
Mon Feb 18 22:08:23 2008 UTC (12 years, 4 months ago) by overbeek
Branch: MAIN
Changes since 1.1: +29 -6 lines
allow one to get only hypo clusters

# -*- 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.
#


use FIG;
my $fig = new FIG;

use HTML;
use strict;

use CGI;
my $cgi = new CGI;

if (0)
{
    my $VAR1;
    eval(join("",`cat /tmp/clust_ss_parms`));
    $cgi = $VAR1;
#   print STDERR &Dumper($cgi);
}

if (0)
{
    print $cgi->header;
    my @params = $cgi->param;
    print "<pre>\n";
    foreach $_ (@params)
    {
	print "$_\t:",join(",",$cgi->param($_)),":\n";
    }

    if (0)
    {
	if (open(TMP,">/tmp/clust_ss_parms"))
	{
	    print TMP &Dumper($cgi);
	    close(TMP);
	}
    }
    exit;
}

my $html = [];
unshift @$html, "<TITLE>Generate Cluster-Based Subsystems</TITLE>\n";

my $user   = $cgi->param('user');

if (! $user)
{
    &get_user_and_type($fig,$cgi,$html);
}
else
{
    my $peg = &get_interesting($fig,$cgi,1);
    if ($peg)
    {
	my $url = "http://anno-3.nmpdr.org/anno/FIG/seedviewer.cgi?user=$user&pattern=" . $peg . "&page=SearchResult&action=check_search";
	print $cgi->redirect($url);
	exit;
    }
    else
    {
	push(@$html,$cgi->h1('Could not get a PEG to work on'));
    }
}

&HTML::show_page($cgi,$html);

sub get_interesting {
    my($fig,$cgi,$retry) = @_;

    my $just_hypo = $cgi->param('just_hypo');
    if (open(INTERESTING,"<$FIG_Config::global/interesting.pegs"))
    {
	my @pegs = <INTERESTING>;
	chomp @pegs;
	close(INTERESTING);
	
	my $tries = 30;
	my $peg;
	while ((! $peg) && $tries)
	{
	    my $i = int(rand() * @pegs);
	    if (($i < @pegs) && $fig->is_real_feature($pegs[$i]))
	    {
		$peg = $pegs[$i];
		my @subs = grep { $fig->usable_subsystem($_) } $fig->peg_to_subsystems($peg);
		if (@subs > 0)
		{
		    $peg = undef;
		}
		if ($just_hypo && &coupled_to_nonhypo($fig,$peg))
		{
		    $peg = undef;
		}
	    }
	    $tries--;
	}

	if ((! $peg) && $retry)
	{
	    &clean_interesting($fig);
	    return &get_interesting($fig,0);
	}
	else
	{
	    return $peg;
	}
    }
    return undef;
}

sub coupled_to_nonhypo {
    my($fig,$peg) = @_;
    my $i;

    my @coupled = $fig->coupled_to($peg);
    for ($i=0; ($i < @coupled) && &is_hypo($fig,$coupled[$i]->[0]); $i++) {}
    return ($i < @coupled);
}

sub is_hypo {
    my($fig,$peg) = @_;

    my $func = $fig->function_of($peg);
    return &FIG::hypo($func);
}

sub clean_interesting {
    my($fig) = @_;

    if ((-s "$FIG_Config::global/interesting.pegs") &&
	open(INTERESTING,"<$FIG_Config::global/interesting.pegs"))
    {
	my @pegs = <INTERESTING>;
	chomp @pegs;
	close(INTERESTING);

	@pegs = grep { &not_in_sub($_) } @pegs;
	open(INTERESTING,">$FIG_Config::global/interesting.pegs")
	    || die "could not open $FIG_Config::global/interesting.pegs";
	print INTERESTING join("\n",@pegs),"\n";
	close(INTERESTING);
    }
}

sub get_user_and_type {
    my($fig,$cgi,$html) = @_;

    push(@$html, $cgi->start_form(-action => "clust_ss.cgi",
				  -method => 'post'),
	         'User: ',
	         $cgi->textfield(-name => "user", -size => 10, -value => ''),
	         $cgi->br,$cgi->br,
	         $cgi->checkbox(-name => 'just_hypo', -value => "", -checked => 0, -label => 'just hypothetical'),
	         $cgi->br,$cgi->br,
	         $cgi->submit( 'Get PEG to Look at' ),
	         $cgi->end_form
	 );

}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3