Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
[euler] prob054 using objects as hash keys
  • Loading branch information
@andreoss
andreoss committed Jun 18, 2015
1 parent 60a7653 commit 6c2842a
Showing 1 changed file with 138 additions and 148 deletions.
286 changes: 138 additions & 148 deletions categories/euler/prob054-andreoss.pl
View file
Expand Up @@ -17,33 +17,31 @@
How many hands does Player 1 win?
Expected result: 376
=end pod

enum Rank <
Two Three Four Five
Six Seven Eight Nine
Ten Jack Queen King Ace
Two Three Four
Six Seven Eight Nine
Ten Jack Queen King Ace
>;

enum Suit <
Hearts Diamonds Clubs Spades
Hearts Diamonds Clubs Spades
>;

enum Hand <
RoyalFlush StraightFlush FourOfKind
FullHouse Flush Straight ThreeOfKind
TwoPairs OnePair HighCard
RoyalFlush StraightFlush FourOfKind
FullHouse Flush Straight ThreeOfKind
TwoPairs OnePair HighCard
>;

multi counts(Positional $h) {
$h.Bag.Hash.invert
bag($h).invert
}

multi strigify(Hash $x) {
join ' and ', do for $x.kv -> $k, $v {
"$k of $v"
"$k of $v"
}
}

Expand All @@ -52,216 +50,208 @@
has Suit $.suit;

method parse-rank(Str $r) returns Rank {
given $r {
when /\d/ { Rank($r.Int - 2) }
when /T/ { Ten }
when /J/ { Jack }
when /Q/ { Queen }
when /K/ { King }
when /A/ { Ace }
}
given $r {
when /\d/ { Rank($r.Int - 2) }
when /T/ { Ten }
when /J/ { Jack }
when /Q/ { Queen }
when /K/ { King }
when /A/ { Ace }
}
}
method parse-suit(Str $s) returns Suit {
given $s {
when /H/ { Hearts }
when /D/ { Diamonds }
when /C/ { Clubs }
when /S/ { Spades }
}
given $s {
when /H/ { Hearts }
when /D/ { Diamonds }
when /C/ { Clubs }
when /S/ { Spades }
}
}
multi method CALL-ME(Str $c where $c.chars == 2) {
my ($r, $s) = $c.comb;
self.new(rank => Card.parse-rank($r),
suit => Card.parse-suit($s));
my ($r, $s) = $c.comb;
self.new(rank => Card.parse-rank($r),
suit => Card.parse-suit($s));
}
multi method CALL-ME(Rank $v, Suit $s) {
self.new(rank => $v, suit => $s)
self.new(rank => $v, suit => $s)
}


}


