三角形の和

下の図には、６つの三角形があります。三角形の頂点の A から J に 1 から 19 の奇数の数字を入れて、６つの三角形の頂点の数字の和が等しくなるようにして下さい、というのが今回の問題です。言い換えれば、右側の等式を解いて下さい、というのと同じです。

今回のプログラムは、各数字の使用回数に着目して作成しました。ここでの使用回数とは、各数字の小さな三角形への所属数です。上の図で各アルファベットの出現回数はそれぞれ１ですが、右の式では違っています。大きな三角形の各頂点 A, G, J は１になっており、内側にある E は３であり、それ以外は２になっています。この点に注目して、プログラムを見て下さい。

プログラム

use strict;
my (%three, @triangle);
my %henkan = (a => 11, b => 13, c => 15, d => 17, e => 19);
print " A  B  C  D  E  F  G  H  I  J\n";
gen_3('', 1, 3, 5, 7, 9, 'a', 'b', 'c', 'd', 'e');

sub gen_3 {
  my ($num3, @list) = @_;
  foreach my $n (0..$#list) {
    my $work = $num3; $work .= $list[$n];
    if (length($work) == 3) {
      my $tmp = eval(join '+', map { /[a-e]/ ? $henkan{$_} : $_ } split //, $work);
      push @{$three{$tmp}}, $work;
    } else {
      gen_3($work, @list[$n + 1 .. $#list]);
    }
  }
}

foreach my $sum (sort { $a <=> $b } keys %three) {
  next if @{$three{$sum}} < 6;
  @triangle = ();
  gen_6(@{$three{$sum}});
}

sub gen_6 {
  my @list = @_;
  foreach my $n (0..$#list) {
    push @triangle, $list[$n];
    if (@triangle == 6) { check(@triangle); }
    else { gen_6(@list[$n + 1 .. $#list]); }
    pop @triangle;
  }
}

sub check {
  my @list = @_;
  return if join('', @list) !~
            /^(?=.*1)(?=.*3)(?=.*5)(?=.*7)(?=.*9)(?=.*a)(?=.*b)(?=.*c)(?=.*d)(?=.*e)/;
  my (%flag, @result);
  $flag{$_}++ foreach split //, join '', @list;
  return if join('', sort values %flag) !~ /^1{3}2{6}3$/;
  foreach (@list) {
    /(.)(.)(.)/;
    return if join('', sort($flag{$1}, $flag{$2}, $flag{$3})) !~ /22/;
  }
  my @sorted_keys = map  { $_->[0] }
                    sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] }
                    map  { [ $_, $flag{$_} ] } keys %flag;
  @result[0, 4] = @sorted_keys[0, 9];
  my ($work) = grep /$result[0]/, @list;
  @list = grep ! /$work/, @list;
  my ($i, $j) = grep ! /$result[0]/, split //, $work;
  @result[1, 2] = ($i, $j);
  ($work) = grep /$result[1]/, @list;
  @list = grep ! /$work/, @list;
  ($i) = grep { ! /$result[1]/ and ! /$result[4]/ } split //, $work;
  $result[3] = $i;
  ($work) = grep /$result[2]/, @list;
  @list = grep ! /$work/, @list;
  ($i) = grep { ! /$result[2]/ and ! /$result[4]/ } split //, $work;
  $result[5] = $i;
  ($work) = grep /$result[3]/, @list;
  @list = grep ! /$work/, @list;
  if ($work =~ /$sorted_keys[1]/) {
    $result[6] = $sorted_keys[1]; $result[9] = $sorted_keys[2];
  } else {
    $result[6] = $sorted_keys[2]; $result[9] = $sorted_keys[1];
  }
  ($i) = grep { ! /$result[3]/ and ! /$result[6]/ } split //, $work;
  $result[7] = $i;
  ($work) = grep /$result[7]/, @list;
  ($i) = grep { ! /$result[4]/ and ! /$result[7]/ } split //, $work;
  $result[8] = $i;
  @result =  map { /[a-e]/ ? $henkan{$_} : $_ } @result;
  printf "%2d %2d %2d %2d %2d %2d %2d %2d %2d %2d\n", @result;
}

プログラムの解説

今回のパズルは３角形の和ですので、１から 19 の奇数の数字の内から３つの数字の組合せのリストを作成します。３つの数字は、文字列として連結します。そのときに、このまま連結してしまっては、１桁の数字と２桁の数字の区別がつかなくなってしまいます。そこで、２桁の数字は記号化して扱うことにしました。

%henkan は、記号化したアルファベットと数字の変換テーブルです。必要なときに、参照することになります。これで 1 から 19 の奇数の数字 10 個は、１文字として扱えるようになりましたので、３つの数字の組合せのリストを作成します。作成されたリストは、ハッシュ %three に格納します。キーは、３つの数字の和になります。%three は、以下のようになります。

ハッシュ %three の値は、３つの数字の組合せのリストです。このうちリストの数が５以下のエントリーは、６つの三角形に割り当てることができないので探索から除外します。上の太字で表示してある部分だけが、探索の対象になります。探索対象になるキーの値 21 から 39 のエントリーは、リストの６つの組合せをすべて生成して、check サブルーチンを呼び出します。ここで、冒頭の式を再掲します。

check サブルーチンは、６つの数字の組合せのリストを受け取ります。受け取ったリストが上の式に該当するか否かを、以下の手順でチェックします。

以上の３つのチェックで、残っているのは正解の２つだけになります。ここからは、A から J に具体的な数字を割り当てる作業に移ります。具体的な数字は、配列 @result に格納します。配列の要素の先頭から A, B, ... F, J の順で、具体的な数字を格納します。

正解は、配列 @result に入っています。@result の要素は、まだ記号化されたままの数字ですので、ここで変換して出力します。今回のプログラムの出力は、次のようになります。少し分かりにくい表示かも知れませんが、図と照らし合わせて確認して下さい。