123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257 |
- #!/usr/bin/perl
- # Daniel "Trizen" Șuteu
- # Date: 28 August 2016
- # License: GPLv3
- # Website: https://github.com/trizen
- # Lazy, ugly and very rough implementation.
- # https://projecteuler.net/problem=54
- #~ In the card game poker, a hand consists of five cards and are ranked, from lowest to highest, in the following way:
- #~ High Card: Highest value card.
- #~ One Pair: Two cards of the same value.
- #~ Two Pairs: Two different pairs.
- #~ Three of a Kind: Three cards of the same value.
- #~ Straight: All cards are consecutive values.
- #~ Flush: All cards of the same suit.
- #~ Full House: Three of a kind and a pair.
- #~ Four of a Kind: Four cards of the same value.
- #~ Straight Flush: All cards are consecutive values of same suit.
- #~ Royal Flush: Ten, Jack, Queen, King, Ace, in same suit.
- #~ The cards are valued in the order:
- #~ 2, 3, 4, 5, 6, 7, 8, 9, 10, Jack, Queen, King, Ace.
- use 5.014;
- use warnings;
- use List::Util qw(uniq max all);
- my %convert = (
- 'T' => '10',
- 'J' => '11',
- 'Q' => '12',
- 'K' => '13',
- 'A' => '14',
- );
- my @keys = keys %convert;
- sub numify {
- my ($card) = @_;
- [$card->[0] =~ s/^([@keys])/$convert{$1}/r, $card->[1]];
- }
- #<<<
- sub split_hand {
- my ($hand) = @_;
- [sort {
- ($a->[0] <=> $b->[0])
- || ($a->[1] cmp $b->[1])
- } map { numify($_) }
- map { [split(//, $_, 2)] } split(' ', $hand)];
- }
- #>>>
- sub royal_flush {
- my ($hand) = @_;
- $hand->[0][0] == 10
- and $hand->[1][0] == 11
- and $hand->[2][0] == 12
- and $hand->[3][0] == 13
- and $hand->[4][0] == 14;
- }
- sub straight {
- my ($hand) = @_;
- all { $hand->[$_][0] - $hand->[$_ - 1][0] == 1 } 1 .. $#{$hand};
- }
- sub straight_flush {
- my ($hand) = @_;
- my @suits = map { $_->[1] } @{$hand};
- uniq(@suits) == 1 or return;
- straight($hand);
- }
- sub n_pairs {
- my ($n, %h) = @_;
- (grep { $_ == 2 } values %h) == $n;
- }
- sub decide_winner {
- my ($h1, $h2) = @_;
- $h1 = split_hand($h1);
- $h2 = split_hand($h2);
- royal_flush($h1) && return 1;
- royal_flush($h2) && return 2;
- my (%t1, %t2);
- my (%u1, %u2);
- for (@$h1) {
- ++$u1{$_->[1]};
- ++$t1{$_->[0]};
- }
- for (@$h2) {
- ++$u2{$_->[1]};
- ++$t2{$_->[0]};
- }
- my %r1 = reverse(%t1);
- my %r2 = reverse(%t2);
- my %s1 = reverse(%u1);
- my %s2 = reverse(%u2);
- if (straight_flush($h1)) {
- if (straight_flush($h2)) {
- return ($h1->[-1] > $h2->[-1] ? 1 : 2);
- }
- return 1;
- }
- elsif (straight_flush($h2)) {
- return 2;
- }
- FOUR_OF_A_KIND:
- if (exists $r1{4}) {
- if (exists $r2{4}) {
- if ($r1{4} == $r2{4}) {
- $r1{1} == $r2{1} && goto FULL_HOUSE;
- return ($r1{1} > $r2{1} ? 1 : 2);
- }
- return ($r1{4} > $r2{4} ? 1 : 2);
- }
- return 1;
- }
- elsif (exists $r2{4}) {
- return 2;
- }
- FULL_HOUSE:
- if (exists($r1{3}) and exists($r1{2})) {
- if (exists($r2{3}) and exists($r2{2})) {
- if ($r1{3} == $r2{3}) {
- $r1{2} == $r2{2} && goto FLUSH;
- return ($r1{2} > $r2{2} ? 1 : 2);
- }
- return ($r1{3} > $r2{3} ? 1 : 2);
- }
- return 1;
- }
- elsif (exists($r2{3}) and exists($r2{2})) {
- return 2;
- }
- FLUSH:
- if (exists $s1{5}) {
- if (exists $s2{5}) {
- goto STRAIGHT;
- }
- return 1;
- }
- elsif (exists $s2{5}) {
- return 2;
- }
- STRAIGHT:
- if (straight($h1)) {
- if (straight($h2)) {
- return ($h1->[-1] > $h2->[-1] ? 1 : 2);
- }
- return 1;
- }
- elsif (straight($h2)) {
- return 2;
- }
- THREE_OF_A_KIND:
- if (exists $r1{3}) {
- if (exists $r2{3}) {
- $r1{3} == $r2{3} && goto TWO_PAIRS;
- return ($r1{3} > $r2{3} ? 1 : 2);
- }
- return 1;
- }
- elsif (exists $r2{3}) {
- return 2;
- }
- TWO_PAIRS:
- if (n_pairs(2, %t1)) {
- if (n_pairs(2, %t2)) {
- my @p1 = sort { $b <=> $a } grep { $t1{$_} == 2 } keys %t1;
- my @p2 = sort { $b <=> $a } grep { $t2{$_} == 2 } keys %t2;
- foreach my $i (0 .. $#p1) {
- if ($p1[$i] > $p2[$i]) {
- return 1;
- }
- elsif ($p2[$i] > $p1[$i]) {
- return 2;
- }
- }
- foreach my $i (reverse(1 .. 14)) {
- if (exists $t1{$i}) {
- if (not exists $t2{$i}) {
- return 1;
- }
- }
- elsif (exists $t2{$i}) {
- return 2;
- }
- }
- }
- return 1;
- }
- elsif (n_pairs(2, %t2)) {
- return 2;
- }
- ONE_PAIR:
- if (n_pairs(1, %t1)) {
- if (n_pairs(1, %t2)) {
- my $cmp = $r1{2} <=> $r2{2};
- if ($cmp > 0) {
- return 1;
- }
- elsif ($cmp < 0) {
- return 2;
- }
- else {
- delete $t1{$r1{2}};
- delete $t2{$r2{2}};
- goto HIGHEST_CARD;
- }
- }
- return 1;
- }
- elsif (n_pairs(1, %t2)) {
- return 2;
- }
- HIGHEST_CARD:
- (max(keys %t1) > max(keys %t2) ? 1 : 2);
- }
- my $count = 0;
- while (<>) {
- my (@game) = split(' ');
- my ($hand1, $hand2) = (join(' ', @game[0 .. 4]), join(' ', @game[5 .. 9]));
- my $winner = decide_winner($hand1, $hand2);
- ++$count if ($winner == 1);
- }
- say $count;
|