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ölkerung haben (rein statistisch zu erwarten) einen IQ von höchstens $IQ.</P>
38 | <P>$percent% der Bevölkerung haben (rein statistisch zu erwarten) einen IQ von hö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;}
© Boris 'pi' Piwinger,
June 26, 2001