Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Genetic Crosses

by pokemonk (Scribe)
on Mar 14, 2001 at 11:00 UTC ( [id://64339] : sourcecode . print w/replies, xml ) Need Help??
Category: Biology
Author/Contact Info josegajefe@hotmail.com
Description: this is a simple program i wrote to do genetic crosses
#!/usr/bin/perl
  if ($ENV{'REQUEST_METHOD'} eq 'GET') {
        @pairs = split(/&/, $ENV{'QUERY_STRING'});
  } elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {      
        read (STDIN, $in, $ENV{'CONTENT_LENGTH'});
        @pairs = split(/&/, $in);                
  } else {                                       
        print "Content-type: text/html\n\n";    
        print "<P>Use Post or Get";               
  }                                                 
foreach $pair (@pairs) {                      
        ($name, $value) = split (/=/, $pair);  
        $name =~ s/\+/ /g;                     
        $name =~ s/%(..)/pack("C", hex($1))/ge;
        $value =~ s/\+/ /g;                      
        $value =~ s/%(..)/pack("C", hex($1))/ge;
        $value =~s/<!--(.|\n)*-->//g;                                 
+               
        if ($parseform{$name}) {                
                $parseform{$name} .= ", $value";                     
        } else {                                                      
                $parseform{$name} = $value;
        } 
  }
print "Content-Type: text/html\n\n";
$about="<br><font color=\"black\">Programmed in PERL by <a href=\"mail
+to:josegajefe\@hotmail.com\">Jose Carrasquel</a>, AOL: josecarrasquel
+</font><br><br>";
$script=$ENV{'SCRIPT_NAME'};
if ($parseform{'action'} eq 'mono_complete'){&mono_complete;}
if ($parseform{'action'} eq 'mono_complete1'){&mono_complete1;}
if ($parseform{'action'} eq 'mono_compfinal'){&mono_compfinal;}
unless ($parseform{'action'}){&start;}
sub start {
print <<"EOF";
<HTML>
<HEAD>
<TITLE>Genetic Problemms Solver</TITLE>
</HEAD>
<BODY BGCOLOR="silver" TEXT="navy" LINK="red" VLINK="#800080">
</BODY>
<a href="$script?action=mono_complete">Solve Monhohybrid Crosses With 
+<b>Complete</b> Dominance</a><br>
$about
</HTML>
EOF
}
sub mono_complete {
print <<"EOF";
<HTML>
<HEAD>
<TITLE>Solve Monohybrid Crosses with Complete Dominance!!!</TITLE>
</HEAD>
<BODY BGCOLOR="silver" TEXT="navy" LINK="red" VLINK="#800080">
</BODY>
<form action="$script" method="post">
<input type="hidden" name="action" value="mono_complete1">
What is the dominant alelle(blue eyes, tall...)<br>
<input type="text" name="dominant"><br>
What is the recesive alelle(long hair, stupid...)<br>
<input type="text" name="recesive"><br>
<input type="submit" value="GO!!!">
</form>
$about 
</HTML>
EOF
}
sub mono_complete1 {
my ($first) = ($parseform{'dominant'} =~ /([a-zA-Z])/);
$dominant=$first;
$recesive=$first;
$dominant=~ tr/a-z/A-Z/;
$recesive=~ tr/A-Z/a-z/;
print <<"EOF";
<HTML>
<HEAD>
<TITLE>Solve Monohybrid Crosses with Complete Dominance!!!</TITLE>
</HEAD>
<BODY BGCOLOR="silver" TEXT="navy" LINK="red" VLINK="#800080">
</BODY> 
<form action="$script" method="post">
<input type="hidden" name="action" value="mono_compfinal">
<input type="hidden" name="dominant" value="$parseform{'dominant'}">
<input type="hidden" name="recesive" value="$parseform{'recesive'}">
<font color="black"><b>Gamete 1</b></font> <br><br>
<input type="radio" checked name="gamete1" value="$dominant,$dominant"
+>$parseform{'dominant'} homozigos ($dominant$dominant)<br>
<input type="radio" name="gamete1" value="$dominant,$recesive">$parsef
+orm{'dominant'} heterozigos ($dominant$recesive)<br>
<input type="radio" name="gamete1" value="$recesive,$recesive">$parsef
+orm{'recesive'} homozigos ($recesive$recesive)<br><br>
<font color="black"><b>Gamete 2</b></font><br><br>
<input type="radio" checked name="gamete2" value="$dominant,$dominant"
+>$parseform{'dominant'} homozigos ($dominant$dominant)<br>
<input type="radio" name="gamete2" value="$dominant,$recesive">$parsef
+orm{'dominant'} heterozigos ($dominant$recesive)<br>
<input type="radio" name="gamete2" value="$recesive,$recesive">$parsef
+orm{'recesive'} homozigos ($recesive$recesive)<br><br>
<input type="submit" value="Go!!!">
</form>
$about
</HTML>
EOF
}
sub mono_compfinal {
($gene1_1,$gene1_2)=split (/,/,$parseform{'gamete1'},2);($gene2_1,$gen
+e2_2)=split (/,/,$parseform{'gamete2'},2);
my ($first) = ($parseform{'dominant'} =~ /([a-zA-Z])/);
$dominant=$first;
$recesive=$first;
$dominant=~ tr/a-z/A-Z/;
$recesive=~ tr/A-Z/a-z/;
$patterna='[A-Z]+';
if ($gene2_1 =~ /[A-Z]/){$fetoa=($gene2_1.$gene1_1);}else{$fetoa=($gen
+e1_1.$gene2_1);}
if ($gene2_1 =~ /[A-Z]/){$fetob=($gene2_1.$gene1_2);}else{$fetob=($gen
+e1_2.$gene2_1);}
if ($gene2_2 =~ /[A-Z]/){$fetoc=($gene2_2.$gene1_1);}else{$fetoc=($gen
+e1_1.$gene2_2);}
if ($gene2_2 =~ /[A-Z]/){$fetod=($gene2_2.$gene1_2);}else{$fetod=($gen
+e1_2.$gene2_2);}
if ($fetoa =~ /$patterna/){$domicount++;}
if ($fetob =~ /$patterna/){$domicount++;}
if ($fetoc =~ /$patterna/){$domicount++;}
if ($fetod =~ /$patterna/){$domicount++;}
$domicount *=25;
$rececount=100-$domicount;
print <<"EOF";
<HTML>
<HEAD>
<TITLE>Solve Monohybrid Crosses with Complete Dominance!!!</TITLE>
</HEAD>
<BODY BGCOLOR="silver" TEXT="navy" LINK="red" VLINK="#800080">
</BODY>
$gene1_1$gene1_2 x $gene2_1$gene2_2<br><br>
"$dominant"=$parseform{'dominant'}<br>"$recesive"=$parseform{'recesive
+'}<br\>
<br><b>F1</b><br>
<table border="1" width="70">
<tr><td width="33%">        </td><td width="33%">$gene1_1</td><td widt
+h="33%">$gene1_2</td></tr>
<tr><td width="33%">$gene2_1</td><td width="33%">$fetoa  </td><td widt
+h="33%">$fetob</td></tr>
<tr><td width="33%">$gene2_2</td><td width="33%">$fetoc  </td><td widt
+h="33%">$fetod</td></tr>
</table><br><br>
Phenotype: $domicount\% $parseform{'dominant'} : $rececount\% $parsefo
+rm{'recesive'}
$about
EOF
}
Replies are listed 'Best First'.
(redmist) Re: Genetic Crosses
by redmist (Deacon) on Mar 14, 2001 at 14:11 UTC

    Please, please use strict and use CGI. This prevents breakage of your query string regexp, and promotes cleaner code.

    redmist
    Silicon Cowboy