読者です 読者をやめる 読者になる 読者になる

初代Masteries

きっとモヒカンにもなれないお前たちに告げる!!!

2013年6月のProject Euler [最終更新: 6月24日(月)]

いよいよ6月. 今月も頑張っていきます!

6月24日(月)

Problem 55

10000以下の数値について, 「反転したものを足す」という操作を繰り返しても回文数にならないLycherel数であるものの個数を求める問題.

use strict;
use warnings;
use Math::BigInt;

my $answer = 9999;

for my $i (1..9999) {
    my $n = Math::BigInt->new($i);
    for my $count (1..49) {
        $n = add($n);

        my $reverse = _reverse($n);

        if ($n->bstr() eq $reverse) {
            $answer--;
            last;
        }
    }
}

print "$answer\n";

sub _reverse {
    my $n = shift;

    (my $reverse = reverse $n->bstr) =~ s/^0+//;
    return $reverse;
}

sub add {
    my $n = shift;

    return $n->badd(_reverse($n));

}

手堅く実装.

6月17日(月)

Problem 54

2人のプレイヤーが持つカードから, ポーカーの勝敗を検査するスクリプト.

use strict;
use warnings;

use List::Util qw/max/;

my @input = <DATA>;

my $answer;
for my $in (@input) {
    $answer += check($in);
}
print "$answer\n";

sub check {
    my @input = split /\s/, shift;

    my $player1_cards = hashnize(@input[0..4]);
    my $player2_cards = hashnize(@input[5..9]);

    my $player1_rank = rank($player1_cards);
    my $player2_rank = rank($player2_cards);

    if ($player1_rank->{rank} == $player2_rank->{rank}) {
        if ($player1_rank->{max} != $player2_rank->{max}) {
            return $player1_rank->{max} > $player2_rank->{max} ? 1 : 0;
        } else {
            my @player1_card_value = sort keys %{$player1_cards};
            my @player2_card_value = sort keys %{$player2_cards};

            while (@player1_card_value && @player2_card_value) {
                my $i = shift @player1_card_value;
                my $j = shift @player2_card_value;

                if ($i != $j) {
                    return $i > $j ? 1 : 0;
                }
            }

        }

    } else {
        return $player1_rank->{rank} > $player2_rank->{rank} ? 1 : 0;
    }
}

sub rank {
    my $cards = shift;

    my $retval;
    if ($retval = is_royal_flash($cards)) {
        return { rank => 9, max => $retval };
    } elsif ($retval = is_straight_flash($cards)) {
        return { rank => 8, max => $retval };
    } elsif ($retval = is_four_card($cards)) {
        return { rank => 7, max => $retval };
    } elsif ($retval = is_full_house($cards)) {
        return { rank => 6, max => $retval };
    } elsif ($retval = is_flash($cards)) {
        return { rank => 5, max => $retval };
    } elsif ($retval = is_straight($cards)) {
        return { rank => 4, max => $retval };
    } elsif ($retval = is_three_card($cards)) {
        return { rank => 3, max => $retval };
    } elsif ($retval = is_two_pair($cards)) {
        return { rank => 2, max => $retval };
    } elsif ($retval = is_one_pair($cards)) {
        return { rank => 1, max => $retval };
    } else {
        return { rank => 0, max => max(keys %{$cards}) };
    }
}

sub hashnize {
    my @cards = @_;

    my $cards_hash = {};

    for my $card (@cards) {
        my ($value, $suit) = split //, $card;
        push (@{$cards_hash->{digitizing($value)}}, $suit);
    }

    return $cards_hash;
}

sub digitizing {
    my $n = shift;

    if ($n eq 'T') {
        return 10;
    } elsif ($n eq 'J') {
        return 11;
    } elsif ($n eq 'Q') {
        return 12;
    } elsif ($n eq 'K') {
        return 13;
    } elsif ($n eq 'A') {
        return 14;
    } else {
        return $n;
    }
}


sub is_one_pair {
    my $cards = shift;

    my $retval = 0;
    for my $value (keys %{$cards}) {
        if (@{$cards->{$value}} == 2) {
            $retval = $value;
        }
    }
    return $retval;
}

sub is_two_pair {
    my $cards = shift;

    my $pair = 0;
    my $retval;
    for my $value (keys %{$cards}) {
        if (@{$cards->{$value}} == 2) {
            $pair++;
            $retval = $value;
        }
    }
    return $pair == 2 ? $retval : 0;

}

sub is_three_card {
    my $cards = shift;

    for my $value (keys %{$cards}) {
        return $value if @{$cards->{$value}} == 3;
    }
    return 0;
}

sub is_straight {
    my $cards = shift;

    return 0 if (keys %{$cards}) != 5;

    my ($key_value, $retval);
    for my $value (sort keys %{$cards}) {
        if (defined $key_value) {
            return 0 if $key_value != $value - 1;
            $retval = $value;
            $key_value++;
        } else {
            $key_value = $value;
        }
    }
    return $retval;

}

sub is_flash {
    my $cards = shift;

    my $key_suit;
    for my $value (keys %{$cards}) {
        for my $suit (@{$cards->{$value}}) {
            if (defined $key_suit) {
                return 0 if $key_suit ne $suit;
            } else {
                $key_suit = $suit;
            }
        }
    }
    return max keys %{$cards};
}

sub is_full_house {
    my $cards = shift;

    my $one_pair = is_one_pair($cards);
    my $three_card = is_three_card($cards);

    if ($one_pair && $three_card) {
        return $three_card;
    } else {
        return 0;
    }
}

sub is_four_card {
    my $cards = shift;

    for my $value (keys %{$cards}) {
        return $value if @{$cards->{$value}} == 4;
    }
    return 0;
}

