Problem54 - ProjectEuler(未解決)

30分プログラム、その330。id:mzp:20080701:eulerを動くようにした。でも答えは違っているので、続きはまた明日。
コード量があるから、ちょっとした修正をするだけですぐ30分たってしまう。

使い方

$ perl problem54.pl
...
702

ソースコード

#! /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;

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'=>1);
    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} @_;
}

sub flash(@){
    my ($x) = @_;
    if(reduce {$a && $b} map { $_->suit eq $x->suit} @_){
	(5,max map {$_->val()} @_);
    }else{
	();
    }
}

sub straight(@){
    my ($a,$b,$c,$d,$e) = map {$_->val()} @_;
    if($b = $a+1 &&
       $c == $b+1 &&
       $d == $c+1 &&
       $e == $d+1){
	(4,$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){
	(9,0);
    }else{
	();
    }
}

sub straight_flash(@){
    my @val = map {$_->val()} @_;
    if(flash(@_) && straight(@_)){
	(8,max @val);
    }else{
	();
    }
}

sub four(@){
    my ($a,$b,$c,$d,$e) = map {$_->val()} @_;
    if(same_value($a,$b,$c,$d)){
	(7,$a)
    }elsif(same_value($b,$c,$d,$e)){
	(7,$b);
    }else{
	();
    };
}

sub full_house(@){
    my ($a,$b,$c,$d,$e) = map {$_->val()} @_;
    if(same_value($a,$b) && same_value($c,$d,$e)){
	(6,$a > $c ? $a : $c);
    }elsif(same_value($a,$b,$c) && same_value($d,$e)){
	(6,$a > $c ? $a : $d);
    }else{
	();
    }
}

sub three(@){
    my ($a,$b,$c,$d,$e) = map {$_->val()} @_;
    if(same_value($a,$b,$c)){
	(3,$a);
    }elsif(same_value($b,$c,$d)){
	(3,$b);
    }elsif(same_value($c,$d,$e)){
	(3,$c);
    }else{
	();
    }
}

sub two(@){
    my ($a,$b,$c,$d,$e) = map {$_->val()} @_;
    if(same_value($a,$b) && same_value($c,$d)){
	(2,$a > $c ? $a : $c);
    }elsif(same_value($a,$b) && same_value($d,$e)){
	(2,$a > $d ? $a : $d);
    }elsif(same_value($b,$c) && same_value($d,$e)){
	(2,$b > $d ? $b : $d);
    }else{
	();
    }
}

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

sub none(@){
    my @x = (0,max map {$_->val()} @_);
    @x;
}

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

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

    my $i=0;
    for(@cmd){
	$i++;
	my @res = $_->(@cards);
	if(scalar @res != 0){
	    return @res;
	}
    }
    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)){
	1;
    }else{
	0;
    }
}

#my @cards = sort { card_cmp($a,$b) } map { Card->parse($_) } qw(AH 2H 3H 4H 5H);

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

参考

• 過去の30分プログラム
• Problem 54 - PukiWiki