Perlサンプル21 数学パズルを解く~改~
投稿:2020-02-23
元のコードはこちらです。
Perlサンプル20 数学パズルを解く
件のアカウントさんのツイートの続きを拝見すると再帰を使う方法がありましたので、再帰を使って書き直しました。
#!/usr/bin/env perl
use utf8;
use strict;
use warnings;
use feature qw/ say /;
use DateTime;
use Encode::Locale;
binmode STDIN, ":encoding(console_in)";
binmode STDOUT, ":encoding(console_out)";
$| = 1;
say DateTime->now(time_zone => "local")->strftime("開始 %T");
# 元の式は
# □/□□ + □/□□ + □/□□ = 1
# □の中に入る数字をa~iとする
# a / bc + d / ef + g / hi = 1
# bc ef hi はそれぞれ2桁の数字
# 通分、変形して除算を排除(計算誤差をなくす)
# a * ef * hi / bc * ef * hi + d * bc * hi / ef * bc * hi + g * bc * ef / hi * bc * ef = 1
# a * ef * hi / bc * ef * hi + d * bc * hi / bc * ef * hi + g * bc * ef / bc * ef * hi = 1
# (a * ef * hi + d * bc * hi + g * bc * ef) / bc * ef * hi = 1
# a * ef * hi + d * bc * hi + g * bc * ef = bc * ef * hi
my %result;
# 全ての組み合わせを生成
combination([1 .. 9], [], \&checker, \%result);
# 解を表示
say for sort keys %result;
say DateTime->now(time_zone => "local")->strftime("終了 %T");
exit;
sub combination {
my ($candidate, $ai, $checker, $result) = @_;
# 選択肢が複数ある場合
if (1 < @{$candidate}) {
# 1つずつ選択しては、残りの選択肢を次の階層へ渡す
for my $trial (@{$candidate}) {
# 残りの選択肢
my @remain = grep {$trial != $_} @{$candidate};
# 次の階層へ
combination(\@remain, [@{$ai}, $trial], $checker, $result);
}
} else {
# 組み合わせが一つ決まったので正解チェック
&{$checker}([@{$ai}, ${$candidate}[0]], $result);
}
}
sub checker {
my ($ai, $result) = @_;
my ($a, $b, $c, $d, $e, $f, $g, $h, $i) = @{$ai};
# 成立する場合
if ($a * "$e$f" * "$h$i" + $d * "$b$c" * "$h$i" + $g * "$b$c" * "$e$f" == "$b$c" * "$e$f" * "$h$i") {
# 3つの項は可換なので昇順にする
my @simplex = sort "$a / $b$c", "$d / $e$f", "$g / $h$i";
# 解をキーにして重複解を整理
$result->{"$simplex[0] + $simplex[1] + $simplex[2] = 1"} = undef;
}
}
開始 23:11:03 5 / 34 + 7 / 68 + 9 / 12 = 1 終了 23:11:17