O Monks. Hallowed by thy Computational Yam-Fries.

This is my first real post. It's about how I can make my Good Enough Code into Martha Stewart. (About looking Perlish. And modern living solutions.) The 'problem solvers' will not like this node because the problem's already solved. This node is for anyone that likes to grok and criticize noob code. I want to understand how I could have written it better, faster, or more succinctly.

Being sacked with organizing a "One Day, On-Campus Departmental Retreat," and having instructions to have each research group present (25), seemed to guarantee a boring crappy day. 25 X 20 min talks; about 8 hours of talking. Feh.

All of the decisions were outside my control, but I still had to help. Thinking of Tomson Highway's "The Rez Sisters" I realized that infusing a BINGO game into the proceedings was just what the doctor ordered. The talks would be on a single computer, and BINGO balls in a "draw sequence" could be inserted into people's slides beforehand. People would have BINGO cards, and would play along (instead of doing draw prizes). Sortof keep people on their toes.

Someone offered to manage the talks, making the BINGO ball graphics, and inserting the call sequence into the talks. My task was to give them a call sequence, and then make ~130 rigged BINGO cards (probably doing the markup with LaTeX because that's all I've been using lately). As well, I wanted a code on each card so I could tell by inspection if it was a winner. Also, I wanted all of the "losing" cards to have lots of call numbers, so it was exciting enough that most people would play.

So this isn't a performance-critical application. It's a rigged BINGO game.

The solution was implemented in two scripts, bridged by some metadata. This was necessitated because the call sequence needed to be determined long before the BINGO cards would be needed (and I was done coding!). Winning and losing would be controlled only at the diagonal; losing cards would have a diagonal of "noncalled" BINGO balls. Winning cards have the same diagonal with one "called" ball at the diagonal (all winners have two BINGOs). The cards have 25 numbers; winning and losing cards both have at least 20 called numbers.

There are a number of less than elegant implications of the solution. With the length of call sequence used, many of the BINGO cards look similar, prompting a lot of people to induce they had losers. All of the winning cards were successfully identified, though, and overall the BINGO game was a hit.

I'm having problems getting the code or readmore tags to preview correctly; after bugging the folks in the Chatterbox to no avail (but getting some indication it wasn't me) here goes.

UPDATE: The code has lost all formatting. Perhaps it's my OS/newline convention/browser (MacOSX, Camino)?

UPDATE: fixed (and not what i thought!) Thanks Corion, planetscape, and atcroft.

The code is too crappy to show. So it's linked here.

SCRIPT 1: MAKING BINGO CALL SEQUENCE, METADATA -this needed to be manually reran until a sufficiently 'diverse' set of BINGO balls made up the call list -I still didn't know how I was going to process the 'call sequence' into the BINGO cards, so there's a lot of sorting and reporting that's unused

