"Biochem BINGO" or "Noob Seeks Zen Thrashing"

NamfFohyr has asked for the wisdom of the Perl Monks concerning the following question:

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}
    }
}
[download]

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
***
[download]

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;
#}
[download]

PLEASE USE THE ZEN STICK. thanks much.

"I'm not afraid of Al Quaeda. I'm afraid of Al Cracker." -Chris Rock

Comment on "Biochem BINGO" or "Noob Seeks Zen Thrashing" Select or Download Code

Replies are listed 'Best First'.
Re: "Biochem BINGO" or "Noob Seeks Zen Thrashing" by talexb (Chancellor) on Dec 12, 2005 at 11:31 UTC
A couple of general comments for your enlightenment. When posting code, delete the stuff that's commented out. Look up 'heredocs' for chunks of text that flow over multiple lines. Whenever you find yourself repeating code, think about how it could be made into a loop. On a grander scale, think about how you could have modelled a BINGO card (of which, more later). There's a reason good code is indented regularly -- it makes it more readable. Your code is not particularly readable, partially because it's not regularly indented Modelling a BINGO card Well. A BINGO card is basically five columns with B-I-N-G-O across the top, and columns of numbers, choose five randomly from 1-15 under B, and so forth to 61-75 under O. Once you know that, lots of the code you've got here can be vastly simplified. You could call a module to set the values of each card, then print out the artwork for each card. The main line program would be a dozen lines long. Anyway, good work posting this code -- read all of the replies carefully, you should learn a great deal, as I have for the four years that I've been here. Good luck. Alex / talexb / Toronto "Groklaw is the open-source mentality applied to legal research" ~ Linus Torvalds	[reply]
Re^2: "Biochem BINGO" or "Noob Seeks Zen Thrashing" by NamfFohyr (Scribe) on Dec 12, 2005 at 18:27 UTC
Thanks Alex, for the encouragement. I could have finished much more quickly if I just had to write cards that look like BINGO cards. My challenge was to, given a call sequence beforehand, make a set of BINGO cards with a known number of winners. My solution IS definately inelegant, but I had to ensure 120 losing cards and 10 winners. Just trying to defend SOME of the complexity! ry "I'm not afraid of Al Quaeda. I'm afraid of Al Cracker." -Chris Rock	[reply]
Re: "Biochem BINGO" or "Noob Seeks Zen Thrashing" by zentara (Cardinal) on Dec 12, 2005 at 14:02 UTC
You probably already know about it, but in case you dont, google for "Bullshit Bingo". Check out Bull$#!^ Bingo (was :By far, the coolest use for perl) and/or use the perlmonks searchbox and search for "bullshit bingo". I'm not really a human, but I play one on earth. flash japh	[reply]
Re: "Biochem BINGO" or "Noob Seeks Zen Thrashing" by QM (Parson) on Dec 12, 2005 at 17:34 UTC
I've got a little time, so I'll give you a few specific suggestions: `my $people = 10; my $prizes = 8; my $draws = 222;` [download] These are probably globals, aren't they? You want them to be available everywhere, right? I'd go with `our`, which is the complement of `my`, and still avoids having that `use vars qw($people $prizes $draws);` thing. These don't seem to be constants, but are perhaps "today's context". There are several ways to improve this, one being to make these changeable on the command line, but have a default: `our $people = (shift or 10); our $prizes = (shift or 8); our $draws = (shift or 222);` [download] That works if you don't have other command line values to pass. Note that to change `$draws`, you have to provide values for the others also. A little more work, if this is a quick and dirty for your own consumption only, you might just filter the command line manually: `our $people = 10; our $prizes = 8; our $draws = 222; my @save_args; while (@ARGV) { if ($ARGV[0] eq '-people') { shift @ARGV; if (@ARGV) { my $temp = shift @ARGV; if (($temp > 0) and ($temp < 1e6)) { $people = $temp; } else { die "Error: -people out of range, <$temp>, " } } else { die "Error: -people, no value, " } next; } # etc. }` [download] However, see that if you really want to make it robust, this gets into a lot of code quickly. Another idea is to use one of the `Getopt::` modules. I prefer `Getopt::Declare`, because the usage documentation generates the command line parsing code. For instance, you might come up with this: use Getopt::Declare; our $PEOPLE_OPT = '-p'; our $PRIZES_OPT = '-z'; our $DRAWS_OPT = '-d'; our $PEOPLE_DEFAULT = 10; our $PRIZES_DEFAULT = 8; our $DRAWS_DEFAULT = 222; our $people = $PEOPLE_DEFAULT; our $prizes = $PRIZES_DEFAULT; our $draws = $DRAWS_DEFAULT; my $option_spec = qq{ $0 does some magic for BS Bingo, yada, yada, yada Options: $PEOPLE_OPT <people> Sets number of people (default is $PEO +PLE_DEFAULT) { reject ($people < 2) or ($people > 1e6); \$::people = $people; } $PRIZES_OPT <prizes> Sets number of prizes (default is $PRI +ZES_DEFAULT) { reject ($prizes < 2) or ($prizes > 1e6); \$::prizes = $prizes ; } $DRAWS_OPT <draws> Sets number of draws (default is $DRAWS_ +DEFAULT) { reject ($draws < 2) or ($draws > 1e6); \$::draws = $draws ; } } my $options = Getopt::Declare->new( $option_spec ) or die "\n*** Error processing command line options, terminating $0 +\n"; [download] This automatically defines options such as `-help` that essentially prints out the option spec (without the code snippets) as the usage statement. Jumping down to `mkWinstring`, you have this: `for (0..($draws-1)){ local $_ = $seq[$_];` [download] A lot of work, and not obvious to non-Perlers with the double use of `$_`. Why not something like this? `for (@seq[0..$draws-1]){` [download] I actually prefer to name the loop variables, if it makes it easier to follow (especially if you're going to have nested or longer loops): `for my $draw (@seq[0..$draws-1]){` [download] Just after that, any reason to use `m,B,` over the more standard `/B/`, or even `m/B/`? Later you have: `my $winstring = $b[$j].' '.$i[$j].' '.$n[$j].' + '.$g[$j].' '.$o[$j]."\n";` [download] which seems like a lot of punctuation compared to: `my $winstring = "$b[$j] $i[$j] $n[$j] $g[$j] $o[$j]\n";` [download] While you'll get the infrequent "Don't interpolate variables (in double-quoted strings) when you don't need to!", I don't think there's much value when using the string concatenation operator ('.'), and it cleans up the statement nicely. Just after that, you've inserted a piece of debug code where you then split `$winstring` on whitespace. Unless there's whitespace in the original values, it would have been better to do this debug work beforehand. `getRand` is particularly misinformed :) `sub getRand(){ while (1){ my $temp = int(1111rand()/11); unless ($temp = 0) {return $temp; exit} } }` [download] You seem to want an integer between 1 and 100 here (you'll never get 101, as `int` truncates towards zero). Wouldn't this work better? `my $temp = int(rand(100)+1;` [download] Also, `{return $temp; exit}` [download] can mistakenly lead someone to believe the program exits here, after finding a suitable number. But `return` means the `exit` is never executed. You might consider reworking your metadata file to use numbers only, instead of the column designators. Look up the column in the code that reads this instead. It makes it easier to read in, and easier to propagate to other scripts. Moving on to "Make Bingo Cards"... `&doInit; &mkCards;` [download] I'm a little fuzzy here, but I think there's some magic that happens with `$_` (or is it `@_`) when calling subs with `&sub` as opposed to `sub()`. Unless you're trying to get around one of these special cases, I'd suggest using the paren form: `doInit(); mkCards();` [download] If these are declared before use, you can drop the parens. I would suggest keeping them, as reorganizing the script can put the use before the declaration, and Perl will gripe at you. Besides, having the parens forces the compiler to accept the lack of parameters passed, instead of guessing when they are used like this: `$status = getRand + 17;` [download] Is that `getRand() + 17` or `getRand(+17)`? You might consider using the `m//x` option to document your more complex regexen `if (m,([01]{10})\n((?:(?:\w\-\d+[\s\n]){5}){5} +),)` [download] Down in `mkCards`: `local getNewDrawBall = sub { #workaround for +scoping inner subroutine with typeglob - ugly Per +lism my $type = shift; my $temp2; while (1){ $temp2 = &getDrawBall($type); if (exists $seen{$temp2}) { next; }else{ $seen{$temp2}++;return $temp2;} #pr +int "DEBUGdraw: $temp\n"; } };` [download] So every time through the loop, you declare a new sub exactly like the last one? Is there some reason this can't be declared elsewhere? You mention some scoping issue, but don't explain. The only variable that isn't declared in the sub is `%seen`, which you're using as a "seen" cache, and create anew with each loop. Why not declare the sub once, and pass in a reference to the variable, if that's required? Or better yet, create a closure with the sub and cache, and a helper sub to clear the cache when needed: `{ # closure for getNewDrawBall, getNewNonDrawBall my %seen; sub clearNewDrawBallCache { %seen = (); } sub getNewDrawBall { # stuff here } sub getNewNonDrawBall { # stuff here } } # end closure for getNewDrawBall, getNewNonDrawBall` [download] Then the top part of your loop reduces to this: `for my $k (1..$losers) { my $linestring; my $count = 0; clearNewDrawBallCache(); #SPOIL CARD HERE # etc... }` [download] Again, you typeglob subs, for what reason? `local *coinFlip = sub { my $z = &getRand; my $coin = int($z)% 2; return $coin; };` [download] This sub doesn't reference anything not created here, except for `getRand`, itself a sub. Using `my`, there are no variable name clobbering issues (except of course with the typeglob :) Well, that's enough for now. Keep looking for improved idioms -- forms that make it easy to read, and easy to follow, and don't duplicate effort. If you code so that a non-programmer can mostly figure out what's happening (by using descriptive names, comments), and you format so that it wouldn't look like line noise if framed on your wall, you will have achieved a lot. -QM -- Quantum Mechanics: The dreams stuff is made of	[reply] [d/l] [select]
Re^2: "Biochem BINGO" or "Noob Seeks Zen Thrashing" by NamfFohyr (Scribe) on Dec 12, 2005 at 18:38 UTC
QM! Thanks so much! It'll take a while to digest all of your feedback, but there is one thing that leaps out: I couldn't figure out how to pass a nested subroutine. This is adapted from the Perl Cookbook: (and one of the beginner-gotchas that got me): `sub outloop { #NOOB GOTCHA my $k = "string"; sub inside { return $k."cheese" } return inside( ); }` [download] So I thought I had to do this, without figuring out how to use references (or restructure the whole thing): `sub outer { #APPARENTLY CORRECT my $k = "string"; local *inside = sub { return $k."cheese" }; return inside( ); }` [download] ry "I'm not afraid of Al Quaeda. I'm afraid of Al Cracker." -Chris Rock	[reply] [d/l] [select]
Re^3: "Biochem BINGO" or "Noob Seeks Zen Thrashing" by QM (Parson) on Dec 12, 2005 at 23:10 UTC
I couldn't figure out how to pass a nested subroutine. "pass" a sub? You didn't pass a sub. You defined it, then used it, then returned it's return value. If you want to pass a sub, you need a reference to it. Off the top of my head, there are 2 easy ways: 1) Define an anonymous (no-name) sub, and assign it to a scalar ref `my $square_this = sub { my $x = shift; return $x2; };` [download] 2) Take a reference to a named sub `sub square { my $x = shift; return $x2; } my $square_this = \&square;` [download] Use it like this (either version): `my $squared = $square_this->($hypotenuse);` [download] Perhaps what you really meant was nested sub, in the Pascal sense. In Perl there's no such animal per se, though it can be emulated. In Perl we could talk about a limited scope sub, only available to a certain sub or collection of subs. Again, a couple of ways: 1) Packages: define a package to limit scope `package Square; sub square { my $x = shift; return $x2; }` [download] Use it one of these ways: 1) Inside package Square (perhaps by other routines in that package) `my $squared = square($hypotenuse);` [download] 2) Outside of package Square, e.g., main: `my $squared = Square::square($hypotenuse);` [download] 3) If you do this, it won't be limited in scope. Package Square is in Square.pm, the following is in main: `use Square qw(square); my $squared = square($hypotenuse);` [download] The solution I think you're looking for (and tell me if I'm wrong), is a closure with an anonymous sub, that can only be seen by your named sub. For instance: `{ # closure for cubed my $square = sub { my $x = shift; return $x2; }; sub cubed { my $z = shift; return $z*$square->($z); } } # end closure for cubed` [download] Now only the subs (and other code) in the closure can see `$square` (unless you give out a reference to it). -QM -- Quantum Mechanics: The dreams stuff is made of	[reply] [d/l] [select]
Re: "Biochem BINGO" or "Noob Seeks Zen Thrashing" by mrborisguy (Hermit) on Dec 12, 2005 at 19:01 UTC
My only suggestion, since I knew I wouldn't be able to handle reading through this, is to clean up your code. Make it look nice. That may sound very picky and worthless, but really it is very helpful for anyone trying to understand your code. Read more... (3 kB) I guess the point I'm trying to make is try to keep your code clean and looking nice. You'll find it does wonders. -Bryan	[reply] [d/l] [select]

Modelling a BINGO card