ルモーリン
ホーム 更新 Perl Sample サービス 雑談 鉄ゲタ Linux リンク 連絡先
【サーバー停止のお知らせ】VPSのホストメンテナンスのため2020-04-08 14:00~17:00のうち1時間程度停止します。

Perlサンプル20 数学パズルを解く

2020-02-23

2020-02-23 再帰バージョンを書きましたのでご覧ください。 Perlサンプル21 数学パズルを解く~改~

こちらのツイートを拝見して挑戦しました。

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

my %result;

# 元の式は
# □/□□ + □/□□ + □/□□ = 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 @a = 1 .. 9; # 変数aの候補
for my $a (@a) { # aの候補を1つずつ試す
	my @b = grep {$a != $_} @a; # aで試す候補以外をbの候補にする
	for my $b (@b) { # bの候補を1つずつ試す
		my @c = grep {$b != $_} @b; # bで試す候補以外をcの候補にする
		for my $c (@c) {
			my @d = grep {$c != $_} @c;
			for my $d (@d) {
				my @e = grep {$d != $_} @d;
				for my $e (@e) {
					my @f = grep {$e != $_} @e;
					for my $f (@f) {
						my @g = grep {$f != $_} @f;
						for my $g (@g) {
							my @h = grep {$g != $_} @g;
							for my $h (@h) {
								my @i = grep {$h != $_} @h;
								for my $i (@i) {
									# 2桁の数字
									my $ef = 10 * $e + $f;
									my $hi = 10 * $h + $i;
									my $bc = 10 * $b + $c;
									# 成立する場合
									if ($a * $ef * $hi + $d * $bc * $hi + $g * $bc * $ef == $bc * $ef * $hi) {
										# 3つの項は可換なので昇順にする
										my @simplex = sort "$a / $bc", "$d / $ef", "$g / $hi";
										# 解をキーにして重複解を整理
										$result{"$simplex[0] + $simplex[1] + $simplex[2] = 1"} = 1;
									}
								}
							}
						}
					}
				}
			}
		}
	}
}

# 解を表示
say for sort keys %result;
say DateTime->now(time_zone => "local")->strftime("終了 %T");
開始 18:08:23
5 / 34 + 7 / 68 + 9 / 12 = 1
終了 18:08:25

変数a~iの9重ループを力まかせに回します。 変数が進むa→iにつれて選択できる数字が減りますからgrepで除外して次の変数へ渡すようにしました。 ですので変数iのループは実は候補が1個しかありません。 一貫性を持たせるほうを優先し同じ書き方にしました。 重複解は、実際に動作させてみて初めて気付きました。 答をハッシュのキーにすると、同一キーは上書きされて1つ残るので重複を取り除けます。 解を表示する行ですが、
say for sort keys %result;
これはハッシュの%resultからキーを取り出して文字列比較で昇順に並べ替えたものを1つずつsayします。 ほぐして書くと次のようになりますが5行に膨れあがりますし不必要な変数@result_keys、@result_sort、$itemもあり読みづらいです。

my @result_keys = keys(%result);
my @result_sort = sort(@result_keys);
for my $item (@result_sort) {
	say $item;
}