Кому СУДОКУ решать надоело?

[Valentin Kuznetsov]

Здpавствуй, All!

Сегодня меня просто задолбали домашние, пришлось, что бы отстали, сварганить
программу для решения СУДОКУ:
===BEG===
/* макет решалки СКДОКУ */

S.1='----1----'
S.2='--4---8--'
S.3='-8--3--9-'
S.4='---945---'
S.5='4-53629-8'
S.6='---871---'
S.7='-7--8--6-'
S.8='--3---1--'
S.9='----9----'

S.1='8-2---6-1'
S.2='-1-----3-'
S.3='---5-1---'
S.4='--42-59--'
S.5='----3----'
S.6='--19-48--'
S.7='---4-7---'
S.8='-5-----8-'
S.9='2-3---7-6'

/* главный цикл */
D.0=0 /* список действий */
Do Forever

/* обсчёт карты вариантов */
R=0
MX=0
MY=0
MZ=10
Do Y=1 To 9
Do X=1 To 9
V.X.Y=''
If SubStr(S.Y,X,1)<>'-' Then Iterate
/* .горизонталь */
Do Z=1 To 9
If Z=X Then Iterate
S=SubStr(S.Y,Z,1)
If S='-' Then Iterate
V.X.Y=V.X.Y''S
End
/* .вертикаль */
Do Z=1 To 9
If Z=Y Then Iterate
S=SubStr(S.Z,X,1)
If S='-' Then Iterate
V.X.Y=V.X.Y''S
End
/* .квадрат */
Select
When Y<4&X<4 Then Do
Do W=1 To 3
Do Z=1 To 3
If Z=Y&W=X Then Iterate
S=SubStr(S.Z,W,1)
If S='-' Then Iterate
V.X.Y=V.X.Y''S
End
End
End
When Y<4&X>3&X<7 Then Do
Do W=4 To 6
Do Z=1 To 3
If Z=Y&W=X Then Iterate
S=SubStr(S.Z,W,1)
If S='-' Then Iterate
V.X.Y=V.X.Y''S
End
End
End
When Y<4&X>6 Then Do
Do W=7 To 9
Do Z=1 To 3
If Z=Y&W=X Then Iterate
S=SubStr(S.Z,W,1)
If S='-' Then Iterate
V.X.Y=V.X.Y''S
End
End
End

When Y>3&Y<7&X<4 Then Do
Do W=1 To 3
Do Z=4 To 6
If Z=Y&W=X Then Iterate
S=SubStr(S.Z,W,1)
If S='-' Then Iterate
V.X.Y=V.X.Y''S
End
End
End
When Y>3&Y<7&X>3&X<7 Then Do
Do W=4 To 6
Do Z=4 To 6
If Z=Y&W=X Then Iterate
S=SubStr(S.Z,W,1)
If S='-' Then Iterate
V.X.Y=V.X.Y''S
End
End
End
When Y>3&Y<7&X>6 Then Do
Do W=7 To 9
Do Z=4 To 6
If Z=Y&W=X Then Iterate
S=SubStr(S.Z,W,1)
If S='-' Then Iterate
V.X.Y=V.X.Y''S
End
End
End

When Y>6&X<4 Then Do
Do W=1 To 3
Do Z=7 To 9
If Z=Y&W=X Then Iterate
S=SubStr(S.Z,W,1)
If S='-' Then Iterate
V.X.Y=V.X.Y''S
End
End
End
When Y>6&X>3&X<7 Then Do
Do W=4 To 6
Do Z=7 To 9
If Z=Y&W=X Then Iterate
S=SubStr(S.Z,W,1)
If S='-' Then Iterate
V.X.Y=V.X.Y''S
End
End
End
When Y>6&X>6 Then Do
Do W=7 To 9
Do Z=7 To 9
If Z=Y&W=X Then Iterate
S=SubStr(S.Z,W,1)
If S='-' Then Iterate
V.X.Y=V.X.Y''S
End
End
End
Qtherwise
End

/* .статистика */
S=V.X.Y
V.X.Y=''
Do Z=1 To 9
If Pos(Z,S)<1 Then V.X.Y=V.X.Y''Z
End
If Length(V.X.Y)<MZ Then Do
MZ=Length(V.X.Y)
MX=X
MY=Y
End
End
End

/* действия */
Say MX' 'MY' 'MZ
Select
When MZ=10 Then Leave
When MZ=0 Then Do
Do Forever
Z=D.0
MX=Word(D.Z,1)
MY=Word(D.Z,2)
MZ=Word(D.Z,3)
S=Word(D.Z,4)
Say 'реверс 'D.Z
S.MY=SubStr(S.MY,1,MX-1)'-'SubStr(S.MY,MX+1)
If MZ<Length(S) Then Do
MZ=MZ+1
S.MY=SubStr(S.MY,1,MX-1)''SubStr(S,MZ,1)''SubStr(S.MY,MX+1)
D.Z=MX' 'MY' 'MZ' 'S
Leave
End
D.0=D.0-1
End
Say ' -->'D.Z
End
Otherwise
S.MY=SubStr(S.MY,1,MX-1)''Left(V.MX.MY,1)''SubStr(S.MY,MX+1)
Z=D.0+1
D.Z=MX' 'MY' 1 'V.MX.MY
D.0=Z
End

/* индикация - можно отключить */
Do Y=1 To 9
S=S.Y

Do X=1 To 9
If V.X.Y='' Then S=S' -'
Else S=S' 'V.X.Y
End

Say S
End


/* конец главного цикла */
End

/* ответ */
Do Y=1 To 9
Say S.Y
End
===END===


Valentin