sub is_straight_flash {
    my $cards = shift;

    my $straight = is_straight($cards);

    return is_straight($cards) && is_flash($cards);
}

sub is_royal_flash {
    my $cards = shift;

    return 0 unless is_flash($cards);

    my $key_value = 10;
    for my $value (sort keys %{$cards}) {
        return 0 if $key_value != $value;
        $key_value++;
    }
    return 13;
}

答えは合ったものの, なんとなく納得のいかない出来になりました.

6月14日(金)

Problem 53

1から100までのnについて, nCrが100万を越えるものはいくつ存在するかを数える問題.

use strict;
use warnings;

use Memoize;
memoize('factorial');

my $answer;

for my $i (1..100) {
    for my $j (1..100) {
        if (combi($i, $j) >= 1000000) {
            $answer++;
        }
    }
}
print "$answer\n";

sub combi {
    my ($n, $r) = @_;

    return factorial($n) / (factorial($r) * factorial($n - $r));
}

sub factorial {
    my $i = shift;

    my $factorial = 1;
    $factorial *= $_ for 2..$i;

    return $factorial;
}

6月12日(水)

Problem 52

ある数xを2倍, 3倍, 4倍, 5倍, 6倍したとき, xと同じ数を含むような最小の整数xを求める問題.

use strict;
use warnings;

my $start = 1;

END: while (1) {
    $start *= 10;

    LOOP: for my $i ($start..$start * 10 / 6) {
        for (2..6) {
            next LOOP unless check($i, $i * $_);
        }
        print "$i\n";
        last END;
    }
}

sub check {
    my ($base, $target) = @_;

    my @base = split //, $base;

    for my $i (@base) {
        return 0 unless $target =~ /$i/;
    }

    return 1;
}

シンプルに実装してみました.

6月10日(月)

Problem 51

桁を同じ数で置き換えることで8つの素数が得られる最小の素数を求める問題. 但し, 数字を置き換える桁は連続していなくてもよい.

1の位は, 0/2/4/5/6/8ならば素数になり得ない. 逆に言えば素数に為りうるパターンは1/3/7/9の4つだけなので, 1の位は置き換えの対象になり得ない.

また, 数値を置き換えられて生成される8つの素数には, 言うまでもなく0から9までの数字のうち8個の数字が現れるので, その中で一番小さい数は0, 1, 2の何れかになります.

というわけで, 1から順番に素数を求めていき, 1の位以外で0, 1, 2のいずれかを2個以上含む場合, 実際に置換して, 素数になるか調べていきます.

置換の結果, 素数が8個以上ある場合, その値が答えです.

use strict;
use warnings;
use Math::Prime::XS qw/is_prime/;
use Math::Combinatorics;

my $n = 1;
END: while (1) {

    last if $n == 121320;

    if (is_prime($n)) {
        my @position;
        my @number = split //, $n;

        for my $pos (0..$#number - 1) {
            for my $i (0..2) {
                push(@{$position[$i]}, $pos) if $i == $number[$pos];
            }
        }

        for my $i (0..2) {
            next unless defined $position[$i];
            next if @{$position[$i]} < 2;

            for my $j (2..@{$position[$i]}) {
                my @trans = combine($j, @{$position[$i]});

                for my $t (@trans) {
                    my $count = 0;
                    for my $change ($i..9) {
                        my @changed_number = @number;
                        for my $pos (@{$t}) {
                            $changed_number[$pos] = $change;
                        }
                        $count++ if is_prime(join '', @changed_number);
                    }
                    if ($count >= 8) {
                        print "$n\n";
                        last END;
                    }
                }
            }
        }
    }

    $n++;
}

変数名が微妙ですね. この辺り, 全然センスないなあ... と思います.
リーダブルコード, もう一度読んでみようかなあ...

6月7日(水)

Problem 50

遂に50問到達!
問題は, 100万未満の素数を連続する素数の和で表したときに, 最大の値となるのはどの素数かを求める問題.

use strict;
use warnings;

use Math::Prime::XS qw/is_prime/;
use bigint;

my $i = 1;
my $sum = 0;
my @primes;

while (1) {
    if (is_prime($i)) {
        push @primes, $i;

        last if $sum + $i > 1000000;
        $sum += $i;
    }

    $i++;
}

for my $prime (@primes) {
    $sum -= $prime;
    last if is_prime($sum);
}

print "$sum\n";

まず, 1から開始した連続する素数の和が100万未満になる値(この値は, 素数でなくてもよい)を求めて, その数から1, 2, 3, 5... と小さい順に素数を引いていった時に, 結果が素数となればそれが答えとなる.

6月5日(水)

Problem 49

項差3330の等差数列について, 3つの項が素数であり, 各項が他項の置換で表されるような4桁の増加列を求める問題.

use strict;
use warnings;

use Math::Prime::XS qw/is_prime/;

my $count = 0;
for my $n (1111..9999) {
    next unless is_same($n, $n+3330) && is_same($n, $n+6660);
    next unless is_prime($n) && is_prime($n+3330) && is_prime($n+6660);
    printf "%d %d %d\n", $n, $n+3330, $n+6660;
    $count++;
    last if $count == 2;
}

sub is_same {
    my ($n, $m) = map { join '', sort split //, $_ } @_;

    return 1 if $n == $m;
    return 0;
}

6月3日(金)

Problem 48

1から1000までの全ての数について, 自分自身のべき乗を足し合わせた答えの下位10桁を答える問題.

use strict;
use warnings;

use Math::BigInt;

my $sum;

for my $i (1..999) {
    my $pow = Math::BigInt->new($i)->bpow($i);

    $sum = substr ($pow->badd($sum)->bstr, -10);
}

print "$sum\n";