Deal or No Deal

Greg Buchholz — 2006-03-10T17:14:08+00:00

Here's a small CGI program to calculate the expected value of the remaining cases on the TV show Deal or No Deal (Oh, and the all important screen shot).

#!/usr/bin/perl use CGI; $q = new CGI; print $q->header; print $q->start_html(-title=>'Deal or No Deal',-BGCOLOR=>'white'), $q->h1('--Deal or No Deal--'), $q->startform(); @left = qw/ 0.01 1 5 10 20 50 75 100 200 300 400 500 750 /; @right= qw/1,000 5,000 10,000 25,000 50,000 75,000 100,000 200,000 300,000 400,000 500,000 750,000 1,000,000/; my $i = 0; print "<table>\n"; for (@left) { print $q->Tr($q->th([ $q->checkbox(-name=>"cl$i", -checked=>'checked', -value=>'YES', -label=>''). $q->textfield(-name=>"l$i", -default=>$left[$i], -size=>9, -override=>0), $q->textfield(-name=>"r$i", -default=>$right[$i], -size=>9, -override=>0). $q->checkbox(-name=>"cr$i", -checked=>'checked', -value=>'YES', -label=>'') ])), "\n"; $i++; } print "</table>"; print $q->submit(-name=>'Calculate'), $q->endform() ; if (@all = $q->param()) { my $acc = 0; my $count = 0; for (@all) { if(/c((?:l|r)\d+)/) { my $val = $q->param($1); $val =~ s/[^.0-9]//g; $count++; $sum += $val; } } print "<p>Expected Value: ".'$'; printf "%.2f<hr>", $sum/$count; } print $q->end_html;

unfold

Greg Buchholz — 2005-09-16T23:26:27+00:00

I came across Limbic~Region's article on iterators and thought I write up some quick perl examples using the more generic unfold (code reuse in action). Fold is the list deconstructor, while unfold is its dual, the list generator.

#!/usr/bin/perl -w use strict; #Demonstrations of iterators using 'unfold' #the natural numbers 1,2,3... my $nats = unfold(\&false, #loop forever \&id, #identity function sub{$_[0]+1}, #increment value 1 ); #initial seed # 0,2,4,6,8 my $evens_5 = unfold( sub{$_[0]>8}, \&id, sub{$_[0]+2}, 0); #Factorials my $facs = unfold(\&false, \&fst, sub{[fst($_[0])*snd($_[0]),snd($_[0])+1]}, [1,1]); #Fibonacci's famous sequence my $fibs = unfold(\&false, \&fst, sub{[snd($_[0]),fst($_[0])+snd($_[0])]},[0,1]); #Enumeration of DNA sequences from... # http://www.perl.com/pub/a/2005/06/16/iterators.html # my $dna = unfold(sub{toDNA($_[0]) eq "CTTTT"}, sub{my $x = toDNA($_[0]); $x=~s/^.(.*)$/$1/; $x}, sub{$_[0]+1}, fromDNA("CAAAA")); #print out some samples... my (@n, @e, @a, @f); push @n, $nats->() for (1..10); push @e, $evens_5->() for (1..5); push @a, $facs->() for (1..10); push @f, $fibs->() for (1..10); print "@n\n@e\n@a\n@f\n"; print $dna->() ."\n" for (1..10); # --Haskell version of unfold... # # unfold p f g x = # if p x # then [] # else f x : unfold p f g (g x) sub unfold { # function $p is a predicate to indicate when to stop iterator # function $f takes the seed ($x) and formats it before returning it # function $g massages $x for the next iteration # $x is the initial value my ($p, $f, $g, $x) = @_; sub{ ($p->($x)) ? undef : do{my $val = $f->($x); $x=$g->($x); $val}} } #Helper functions sub fst { $_[0]->[0] } sub snd { $_[0]->[1] } sub false { 0 } sub id { $_[0] } # These subs convert back and forth between strings of "ACGT" and # integers, using base-4 arithmetic. Something with pack/unpack # might be cleaner. sub fromDNA { my $s = shift; $s =~ tr/ACGT/0-3/; my $n=0; $n = $n*4+$_ for (split(//, $s)); return $n; } sub toDNA { my $n = shift; my $acc = ""; while($n) { my $d = $n % 4; $n = int($n/4); $acc = "$d" . $acc; } ($acc="$acc") =~ tr/0-3/ACGT/; return $acc; }

Greg Buchholz's Journal

Deal or No Deal

unfold