今回は、正月にちなんで正月の「正」の字を取り上げます。「正」の字の各辺の端と辺の接点に、0 から 9 まで異なる数字を各辺の合計が同じになるように配置する問題です。

   A---B---C               A + B + C = B + E + I
       |                             = D + H
   D   E--F                          = E + F
   |   |                             = G + H + I + J
G--H---I-----J

図を見ていただけるとわかりますが、A と C (G と J も同じ) は常に入れ替え可能です。 プログラムでは、A < C (G < J) として重複解を発生させないようにしています。

プログラム

use strict;
my $n = 0;
my %trans = map { $_ => $n++ } ('a' .. 'j');

my (%sum, %result, @temp);
$n = 4; comb('a' .. 'j');
$n = 3; comb('a' .. 'j');
$n = 2; comb('a' .. 'j');

sub comb {
  my @list = @_;
  foreach my $i (0 .. $#list) {
    push @temp, $list[$i];
    if (@temp == $n) {
      my $add = eval(join '+', map { $trans{$_} } @temp);
      push @{$sum{$add}->{$n}}, join('', @temp);
    } else {
      comb(@list[$i + 1 .. $#list]);
    }
    pop @temp;
  }
}

foreach my $i (sort { $a <=> $b } keys %sum) {
 next unless exists $sum{$i}->{2} && @{$sum{$i}->{2}} >= 2 and 
             exists $sum{$i}->{3} && @{$sum{$i}->{3}} >= 2 and
             exists $sum{$i}->{4};
 foreach my $bar_1 (@{$sum{$i}->{4}}) {
  foreach my $j (0 .. ($#{$sum{$i}->{3}} - 1)) {
   my $bar_2 = $sum{$i}->{3}->[$j];
   foreach my $bar_3 (@{$sum{$i}->{3}}[($j + 1) .. $#{$sum{$i}->{3}}]) {
    foreach my $k (0 .. ($#{$sum{$i}->{2}} - 1)) {
     my $bar_4 = $sum{$i}->{2}->[$k];
     foreach my $bar_5 (@{$sum{$i}->{2}}[($k + 1) .. $#{$sum{$i}->{2}}]) {
       my %hist;
       ++$hist{$_} foreach (split(//, $bar_1), split(//, $bar_2), split(//, $bar_3));
       foreach (split(//, $bar_4), split(//, $bar_5)) {
         if (exists $hist{$_}) { $hist{$_} += 2; }
         else { $hist{$_} = 1; }
       }
       next if join('', sort keys %hist) !~ /abcdefghij/;
       next if join('', sort values %hist) !~ /1111112233/;
       next if join('', sort map { $hist{$_} } split //, $bar_1) !~ /1123/;
       next if join('', sort(join('', sort map { $hist{$_} } split //, $bar_2),
                 join('', sort map { $hist{$_} } split //, $bar_3))) !~ /112223/;
       next if join('', sort map { $hist{$_} } split //, $bar_4) !~ /13/;
       next if join('', sort map { $hist{$_} } split //, $bar_5) !~ /13/;
       my @result;
       @result[6, 9, 8, 7] = map { $_->[0] }
                             sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] }
                             map { [$_, $hist{$_}] } split //, $bar_1;
       if (join('', sort map { $hist{$_} } split //, $bar_2) =~ /112/) {
         @result[0, 2, 1] = map { $_->[0] }
                            sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] }
                            map { [$_, $hist{$_}] } split //, $bar_2;
         ($result[4]) = grep { $hist{$_} == 3 } split //, $bar_3;
       } else {
         @result[0, 2, 1] = map { $_->[0] }
                            sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] }
                            map { [$_, $hist{$_}] } split //, $bar_3;
         ($result[4]) = grep { $hist{$_} == 3 } split //, $bar_2;
       }
       if ((split //, $bar_4)[0] eq $result[7] or (split //, $bar_4)[1] eq $result[7]) {
         ($result[3]) = grep { $hist{$_} == 1 } split //, $bar_4;
         ($result[5]) = grep { $hist{$_} == 1 } split //, $bar_5;
       } else {
         ($result[3]) = grep { $hist{$_} == 1 } split //, $bar_5;
         ($result[5]) = grep { $hist{$_} == 1 } split //, $bar_4;
       }
       @result = map { $_ < 10 ? " $_" : "$_" } map { $trans{$_} } @result;
       push @{$result{$i}}, join(':', @result);
     }
    }
   }
  }
 }
}

print "(", join(', ', sort { $a <=> $b } values %trans), ")\n";
foreach my $key (sort { $a <=> $b } keys %result) {
  print " sum: $key\n";
  my ($line_1, $line_2, $line_3, $line_4, $line_5); my $blank = "   ";
  foreach my $i (0 .. $#{$result{$key}}) {
    my @work = split /:/, $result{$key}->[$i];
    $line_1 = ($line_1 ? $line_1 . $blank : " ") . "   $work[0]-$work[1]-$work[2]   ";
    $line_2 = ($line_2 ? $line_2 . $blank : " ") . "       |      ";
    $line_3 = ($line_3 ? $line_3 . $blank : " ") . "   $work[3] $work[4]-$work[5]   ";
    $line_4 = ($line_4 ? $line_4 . $blank : " ") . "    |  |      ";
    $line_5 = ($line_5 ? $line_5 . $blank : " ") . "$work[6]-$work[7]-$work[8]----$work[9]";
    if ($i % 4 == 3 or $i == $#{$result{$key}}) {
      $line_1 =~ s/- /--/g;
      $line_3 =~ s/- /--/g;
      $line_5 =~ s/- /--/g;
      print "$line_1\n$line_2\n$line_3\n$line_4\n$line_5\n\n";
      $line_1 = $line_2 = $line_3 = $line_4 = $line_5 = "";
    }
  }
}

プログラムの説明

プログラムの最初に、配置する 10 個の数字を a から j までのアルファベットに記号化します。 記号化すると、2桁の数字もプログラムの中で1文字として扱うことができます。

my $n = 0;
my %trans = map { $_ => $n++ } ('a' .. 'j');

$n には、連続する 10 個の数字の最初の数字を指定します。$n を1に変更すると、1から 10 の連続した数字でプログラムを実行できます。ハッシュ %trans のキーには記号化されたアルファベット、値には変換用の数字を格納します。

次は、少し複雑なデータ構造のハッシュを作成します。 ハッシュの基本構造は、「正」の字の構造に合わせて次のようにします。

%sum = ( 加算値1 => { 2 => [ 2つの数字の和が加算値になるリスト (D + H, E + F 割り当て用)],
                       3 => [ 3つの数字の和が加算値になるリスト (A + B + C, B + E + I 割り当て用)],
                       4 => [ 4つの数字の和が加算値になるリスト (G + H + I + J 割り当て用)] },
         加算値2 ...
         ....
   A---B---C
       |
   D   E--F
   |   |
G--H---I-----J

ハッシュ %sum のキーは、無名ハッシュを値にしています。無名ハッシュのキーは、 無名配列を値にしています。このような構造を作成するのは大変と思うかもしれませんが、Perl では実に簡単です。その部分のコードは、次のようになります。

my (%sum, @temp);
$n = 4; comb('a' .. 'j');
$n = 3; comb('a' .. 'j');
$n = 2; comb('a' .. 'j');

sub comb {
  my @list = @_;
  foreach my $i (0 .. $#list) {
    push @temp, $list[$i];
    if (@temp == $n) {
      my $add = eval(join '+', map { $trans{$_} } @temp);   # 加算値を生成
      push @{$sum{$add}->{$n}}, join('', @temp);            # ハッシュ構造を生成
    } else {
      comb(@list[$i + 1 .. $#list]);
    }
    pop @temp;
  }
}

サブルーチン comb は、$n で指定された個数の組み合わせをすべて生成します。 組み合わせが生成される毎に、加算値 $add をハッシュ %trans を参照して計算します。 そして、次の push の行で @{$sum{$add}->{$n}} のように書くと、それまでにハッシュ %sum の中になければ、$add で指定したキー、無名ハッシュ、$n で指定したキー、無名配列を一度に生成してくれます。上のコードを実行すると、次のようなハッシュが作成されます。

%sum = ( 1 => { 2 => [ab] },
         ...

         3 => { 2 => [ad, bc],
                3 => [abc] },
         ...

         11 => { 2 => [cj, di, eh, fg],
                 3 => [acj, adi, aeh, afg, bci, bdh, beg, cdg, cef],
                 4 => [abci, abdh, abeg, acdg, acef, bcdf] },
         12 => { 2 => [dj, ei, fh],
                 3 => [adj, aei, afh, bcj, bdi, beh, bfg, cdh, ceg, def],
                 4 => [abcj, abdi, abeh, abfg, acdh, aceg, adef, bcdg, bcef] },
         13 => { 2 => [ej, fi, gh],
                 3 => [aej, afi, agh, bdj, bei, bfh, cdi, ceh, cfg, deg]
                 4 => [abdj, abei, abfh, acdi, aceh, acfg, adeg, bcdh, bceg, bdef] }
         14 => { 2 => [fj, gi],
                 3 => [afj, agi, bej, bfi, bgh, cdj, cei, cfh, deh, dfg],
                 4 => [abej, abfi, abgh, acdj, acei, acfh, adeh, adfg, bcdi, bceh, bcfg, bdeg, cdef] },
         ...

         24 => { 3 => [hij],
                 4 => [ahij, bgij, cfij, cghj, deij, dfhj, dghi, efgj, efhi] },
         ...

         30 => { 4 => [ghij] } 
);

ハッシュ %sum を作成したら、「正」の字の各辺に無名配列に入っている各要素を割り当てて、 チェックしていきます。キー 4 の要素は G + H + I + J に割り当て、キー 3 の要素は A + B + C と B + E + I に割り当て、キー 2 の要素は D + H と E + F に割り当てます。割り当てには、foreach を使います。foreach を6つ重ねているので、ここではインデントを1文字としています。

foreach my $i (sort { $a <=> $b } keys %sum) {
 next unless exists $sum{$i}->{2} && @{$sum{$i}->{2}} >= 2 and    # 加算値が条件を満たしているかチェック
             exists $sum{$i}->{3} && @{$sum{$i}->{3}} >= 2 and
             exists $sum{$i}->{4};
 foreach my $bar_1 (@{$sum{$i}->{4}}) {   # G + H + I + J
  foreach my $j (0 .. ($#{$sum{$i}->{3}} - 1)) {     # A + B + C or B + E + I
   my $bar_2 = $sum{$i}->{3}->[$j];
   foreach my $bar_3 (@{$sum{$i}->{3}}[($j + 1) .. $#{$sum{$i}->{3}}]) {     # A + B + C or B + E + I
    foreach my $k (0 .. ($#{$sum{$i}->{2}} - 1)) {   # D + H or E + F
     my $bar_4 = $sum{$i}->{2}->[$k];
     foreach my $bar_5 (@{$sum{$i}->{2}}[($k + 1) .. $#{$sum{$i}->{2}}]) {   # D + H or E + F

まず最初に、加算値が条件を満たしているかどうかをチェックします。無名配列のキー 2, 3, 4 が揃ってない場合や、2, 3 の要素が2つ以上ない場合はスキップします。次の foreach から各辺に要素を割り当てます。キー 4 の要素は、一番下の辺に割り当てます。キー 3 の要素とキー 2 の要素は、辺が2つあるのでとりあえずの割り当てです。 次は、要素を分解して各アルファベットの出現回数を数えます。

       my %hist;
       ++$hist{$_} foreach (split(//, $bar_1), split(//, $bar_2), split(//, $bar_3));
       foreach (split(//, $bar_4), split(//, $bar_5)) {
         if (exists $hist{$_}) { $hist{$_} += 2; }
         else { $hist{$_} = 1; }
       }
          A---B---C          1---2---1
              |                  |
          D   E--F           1   3--1
          |   |              |   |
       G--H---I-----J     1--3---2-----1

各アルファベットの出現回数は、ハッシュ %hist に記録します。ここで、一工夫します。キー 2 の要素の各アルファベットのなかで、すでに %hist に存在するアルファベット (E or H に配置予定) は、+1 ではなく +2 とします。このようにしておくと、後での E と H の割り当てが簡単になります。%hist を作成したら、次のコードでチェックします。

                                                                                # 5711
       next if join('', sort keys %hist) !~ /abcdefghij/;                       # 504
       next if join('', sort values %hist) !~ /1111112233/;                     # 125
       next if join('', sort map { $hist{$_} } split //, $bar_1) !~ /1123/;     # 42
       next if join('', sort(join('', sort map { $hist{$_} } split //, $bar_2),
         join('', sort map { $hist{$_} } split //, $bar_3))) !~ /112223/;       # 18
       next if join('', sort map { $hist{$_} } split //, $bar_4) !~ /13/;       # 12
       next if join('', sort map { $hist{$_} } split //, $bar_5) !~ /13/;       # 12

まず初めに a から j までのすべての文字が揃っているかどうかをチェックします。 コメントに記してある数字は、上の行がチェック数、該当行が通過数となります。ここでは、5711 チェックして 504 が通過したということです。次は、全体の出現回数をチェックします。ここでは、504 チェックして 125 通過しています。最後は、各辺の出現回数をチェックします。この中で、A + B + C と B + E + I は出現回数が違いますので、連結してチェックしています。最後まで残っているのが 12 で、これが正解の数となります。

正解が得られたら、「正」の字の A から J に数字を記号化した a から j を割り当てます。ハッシュを使ってもよいのですが、ここでは配列 @result を使っています。A が $result[0]、B が $result[1] ...、J が $result[9] というように対応しています。

       my @result;
       @result[6, 9, 8, 7] = map { $_->[0] }
                             sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] }
                             map { [$_, $hist{$_}] } split //, $bar_1;

上は、$bar_1 を下の辺にに割り当てています。ここで、先ほど +1 ではなく +2 としておいた効果が現れます。+1 とした場合は、$bar_1 の出現回数が 1122 となり、出現回数 2 の2つを H と I に割り当てるための判断するコードが必要になります。+2 としておけば、$bar_1 の出現回数が 1123 となりますので、出現回数 3 を H に、出現回数 2 を I に割り当てることができます。次は、上の辺と E を割り当てます。

       if (join('', sort map { $hist{$_} } split //, $bar_2) =~ /112/) {
         @result[0, 2, 1] = map { $_->[0] }
                            sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] }
                            map { [$_, $hist{$_}] } split //, $bar_2;
         ($result[4]) = grep { $hist{$_} == 3 } split //, $bar_3;
       } else {
         @result[0, 2, 1] = map { $_->[0] }
                            sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] }
                            map { [$_, $hist{$_}] } split //, $bar_3;
         ($result[4]) = grep { $hist{$_} == 3 } split //, $bar_2;
       }

上の辺は、出現回数が 112 になっています。$bar_2 と $bar_3 は一方が 112、もう一方が 223 の出現回数になっています。$bar_2 と $bar_3 のうち、出現回数が 112 になっている方を上の辺に割り当てます。そして、他方の出現回数が 223 の 3 になっている文字を E に割り当てます。残りの D と F も、同様の方法で割り当てます。

割り当てが終わったら、a から j のアルファベットを数字に変換して、一旦ハッシュ %result に格納しておき、プログラムの最後に表示します。

       @result = map { $_ < 10 ? " $_" : "$_" } map { $trans{$_} } @result;
       push @{$result{$i}}, join(':', @result);

結果を表示するコードは、難しいところはありません。見ていただけると、わかります。 解の数が多いものについては、横に4つ表示するようにしています。 プログラムを実行すると、次のように表示されます。

(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
 sum: 12
     2--4--6          2--6--4          5--1--6          1--6--5   
        |                |                |                |      
     9  7--5          9  5--7          9  4--8          9  4--8   
     |  |             |  |             |  |             |  |      
  0--3--1-----8    0--3--1-----8    0--3--7-----2    0--3--2-----7

     0--4--8          0--7--5   
        |                |      
     9  7--5          9  4--8   
     |  |             |  |      
  2--3--1-----6    2--3--1-----6

 sum: 13
     2--3--8          2--8--3          3--1--9          1--3--9   
        |                |                |                |      
     6  9--4          6  4--9          6  8--5          6  8--5   
     |  |             |  |             |  |             |  |      
  0--7--1-----5    0--7--1-----5    0--7--4-----2    0--7--2-----4

     0--4--9          0--8--5   
        |                |      
     6  8--5          6  4--9   
     |  |             |  |      
  2--7--1-----3    2--7--1-----3

連続する 10 の数字では、(0 .. 9) の他に (1 .. 10)、(2 .. 11)、(3 .. 12) に解があります。プログラムの2行目で、$n に 2, 3, 4 などと指定すると実行することができます。 他にも逆方向にずらす (-1 .. 8)、(-2 .. 7) などにも解があります (今回のプログラムでは、表示部分が負数に対応していません)。 いずれも解の数が多く、パズルとしてはもう1つの感じがします。連続しない 10 の数字の中には、正解が1つしかないものもあります。こちらの方が、パズルに向くかもしれません。 以下に、いくつか例を挙げます。

(0, 1, 2, 3, 4, 5, 6, 7, 10, 12)
 sum: 15
     6--2--7
        |
     5 12--3
     |  |
  0-10--1-----4

(3, 4, 5, 6, 7, 10, 11, 12, 13, 14)
 sum: 24
     5--7-12
        |
    13 14-10
     |  |
  4-11--3-----6

(2007/01/01)

TopPage