multi infix:«<=>»(Card $a, Card $b) returns Order {
multi infix:«<=>»(Card $a, Card $b) is export returns Order {
$a.rank <=> $b.rank
}


class Deal {
subset Ranks where -> $r {
$r ~~ Rank || $r ~~ Array[Rank]
$r ~~ Rank || $r ~~ Array[Rank]
};

has Card @.cards;
has Ranks %.score;
has Ranks %.score{Hand};

method CALL-ME(Str $h) {
my $x = self.new(
cards => map { Card($_) } , $h.split: /\s/
);
#warn $x!best-hand.perl;
$x.score = $x!best-hand;
$x;
my $x = self.new(
cards => map { Card($_) } , $h.split: /\s/
);
$x.score = $x!best-hand;
$x;
}
method ACCEPTS(Hand $h) {
so %.score{$h};
}

method !best-hand {
self!royal-flush //
self!straight-flush //
self!full-house //
self!flush //
self!straight //
self!four-of-kind //
self!three-of-kind //
self!two-pairs //
self!one-pair //
self!high-card
self!royal-flush
// self!straight-flush
// self!full-house
// self!flush
// self!straight
// self!four-of-kind
// self!three-of-kind
// self!two-pairs
// self!one-pair
// self!high-card
}


method !straight {
my @v = @.cards».rank.sort;
if @v.join eq (@v.min ... @v.max).map({Rank($_)}).join {
Straight => @v.max
}
my @v = @.cards».rank.sort;
if @v eq (@v.min ... @v.max).map({Rank($_)}) {
(Straight) => @v.max
}
}

method !flush {
if [~~] @.cards».suit {
Flush => Array[Rank].new(|@.cards».rank);
}
if [~~] @.cards».suit {
(Flush) => Array[Rank].new: @.cards».rank;
}
}

method !royal-flush {
if self!flush && self!straight && @.cards».rank.max ~~ Ace {
RoyalFlush => Ace
}
if self!flush && self!straight && @.cards».rank.max ~~ Ace {
(RoyalFlush) => Ace
}
}

method !straight-flush {
if self!straight && self!flush {
StraightFlush => self!straight.value
}
if self!flush && my $s = self!straight {
(StraightFlush) => $s.value
}
};
method !four-of-kind {
# Four cards of the same value.
my @ranks = @.cards».rank;
my @four = @ranks.&counts.grep(*.key == 4);
if so @four {
FourOfKind => my $x = EVAL(@four[0].value),
HighCard => max grep { $_ !~~ $x }, @ranks
}
# Four cards of the same value.
my @ranks = @.cards».rank;
my @four = @ranks.&counts.grep(*.key == 4);
if so @four {
(FourOfKind) => my $x = @four[0].value,
(HighCard) => max grep { $_ !~~ $x }, @ranks
}
}
method !full-house {
# Three of a kind and a pair.
my %x = self!three-of-kind , self!one-pair;
if %x<ThreeOfKind>.defined && %x<OnePair>.defined {
FullHouse => Ace
}
my Ranks %x{Hand} = self!three-of-kind , self!one-pair;
if %x{ThreeOfKind}.defined && %x{OnePair}.defined {
(FullHouse) => Ace
}
}

method !three-of-kind {
my $rank = @.cards».rank.&counts.grep(*.key == 3)[0];

if $rank {
my %h = ThreeOfKind => my $x = EVAL($rank.value);

if my $one-pair = @.cards».rank.&counts.grep(*.key == 2)[0] {
%h<OnePair> = EVAL($one-pair.value);
} else {
%h<HighCard> = max grep { $_ !~~ $x }, @.cards».rank;
}
%h;
}
my $rank = @.cards».rank.&counts.grep(*.key == 3)[0];

if $rank {
my Ranks %h{Hand} = (ThreeOfKind) => my $x = $rank.value;

if my $one-pair = @.cards».rank.&counts.grep(*.key == 2)[0] {
%h{OnePair} = $one-pair.value;
}
else {
%h{HighCard} = max grep { $_ !~~ $x }, @.cards».rank;
}
%h;
}
}

method !two-pairs {
my @pairs = @.cards»\
.rank.&counts\
.sort(*.key).grep(*.key == 2);
if +@pairs == 2 {
OnePair => my $x=@pairs.map({ EVAL $_.value }).min,
TwoPairs => my $y=@pairs.map({ EVAL $_.value }).max,
HighCard => max grep { $_ !~~ $x | $y },@.cards».rank;
}
my @pairs = @.cards»\
.rank.&counts\
.sort(*.key).grep(*.key == 2);
if +@pairs == 2 {
(OnePair) => my $x= @pairs».value.min,
(TwoPairs) => my $y= @pairs».value.max,
(HighCard) => max grep { $_ !~~ $x | $y },@.cards».rank;
}

}

method !one-pair {
my @pairs = @.cards»\
.rank.&counts\
.sort(*.key).grep(*.key == 2);
if so @pairs {
OnePair => my $x = EVAL(@pairs[0].value),
HighCard => max grep { $_ !~~ $x}, @.cards».rank;
}
my $pair = @.cards»\
.rank.&counts\
.sort(*.key).grep(*.key == 2)[0];
if $pair {
(OnePair) => my $x = $pair.value,
(HighCard) => max grep { $_ !~~ $x}, @.cards».rank;
}
}

method !high-card {
HighCard => max @.cards».rank ;
(HighCard) => @.cards».rank.max;
}
}


multi infix:«~~~»(Deal $a, Hand $h) {
so $a.score{$h};
}

multi infix:«<=>»(Deal $a, Deal $b) returns Order {
for Hand.enums.sort(*.value).keys.map({Hand($_)}) -> $h {
return More if $a.score{$h}.defined && !$b.score{$h}.defined;
return Less if $b.score{$h}.defined && !$a.score{$h}.defined;
next unless $a.score{$h} & $b.score{$h};

return More if $a.score{$h}.defined && !$b.score{$h}.defined;
return Less if $b.score{$h}.defined && !$a.score{$h}.defined;
next unless $a.score{$h}.defined && $b.score{$h}.defined;

if $a.score{$h} & $b.score{$h} ~~ List {
my $cmp = max $a.score{$h} Z<=> $b.score{$h};
return Less if $cmp ~~ Same | Less;
return More if $cmp ~~ More;
}
if $a.score{$h} & $b.score{$h} ~~ List {
my $cmp = max $a.score{$h} Z<=> $b.score{$h};
return Less if $cmp ~~ Less;
return More if $cmp ~~ More;
}

my $cmp = $a.score{$h} <=> $b.score{$h};
my $cmp = $a.score{$h} <=> $b.score{$h};

next if $cmp ~~ Same;
return $cmp;
next if $cmp ~~ Same;
return $cmp;
}
Same;
}

sub MAIN(Bool :$verbose = False,
Bool :$run-tests = False,
:$file = $*SPEC.catdir($*PROGRAM_NAME.IO.dirname, 'poker.txt'),
:$lines = Inf, # read only X lines from file
) {
Bool :$run-tests = False,
:$file = $*SPEC.catdir($*PROGRAM_NAME.IO.dirname, 'poker.txt'),
:$lines = Inf, # read only X lines from file
) {
die "'$file' is missing" unless $file.IO.e ;
return tests if $run-tests;

say [+] gather for $file.IO.lines[^$lines] {
my $line = $_; # for mutability
$line ~~ s:nth(5)/\s/;/;
my ($h1,$h2) = $line.split: /';'/;
my $d1 = Deal($h1);
my $d2 = Deal($h2);
if $d1 <=> $d2 ~~ More {
say "player1 wins on $line \n\twith {$d1.score.&strigify} against {$d2.score.&strigify} " if $verbose ;
take 1;
}
return TEST if $run-tests;

say [+] gather for $file.IO.lines[^$lines] <-> $line {
$line ~~ s:nth(5)/\s/;/;
my ($h1,$h2) = $line.split: /';'/;
my $d1 = Deal($h1);
my $d2 = Deal($h2);
if $d1 <=> $d2 ~~ More {
say "player1 wins on $line \n\twith {$d1.score.&strigify} against {$d2.score.&strigify} " if $verbose ;
take 1;
}
}

}

sub tests {
sub TEST {
use Test;
ok Card("TC") <=> Card("TD") ~~ Same, "cards are equal if ranks are equal ";
ok Card("2C") <=> Card("AC") ~~ Less, "2C < AC";
ok (Deal("5H 6C 7S 8D 9D") ~~~ Straight) &&
(Deal("2H 6C 7S 8D 9D") !~~~ Straight) , "Detects straight";
ok (Deal("5H 7H 8H AH TH") ~~~ Flush) &&
(Deal("5H 7H 8H AC TH") !~~~ Flush), "Detects flush ";
ok Deal("TH JH QH KH AH") ~~~ RoyalFlush, "Detects royal flush ";
ok (Straight ~~ Deal("5H 6C 7S 8D 9D") ) &&
(Straight !~~ Deal("2H 6C 7S 8D 9D")) , "Detects straight";
ok (Flush ~~ Deal("5H 7H 8H AH TH")) &&
(Flush !~~ Deal("5H 7H 8H AC TH")), "Detects flush ";
ok RoyalFlush ~~ Deal("TH JH QH KH AH") , "Detects royal flush ";
ok Deal("5H 5C 6S 7S KD") <=> Deal("2C 3S 8S 8D TD") ~~ Less,"Player 2 wins [1]";
ok Deal("5D 8C 9S JS AC") <=> Deal("2C 5C 7D 8S QH") ~~ More, "Player 1 wins [2]";
ok Deal("2D 9C AS AH AC") <=> Deal("3D 6D 7D TD QD") ~~ Less, "Player 2 wins [3]";
ok Deal("4D 6S 9H QH QC") <=> Deal("3D 6D 7H QD QS") ~~ More, "Player 1 wins [4]";
ok Deal("2H 2D 4C 4D 4S") <=> Deal("3C 3D 3S 9S 9D") ~~ More, "Player 1 wins [5]";
ok Deal("2H 2D 4C 4D 4S") <=> Deal("3C 3D 3S 9S 9D") ~~ Same, "Nobody wins [5]";
ok Deal("7C 5H KC QH JD") <=> Deal("AS KH 4C AD 4S") ~~ Less, "Player 2 wins [6]";
ok Deal("KS KC 9S 6D 2C") <=> Deal("QH 9D 9H TS TC") ~~ Less, "Problem [1]";
ok Deal("TS QH 6C 8H TH") <=> Deal("5H 3C 3H 9C 9D") ~~ Less, "Problem [2]";
Expand Down

0 comments on commit 6c2842a

Please sign in to comment.