|
|
#!/usr/bin/perl
########################################################################
# Information about the Project:
# Author Info -- This program was written by Aaron
# Thompson [thompson@cns.uni.edu] as a part
# of a probability project.
#
# Program Info -- This program was created to illistrate
# the Saddlepoint Approximation to the
# Poisson Mass Function for a course in
# probability taught by Robert Paige.
# http://www.cns.uni.edu/~paige/
#
# Licensing Info -- Credit me, the author. Use freely..
# But know what it does and how it works...
# I'm not responsible for what you do with it...
#
#
# Information about Sub Programs:
#
# sub createTable -- This sub program will call poisson and
# saddlepoint to create the page displaying
# the table of values for 1 <= y <= $yvalue.
#
# sub saddlepoint -- This sub program will compute the saddlepoint
# Approx. to the Poisson Mass Function and store
# that value in $saddlepoint.
#
# sub poisson -- This sub program will compute the poisson
# mass function and store that value in
# $poisson.
#
# sub factorial -- This program will take @_[0]! and store it
# in $result. ->call by using factorial(X).
#
#sub displayStartPage -- This sub program will display the start
# page that contains the description of the
# program and gets information from the user
# before it envokes the createTable.
#
# sub startHTML -- This sub program prints out the "Content"
# line...
#
# sub parse_form -- This sub program parses the information
# passed to the webserver and pulls out
# useful information and stores it in %data
# (a hash). Code copied from CGI-Lite modules.
#
############################################################################
#global variables...
$scriptURL = "http://student.cns.uni.edu/~thompson/cgi-bin/poisson.cgi";
$pageTitle = "Saddlepoint Approximation to the Poisson Mass Function.";
$PI = 4 * atan2 1,1;
#lets get it on...
&parse_form;
OPTION: {
if ($data{option} eq "createTable") { &createTable;
last OPTION;
}
&displayStartPage;
} #end option
exit(0);
##############################################################################
sub createTable{
&startHTML;
print << "(ENDHTML)";
<html>
<head>
<title>
$pageTitle
</title>
</head>
<body>
<h1 align="center">
$pageTitle
</h1>
<h3 align="center">
Lambda: $data{lambda} Range: {1 <= Y <= $data{yvalue}}
</h3>
<hr width="80%" align="center">
<table align="center" width="80%" border="1"
cellspacing="0" cellpadding="0">
<tr>
<td width="5%" align="center">
<b>
k
</b>
</td>
<td width="33%" align="center">
<b>
Poisson Mass Function.
</b>
</td>
<td width="34%" align="center">
<b>
Saddlepoint Approx.
</b>
</td>
<td width="29%" align="center">
<b>
% Reletive Error.
</b>
</td>
</tr>
(ENDHTML)
$index = 1;
while($index <= $data{yvalue}){
$yvalue = $index;
$lambda = $data{lambda};
&saddlepoint;
&poisson;
$relError = (($poisson - $saddlepoint)/$poisson) *100;
print << "(ENDHTML)";
<tr>
<td width="5%" align="center">
<i>
$index
</i>
</td>
<td width="33%" align="center">
$poisson
</td>
<td width="34%" align="center">
$saddlepoint
</td>
<td width="29%" align="center">
$relError
</td>
</tr>
(ENDHTML)
$index++;
}#end while
print << "(ENDHTML)"
</table>
</body>
<html>
(ENDHTML)
}#end createTable
##############################################################################
sub saddlepoint{
$saddlepoint = sqrt(2*$PI*$yvalue);
$saddlepoint *= ($yvalue ** $yvalue);
$saddlepoint *= (exp(-1*$yvalue));
$saddlepoint = 1/$saddlepoint;
$saddlepoint *= (exp(-1 * $lambda));
$saddlepoint *= ($lambda ** $yvalue);
}#end saddlepoint
##############################################################################
sub poisson{
$poisson = exp(-1*$lambda);
$poisson *= $lambda ** $yvalue;
&factorial($yvalue);
$poisson /= $result;
}#end poisson
##############################################################################
sub factorial{
$thing = @_[0];
$result = 1;
while($thing > 0){
$result *= $thing;
$thing--;
}#end while
}#end factorial
##############################################################################
sub displayStartPage{
&startHTML;
print << "(ENDHTML)";
<html>
<head>
<title>
$pageTitle
</title>
</head>
<body>
<h1>
$pageTitle
</h1>
<hr width="80%" align="left">
<p>
<b>
<u>
Description
</u>
</b>
<blockquote>
This application will create a table containing both the Poisson Mass
Function and Saddlepoint approximation to the Poisson Mass Function
</blockquote>
<b>
<u>
Author Information
</u>
</b>
<blockquote>
This application was written by Aaron Thompson (
<a href="mailTo:thompson\@cns.uin.edu">thompson\@cns.uni.edu</a>
). For Introduction to Probability taught by
<a href="http://www.cns.uni.edu/~paige/">Robert Paige</a>
</blockquote>
</p>
<form name="inputForm" method="POST" action="$scriptURL">
<input type="hidden" name="option" value="createTable">
<blockquote>
<p>
Lambda:
<input type="text" name="lambda">
</p>
<p>
end Y value:
<input type="text" name="yvalue">
</p>
<div align="Left">
<input type="submit" name="submit" value="Go...">
</div>
</blockquote>
</form>
</body>
</html>
(ENDHTML)
}#end displayStartPage
##############################################################################
sub startHTML{
print "Content-type: text\/html\n\n";
}#end sub startHTML
##############################################################################
sub parse_form {
# Determine the form's REQUEST_METHOD (GET or POST) and split the form #
# fields up into their name-value pairs. If the REQUEST_METHOD was #
# not GET or POST, send an error. #
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
# Split the name-value pairs
@pairs = split(/&/, $ENV{'QUERY_STRING'});
}
elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
# Get the input
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
# Split the name-value pairs
@pairs = split(/&/, $buffer);
}
else {
#&error('request_method');
}#end if
# For each name-value pair: #
foreach $pair (@pairs) {
# Split the pair up into individual variables. #
local($name, $value) = split(/=/, $pair);
# Decode the form encoding on the name and value variables. #
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# If they try to include server side includes, erase them, so they
# aren't a security risk if the html gets returned. Another
# security hole plugged up.
$value =~ s/<!--(.|\n)*-->//g;
# If the field name has been specified in the %Config array, it will #
# return a 1 for defined($Config{$name}}) and we should associate #
# this value with the appropriate configuration variable. If this #
# is not a configuration form field, put it into the associative #
# array %Form, appending the value with a ', ' if there is already a #
# value present. We also save the order of the form fields in the #
# @Field_Order array so we can use this order for the generic sort. #~
if (defined($Config{$name})) {
$Config{$name} = $value;
}
else {
if ($data{$name} && $value) {
$data{$name} = "$data{$name}, $value";
}
elsif ($value) {
push(@Field_Order,$name);
$data{$name} = $value;
}#end if
}#end if
}#end foreach
}#end parse_form
syntax highlighted by Code2HTML, v. 0.8.12
|