#!/usr/bin/perl use strict; use warnings; ###################################################USER VARIABLES #define number of people, number of prizes, number of draws (> 5) my $people = 10; my $prizes = 8; my $draws = 22*2; #define total set of BINGO numbers #range of numbers my $range = 75; ####################################################INTERNAL/DEVELOPME +NT VARIABLES my $bin = int $range/5; my @bins = ($bin, 2*$bin, 3*$bin, 4*$bin); #my @seq = @fudgedDrawSeq; my (@callseq, @noncallseq); #auxillary lists to build my @winstring; ####################################################MAIN EXECUTION 1 ###########-this part used to define metadata; cards outputed from met +adata ###########-this metadata needed so Matt can have the draw sequence no +w. #my %ball; #hash containing $range BINGO balls THIS SHOULDN'T BE HERE #my @drawSeq; #for &defDrawSeq, draw sequence #&defDrawSeq; #define @drawSwq #my @seq = @drawSeq; #for modularity to &mkWinstring #print "DEBUG: @seq\n"; #print "CALL SEQUENCE:"; #for (0..($draws-1)){push( @callseq, $seq[$_] ); print "$seq[$_], ";} #print "\nNONCALL SEQUENCE:"; #for ($draws..($range-1)){push( @noncallseq, $seq[$_] ); print "$seq[$ +_], ";} #&mkWinstring;######################################################## +####### #unless (&chkWinstring){die "\nplease rerun, internal randomization er +ror"} #&mkCards; ####################################################FUNCTIONS 1 sub defDrawSeq (){ #define draw sequences (string of $draw numbers, randomized with hasht +able lookup) { for (1..$range){ if ( $_ <= $bins[0] ){$ball{$_}="B-$_"} elsif ( $_ <= $bins[1] ){$ball{$_}="I-$_"} elsif ( $_ <= $bins[2] ){$ball{$_}="N-$_"} elsif ( $_ <= $bins[3] ){$ball{$_}="G-$_"} else{$ball{$_}="O-$_"}; } } for (keys %ball){ push (@drawSeq, $ball{$_}); #print "\'$ball{$_}\', "; }; } sub chkWinstring () { for (@winstring){ my @temp = split; my ($sum,$err); for (@temp){$sum++;} if ($sum != 5){return 1}else{return 0} } } sub mkWinstring (){ my (@b, @i, @n, @g, @o); for (0..($draws-1)){ local $_ = $seq[$_]; # print "DEBUG $_\n"; if (m,B,){push(@b,$_);next;} elsif(m,I,){push(@i,$_);next;} elsif(m,N,){push(@n,$_);next;} elsif(m,G,){push(@g,$_);next;} elsif(m,O,){push(@o,$_);next;} } print "\nSUBLISTS FOR CARD MAKING:\n"; print "***\n B: @b \nI: @i\nN: @n\nG: @g\nO: @o\n***\n"; for my $j (0..($prizes-1)) { my $winstring = $b[$j].' '.$i[$j].' '.$n[$j].' '.$g[$j].' '.$o[$j] +."\n"; my @temp = split(/\s+/,$winstring); my $temp; for (@temp){$temp++;} #print "DEBUG $m\n";} if ($temp == 5){ push (@winstring, $winstring); }else{ print "ERROR $winstring"; } } print "WINSTRINGS:\n***\n@winstring***\n"; } sub mkCards{#needs global @winstring my( @wincard, @losecard); #print winning cards; print "WINNING CARDS:\n"; for my $k (1..$prizes) { my $l = "$winstring[$k-1]"; print "LINESTRING 0: $l"; for my $line (1..4) { my $linestring; my $pos = &getPos(); my $temp = &getDrawBall; print "$temp "; # if( $pos == 1 ){ $linestring = ";} # elsif( $pos == 2 ){ $linestring = "$b[$j] $i[$j] $n[$j] $g[$j +] $o[$j]\n";} # elsif( $pos == 3 ){ $linestring = "$b[$j] $i[$j] $n[$j] $g[$j +] $o[$j]\n";} # elsif( $pos == 4 ){ $linestring = "$b[$j] $i[$j] $n[$j] $g[$j +] $o[$j]\n";} # print "\nLINESTRING $line: $linestring\n"; } } } sub getRand(){ while (1){ my $temp = int(1111*rand()/11); unless ($temp = 0) {return $temp; exit} } } sub getPos(){ while (1){ my $temp = int((1111*rand()/111)%5)+1; unless ($temp > 5) {return $temp; exit} } }
METADATA USED (metadata2.dat):
DEBUG: N-42 N-34 O-67 G-59 B-9 O-71 O-75 O-72 O-73 I-22 B-15 O-63 O-70 + I-19 B-3 N-32 G-48 N-33 O-74 N-31 B-10 N-37 B-4 N-36 B-7 I-26 G-47 G +-51 G-57 I-30 G-52 I-20 O-62 G-58 N-38 I-16 I-24 I-25 G-49 B-8 N-44 B +-13 I-28 G-50 O-61 O-64 N-39 G-54 I-23 B-14 I-17 N-45 N-35 B-6 B-5 B- +12 G-53 O-65 I-27 O-66 N-41 G-55 O-68 G-56 G-46 N-43 B-11 I-29 N-40 O +-69 B-2 G-60 I-21 I-18 B-1 CALL SEQUENCE:N-42, N-34, O-67, G-59, B-9, O-71, O-75, O-72, O-73, I-2 +2, B-15, O-63, O-70, I-19, B-3, N-32, G-48, N-33, O-74, N-31, B-10, N +-37, B-4, N-36, B-7, I-26, G-47, G-51, G-57, I-30, G-52, I-20, O-62, +G-58, N-38, I-16, I-24, I-25, G-49, B-8, N-44, B-13, I-28, G-50, NONCALL SEQUENCE:O-61, O-64, N-39, G-54, I-23, B-14, I-17, N-45, N-35, + B-6, B-5, B-12, G-53, O-65, I-27, O-66, N-41, G-55, O-68, G-56, G-46 +, N-43, B-11, I-29, N-40, O-69, B-2, G-60, I-21, I-18, B-1, SUBLISTS FOR CARD MAKING: *** B: B-9 B-15 B-3 B-10 B-4 B-7 B-8 B-13 I: I-22 I-19 I-26 I-30 I-20 I-16 I-24 I-25 I-28 N: N-42 N-34 N-32 N-33 N-31 N-37 N-36 N-38 N-44 G: G-59 G-48 G-47 G-51 G-57 G-52 G-58 G-49 G-50 O: O-67 O-71 O-75 O-72 O-73 O-63 O-70 O-74 O-62 *** WINSTRINGS: *** B-9 I-22 N-42 G-59 O-67 B-15 I-19 N-34 G-48 O-71 B-3 I-26 N-32 G-47 O-75 B-10 I-30 N-33 G-51 O-72 B-4 I-20 N-31 G-57 O-73 B-7 I-16 N-37 G-52 O-63 B-8 I-24 N-36 G-58 O-70 B-13 I-25 N-38 G-49 O-74 ***
SCRIPT 2: MAKING BINGO CARDS
#!/usr/bin/perl #rigged BINGO name, part 2 (known sequence of call numbers, random dis +tribution of cards) #all winning cards are double bingos; one unspoiled point at diagonal #all losing cards hit 20 numbers; spoiled (noncalled) numbers at eithe +r (randomly chosen) diagonal ensure nonwinnner, but exciting use strict; use warnings; my $losers = 120; my $prizes = 8; #my $losers = 6; #my $prizes = 0; #this script corrupts original @callseq my( @callseq, @winstring, @noncallseq); #auxillary lists to build ###N +O LONGER NEED WINSTRING 3.0 my( @wincard, @losecard); #lists of strings, strings are info for card +s my( %serialNumber ); ####################################################MAIN EXECUTION 2 &doInit; &mkCards; my @allcards = (@losecard,@wincard); print '\documentclass[portrait]{seminar} \slidesmag{6} \slideframe{none} \usepackage{graphicx} \usepackage{times} \begin{document} \begin{center} '; my $count; for (@allcards){ if (m,([01]{10})\n((?:(?:\w\-\d+[\s\n]){5}){5}),) { my $code = $1; my $card = $2; $card =~ s,((?:\w\-\d+\s){5}),$1\n,g; $card =~ s,\w\-(\d+),$1,g; $card =~ s, , \& ,g; $card =~ s,\&\s*?\n,\\\\\n\\hline\n,g; print '\begin{tabular}[]{| c | c | c | c | c |}'; print "\n"; print '\multicolumn{5}{c}{{\large B}IOCHEMISTRY {\large R}ETREAT { +\large 2005}} \\\\'; print "\n"; print '{\huge \bf B} & {\huge \bf I } & {\huge \bf N } & {\huge +\bf G } & {\huge \bf O! } \\\\[-1.5pt] \hline'; print "\n"; print "$card"; print '\multicolumn{5}{c}{{\tiny '."$code"."}}\n\n"; print '\end{tabular}'."\n%%%%%\n"; }} print '\end{center} \end{document}'; ####################################################FUNCTIONS sub mkCards{ #needs global @winstring #print losing cards; ################################################################## +################ for my $k (1..$losers) { my $linestring; my $count = 0; my %seen; local *getNewDrawBall = sub { #workaround for scoping inner subrou +tine with typeglob - ugly Perlism my $type = shift; my $temp2; while (1){ $temp2 = &getDrawBall($type); if (exists $seen{$temp2}) { next; }else{ $seen{$temp2}++;return $temp2;} #print "DEBUGdraw: $tem +p\n"; } }; local *getNewNonDrawBall = sub { #workaround for scoping inner sub +routine with typeglob - ugly Perlism my $type = shift; my $temp2; while (1){ $temp2 = &getNonDrawBall($type); if (exists $seen{$temp2}) { next; }else{ $seen{$temp2}++;return $temp2;} #print "DEBUG_no_draw: +$temp\n"; } }; #SPOIL CARD HERE my @spoil = &getSpoilScheme(); ### @SPOIL DECLARED HERE +### my $scheme; if ($spoil[0] == 0){$scheme= '01'}else{$scheme = '10'}; ############serial number local *coinFlip = sub { my $z = &getRand; my $coin = int($z)% 2; return $coin; }; local *buildSN = sub { my @sn; for (1..4){ local $_ = &coinFlip; push( @sn, $_); }; push( @sn, "$scheme"); for (1..4){ local $_ = &coinFlip; push( @sn, $_); }; my $temp = "@sn"; $temp =~ s,\s+,,g; # $temp;}; my $sn;my $thing =1; while ($thing == 1){ $sn = &buildSN; unless (exists $serialNumber{$sn}){ $thing=0}}; my $spoilflag = 'nospoil'; #actually write card for my $num (1..25) { my( $mod, $temp); $mod = $num % 5; if (($num) == ($spoil[0] + 1)) ##SET SPOILFLAG { shift @spoil unless (@spoil == 1); $spoilflag = 'spoil'; }else{ $spoilflag = 'nospoil'; }; # print "DEBUG.spoil: k $k num $num flag $spoilflag spoil @spoi +l \n"; if ($spoilflag eq 'nospoil') ##REACT TO SPOILFLAG { if( $mod == 1){$temp = &getNewDrawBall('B');$seen{$temp}++;} elsif( $mod == 2){$temp = &getNewDrawBall('I');$seen{$temp}++; +} elsif( $mod == 3){$temp = &getNewDrawBall('N');$seen{$temp}++; +} elsif( $mod == 4){$temp = &getNewDrawBall('G');$seen{$temp}++; +} elsif( $mod == 0){$temp = &getNewDrawBall('O');$seen{$temp}++; +}; }elsif($spoilflag eq 'spoil') { if( $mod == 1){$temp = &getNewNonDrawBall('B');$seen{$temp}++; +} elsif( $mod == 2){$temp = &getNewNonDrawBall('I');$seen{$temp} +++;} elsif( $mod == 3){$temp = &getNewNonDrawBall('N');$seen{$temp} +++;} elsif( $mod == 4){$temp = &getNewNonDrawBall('G');$seen{$temp} +++;} elsif( $mod == 0){$temp = &getNewNonDrawBall('O');$seen{$temp} +++;}; }else{die "THIS SHOULDN'T HAPPEN\n";}; $linestring .= "$temp "; $count++; # print "DEBUG: k $k n $num m $mod t $temp\n"; } push( @losecard , ($sn."\n".$linestring)); } #print win cards ################################################################## +################ for my $k2 (1..$prizes) { my $linestring; my $count = 0; my %seen; local *getNewDrawBall = sub { #workaround for scoping inner subrou +tine with typeglob - ugly Perlism my $type = shift; my $temp2; while (1){ $temp2 = &getDrawBall($type); if (exists $seen{$temp2}) { next; }else{ $seen{$temp2}++;return $temp2;} #print "DEBUGdraw: $tem +p\n"; } }; local *getNewNonDrawBall = sub { #workaround for scoping inner sub +routine with typeglob - ugly Perlism my $type = shift; my $temp2; while (1){ $temp2 = &getNonDrawBall($type); if (exists $seen{$temp2}) { next; }else{ $seen{$temp2}++;return $temp2;} #print "DEBUG_no_draw: +$temp\n"; } }; #SPOIL CARD HERE my @spoil = &getSpoilScheme(); my $spoilflag = 'nospoil'; #actually write card #define modified spoil and winstring my $winline; my %winNums; my $tempWL = 1; while ($tempWL == 1) {$winline = &getRand; if ($winline < 5){$tem +pWL = 0};} #perhaps cleaner way to deal with loops; uses variables th +ough my $winNumStart = 5 * $winline - 4; for ($winNumStart .. ($winNumStart+4)){$winNums{$_}++}; local *coinFlip = sub { my $z = &getRand; my $coin = int($z)% 2; return $coin; }; ############serial number my $scheme = '11'; local *buildSN = sub { while (1){ my @sn; for (1..4){ local $_ = &coinFlip; push( @sn, $_); }; push( @sn, "$scheme"); for (1..4){ local $_ = &coinFlip; push( @sn, $_); }; my $temp = "@sn"; $temp =~ s,\s+,,g; # unless (exists $serialNumber{$temp}){ return $temp; }} ; my $sn;my $thing =1; while ($thing == 1){ $sn = &buildSN; unless (exists $serialNumber{$sn}){ $thing=0}}; for my $num (1..25) { my( $mod, $temp); $mod = $num % 5; if (($num) == ($spoil[0] + 1)) ##SET SPOILFLAG { shift @spoil unless (@spoil == 1); $spoilflag = 'spoil'; #print "intend to spoil $num\n"; }else{ $spoilflag = 'nospoil'; }; if(exists $winNums{$num}) { $spoilflag = 'nospoil'; #print "spoiling of $num rescued here\ +n"; } # print "DEBUG.spoil: k $k num $num flag $spoilflag spoil @spoi +l \n"; if ($spoilflag eq 'nospoil') ##REACT TO SPOILFLAG { if( $mod == 1){$temp = &getNewDrawBall('B');$seen{$temp}++;} elsif( $mod == 2){$temp = &getNewDrawBall('I');$seen{$temp}++; +} elsif( $mod == 3){$temp = &getNewDrawBall('N');$seen{$temp}++; +} elsif( $mod == 4){$temp = &getNewDrawBall('G');$seen{$temp}++; +} elsif( $mod == 0){$temp = &getNewDrawBall('O');$seen{$temp}++; +}; }elsif($spoilflag eq 'spoil') { if( $mod == 1){$temp = &getNewNonDrawBall('B');$seen{$temp}++; +} elsif( $mod == 2){$temp = &getNewNonDrawBall('I');$seen{$temp} +++;} elsif( $mod == 3){$temp = &getNewNonDrawBall('N');$seen{$temp} +++;} elsif( $mod == 4){$temp = &getNewNonDrawBall('G');$seen{$temp} +++;} elsif( $mod == 0){$temp = &getNewNonDrawBall('O');$seen{$temp} +++;}; }else{die "THIS SHOULDN'T HAPPEN\n";}; $linestring .= "$temp "; $count++; # print "DEBUG: k $k n $num m $mod t $temp\n"; } push( @wincard , ($sn."\n".$linestring)); } } sub getSpoilScheme{ my @spoil; my @spoil1 = (0,6,12,18,24); my @spoil2 = (4,8,12,16,20); #select spoil scheme (coin flip) my $z = &getRand; my $coin = int($z)% 2; if ($coin==0){@spoil = @spoil1}else{@spoil = @spoil2}; # print "DEBUGspoil\:\: z $z coin $coin spoil @spoil\n"; return @spoil; } sub getRand{ my $temp; while (1){ $temp = int(1111*rand()/11); unless ($temp == 0) {return $temp}}}; sub getDrawBall{ my $type = shift; while (1){ my $temp = pop @callseq; unshift( @callseq, $temp ); if ($temp =~ /$type/){return $temp; print "DEBUG getDrawBall: $tem +p\n";}}} sub getNonDrawBall{ my $type = shift; while (1){ my $temp = pop @noncallseq; unshift( @noncallseq, $temp ); #print "sNDB\:\: TEMP $temp TYPE $t +ype\n"; if ($temp =~ /$type/){return $temp; print "DEBUG getnonDrawBall: $ +temp\n";}}} ###########-this part used to load predefined metadata; cards outpute +d from metadata ###########-this metadata needed so Matt can have the draw sequence no +w. sub doInit () #with lispy whitespace! { open (IN, "metadata2.dat"); my $tempState = 'start'; while( <IN> ){ if ( m{\ACALL SEQUENCE:([^\n]+),} ){ $tempState = 'callseq'; my $temp = $1; #print "$temp\n"; $temp =~ s/,//g; @callseq = split(/\s+/,$temp); } # print "DEBUGY3: here\n"; # for (@callseq){print "callseq:: $_\n";} if ( m! \A NONCALL\sSEQUENCE: ([^\n]+), !x){ # print "DEBUGY2: here\n"; $tempState = 'noncallseq'; my $temp = $1; #print "$temp\n"; $temp =~ s/,//g; @noncallseq = split(/\s+/,$temp); # for (@noncallseq){print "DEBUGY1: noncallseq\:\: $_\n";} if ( m{WINSTRINGS} ){ $tempState = 'winstring'; next;} if ($tempState eq 'winstring'){ next if (m,\*{3},); if ( m,\s?(B-\d.+?)\n, ){ push( @winstring,$_ );}}}}} #{#test suite #print "LOSECARDS:\n"; #{my $i;for(@losecard){$i++; s,((?:\w\-\d+\s){5}),$1\n,g;}} #{my $i;for(@wincard){$i++; s,((?:\w\-\d+\s){5}),$1\n,g;}} #my $test = &chkCards(\@wincard); #$test =~ s,((?:[\w\!]+\s){5}),$1\n,g; #$test =~ s,((?:[^\n]+\n){5}),$1\n,g; #$test =~ s,((?:!DAUB!\s?){5}),$1 OOOO,g; #print "$test"; #$test = &chkCards(\@losecard); #$test =~ s,((?:[\w\!]+\s){5}),$1\n,g; #$test =~ s,((?:[^\n]+\n){5}),$1\n,g; #$test =~ s,((?:!DAUB!\s?){5}),$1 OOOO,g; #print "$test"; #$test = &testSuite; #my $ref = $test; #my %testSeen; #$test =~ s,([01]{10}),$1(?{$testSeen{$1}++}),g; #for ( sort{ $a <=> $b } keys %testSeen ) #for ( keys %testSeen ) #{print;print "\n";}; #} #my @allcards = push( @wincard, @losecard ); #{my $i;for(@allcards){$i++; s,((?:\w\-\d+\s){5}),$1\n\n,g;print "$i\n +";print;}} #sub chkCards{ # my @cards = shift; # my $count; # my $out; # my( %call, %nocall); # for (@callseq){$call{$_}++}; # for (@noncallseq){$nocall{$_}++}; # local *chkCard = sub { # my $card = shift; # my @seq = split(/\s+/,$card); # for (@seq) # { # if (m,[01]{10},){print "$&\n";next;} # if(exists $call{$_}){ # $out .= "!DAUB! "; # }elsif(exists $nocall{$_}){ # $out .= "NODAUB "; # }else{ # die "this shouldn't happen"; # } # } # }; # for (@wincard){ # &chkCard($_) # }; # return $out; #}
PLEASE USE THE ZEN STICK. thanks much.
"I'm not afraid of Al Quaeda. I'm afraid of Al Cracker." -Chris Rock

In reply to "Biochem BINGO" or "Noob Seeks Zen Thrashing" by NamfFohyr

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.