ルモーリン

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