#!/usr/statlocal/bin/perl -wT

use CGI;
use CGI::Carp 'fatalsToBrowser';

use English;
use strict;

sub htmldie
{
    my $query = shift;
    print "<p><h1>CGI Error</h1><p>" . join(' ', @_ ) . "<p>\n";
    exit;
}

my $q = new CGI;
my $title = "Generate Values from a Discrete Distribution";

&print_head( $q, $title ); 
&print_form( $q );
&sample($q) if( join('',$q->param) ne '' );
&print_tail( $q );

sub sample
{
    my $query = shift;
    my $captn = "Simulation Summary: Counts and Proportions versus Probabilities";

    my @xvals = split( ' ', $query->param('xvals') );
    my @probs = split( ' ', $query->param('probs') );

    &htmldie( $query, "Possible values field is empty.\n" ) if( !@xvals );
    &htmldie( $query, "All possible values of the random variable must be numbers.\n" ) if( &anynonreal( 1, @xvals ) );

    &htmldie( $query, "Probabilities field is empty.\n" ) if( !@probs );
    &htmldie( $query, "All probabilities must be real numbers between 0 and 1.\n" ) if( &anynonposreal( @probs ) );

    my @cumprobs = &cumsum( @probs );

    &htmldie( $query, "Probabilities must sum to 1.\n" ) if( $cumprobs[$#probs] < 1.0 - 1.0e-8 || $cumprobs[$#probs] > 1.0 + 1.0e-8 );
    &htmldie( $query, "Value and probability lists must be the same length.\n" ) if( $#probs != $#xvals );

    my $k = $#probs;

    my $n = $query->param('number');

    &htmldie( $query, "Number of draws must be <= 10000.\n" ) if( $n > 10000 );
    &htmldie( $query, "Number of draws must be positive.\n" ) if( $n <= 0 );
    &htmldie( $query, "Number of draws must be a number.\n" ) if( $n !~ /^\d+$/ );

    my @cnts = (0) x $k;
    my @prpn = (0) x $k;

    for my $i ( 1..$n )
    {
        my $v = rand();

        for( my $j = 0; $j <= $k; $j++ )
        {
            if( $v <= $cumprobs[$j] )
            {
                $cnts[$j]++;
                last;
            }
        }
    }

    for( my $j = 0; $j <= $k; $j++ )
    {
        $prpn[$j] = $cnts[$j]/$n;
    }


    print $query->table({-border=>undef},
                $query->caption($captn),
                $query->Tr({-align=>"CENTER",-valign=>"TOP"},
                   [
                    $query->th(['<strong>Values</strong>', @xvals]),
                    $query->td(['<strong>Counts</strong>',@cnts]),
                    $query->td(['<strong>Proportion</strong>',@prpn]),
                    $query->td(['<strong>Probability</strong>',@probs])
                    ]
                   )
                );

#     print $query->table({-border=>undef},
#                 $query->caption($captn),
#                 $query->Tr({-align=>"CENTER",-valign=>"TOP"},
#                    [
#                     $query->th(['Values','Counts','Proportion','Probability']),
#                     $query->td(\@xvals),
#                     $query->td(\@cnts),
#                     $query->td(\@prpn),
#                     $query->td(\@probs)
#                     ]
#                    )
#                 );
}

sub anynonreal
{
    my $isreal = '(\+|\-)?((\d+((\.\d+)|((E|e)(\+|\-)?\d+)|(\.\d+)((E|e)(\+|\-)?\d+)?)?)|((\.\d+)((E|e)(\+|\-)?\d+)?))';

    return scalar( grep { !/^$isreal$/o } @_ );
}

sub anynonposreal
{
    my $isreal = '((\d+((\.\d+)|((E|e)(\+|\-)?\d+)|(\.\d+)((E|e)(\+|\-)?\d+)?)?)|((\.\d+)((E|e)(\+|\-)?\d+)?))';

    return scalar( grep { !/^$isreal$/o } @_ );
}

sub cumsum
{
    my @cumvals = @_;

    for my $i (1..$#cumvals)
    {
        $cumvals[$i] += $cumvals[$i-1];
    }

    return @cumvals;
}

sub print_head
{
    my $query = shift;

    print $query->header, "\n";
    print $query->start_html( $title );
    print $query->h1( $title ), "\n";
}

sub print_form
{
    my $query = shift;

    print $query->startform;

    print "Possible Values: ",
          $query->textfield( -name=>'xvals', -default=>"",
                             -size=>80, -maxlength=>128 ), $query->p;

    print "Probabilities: ",
          $query->textfield( -name=>'probs', -default=>"",
                             -size=>80, -maxlength=>128 ), $query->p;

    print "Number of Draws: ",
          $query->textfield( -name=>'number', -default=>"",
                             -size=>80, -maxlength=>128 ), $query->p;

#     print "View ",
#           $query->radio_group( -name=>'view',
#                                -Values=>['Sample Only','Summary Only','Summary and Sample'],
#                                -default=>'Summary Only',
#                                -linebreak=>'true' ), $query->p;

    print $query->submit( 'Draw Sample' ), $query->defaults( 'Clear Fields' ), $query->p;
 
    print $query->endform, "\n", $query->hr, $query->p, "\n";
}

sub print_tail
{
    my $query = shift;

    print $query->hr,"\n";
    print $query->a({href=>"http://www.stat.cmu.edu/~genovese/s00-217/"},"Back To Course Home Page"), "\n";
    print $query->end_html,"\n";
}



# Local Variables:
# mode: perl
# End: