Problem54 - Project Euler

Perl 30分プログラム

30分プログラム、その331。Problem54 - ProjectEuler。id:mzp:20080703:eulerの訂正版。やっと解けた。
id:rst76さんの５４問目 - Life Goes Onを走らせて、diffを取ったりしてデバッグした。=と==を間違えてたり、Kの次がAじゃなかったりしてたところを直した。

使い方

$ time perl problem54.pl
376
perl problem54.pl  1.35s user 0.04s system 93% cpu 1.480 total

ソースコード

#! /usr/bin/perl
# -*- mode:perl; coding:utf-8 -*-
#
# problem54.pl -
#
# Copyright(C) 2008 by mzp
# Author: MIZUNO Hiroki / mzpppp at gmail dot com
# http://howdyworld.org
#
# Timestamp: 2008/07/01 22:35:35
#
# This program is free software; you can redistribute it and/or
# modify it under MIT Lincence.
#
use strict;
use warnings;
use Data::Dumper;

# Cardを表す構造体(っぽいクラス)
package Card;
use Class::Struct;

struct Card =>{
    suit => '$',val=>'$'
};

sub make($$){
    my ($self,$s,$v) = @_;
    my $card = Card->new();
    $card->suit($s);
    $card->val($v);
    return $card;
}

sub parse($){
    my ($self,$s) = @_;
    my %special = ('T'=>10,'J'=>11,'Q'=>12,'K'=>13,'A'=>14);
    if($s =~ /\A(..?)(.)\Z/){
	my $v = $1;
	my $s = $2;

	if(defined $special{$v}){
	    $v = $special{$v};
	}
	$self->make($s,$v);
    }
}

# 本体
package main;
use List::Util qw(reduce max);

sub card_cmp($$){
    my ($a,$b) = @_;
    my $r = $a->val <=> $b->val;
    unless($r==0){
	$r;
    }else{
	$a->suit cmp $b->suit;
    }
}

sub same_value(@){
    my ($x) = @_;
    reduce {$a && $b} map { $_ == $x} @_;
}

# カード的な意味での次
# ... T J Q K A 2 3 ..
sub succ($){
    my ($v) = @_;
    return ($v+1-2)%13+2;
}

# フラッシュ
sub flash(@){
    my ($x) = @_;
    if(reduce {$a && $b} map { $_->suit() eq $x->suit()} @_){
	max map {$_->val()} @_;
    }else{
	();
    }
}

# ストレート
sub straight(@){
    my ($a,$b,$c,$d,$e) = map {$_->val()} @_;

    if($b ==  succ $a &&
       $c == succ $b &&
       $d == succ $c &&
       $e == succ $d){
	$e;
    }else{
	();
    }
}

# ロイヤルストレートフラッシュ
sub royal_flash(@){
    my ($a,$b,$c,$d,$e) = map {$_->val()} @_;
    if(flash(@_) && 
       $a == 1  &&
       $b == 10 &&
       $c == 11 &&
       $d == 12 &&
       $e == 13){
	14;
    }else{
	();
    }
}

# ストレートフラッシュ
sub straight_flash(@){
    my @val = map {$_->val()} @_;
    if(flash(@_) && straight(@_)){
	max @val;
    }else{
	();
    }
}

# フォーカード
sub four(@){
    my ($a,$b,$c,$d,$e) = map {$_->val()} @_;
    if(same_value($a,$b,$c,$d)){
	$a;
    }elsif(same_value($b,$c,$d,$e)){
	$b;
    }else{
	();
    };
}

# フルハウス
sub full_house(@){
    my ($a,$b,$c,$d,$e) = map {$_->val()} @_;
    if(same_value($a,$b) && same_value($c,$d,$e)){
	$c;
    }elsif(same_value($a,$b,$c) && same_value($d,$e)){
	$a;
    }else{
	();
    }
}

# スリーカード
sub three(@){
    my ($a,$b,$c,$d,$e) = map {$_->val()} @_;
    if(same_value($a,$b,$c)){
	$a;
    }elsif(same_value($b,$c,$d)){
	$b;
    }elsif(same_value($c,$d,$e)){
	$c;
    }else{
	();
    }
}

# ツーペア
sub two(@){
    my ($a,$b,$c,$d,$e) = map {$_->val()} @_;
    if(same_value($a,$b) && same_value($c,$d)){
	max $a,$c;
    }elsif(same_value($a,$b) && same_value($d,$e)){
	max $a,$d;
    }elsif(same_value($b,$c) && same_value($d,$e)){
	max $b,$d;
    }else{
	();
    }
}

# ワンペア
sub one(@){
    my ($a,$b,$c,$d,$e) = map {$_->val()} @_;
    if(same_value($a,$b)){
	$a;
    }elsif(same_value($b,$c)){
	$b;
    }elsif(same_value($c,$d)){
	$c;
    }elsif(same_value($d,$e)){
	$d;
    }else{
	();
    }
}

# 役なし
sub none(@){
    max map {$_->val()} @_;
}

sub check(@){
    my @cards = @_;

    my @cmd = (\&royal_flash,\&straight_flash,\&four,\&full_house,\&flash,\&straight,\&three,\&two,\&one,\&none);

    my $i=@cmd;
    for(@cmd){
	my @res = $_->(@cards);
	if(scalar @res != 0){
	    return ($i,@res);
	}
	$i--;
    }
    die "must not happen";
}

sub cmp_line($){
    my ($line) = @_;
    my @cards = split /\s+/,$line;

    my @player1 = sort { card_cmp($a,$b) } map { Card->parse($_) } @cards[0..4];
    my @player2 = sort { card_cmp($a,$b) } map { Card->parse($_) } @cards[5..9];

    my ($x1,$y1) = check(@player1);
    my ($x2,$y2) = check(@player2);

    if($x1==$x2 && $y1 == $y2){
	for(my $i = 0; $i < 5; $i++){
	    my $n = 5-$i-1;
	    return 0 if($player1[$n]->val() < $player2[$n]->val());
	    return 1 if($player1[$n]->val() > $player2[$n]->val());
	}
    }elsif($x1 > $x2){
	1;
    }elsif($x1 == $x2 && $y1 > $y2){
	1;
    }else{
	0;
    }
}

open(FILE,'poker.txt');
my $i=0;
while(<FILE>){
    $i += cmp_line($_);
}
print $i,"\n";

参考