ソースコード 虫食い算パズルの解法
Turbo Pascal バージョン
by A. Udagawa
{ $r+}
program mushi;
uses dos, crt;
{*******************************************************************
OS-9 虫食い算パズルの解法 ＜かけ算＞
-------------------------------------------------------------
by A. Udagawa
OS9/Basic09 ver 2.0 1988.7
OS9 -> MS.DOS/Quick Basic 1989.12
Quick Basic -> Turbo Pascal 1990.2 coded H.Takahashi
ver 2.2 1992.12
long Integer(9桁まで) version
*******************************************************************}
const
MAXMOJISU = 9; { 最大文字列数（被乗数ならびに乗数）}
XHABA = MAXMOJISU * 2; { 格納用配列の横幅 }
YHABA = 3 + MAXMOJISU; { の縦幅 }
XA = XHABA - 1; { 配列用横サイズ = 17 }
YA = YHABA - 1; { 縦サイズ = 11 }
type
_gyou = record { １行の各種情報 }
keta: integer; { 桁数 }
head: integer; { 有効文字列の左端の位置 }
tail: integer; { の右端の位置 }
relcnt: integer; { リレーションが設定されている文字の数 }
dfp: integer; { 最初に現れるリレーション文字位置 }
vmin: longint; { この行の有効文字列がとりうる最小数値 }
vmax: longint { 最大数値 }
end;
_inta10 = array[0..9] of boolean;
_intaxa = array[0..XA] of integer;
var
s: array[0..YA, 0..XA] of string[2];
{ キーボード入力された文字を正序化して格納 }
v: array[0..YA, 0..XA] of integer;
{ 対応する文字の値を格納する配列 }
relationtb: array[0..YA, 0..XA, 0..1] of integer;
{ 文字相互間の親子関係を(x,y)表示 }
gyotbl: array[0..YA] of _gyou; { 各行の情報を格納 }
ytail: integer;
zsum: integer;
zerocounter:array[0..XA] of integer; { 乗数行に含まれる初期値ゼロを記録 }
lvlid: integer; { 入力時に指定する経過表示レベル }
hour, min, sec, sec100: word;
adtabs: _intaxa;
usednumtb: _inta10; { 数字が使用済か否かを登録 }
kanjsw: boolean; { 全角入力スイッチ }
procedure chrchk( valu, zeroid:integer;
hijyosu: longint;
x: integer;
var result: integer;
var linked: boolean;
var adtabs: _intaxa;
var usednumtb: _inta10);
{ =======================================================
数字の妥当性をチェック
-------------------------------------------------------
hijyosu : 被乗数の値
valu : チェックする数値（この数値が妥当かどうか？）
x : チェックする乗数行の文字位置
adtabs: 合計行の桁上がり数値保存テーブル
usednumtb:
result : このルーチンが返す値 0=チェクｏｋ
linked :
zeroid :
======================================================= }
label
10, 20, 90, 99;
var
cyukan: array[0..XA] of integer;
temp: longint;
ws: string;
py, i, j: integer;
dx, dy: integer;
sum, amari: integer;
ch: char;
st: string[1];
begin
result := 99; { 初期値はエラー状態にしておく }
py := XA - x + 2 - zerocounter[x]; { 中間行の y 位置を割り出す }
if zeroid > 0 then goto 10; { 乗数桁 X がゼロでないので縦計チェックのみ }
temp := hijyosu * valu; { 中間行の値 }
{ 1. 桁数チェック }
if (temp < gyotbl[py].vmin) or (temp > gyotbl[py].vmax) then begin
goto 99 { 桁エラー }
end;
str(temp, ws); { 中間行 temp の数値をセット }
j:= 1;
if gyotbl[py].relcnt = 0 then { この行に,親へのリンクの設定がない場合は }
for i := gyotbl[py].head to gyotbl[py].tail do begin
st := copy(ws, j, 1);
v[py, i] := ord(st[1]) - 48;
j := j + 1
end
else begin { そうでなく}
{ 2. 中間行に定義文字がある場合の処理 }
for i := gyotbl[py].head to gyotbl[py].tail do begin
{ 中間行の数値を cyukan にセット }
st := copy(ws, j, 1);
cyukan[i] := ord(st[1]) - 48; { 中間行の数値を cyukan にセット }
j := j + 1
end;
for i := gyotbl[py].dfp to gyotbl[py].tail do begin
if relationtb[py, i, 0] < 90 then begin { 親が設定されているなら }
dy := relationtb[py, i, 0]; { 親の座標を取り出し }
dx := relationtb[py, i, 1];
if (dy = py) and (dx <> i) then begin { 同じ行の他の文字へリンク }
if cyukan[dx] <> cyukan[i] then begin
goto 99 { エラー }
end
end else
if v[dy, dx] <> cyukan[i] then begin
goto 99
end
end
else begin
if relationtb[py, i, 0] = 90 then begin { 覆面文字のルートなら }
if usednumtb[cyukan[i]] then begin
goto 99
end;
usednumtb[cyukan[i]] := TRUE
end
end;
if gyotbl[py].relcnt = 1 then goto 20
end; {for}
20:
for i := gyotbl[py].head to gyotbl[py].tail do begin
v[py, i] := cyukan[i]
end
end;
10:
sum := adtabs[x];
if py >= 2 then
for i := 2 to py do begin
sum := sum + v[i, x]
end;
amari := sum mod 10;
adtabs[x - 1] := sum div 10; { 桁上がり数をセットする }
{ 3. 合計行の x 位置には数字の定義があるか？ }
if relationtb[ytail, x, 0] < 90 then begin
dy := relationtb[ytail, x, 0];
dx := relationtb[ytail, x, 1];
if amari <> v[dy, dx] then begin
goto 99 { 桁の合計が定義値と不一致 }
end
end else
if relationtb[ytail, x, 0] = 90 then begin { 覆面文字ルート }
if usednumtb[amari] then begin
goto 99
end;
usednumtb[amari] := TRUE
end;
v[ytail, x] := amari;
if zeroid > 0 then goto 90 ;
{ 4. 最終行の場合は合計値の妥当性をチェック }
if py = ytail - 1 then begin
for i := x - 1 downto gyotbl[ytail].head do begin { 左半分のみチェック }
sum := adtabs[i];
for j := 2 to ytail - 1 do sum := sum + v[j, i]; { 桁合計 }
if i > 0 then
adtabs[i - 1] := sum div 10; { 桁上がり数値をセット }
amari := sum mod 10;
if relationtb[ytail, i, 0] < 90 then begin
dy := relationtb[ytail, i, 0];
dx := relationtb[ytail, i, 1];
if v[dy, dx] <> amari then goto 99
end else
if relationtb[ytail, i, 0] = 90 then begin { 覆面文字ルート }
if usednumtb[amari] then goto 99;
usednumtb[amari] := TRUE
end;
v[ytail, i] := amari
end; {for i}
if v[ytail, gyotbl[ytail].head] = 0 then goto 99
end;
90:
result := 0;
99:
end;
procedure fdisply (id: integer);
{ =================================================
表 示 ル ー チ ン
id = 0 処理結果出力
id <>0 入力式出力
================================================ }
var
i,j,k: integer;
begin
if id = 0 then begin
gettime(hour, min, sec, sec100);
writeln('>> 解発見 ', hour:2, ':', min:2, ':',sec:2)
end;
for i := 0 to ytail do begin
for k := 0 to XA do
if (k < gyotbl[i].head) or (k > gyotbl[i].tail) then write(' ')
else if id = 0 then write(v[i, k]:4) else write(' ', s[i, k]:2);
writeln;
if (i = 1) or (i = ytail - 1) then begin { 線を引く }
for j := 1 to gyotbl[ytail].head do write(' ');
for j := gyotbl[ytail].head to XA do write('----');
writeln
end
end {for i}
end;
procedure initset ( var adtabs: _intaxa; var usednumtb: _inta10);
{ ==================================================
計算前に各種テーブルをセット
================================================== }
label
5, 10, 11;
var
indata: string;
v1: longint;
v2: longint;
i,j,k, l,m: integer;
x,y: integer;
zerocnt, zerop: integer;
code, digit: integer;
inchar: char;
st, s2: string[2];
procedure init_sub( k, m: integer );
var
x, y: integer;
begin
if (relationtb[k, m, 0] = 99) and ((s[k, m] <> '* ') and (s[k, m] <> '＊')) then begin
{ ＊以外は覆面文字とする }
relationtb[k, m, 0] := 90;
relationtb[k, m, 1] := 90; { 同一覆面文字のルート=90 }
for y := 0 to ytail do
for x := gyotbl[y].head to gyotbl[y].tail do
if (relationtb[y, x, 0] = 99) and (s[y, x] = s[k, m])
and ((y <> k) or (x <> m)) then begin
relationtb[y, x, 0] := k;
relationtb[y, x, 1] := m
end
end {if}
end;
begin
{ テーブル初期化 }
for i := 0 to 9 do { usednumtbの配列要素 0--9 は 0 から 9 までの数字を代表し}
usednumtb[i] := FALSE; { その数字が既に使用されている場合は true 値をとる}
for i := 0 to YA do begin { 行情報テーブルを初期化 }
gyotbl[i].relcnt := 0;
gyotbl[i].keta := 0; { 桁数 }
gyotbl[i].head := 0; { 有効文字列の左端の位置 }
gyotbl[i].tail := 0; { の右端の位置 }
gyotbl[i].relcnt := 0; { リレーションが設定されている文字の数 }
gyotbl[i].dfp := 0; { 最初に現れるリレーション文字位置 }
gyotbl[i].vmin := 0; { この行の有効文字列がとりうる最小数値 }
gyotbl[i].vmax := 0 { 最大数値 }
end;
{ メイン処理 }
writeln;
writeln('=> 文字列を入力してください．',
'( 虫食い文字は＊です．終了はｃｒのみ )');
repeat
for y := 0 to YA do { テーブルの初期化 }
for x := 0 to XA do begin
s[y, x] := ' '; { シンボル（ソースストリング）テーブル }
v[y, x] := 0; { 値テーブル }
relationtb[y, x, 0] := 99; { 同一文字間の親子関係（位置）記録テーブル }
relationtb[y, x, 1] := 99
end;
for i := 0 to XA do begin
adtabs[i] := 0;
zerocounter[i] := 0
end;
x := 0;
zerocnt := 0;
zerop := XA + 1;
zsum := 0;
kanjsw := false;
(* writeln; *)
for y := 0 to YA do begin { 一行分の入力データの取り込み }
write('> '); readln(indata);
if y=0 then begin
if ord(indata[1]) < $20 then begin
l := length(indata) -1;
indata := copy(indata, 2, l)
end;
if (ord(indata[1]) >= $80) and (ord(indata[1]) <= $9F) then kanjsw := TRUE;
if (ord(indata[1]) >= $E0) and (ord(indata[1]) <= $FF) then kanjsw := TRUE;
end;
if indata = '' then begin { CR 入力なら }
if y=0 then halt;
if y - 1 <> ytail then begin
write('==> 入力式の行数があいません．');
goto 11
end else begin
ytail := y - 1
end;
goto 10
end;
{ 作業テーブルにパラメーターをセット }
if not kanjsw then { 半角の場合は }
l := length(indata)
else
l := length(indata) div 2; { 全角の場合は }
if (l > MAXMOJISU) and (y < 2 ) then begin
write('==> 文字数が多すぎます．');
goto 11
end;
gyotbl[y].keta := l; { 行テーブルに桁数登録 }
v1 := 1;
v2 := 9;
for i := 2 to l do begin { 桁数に該当する有効数字を登録 }
v1 := v1 * 10;
v2 := v2 * 10 + 9
end;
gyotbl[y].vmin := v1; { 桁数がとる最小値 }
gyotbl[y].vmax := v2; { 桁数がとる最大値 }
if (y < 2) or (y = ytail) then { 行位置が被乗数行,乗数行,積行の場合は }
i := 0 { 桁末尾の空白文字数はゼロ }
else begin { その他の場合は }
i := y - 2;
{ 次に，乗数行にゼロがある場合について行位置の補正を行う }
repeat
zerop := zerop - 1;
if adtabs[zerop] = 0 then goto 5;
zerocnt := zerocnt + 1
until zerop < gyotbl[1].head;
5:
i := i + zerocnt
end;
gyotbl[y].head := XA - l + 1 - i; { 有効文字列の左端位置 }
gyotbl[y].tail := gyotbl[y].head + l - 1; { 有効文字列の右端位置 }
{ データをシンボルテーブルに右詰めに移す．}
for x := 0 to l - 1 do
if not kanjsw then
s[y, gyotbl[y].head + x] := copy(indata, x + 1, 1) + ' '
else { 全角の場合は }
s[y, gyotbl[y].head + x] := copy(indata, x*2+1, 2);
if y = 1 then begin { 乗数行の場合のみゼロがあるかチェック？ }
for i := gyotbl[1].tail downto gyotbl[1].head do begin
if (s[1, i] = '0 ') or (s[1, i] = '０') then begin
adtabs[i] := 99;
zsum := zsum + 1
end else { 乗数行の該当桁は，右から数えて既に何個のゼロが }
zerocounter[i] := zsum { 出現しているか，を記録 }
end;
ytail := l + 2 - zsum { 入力最終行の位置ポインターを決定する}
end
end; {for y}
10:
fdisply(1);
11:
write('データＯＫ？ (Y/N/E) >');
readln(indata);
if (indata = 'E') or (indata = 'e') or (indata = 'Ｅ') or (indata = 'ｅ') then halt
until (indata = 'Y') or (indata = 'y') or (indata = 'Ｙ') or (indata = 'ｙ');
lvlid := 0;
write('被乗数行の途中経過表示をする場合は，表示桁(1--) を入力 >');
read(inchar);
if indata <> '' then begin
lvlid := ord(inchar) - 48;
read(inchar)
end;
writeln;
{ 後処理 }
for i := 0 to XA do adtabs[i] := 0;
{シンボルテーブルの数字(0-9)を定義テーブル(relationtb)に登録（親子関係なし）}
for y := 0 to ytail do begin
for x := gyotbl[y].head to gyotbl[y].tail do begin
if not kanjsw then begin { 半角数字処理 }
if (s[y, x] >= '0 ') and (s[y, x] <= '9 ') then begin
s2 := copy(s[y,x], 1,1);
val(s2, digit, code);
v[y, x] := digit;
relationtb[y, x, 0] := y;
relationtb[y, x, 1] := x { 変更なし用に自分自身を定義する }
end;
end else begin { 全角数字処理 }
if (s[y, x] >= '０') and (s[y, x] <= '９') then begin
if s[y, x] = '１' then v[y, x] := 1
else if s[y, x] = '２' then v[y, x] := 2
else if s[y, x] = '３' then v[y, x] := 3
else if s[y, x] = '４' then v[y, x] := 4
else if s[y, x] = '５' then v[y, x] := 5
else if s[y, x] = '６' then v[y, x] := 6
else if s[y, x] = '７' then v[y, x] := 7
else if s[y, x] = '８' then v[y, x] := 8
else if s[y, x] = '９' then v[y, x] := 9
else if s[y, x] = '０' then v[y, x] := 0;
relationtb[y, x, 0] := y;
relationtb[y, x, 1] := x { 変更なし用に自分自身を定義する }
end;
end
end{for x}
end; {for y}
{ 同一覆面文字をサーチして，その親子関係を設定する }
for i := gyotbl[0].head to gyotbl[0].tail do init_sub( 0, i );
for i := gyotbl[1].tail downto gyotbl[1].head do begin
init_sub( 1, i );
l := XA - i + 2 - zerocounter[i];
for j := gyotbl[l].tail downto gyotbl[l].head do init_sub( l, j );
init_sub( ytail, i )
end;
for i := gyotbl[ytail-1].tail-1 downto gyotbl[ytail].head do
init_sub( ytail, i );
{ 各行の定義文字情報を作成 }
for y := 0 to ytail do begin
for x := gyotbl[y].tail downto gyotbl[y].head do begin
if relationtb[y, x, 0] < 99 then begin
{ この行に含まれるリレーション文字数合計 }
gyotbl[y].relcnt := gyotbl[y].relcnt + 1;
gyotbl[y].dfp := x { 一番始め（左端）のリレーション文字位置 }
end
end
end
end;
procedure solut2( hijyosu: longint; x2: integer;
adtabs: _intaxa; usednumtb: _inta10 );
{=========================================================================
２行目の乗数の値を（右から左方向に）決定するルーチン．
------------------------------------------------------------------------
hijyosu: 被乗数値
x2: 解を決定すべき乗数の左端からの位置（この値を変えて再帰呼出しする）
adtabs: chrchk で使用する合計行の桁上がり数値保存テーブル
usednumtb:
=========================================================================}
label
10, 20, 90;
var
l: integer; { 解の値（０から９までの数字）}
fukws: _inta10;
fukroot, linked: boolean;
i: integer;
result: integer;
dx, dy: integer;
begin
{ 初期値設定 }
fukroot := FALSE;
linked := FALSE;
{ 乗数行のX 位置の数値がゼロなら，位置をさらに左に移行 }
while s[1, x2] = '0' do begin
chrchk(0, 1, hijyosu, x2, result, linked, adtabs, usednumtb);
if result <> 0 then goto 90;
x2 := x2 - 1
end;
{ x 位置の乗数の初期値を 1 にセット }
if gyotbl[XA - x2 + 2 - zsum].keta > gyotbl[0].keta then l := 2
else l := 1;
if relationtb[1, x2, 0] < 90 then begin
dx := relationtb[1, x2, 1];
dy := relationtb[1, x2, 0]; { リンク先 }
l := v[dy, dx];
linked := TRUE { リンク先に値をセット }
end else begin
if relationtb[1, x2, 0] = 90 then { 覆面文字ルート }
while ( true ) do begin
if not usednumtb[l] then begin { まだ使用していない }
usednumtb[l] := TRUE;
fukroot := TRUE;
goto 10
end;
l := l + 1;
if l > 9 then goto 90
end;
10:
end;
{ メインルーチン }
repeat
{ --- 初期値をセット }
for i := 0 to 9 do fukws[i] := usednumtb[i];
v[1, x2] := l; { 乗数に値をセット }
{ --- メイン処理 }
chrchk(l, 0, hijyosu, x2, result, linked, adtabs, usednumtb);
if result = 0 then { 処理位置の文字 s(1,x) の値は１でｏｋ }
if x2 = gyotbl[1].head then { 全文字へ割当が終了 }
fdisply(0)
else { 次の位置の文字処理へ進む }
solut2(hijyosu, x2 - 1, adtabs, usednumtb);
{ --- 後処理 }
if linked then goto 90;
for i := 0 to 9 do usednumtb[i] := fukws[i];
if fukroot then begin
usednumtb[l] := FALSE;
while( true ) do begin
l := l + 1;
if l > 9 then goto 90;
if not usednumtb[l] then begin { まだ使用していない }
usednumtb[l] := TRUE;
goto 20
end
end;
20:;
end else l := l + 1
until l > 9;
90:
end;
procedure solution( x, level: integer;
adtabs: _intaxa; usednumtb: _inta10 );
{===========================================================================
１行目の被乗数の値を（左から右方向順に）決定するルーチン．
---------------------------------------------------------------------------
x: 解を決定すべき被乗数の左端からの位置（この値を変えて再帰呼出する）
adtabs: 合計行データ(chrchkで使用)値
usednumtb:
level: 途中経過表示をする際の表示レベル（乗数行の左端より１，２．）
===========================================================================}
label
30, 40, 90;
var
linked, fukroot: boolean;
l: integer; { 解の値（０から９の数字）}
hijyosu: longint;
i: integer;
dx, dy: integer;
nx: integer;
procedure milestone; { 途中経過表示 }
var
i: integer;
begin
if level <= lvlid then begin
for i := 1 to level do write(' ');
write('位置-',level:2);
write('=', l);
gettime(hour, min, sec, sec100);
writeln(' ', hour:2, ':', min:2, ':',sec:2)
end
end;
begin
{ 初期値セット}
linked := FALSE;
fukroot := FALSE;
{ ｘ位置の被乗数の解の初期値をセット }
if x = gyotbl[0].head then l := 1 { 左端文字の初期値は１ }
else l := 0; { それ以外は０ }
if relationtb[0, x, 0] < 90 then begin { この位置の文字は既出なので親を捜す }
dx := relationtb[0, x, 1];
dy := relationtb[0, x, 0]; { リンク先(親の位置) }
l := v[dy, dx]; { 初期値には親の値を採用する }
linked := TRUE { この文字はリンク値を採用したというリンクサインをセット }
end else { 新しい文字なので新しい値を採用する }
if relationtb[0, x, 0] = 90 then begin { 覆面文字のルートの場合は }
while( true ) do begin
if not usednumtb[l] then begin { この値はまだ使用されていないので }
usednumtb[l] := TRUE; { 使用済みにし，}
fukroot := TRUE; { 覆面文字のルートサインをセットする }
goto 30
end;
l := l + 1;
if l > 9 then goto 90
{ 全ての数字が使われており，新しい数字が得られない }
end;
30:
end;
{ メインルーチン }
repeat
v[0, x] := l; { 初期値を値テーブルにセット }
milestone; {（採用値の）途中経過表示 }
{ --- メイン処理 }
if x <> gyotbl[0].tail then { 被乗数行の右端まで達していないなら }
solution(x + 1, level + 1, adtabs, usednumtb) { 次の位置で再帰呼出 }
else begin { 被乗数行は終了したので }
hijyosu := v[0, gyotbl[0].head]; { 被乗数値を作成して }
for i := gyotbl[0].head + 1 to gyotbl[0].tail do
hijyosu := hijyosu * 10 + v[0, i];
nx := gyotbl[1].tail;
{ 乗数行の解析文字位置（右端から左へ）をセットして }
solut2(hijyosu, nx, adtabs, usednumtb) { 乗数行の値を決定に行く }
end;
{ 後処理：リカーシブコールで値をさらに決定しに行ったが失敗に終わった．
ということは，このルーチンで採用した値が妥当ではなかったわけで
設定した値を戻し，このルーチンを呼んだ親に戻る }
if linked then goto 90; { 子であるので値を他の文字にする必要がない }
if fukroot then begin { 覆面文字ルートなら }
usednumtb[l] := FALSE;
while( true ) do begin
l := l + 1;
if l > 9 then goto 90;
if not usednumtb[l] then begin { まだ未使用 }
usednumtb[l] := TRUE;
goto 40
end
end;
40:
end else
l := l + 1 { ｘ位置の値を次の数字(+1)にして再トライする }
until l > 9;
90:
end;
{ --------------------------------------------
メインルーチン
-------------------------------------------- }
begin
clrscr;
writeln(' +++ +++');
writeln(' +++ 虫食い算パズルの解法（かけ算） +++');
writeln(' +++ +++');
writeln(' +++ a. udagawa : ver 2.2 +++');
writeln(' +++ Long Integer (9 桁まで) version +++');
repeat
initset( adtabs, usednumtb );
gettime(hour, min, sec, sec100);
writeln('解析スタート ', hour:2, ':', min:2, ':',sec:2);
solution( gyotbl[0].head, 1, adtabs, usednumtb );
gettime(hour, min, sec, sec100);
writeln('解析終了 ', hour:2, ':', min:2, ':',sec:2)
until hour <0;
end.
|
|
|