IQ-Rechner.pl

    1 | #!/usr/bin/perl
    2 | if (length($ENV{'QUERY_STRING'})==0) {
    3 | print <<END;
    4 | Content-Type: text/html
    5 | 
    6 | <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/REC-html 40/loose.dtd">
    7 | <HTML><HEAD><TITLE>IQ-Rechner</TITLE></HEAD>
    8 | <BODY bgcolor="white">
    9 | <FORM method=get action="IQ-Rechner.pl">
   10 | <TABLE>
   11 | <TR><TD>IQ-Punkte</TD><TD><INPUT name="IQ" value="100"></TD></TR>
   12 | <TR><TD>Anteil</TD><TD><INPUT name="percent" value="0.5"></TD></TR>
   13 | <TR><TD colspan=2><INPUT type=SUBMIT></TD></TR>
   14 | </TABLE>
   15 | </FORM>
   16 | </BODY>
   17 | </HTML>
   18 | END
   19 | } else {
   20 |   my%cgivars = &getcgivars;
   21 |   my$IQ=$cgivars{"IQ"};
   22 |   my$percent=$cgivars{"percent"};
   23 |   $percent = 0.0001 if ($percent < 0.0001);
   24 |   $percent = 0.9999 if ($percent > 0.9999);
   25 |   my$pIQ=&percent($IQ)*100;
   26 |   my$IQp=&IQ($percent);
   27 |   $percent*=100;
   28 |   $pIQ=sprintf("%.2f", $pIQ);
   29 |   $percent=sprintf("%.2f", $percent);
   30 |   $IQp=sprintf("%d", $IQp);
   31 | print <<END;
   32 | Content-Type: text/html
   33 | 
   34 | <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/REC-html 40/loose.dtd">
   35 | <HTML><HEAD><TITLE>IQ-Rechner</TITLE></HEAD>
   36 | <BODY bgcolor="white"><H1>IQ-Rechner</H1>
   37 | <P>$pIQ% der Bev&ouml;lkerung haben (rein statistisch zu erwarten) einen IQ von h&ouml;chstens $IQ.</P>
   38 | <P>$percent% der Bev&ouml;lkerung haben (rein statistisch zu erwarten) einen IQ von h&ouml;chstens $IQp.</P>
   39 | </BODY>
   40 | </HTML>
   41 | END
   42 | }
   43 | 
   44 | exit;
   45 | 
   46 | sub percent {
   47 |   my$z = ($_[0]-100)/15;
   48 |   my$p = &Norm_p($z);
   49 |   $p=1-$p/2;
   50 |   if ($z<0) {$p=1-$p} 
   51 |   return $p;
   52 | }
   53 | 
   54 | sub IQ {
   55 |   my$p=$_[0];my$z;
   56 |   if ($p<0.5) {
   57 |     $z = -&Norm_z(0.5-$p);
   58 |   } else {
   59 |     $z = &Norm_z($p-0.5);
   60 |   }
   61 |   return $z*15+100;
   62 | }		
   63 | 
   64 | sub Norm_p {
   65 | # Returns the two-tailed standard normal probability of z
   66 |   my$z = abs($_[0]);
   67 |   return ((((((0.0000053830*$z+0.0000488906)*$z+0.0000380036)*$z+0.0032776263)*$z+0.0211410061)*$z+0.0498673470)*$z+1)**(-16);
   68 | }
   69 |  
   70 | sub Norm_z {
   71 | # Returns z given a half-middle tail type p.
   72 |   my$p=$_[0];my$z;
   73 |   if ($p>0.42) {
   74 |     my$r=sqrt(-log(0.5-$p));
   75 |     $z=(((2.3212128*$r+4.8501413)*$r-2.2979648)*$r+-2.7871893)/((1.6370678*$r+3.5438892)*$r+1)
   76 |   } else {
   77 |     my$r=$p*$p;
   78 |     $z=$p*(((-25.4410605*$r+41.3911977)*$r-18.6150006)*$r+2.5066282)/((((3.1308291*$r-21.0622410)*$r+23.0833674)*$r-8.4735109)*$r+1)
   79 |   }
   80 |   return $z;
   81 | }
   82 | 
   83 | sub getcgivars {
   84 |   my($in,%in);
   85 |   my($name,$value);
   86 |   $in = $ENV{'QUERY_STRING'};
   87 |   foreach (split('&',$in)) {
   88 |     tr/+/ /;
   89 |     ($name,$value) = split('=', $_, 2);
   90 |     $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/chr(hex($1))/ge;
   91 |     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/chr(hex($1))/ge;
   92 |     $value =~ s/,/./g;
   93 |     $value+=0;
   94 |     if ($in{$name} eq "") {$in{$name} = $value;} else {$in{$name} .= ", $value";}}
   95 |   return %in;}

Valid CSS!Valid HTML 4.01!
© Boris 'pi' Piwinger, June 26, 2001