Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

'96 ACM Problem A

by jjdraco (Scribe)
on Oct 06, 2002 at 20:15 UTC ( #203201=sourcecode: print w/ replies, xml ) Need Help??

Category: Fun Stuff
Author/Contact Info Joseph Jones jjdraco@acsalaska.net
Description: I've searched long and hard for programming problems to try so that i could practice writing programs and improve my skills. i cam a cross ACM which hold an annual programming contest for College students. Even though I'm probably not elegable to enter the compatition, I did find that they keep an archive of all they're past problems for they're contest, so theres nothing stopping me from writing my on solution to the problem for the benefit of bettering myself.

well this is my solution to Problem A in the 1996 contest. You can go and read the full problem, but basicly given a standard deck of 52 cards it plays a solitaire card game called 10-20-30 and prints out the results: Win, Loss, Draw and the number of cards dealt in that game.
I have a few conserns with my solution however. I think theres still some bugs in it and I can't find them, but I think its in the subroutine _gameOver(), or _draw().
given the test cases on the website my results should print out:
Win: 66
Loss: 82
Draw: 73
but the results I'm getting are:
Win: 66
loss: 118
Draw: 75
As of yet I haven't found out why my results don't match theres. I'm tempted to sit down and play the game with a deck of cards myself and see if I still get the same results.
Also I have a question on proper programming.
I have subroutines that I don't expect to get called outside the module. I name all these subroutines with a '_' underscore in front of their names, I also still pass $self to them because they need that information. Is the way I did it poor style? How should I have done it?
I would also like to appologies for the really long comment in the play() subroutine, but I thought someone might not understand my line of thinking.
And the last consern I have with this program, or the last one I can think of is...@history, which holds the previous states of the game. I use this to test for draw since a draw happens when a state repeats itself. I defined it outside of _gameOver() and _draw() but in a block so that both functions could see it and it would hold its contents through multipule calls to the two functions. Should I have down this some other way?

Thanks for any feedback
jjdraco
package TenTwentyThirty;

use strict;
use warnings;

sub new {
   my $class = shift;
   my $self  = { DECK    => shift,# a references to an array
                 RESULTS => 0,    # scalar for play, win,
                                  # lose, draw
                                  # integers are 0, 1, 2,
                                  # 3 respectfully
                 DEALT   => 0,    # scalor for number of
                                  # cards dealt
                 TABLE   => [     # list of lists
                             [],
                             [],
                             [],
                             [],
                             [],
                             [],
                             []
                            ],
               };
   bless $self,$class;
   return $self;
} #### end of constructor



sub play {                        # this will play the game
   my $self = shift;
   my $testres;                   # used to store
                                  # return value of
                                  # _checkSum()

   do{                            # do..until game over

DONE:  for my $pile (0..6) {      # works through one pile at a time
          no warnings;            # first time for each pile
                                  # in TABLE its undef

          if( $self->{'TABLE'}->[$pile]->[0] != -1) {
          use warnings;               

             last DONE if @{$self->{'DECK'}} == 0;
                                 # exits for loop if no more
                                 # cards can be dealt

             push @{$self->{'TABLE'}->[$pile]}, shift @{$self->{'DECK'
+}};
             $self->{'DEALT'}++;     
                # takes card from top of deck and puts on
                                     # top of pile
# I feel I have to go into detail on what I mean by top of deck and to
+p of pile
# for someone might get confused on why i did the above statement this
+ way
# when you play cards, all the cards in the deck are face down and the
+ top
# of the deck is the first card in the deck, that is where you'll be d
+rawing
# cards from, the top
# know you'll be placing cards on the pile face up, the first card on 
+the
# pile will end up being at the bottom of the pile as you place more
# cards on the pile, and the top of the pile is the last card you play
+ed

             $testres = _checkSum($self,$pile);       
                                  # not sure if this is
                                  # in good style
             
             _removeCards($self,$testres,$pile);
                                  # still not sure if this
                                  # is in good style
           }                      # end of if
        }                         # end of for
   }until(_gameOver($self));      # loop until game over


} #### end of play method




sub display {                # this will display the results
                             # of the game
   my $self = shift;
   
   print "\n#########\n";
   if( $self->{'RESULTS'} == 1) {
      print "WIN : ";
   } elsif( $self->{'RESULTS'} == 2) {
      print "LOSS: ";
   } elsif( $self->{'RESULTS'} == 3) {
      print "DRAW: ";
   } else {
      print "INVALID RESULTS: ";
   }
   print $self->{'DEALT'};
   print "\n#########\n";
} #### end of display method




                           # _checkSum makes 3 checks to a 
                           # given array that is referenced
                           # by @{$self->{'TABLE'}->[$pile]}
                           # checks for sum of 10,20, or 30
                           # for following array elements
                           #     1.  first, second, last
                           #     2.  first, and last two
                           #     3.  last three
                           # returns 0 if none sum right
                           # returns 1,2,3 for the respected
                           # test case that summed right
sub _checkSum {
   my $self = shift;
   my $pile = shift;
   my $check;

   if( @{$self->{'TABLE'}->[$pile]} >= 3 ) {

      $check = $self->{'TABLE'}->[$pile]->[0] +
               $self->{'TABLE'}->[$pile]->[1] +
               $self->{'TABLE'}->[$pile]->[-1];
      if( $check == 10 ||
          $check == 20 ||
          $check == 30 ) { return 1; }

      $check = $self->{'TABLE'}->[$pile]->[0]  +
               $self->{'TABLE'}->[$pile]->[-1] +
               $self->{'TABLE'}->[$pile]->[-2];
      if( $check == 10 ||
          $check == 20 ||
          $check == 30 ) { return 2; }

      $check = $self->{'TABLE'}->[$pile]->[-1] +
               $self->{'TABLE'}->[$pile]->[-2] +
               $self->{'TABLE'}->[$pile]->[-3];
      if( $check == 10 ||
          $check == 20 ||
          $check == 30 ) { return 3; }
   } # end of if 
   return 0;
  
} #### end of _checkSum method



sub _removeCards {
   my ($self,$results,$pile) = @_;

   if( $results==1) {
      push @{$self->{'DECK'}}, shift @{$self->{'TABLE'}->[$pile]};
      push @{$self->{'DECK'}}, shift @{$self->{'TABLE'}->[$pile]};
      push @{$self->{'DECK'}}, pop   @{$self->{'TABLE'}->[$pile]};

   } elsif( $results==2 ) {
      push @{$self->{'DECK'}}, shift   @{$self->{'TABLE'}->[$pile]};
      push @{$self->{'DECK'}}, splice( @{$self->{'TABLE'}->[$pile]}, -
+2);

   } elsif( $results==3 ) {
      push @{$self->{'DECK'}}, splice( @{$self->{'TABLE'}->[$pile]}, -
+3);
   }
   $self->{'TABLE'}->[$pile]->[0] = -1 if( @{$self->{'TABLE'}->[$pile]
+}==0 );

} #### end of _removeCards method



{
my @history;
sub _gameOver {
   my $self = shift;
   my $emptyPile = 0;              # count number of
                                   # empty piles
   
   foreach my $pile (@{$self->{'TABLE'}}) {
      $emptyPile++ if( $pile->[0] == -1);
   }
                                   # all piles must be empty
                                   # to win the game
   if( $emptyPile == 7) {
      $self->{'RESULTS'} = 1;
      return 1;                    # game over WIN
   } elsif( @{$self->{'DECK'}} == 0) {
      $self->{'RESULTS'} = 2;
      return 1;                    # game over LOSS
   } elsif(_draw($self)) {
      $self->{'RESULTS'} = 3;
      return 1;                    # game over DRAW
   } else {
      my $table;
      for my $pile (0..6) {
         $table .= join(" ",@{$self->{'TABLE'}->[$pile]});
         $table .= " ";
      }
      push @history, $table;
      return 0;
                                   # game not over
   }

} #### end of _gameOver method

sub _draw {
   my $self = shift;
   
   foreach my $table (@history) {
      my $currentTable;
      for my $pile (0..6) {
         $currentTable .= join(" ",@{$self->{'TABLE'}->[$pile]});
         $currentTable .= " ";
      }
      return 1 if($currentTable eq $table);
   }
   return 0;
}
}

1; #### end of TenTwentThirty.pm

#!perl  

use strict;
use warnings;
use TenTwentyThirty;
use Array::Reform;

my @decks;
ReadCards(\@decks);


foreach my $deck (@decks) {
   my $ttt = TenTwentyThirty->new($deck); # starts a new game
   $ttt->play();                          # Plays a game
   $ttt->display();                       # displays results of game
}


sub ReadCards {
   my $decks = shift;

READ:   while(<>) {
   push @{$decks}, $_;
   last READ if(/\b0/);
   }

   chomp @{$decks};                        
   @{$decks} = split /\s+/,join(" ", @{$decks});
   @{$decks} = Array::Reform->reform(52,\@{$decks});
   pop @{$decks};

   my $i = 0;
   foreach my $item (@{$decks}) {
      $i++;
      if ( @{$item} != 52 ) {
         die "$i doesn't have 52 cards\n";
      }
   }
}

Comment on '96 ACM Problem A
Download Code
Re: '96 ACM Problem A
by Anonymous Monk on Oct 12, 2002 at 00:32 UTC

    Hi, heres a few comments, plus an alternate solution to the problem. I fully empathize with your difficultly finding a way to learn to program. There is a large gap between the beginners books and the reference books.

    It may be helpful to try something that you can use yourself. A very simple address book, or todo list would be a good start. If you do try something like this however make sure you start very simply. Don't try to add features until the basics are working. A simple, working application is much better than an ambitious broken one.

    Now on to your code. You've written this in an OO'ish way, but thats not always necessary. I can appreciate that you might be practicing OO coding of course, and your syntax isn't bad. I think the largest problem with OO coding in your example is that your one object corresponds to the entire game. You are making it more difficult for yourself, as your trouble with the @history array shows. It needs to be visible to a couple of subs, but its not part of your object.

    Your   _checkSum($self,$pile);

    is better written as   $self->_checkSum($pile)

    $self is automatically passed in as the first argument, because of the -> method call syntax.

    I don't see a repetition of _checkSum if its successful. The rules of the game state that if you can remove the three cards you should check again, and keep removing any matches until you can't match.

    Below is another solution to the problem. I haven't used any OO features. I also didn't bother implementing reading the card lists from STDIN.

    Here are a few notes about my code that might interest you.

    Most of the variables are visible throughout, since they are needed by the subs.

    I've made liberal use of array slices. @$stack[0,1,-1] return the first, second and last items in from the arrayref $stack.

    The % (modulo) operator returns the remainder from a division. 10 20 or 30 % 10 all return 0, while any of the other possible card sums will return some number. So we can condense three tests into one.

    After getting the values form the stacks and pushing them on the deck, you have to remove the elements from the array. You did this with shifting, poping and spicing, but it can also be accomplished in other ways. I set the elements values to undef, then grep'ed the list onto itself.

    To fix the bugs in your own program, you might want to add warn statements throughout similar to those below. I spent most of my time trying to figure out what was the "bottom" or "top" of the deck and stacks. But looking at the warn statements and checking each against the game rules let me fix the errors.

    Good luck coding! There's always plenty more to learn, and I by no means consider myself proficient. If anyone wants to improve my code I'll be very happy.

    #!/usr/bin/perl use strict; my @input = qw( 2 6 5 10 10 4 10 10 10 4 5 10 4 5 10 9 7 6 1 7 6 9 5 3 + 10 10 4 10 9 2 1 10 1 10 10 10 3 10 9 8 10 8 7 1 2 8 6 7 3 3 8 2 4 3 2 10 8 10 6 8 9 5 8 10 5 3 5 4 6 9 9 1 7 6 3 5 10 10 8 10 9 10 10 +7 2 6 10 10 4 10 1 3 10 1 1 10 2 2 10 4 10 7 7 10 10 5 4 3 5 7 10 8 2 3 9 10 8 4 5 1 7 6 7 2 6 9 10 2 3 10 3 4 4 9 10 1 +1 10 5 10 10 1 8 10 7 8 10 6 10 10 10 9 6 2 10 10 ); # variables need to be visible my ($initial_deck, $offset, $deck, $dealt); my @stacks; my @gamestates; # play the three games for ( 0..2 ) { $offset = $_ * 52; @$initial_deck = @input[ 0 + $offset .. 51 + $offset ]; play(); } # # play one game sub play { $deck = $initial_deck; $dealt = 0; @stacks = ([],[],[],[],[],[],[]); @gamestates = (); # warn 'INITIAL: ' . join ' ', @$initial_deck; while ( 1 ) { # warn "\n\nDEALT: $dealt -----------------------\n"; # warn "DECK: " . join ' ', @$deck; foreach my $stack ( @stacks ) { # warn "---------"; # deal card push @$stack, shift @$deck; $dealt++; return done( 'Loss' ) if ! scalar @$deck; # check for 10,20,30 $stack = check_stack($stack); # check for repeated game state return done( 'Draw' ) if repeated(); # die if $dealt >= 200; } @stacks = grep { scalar @$_ } @stacks; return done('Win') if ! scalar @stacks; } } # evaluate stack for ten twenty thirty and resize array sub check_stack { my $stack = shift; # warn "Stack: " . join ' ', @$stack; foreach my $card_combo ( ( [0,1,-1],[0,-2,-1],[-3,-2,-1] ) ) { my $sum; return $stack if scalar @$stack < 3; foreach ( @$stack[ @$card_combo ] ) { $sum += $_ }; next if ( $sum % 10 ); # warn "GOT ONE: @$card_combo / " . join '+', @$stack[ @$card_comb +o ]; push @$deck, @$stack[ @$card_combo ]; # remove elements from array @$stack[ @$card_combo]= undef; @$stack = grep { $_ } @$stack; check_stack( $stack ); } $stack; } sub repeated { my $gamestate = join ' ', map { join ' ', @$_ } @stacks; # $gamestate .= ' ' . join ' ', @$deck; foreach ( @gamestates ) { if ( $gamestate eq $_ ) { # warn "Seen: $_"; # warn "Now : $gamestate"; return 'draw'; } } push @gamestates, $gamestate; return 0; } sub done { print shift() . ": $dealt\n"; } 1;
      hmmm... I'm going to have to give this code a lot of thought. I seem to have a problem thinking this way and the way I wrote it it just seemed to flow better in my mind. I'll see if I can't think through your code, even thow I can understand any given statement in your example, over all I need to do some reflecking on it to really see whats going to. On one note, the reason I took my input from STDIN is it seems to me that is what the problem called for and I wanted to keep to the rules of the problem. In all honesty thow, I guess it doesn't really matter since I'm just doing it for learning perposes anyway

      jjdraco
      learning Perl one statement at a time.

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://203201]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (11)
As of 2014-12-19 21:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (91 votes), past polls