Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
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

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://64339]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others examining the Monastery: (2)
As of 2024-04-25 05:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found