Matt Owen

source code for "files/pe/pe_054.pl"

return to portfolio
  1.  #!/usr/bin/perl
  2.  
  3.  use strict;
  4.  use warnings;
  5.  
  6.  # distinct elements
  7.  sub distinct {
  8.   my (%h);
  9.   return grep { not $h{$_}++ } int @_ > 1 ? @_ : split / /, shift;
  10.  }
  11.  
  12.  # return just numbers
  13.  sub numbers {
  14.   my ($s) = shift;
  15.   $s =~ s/T/10/g;
  16.   $s =~ s/J/11/g;
  17.   $s =~ s/Q/12/g;
  18.   $s =~ s/K/13/g;
  19.   $s =~ s/A/14/g;
  20.   $s =~ s/[^0-9 ]//g;
  21.   return join ' ', sort { $a <=> $b } split / /, $s;
  22.  }
  23.  
  24.  # return just suits
  25.  sub suits {
  26.   my ($s) = shift;
  27.   $s =~ s/[^DHCS ]//g;
  28.   return $s;
  29.  }
  30.  
  31.  #
  32.  sub group {
  33.   my ($s) = shift;
  34.   my (%cards);
  35.  
  36.   # strip to just numbers
  37.   $s =~ s/T/10/g;
  38.   $s =~ s/J/11/g;
  39.   $s =~ s/Q/12/g;
  40.   $s =~ s/K/13/g;
  41.   $s =~ s/A/14/g;
  42.   $s =~ s/[^0-9 ]//g;
  43.  
  44.   $cards{$_}++ for split / /, $s;
  45.  
  46.   return %cards;
  47.  }
  48.  
  49.  # order
  50.  sub order {
  51.   my ($s) = shift;
  52.   my (%cards) = group $s;
  53.   my (@ordered);
  54.  
  55.   # adds them to the array in an appropriate order
  56.   for my $quantity (reverse 1..4) {
  57.   for my $n (grep { $cards{$_} == $quantity } sort { $b <=> $a } keys %cards) {
  58.   unshift @ordered, $n for (1..$quantity);
  59.   }
  60.   }
  61.  
  62.   return wantarray ? @ordered : join(' ', @ordered);
  63.  }
  64.  
  65.  # is a straight?
  66.  sub is_straight {
  67.   my (@cards) = order shift;
  68.   my ($c) = shift @cards;
  69.  
  70.   for (@cards) {
  71.   return 0 if $c != $_ -1;
  72.   $c = $_;
  73.   }
  74.  
  75.   return 1;
  76.  }
  77.  
  78.  # is boat?
  79.  sub is_boat {
  80.   my (%grouped) = group shift;
  81.   my ($has2, $has3);
  82.   $has2 = 0 < int grep { $grouped{$_} == 2 } keys %grouped;
  83.   $has3 = 0 < int grep { $grouped{$_} == 3 } keys %grouped;
  84.   return $has2 && $has3 ? 1 : 0;
  85.  }
  86.  
  87.  #
  88.  sub score {
  89.   my ($cards) = shift;
  90.   my (%grouped) = group $cards;
  91.   my ($number_suits) = int distinct suits $cards;
  92.   my ($is_straight) = is_straight($cards) ? 1 : 0;
  93.  
  94.   return 8 if $is_straight && $number_suits == 1;
  95.   return 7 if grep { $grouped{$_} == 4 } keys %grouped;
  96.   return 6 if is_boat $cards;
  97.   return 5 if 1 == int distinct suits $cards;
  98.   return 4 if is_straight $cards;
  99.   return 3 if grep { $grouped{$_} == 3 } keys %grouped;
  100.   return 2 if 2 == int grep {$grouped{$_} == 2} keys %grouped;
  101.   return 1 if 1 == int grep {$grouped{$_} == 2} keys %grouped;
  102.   return 0;
  103.  }
  104.  
  105.  #
  106.  sub is_higher {
  107.   my ($score1, $score2) = map { score $_ } @_;
  108.  
  109.   my ($a, $b) = @_;
  110.  
  111.   my (@p1) = order shift;
  112.   my (@p2) = order shift;
  113.  
  114.  
  115.   return 1 if ($score1 > $score2);
  116.  
  117.   if ($score1 == $score2) {
  118.   for (reverse 0..@p1-1) {
  119.   return 1 if ($p1[$_] > $p2[$_]);
  120.   return 0 if ($p1[$_] < $p2[$_]);
  121.   }
  122.   }
  123.  }
  124.  
  125.  # file handle
  126.  open GAME, "cards.txt";
  127.  
  128.  # init
  129.  my ($wins) = 0;
  130.  
  131.  # work
  132.  for (<GAME>) {
  133.   chomp;
  134.  
  135.   my ($p1, $p2) = (substr($_, 0, 14), substr($_, 15));
  136.  
  137.   $wins++ if (is_higher $p1, $p2);
  138.  }
  139.  
  140.  print "$wins\n";
  141.  
  142.  close GAME;