Sudoku/REXX: Difference between revisions

From Rosetta Code
Content added Content deleted
(→‎REXX: Version 1: Add further version headers.)
 
(18 intermediate revisions by 5 users not shown)
Line 1: Line 1:
{{collection|Sudoku}}
==REXX: Version 1==

This is the   '''$SUDOKU.REX'''   (REXX) program and is used to solve the Rosetta Code task of "sudoku".
==[[REXX]]==
<br><br>This REXX program was originally written to assist in sudoku puzzle solving (by giving strong hints), and not to solve the puzzle outright.
=== REXX version 1 ===
<br>The REXX program was written to give increasing better hints and also show the possibilities (of what is possible solution for any cell),
This is the <code>$SUDOKU.REX</code> (REXX) program and is used to solve the Rosetta Code task of "sudoku".

This REXX program was originally written to assist in sudoku puzzle solving (by giving strong hints), and not to solve the puzzle outright.

The REXX program was written to give increasing better hints and also show the possibilities (of what is possible solution for any cell),
<br>and to partially solve the puzzle using distinct strategies (separately or in combination). &nbsp; One option is to solve the puzzle.
<br>and to partially solve the puzzle using distinct strategies (separately or in combination). &nbsp; One option is to solve the puzzle.

<br><br>The help for the &nbsp; '''$SUDOKU''' &nbsp; REXX program is included here ──► [[Sudoku/REXX#REXX_Version_1_Help]].
The help for the <code>$SUDOKU</code> REXX program is included here ───► [[$SUDOKU.HEL]].
<br>The &nbsp; '''$SUDOKU.REX''' &nbsp; REXX program makes use of &nbsp; '''$ERR.REX''' &nbsp; REXX program which is used to display error messages (via &nbsp; '''$T.REX''').

<br>The &nbsp; '''$ERR.REX''' &nbsp; REXX program is included here ──► [[Sudoku/REXX#REXX_Version_1_Errors]].
<br>The &nbsp; '''$SUDOKU.REX''' &nbsp; REXX program makes use of &nbsp; '''$T.REX''' &nbsp; REXX program which is used to display text messages.
The <code>$SUDOKU.REX</code> REXX program makes use of <code>$ERR.REX</code> REXX program which is used to display error messages (via '''$T.REX''').

<br>The &nbsp; '''$T.REX''' &nbsp; REXX program is included here ──► [[Sudoku/REXX#REXX_Version_1_Messages]].
The <code>$ERR.REX</code> REXX program is included here ───► [[$ERR.REX]].
<br>Some older REXXes don't have a &nbsp; '''changestr''' &nbsp; BIF, so one is included here ──► [[Sudoku/REXX#REXX_Version_1_CHANGESTR_function]].

<br>REXX programs not included are &nbsp; '''$H''' &nbsp; which shows '''help''' and other documentation.
The <code>$SUDOKU.REX</code> REXX program makes use of <code>$T.REX</code> REXX program which is used to display text messages.
<lang rexx>/*REXX program displays, can give hints, and/or solve a sudoku puzzle. */

The <code>$T.REX</code> REXX program is included here ───► [[$T.REX]].

Some older REXXes don't have a &nbsp; '''changestr''' &nbsp; BIF, so one is included here ───► [[CHANGESTR.REX]].

REXX programs ''not'' included are <code>$H</code> which shows/displays '''help''' and other documentation.
<syntaxhighlight lang="rexx">
/*REXX program displays, can give hints, and/or solve a sudoku puzzle. */
trace off
trace off
parse arg !
parse arg !
Line 768: Line 781:
return foundmatch
return foundmatch


/*────────────────────────────────────────────────────────────────────────────*/
/*═════════════════════════════general 1-line subs════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════*/
commas: procedure; parse arg _; n=_'.9'; #=123456789; b=verify(n,#,"M")
!all:!!=!;!=space(!);upper !;call !fid;!nt=right(!var('OS'),2)=='NT';!cls=word('CLS VMFCLEAR CLRSCREEN',1+!cms+!tso*2);if arg(1)\==1 then return 0;if wordpos(!,'? ?SAMPLES ?AUTHOR ?FLOW')==0 then return 0;!call=']$H';call '$H' !fn !;!call=;return 1
e=verify(n,#'0',,verify(n,#"0.",'M'))-4
!cal: if symbol('!CALL')\=="VAR" then !call=; return !call
do j=e to b by -3; _=insert(',',_,j); end /*j*/; return _
/*═════════════════════════════general 1-line subs══════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════*/
!all: !!=!;!=space(!);upper !;call !fid;!nt=right(!var('OS'),2)=='NT';!cls=word('CLS VMFCLEAR CLRSCREEN',1+!cms+!tso*2);if arg(1)\==1 then return 0;if wordpos(!,'? ?SAMPLES ?AUTHOR ?FLOW')==0 then return 0;!call=']$H';call '$H' !fn !;!call=;return 1
!cal: if symbol('!CALL')\=="VAR" then !call=; return !call
!env: !env='ENVIRONMENT'; if !sys=='MSDOS' | !brexx | !r4 | !roo then !env='SYSTEM'; if !os2 then !env='OS2'!env; !ebcdic=1=='f0'x; if !crx then !env='DOS'; return
!env: !env='ENVIRONMENT'; if !sys=='MSDOS' | !brexx | !r4 | !roo then !env='SYSTEM'; if !os2 then !env='OS2'!env; !ebcdic=1=='f0'x; if !crx then !env='DOS'; return
!fid: parse upper source !sys !fun !fid . 1 . . !fn !ft !fm .; call !sys; if !dos then do; _=lastpos('\',!fn); !fm=left(!fn,_); !fn=substr(!fn,_+1); parse var !fn !fn '.' !ft; end; return word(0 !fn !ft !fm,1+('0'arg(1)))
!fid: parse upper source !sys !fun !fid . 1 . . !fn !ft !fm .; call !sys; if !dos then do; _=lastpos('\',!fn); !fm=left(!fn,_); !fn=substr(!fn,_+1); parse var !fn !fn '.' !ft; end; return word(0 !fn !ft !fm,1+('0'arg(1)))
!rex: parse upper version !ver !vernum !verdate .; !brexx='BY'==!vernum; !kexx='KEXX'==!ver; !pcrexx='REXX/PERSONAL'==!ver | 'REXX/PC'==!ver; !r4='REXX-R4'==!ver; !regina='REXX-REGINA'==left(!ver,11); !roo='REXX-ROO'==!ver; call !env; return
!rex: parse upper version !ver !vernum !verdate .; !brexx='BY'==!vernum; !kexx='KEXX'==!ver; !pcrexx='REXX/PERSONAL'==!ver | 'REXX/PC'==!ver; !r4='REXX-R4'==!ver; !regina='REXX-REGINA'==left(!ver,11); !roo='REXX-ROO'==!ver; call !env; return
!sys: !cms=!sys=='CMS'; !os2=!sys=='OS2'; !tso=!sys=='TSO' | !sys=='MVS'; !vse=!sys=='VSE'; !dos=pos('DOS',!sys)\==0 | pos('WIN',!sys)\==0 | !sys=='CMD'; !crx=left(!sys,6)=='DOSCRX'; call !rex; return
!sys: !cms=!sys=='CMS'; !os2=!sys=='OS2'; !tso=!sys=='TSO' | !sys=='MVS'; !vse=!sys=='VSE'; !dos=pos('DOS',!sys)\==0 | pos('WIN',!sys)\==0 | !sys=='CMD'; !crx=left(!sys,6)=='DOSCRX'; call !rex; return
Line 782: Line 799:
$sfxm: parse arg z; arg w; b=1000; if right(w,1)=='I' then do; z=shorten(z); w=z; upper w; b=1024; end; p=pos(right(w,1),'KMGTPEZYXWVU'); if p==0 then return arg(1); n=shorten(z); r=num(n,f,1); if isNum(r) then return r*b**p; return arg(1)
$sfxm: parse arg z; arg w; b=1000; if right(w,1)=='I' then do; z=shorten(z); w=z; upper w; b=1024; end; p=pos(right(w,1),'KMGTPEZYXWVU'); if p==0 then return arg(1); n=shorten(z); r=num(n,f,1); if isNum(r) then return r*b**p; return arg(1)
$sfxz: return $sfxa($sfxa($sfxa($sfxa($sfxa($sfxa(y,'PAIRs',2),'DOZens',12),'SCore',20),'GREATGRoss',1728),'GRoss',144),'GOOGOLs',1e100)
$sfxz: return $sfxa($sfxa($sfxa($sfxa($sfxa($sfxa(y,'PAIRs',2),'DOZens',12),'SCore',20),'GREATGRoss',1728),'GRoss',144),'GOOGOLs',1e100)
$t: if tops=='' then say arg(1); else do; !call=']$T'; call "$T" tops arg(1); !call=; end; return
$t: if tops=='' then say arg(1); else do; !call=']$T'; call "$T" tops arg(1); !call=; end; return
ab: arg ab,abl; return abbrev(ab,_,abl)
ab: arg ab,abl; return abbrev(ab,_,abl)
abb: arg abbu; parse arg abb; return abbrev(abbu,_,abbl(abb))
abb: arg abbu; parse arg abb; return abbrev(abbu,_,abbl(abb))
Line 788: Line 805:
abbn: parse arg abbn; return abb(abbn) | abb('NO'abbn)
abbn: parse arg abbn; return abb(abbn) | abb('NO'abbn)
abn: arg ab,abl; return abbrev(ab,_,abl) | abbrev('NO'ab,_,abl+2)
abn: arg ab,abl; return abbrev(ab,_,abl) | abbrev('NO'ab,_,abl+2)
comma: procedure; parse arg _,c,p,t; c=pickBlank(c,","); o=p(p 3); p=abs(o); t=p(t 999999999); if \isInt(p) | \isInt(t) | p==0 | arg()>4 then return _; n=_'.9'; #=123456789; k=0; return comma_()
comma_: if o<0 then do; b=verify(_,' '); if b==0 then return _; e=length(_)-verify(reverse(_),' ')+1; end; else do; b=verify(n,#,"M"); e=verify(n,#'0',,verify(n,#"0.",'M'))-p-1; end; do j=e to b by -p while k<t; _=insert(c,_,j); k=k+1; end; return _
copies2: return copies(arg(1),2)
copies2: return copies(arg(1),2)
copies3: return copies(arg(1),3)
copies3: return copies(arg(1),3)
drc: procedure; parse arg r,c,p; _=r","c; if p\=='' then _=_ "("p')'; return _
drc: procedure; parse arg r,c,p; _=r","c; if p\=='' then _=_ "("p')'; return _
er: parse arg _1,_2; call '$ERR' "14"p(_1) p(word(_1,2) !fid(1)) _2; if _1<0 then return _1; exit result
er: parse arg _1,_2; call '$ERR' "14"p(_1) p(word(_1,2) !fid(1)) _2; if _1<0 then return _1; exit result
err: call er '-'arg(1),arg(2); return ''
err: call er '-'arg(1),arg(2); return ''
erx: call er '-'arg(1),arg(2); exit ''
erx: call er '-'arg(1),arg(2); exit ''
halt: call er .1
halt: call er .1
int: int=num(arg(1),arg(2)); if \isInt(int) then call er 92,arg(1) arg(2); return int/1
int: int=num(arg(1),arg(2)); if \isInt(int) then call er 92,arg(1) arg(2); return int/1
isInt: return datatype(arg(1),'W')
isInt: return datatype(arg(1),'W')
isNum: return datatype(arg(1),'N')
isNum: return datatype(arg(1),'N')
kount1: parse arg qd,string; k1=pos(qd,string); if k1==0 then return 0; return pos(qd,string,k1+1)==0
kount1: parse arg qd,string; k1=pos(qd,string); if k1==0 then return 0; return pos(qd,string,k1+1)==0
lower: return translate(arg(1),@abc,translate(@abc))
lower: return translate(arg(1),@abc,translate(@abc))
na: if arg(1)\=='' then call er 01,arg(2); parse var ops na ops; if na=='' then call er 35,_o; return na
na: if arg(1)\=='' then call er 01,arg(2); parse var ops na ops; if na=='' then call er 35,_o; return na
nai: return int(na(),_o)
nai: return int(na(),_o)
nail: return squish(int(translate(na(),0,','),_o))
nail: return squish(int(translate(na(),0,','),_o))
nan: return num(na(),_o)
no: if arg(1)\=='' then call er 01,arg(2); return left(_,2)\=='NO'
no: if arg(1)\=='' then call er 01,arg(2); return left(_,2)\=='NO'
noValue:!sigl=sigl; call er 17,!fid(2) !fid(3) !sigl condition('D') sourceline(!sigl)
noValue:!sigl=sigl; call er 17,!fid(2) !fid(3) !sigl condition('D') sourceline(!sigl)
num: procedure; parse arg x .,f,q; if x=='' then return x; if isNum(x) then return x/1; x=space(translate(x,,','),0); if \isNum(x) then x=$sfxf(x); if isNum(x) then return x/1; if q==1 then return x; if q=='' then call er 53,x f; call erx 53,x f
num: procedure; parse arg x .,f,q; if x=='' then return x; if isNum(x) then return x/1; x=space(translate(x,,','),0); if \isNum(x) then x=$sfxf(x); if isNum(x) then return x/1; if q==1 then return x; if q=='' then call er 53,x f; call erx 53,x f
p: return word(arg(1),1)
p: return word(arg(1),1)
pickBlank: procedure; parse arg x,y; arg xu; if xu=='BLANK' then return ' '; return p(x y)
shorten:procedure; parse arg a,n; return left(a,max(0,length(a)-p(n 1)))
shorten:procedure; parse arg a,n; return left(a,max(0,length(a)-p(n 1)))
simple: return translate(arg(1),'.||--%<>AV'copies('+',25),"·│║─═☼◄►↑↓┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣")
simple: return translate(arg(1),'.||--%<>AV'copies('+',25),"·│║─═☼◄►↑↓┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣")
squish: return space(translate(arg(1),,word(arg(2) ',',1)),0)
squish: return space(translate(arg(1),,word(arg(2) ',',1)),0)
syntax: !sigl=sigl; call er 13,!fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl)
syntax: !sigl=sigl; call er 13,!fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl)
tem: parse arg r,c,w; if tellinvalid then say '***error!*** row' r", col" c '('@.r.c") is a duplicate of another in the same" w'.'; return 0
tem: parse arg r,c,w; if tellInvalid then say '***error!*** row' r", col" c '('@.r.c") is a duplicate of another in the same" w'.'; return 0
tg: arg tg; if simple then tg=simple(tg); call $t gridindent || tg; return</lang>
tg: arg tg; if simple then tg=simple(tg); call $t gridindent || tg; return</syntaxhighlight>


===REXX Version 1 Help===


The following text file is the documentation (HELp) for the &nbsp; '''$SUDOKU.REX''' &nbsp; program.
This REXX program makes use of &nbsp; '''$ERR.REX''' &nbsp; REXX program
which is used to write (display) error messages to the terminal screen, with
supplemental text that identifies what program issued the error, and in some
cases, also identifies the failing REXX statement and some particulars about
the failure.


Note that the &nbsp; $SUDOKU# &nbsp; ($SUDOKU#.REX) &nbsp; isn't included here because of the size of the program.
The &nbsp; '''$ERR.T.REX''' &nbsp; REXX program can be found here &nbsp; ───► &nbsp; [[$ERR.REX]].
<pre>
The $SUDOKU command will display a sudoku puzzle, cells/rows/columns of which
may be specified. A sudoku puzzle is a grid of nine 3x3 cells (for a total
of 9x9 cells) that can contain the digits 1──►9. The object is to fill in
the puzzle so that every row, column, and 3x3 box has every (unique) digit.


changestr $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$@@@@@@@@@@@@@@@@@@@@@@@@##############%%%%%%%%%%%%%%%%%%%
To show several supplied sudoku puzzles, the $SUDOKU# program can be used to
display over 12,600 different puzzles. To see that help, issue: $H $SUDOKU#


{{out|output| &nbsp; when using the input of: <br>
╔══════════════════════════════════════════════════════════════════════════════╗
<tt> row 1 .5..7.89 row 2 9...3 row 3 1...89.4 row 4 ..9.....1 row 5 ..13.52 row 6 6.....5 row 7 .6.89...3 row 8 ....5...7 row 9 .98.2..5 pruneALL </tt>}}
║ {CLearscneen | NOCLearscreen} ║
<pre style="height:130ex">
║ {HIGHLightsingles | NOHIGHLightsingles} ║
$SUDOKU is showing the puzzle
║ {PUZZle .d..dd..d.......d..dddd.ddd...ddd.dddd....} ║
┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐
║ {COLumn n .d..dd..d.} ║
║ {ROW n ...d..d.dd} ║
│ │ │ ││ │ │ ││ │ │ │
║ $SUDOKU {CELL rc d} ║
│ │ 5 │ ││ │ 7 │ ││ 8 │ 9 │ │
║ {PRUNEEXCLusives} {PRUNELINEs} ║
│ │ │ ││ │ │ ││ │ │ │
├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
║ ? {PRUNEMATches} {PRUNEONLYs} {PRUNESINGLes} ║
║ ?AUTHOR {PRUNEALL} ║
│ │ │ ││ │ │ ││ │ │ │
║ ?FLOW {SHORTgrid} ║
│ 9 │ │ ││ │ 3 │ ││ │ │ │
║ ?SAMPLES {SHOWCELL rc,xy,ab,...} ║
│ │ │ ││ │ │ ││ │ │ │
├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
║ {SHOWBOXes bbb} {SHOWCOLs ccc} {SHOWROWs rrr} ║
║ {SHOWCOMBinations} ║
│ │ │ ││ │ │ ││ │ │ │
║ {SHOWGrid | NOSHOWGrid} ║
│ 1 │ │ ││ │ 8 │ 9 ││ │ 4 │ │
║ {SHOWINFOmation | NOSHOWINFOmation} ║
│ │ │ ││ │ │ ││ │ │ │
└───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘
║ {SHOWPOSSibles} ║
┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐
║ {SHOWONELINE} ║
║ {SIMPLE} ║
│ │ │ ││ │ │ ││ │ │ │
║ {tops} ║
│ │ │ 9 ││ │ │ ││ │ │ 1 │
│ │ │ ││ │ │ ││ │ │ │
╚══════════════════════════════════════════════════════════════════════════════╝
├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
│ │ │ ││ │ │ ││ │ │ │
│ │ │ 1 ││ 3 │ │ 5 ││ 2 │ │ │
│ │ │ ││ │ │ ││ │ │ │
├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
│ │ │ ││ │ │ ││ │ │ │
│ 6 │ │ ││ │ │ ││ 5 │ │ │
│ │ │ ││ │ │ ││ │ │ │
└───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘
┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐
│ │ │ ││ │ │ ││ │ │ │
│ │ 6 │ ││ 8 │ 9 │ ││ │ │ 3 │
│ │ │ ││ │ │ ││ │ │ │
├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
│ │ │ ││ │ │ ││ │ │ │
│ │ │ ││ │ 5 │ ││ │ │ 7 │
│ │ │ ││ │ │ ││ │ │ │
├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
│ │ │ ││ │ │ ││ │ │ │
│ │ 9 │ 8 ││ │ 2 │ ││ │ 5 │ │
│ │ │ ││ │ │ ││ │ │ │
└───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘


$SUDOKU is starting prune pass # 1
───where:
$SUDOKU found the digit 8 by exclusiveness at cell 2,2 (2478)
$SUDOKU found the digit 3 by exclusiveness at cell 3,7 (367)
$SUDOKU found the digit 5 by exclusiveness at cell 4,1 (234578)
$SUDOKU found the digit 8 by exclusiveness at cell 5,1 (478)
$SUDOKU found the digit 9 by exclusiveness at cell 6,4 (12479)
$SUDOKU found the digit 9 by exclusiveness at cell 5,9 (469)
$SUDOKU found the digit 5 by exclusiveness at cell 7,3 (2457)
$SUDOKU found the digit 1 by exclusiveness at cell 8,2 (1234)
$SUDOKU found the digit 9 by exclusiveness at cell 8,7 (469)
$SUDOKU found the digit 8 by exclusiveness at cell 8,8 (268)
$SUDOKU found the digit 8 by exclusiveness at cell 6,9 (48)
$SUDOKU found the digit 8 by exclusiveness at cell 4,6 (24678)
$SUDOKU found the digit 4 by exclusiveness at cell 4,7 (467)
$SUDOKU found the digit 2 by exclusiveness at cell 7,8 (12)
$SUDOKU found the digit 4 by exclusiveness at cell 9,9 (46)
$SUDOKU found the digit 6 by exclusiveness at cell 9,7 (16)
$SUDOKU found the digit 1 by exclusiveness at cell 7,7 (1)
$SUDOKU found the digit 1 by exclusiveness at cell 2,8 (167)
$SUDOKU found the digit 7 by exclusiveness at cell 2,7 (7)
∙
∙
∙
some output elided ∙∙∙
∙
∙
∙
┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐
│ │ │ ││ │ │ ││ │ │ │
│ 4 │ 5 │ 3 ││ 1 │ 7 │ 6 ││ 8 │ 9 │ 2 │
│ │ │ ││ │ │ ││ │ │ │
├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
│ │ │ ││ │ │ ││ │ │ │
│ 9 │ 8 │ 6 ││ 4 │ 3 │ 2 ││ 7 │ 1 │ 5 │
│ │ │ ││ │ │ ││ │ │ │
├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
│ │ │ ││ │ │ ││ │ │ │
│ 1 │ 2 │ 7 ││ 5 │ 8 │ 9 ││ 3 │ 4 │ 6 │
│ │ │ ││ │ │ ││ │ │ │
└───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘
┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐
│ │ │ ││ │ │ ││ │ │ │
│ 5 │ 3 │ 9 ││ 2 │ 6 │ 8 ││ 4 │ 7 │ 1 │
│ │ │ ││ │ │ ││ │ │ │
├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
│ │ │ ││ │ │ ││ │ │ │
│ 8 │ 7 │ 1 ││ 3 │ 4 │ 5 ││ 2 │ 6 │ 9 │
│ │ │ ││ │ │ ││ │ │ │
├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
│ │ │ ││ │ │ ││ │ │ │
│ 6 │ 4 │ 2 ││ 9 │ 1 │ 7 ││ 5 │ 3 │ 8 │
│ │ │ ││ │ │ ││ │ │ │
└───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘
┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐
│ │ │ ││ │ │ ││ │ │ │
│ 7 │ 6 │ 5 ││ 8 │ 9 │ 4 ││ 1 │ 2 │ 3 │
│ │ │ ││ │ │ ││ │ │ │
├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
│ │ │ ││ │ │ ││ │ │ │
│ 2 │ 1 │ 4 ││ 6 │ 5 │ 3 ││ 9 │ 8 │ 7 │
│ │ │ ││ │ │ ││ │ │ │
├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
│ │ │ ││ │ │ ││ │ │ │
│ 3 │ 9 │ 8 ││ 7 │ 2 │ 1 ││ 6 │ 5 │ 4 │
│ │ │ ││ │ │ ││ │ │ │
└───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘


$SUDOKU is starting prune pass # 4
? shows this help file (press ESC to quit when viewing).
sudoku puzzle solved.
</pre>


=== REXX version 2 ===
?AUTHOR shows the author of this program.
{{trans|PL/I}}
<syntaxhighlight lang="rexx"> Parse Arg g.0fid
Select
When g.0fid='?' Then Do
Say 'This program solves any (valid) SUDOKU puzzle'
Say 'Specify the name of the file containing the puzzle as argument'
Exit
End
When g.0fid='' Then
Call exit 'no input specified'
When lines(g.0fid)=0 Then
Call exit 'specified input does not exist'
Otherwise
Nop
End
instr=''
Do While lines(g.0fid)>0
instr=instr||linein(g.0fid)
End
Call lineout g.0fid
digits='123456789'
buffer=translate(instr,digits'000',digits'0.x'||xrange('00'x,'ff'x))
buffer=space(buffer,0)
If length(buffer)<>81 Then
Call exit 'invalid input from file' g.0fid
Call set_geometry


posbit.=copies('0',9)
?FLOW shows the external execution flow of this program.
z=posbit.0
d.z=0


Do i=1 To 9
?SAMPLES shows some sample uses (press ESC to quit when viewing).
posbit.i=overlay('1',posbit.i,i,1)
z=posbit.i
d.z=i
End


Do r=1 To 9
CLearscreen clears the screen before any grid is shown.
Do c=1 To 9
The default is: CLEARSCREEN
Parse Var buffer d +1 buffer
matrix.r.c=posbit.d
End
End


nn=0
NOCLearscreen doen't clear the screen before any grid is show.
Call show_matrix 'input from' g.0fid
The default is: CLEARSCREEN
res=solve()
If res Then Do
Call dbg 'nn='format(nn,5) 'res='res
Call show_matrix 'solution'
End
Else
Say 'impossible'
Exit


solve: Procedure Expose g. matrix. posbit. nn box. boxlr. boxlc.
HIGHLightsingles highlights all specified digits (if the grid is shown).
nn=nn+1
A highlighted digits is prefixed and suffixed with a
Call dbg 'solve nn='format(nn,5)
minus sign (-), or shown in yellow if running on CMS or
do i = 1 to 9
with PC/REXX. The default is: NOHIGHLIGHTSINGLES
do j = 1 to 9
if matrix.i.j=posbit.0 Then
Leave i
End
End
If i>9 Then Do
do i = 1 to 9
do j = 1 to 9
k = pos('1',matrix.i.j)
Call dbg 'sudoku',
Format(nn,9) Format(i,9) Format(j,9) Format(k,9)
matrix.i.j=posbit.0
result_=neg(or(any_col(i),any_row(j),any_box(i,j)))
If substr(result_,k,1)=0 Then
Return 0
matrix.i.j=posbit.k
End
End
Return 1
End
Else Do
result_=neg(or(any_col(i),any_row(j),any_box(i,j)))
Call dbg 'resulta='result_
k=0;
do Until k=0
Call dbg 'resultb='result_
k=pos('1',result_,k+1)
Call dbg 'k='Format(k,2)Format(i,2)Format(j,2)
if k>0 then Do;
matrix.i.j=posbit.k
Call dbg 'setting matrix('i','j')->'k
res=solve()
Call dbg 'A nn='format(nn,5) 'res='res
if res then
return 1
else Do;
matrix.i.j=posbit.0
Call dbg 'setting matrix('i','j')->'0
End;
end;
end;
return 0
end;


set_geometry:
NOHIGHLightsingles doesn't highlight specified digits (if the grid is
box.=''
shown). The default is: NOHIGHLIGHTSINGLES
Do j=1 To 9 /* build the box bounds. */
rr=(((j*3)%10)+1)*3-2 /* compute row lower bound. */
cc=(((j-1)//3)+1)*3-2 /* compute col lower bound. */
boxr.j=rr
boxc.j=cc
Do r=rr To rr+2 /* build boxes with cell #s. */
Do c=cc To cc+2
box.r.c=j
End
End
End /* j */
rowlb.=10 /* row R, low box number=b. */
collb.=10 /* col R, low box number=b. */
boxlr.=10 /* box B, low row number=r. */
boxlc.=10 /* box B, low col number=c. */


Do r=1 To 9
PUZZle .d..dd..d.......d..dddd.ddd...ddd.dddd.... (for example)
Do c=1 To 9
The character string that follows are the digits to be placed
into the puzzle (going from left to right). row by row. Any
b=box.r.c /* what box is this R,C in ? */
position that has a period (.) is skipped over. The 10th
rowlb.r=min(rowlb.r,b) /* find min box # for row R. */
character would be the start of row 2, the 19th character would
collb.c=min(collb.c,b) /* find min box # for col C. */
be the start of row 3, etc. The character string is considered
boxlr.b=min(boxlr.b,r) /* find min row # for box B. */
to "wrap around", row to row. Up to 81 chars may be specified.
boxlc.b=min(boxlc.b,c) /* find min col # for box B. */
End
End
Return


any_col: Procedure Expose matrix.
COL n .d..dd..d. (for example)
Parse Arg r
D is the column to be specified and must be 1 ───► 9. The
res='000000000'
character string that follows are the digits to be placed in
Do c=1 To 9
that column (going from top to bottom), and any position that
p=pos('1',matrix.r.c)
has a period (.) is skipped over. I.E., to set column 9 (the
If p>0 Then
rightmost column) to blank 3 blank blank 4 7 blank 8, the
res=overlay('1',res,p,1)
following could be specified: col 9 .3..47.8 (the rest of
End
the column is left blank). Up to 9 digits (or chars) may be
Return res
specified. Any number of COL keywords may be specified and
they may be given in any order.


any_row: Procedure Expose matrix.
ROW n ...d..d.dd (for example)
Parse Arg c
D is the row to be specified and must be 1 ───► 9. The
res='000000000'
character string that follows are the digits to be placed in
Do r=1 To 9
that row (going from left to right), and any position that has
p=pos('1',matrix.r.c)
a period (.) is skipped over. I.E., to set row 5 (the
If p>0 Then
middle row) to blank blank 6 9 blank 5 blank 2, the
res=overlay('1',res,p,1)
following could be specified: row 5 ..69.5.2 (the rest
End
of the row is left blank). Up to nine digits (or chars) may
Return res
be specified. Any number of ROW keywords may be specified
and they may be given in any order.


any_box: Procedure Expose matrix. box. boxlr. boxlc.
CELL rc d R is the row to be specified and must be 1 ───► 9,
Parse Arg r,c
C is the col to be specified and must be 1 ───► 9,
b=box.r.c
D is the digit to be placed and must be 1 ───► 9 or "."
res='000000000'
Do r=boxlr.b For 3
Do c=boxlc.b For 3
p=pos('1',matrix.r.c)
If p>0 Then
res=overlay('1',res,p,1)
End
End
Return res


or: Procedure
I.E., to set the 4th cell in the grid (row 1, col 4) to the
res='000000000'
digit 7, the following could be specified: CELL 14 7
Do ia=1 To 3
Any number of CELL keywords my be specified and they may be
a=arg(ia)
in any order.
Do p=1 To 9
If substr(a,p,1)=1 Then
res=overlay('1',res,p,1)
End
End
Return res


neg: Procedure
PRUNEEXCLusives will prune any possible values that are the only value (digit)
Parse Arg s
for a box. If PRUNESINGLE is in effect, than this digit is
res=''
made into a specified digit (solves that cell).
Do p=1 To 9
The default is: NOPRUNEEXCLUSIVES
If substr(s,p,1)=1 Then
res=res'0'
Else
res=res'1'
End
Return res


o: Say arg(1)
PRUNEMATches will prune any possible values that are matched up (two pairs,
Return
three triplets, ...) and then removes them from any other
possible on the same row and/or column. If PRUNESINGLE is
in effect, any possible values that have now become one digit
are made into a specified digit.
The default is: NOPRUNEMATCHES


show_matrix:
PRUNEONLYs will prune any possible values that are the only digit in a
Call o arg(1)
row or column, and then then removes all other digits in that
Do r=1 To 9
cell, and if just a single digit remains, makes it a specified
ol=''
digit (solves that cell). The default is: NOPRUNEONLYS
Do c=1 To 9
m=matrix.r.c
ol=ol||d.m' '
If c//3=0 Then
ol=ol' '
End
Call o ol
If r//3=0 Then
Call o ' '
End
Return


dbg:
PRUNESINGles will prune any possible values that have a single value (one
If debug=1 Then
digit) to be as if it were a specified digit. This is the
Say arg(1)
simplest form of pruning. The default is: NOPRUNESINGles
Return


exit: Say '*ERROR*' arg(1)
PRUNELINEs will prune any possible values that exist in any row or column
</syntaxhighlight>
that can only can exist in a particular row or column in a
box. The default is: NOPRUNELINEs


{{out}}
PRUNEALL will prune all of the above PRUNExxx.
<pre>input from d:\_sudoku\in\sdk001.in
The default is: NOPRUNEALL
4 6 0 0 0 1 0 0 0
0 0 2 0 9 6 0 0 0
0 3 0 0 0 0 0 6 8


0 0 0 0 0 0 0 3 7
SHORTgrid shows a shortened versin of the grid.
0 0 0 6 0 7 0 0 0
The default is: NOSHORTGRID
5 1 0 0 0 0 0 0 0


8 4 0 0 0 0 0 5 0
NOSHORTgrid shows a full versin of the grid.
0 0 0 7 1 0 9 0 0
The default is: NOSHORTGRID
0 0 0 3 0 0 0 2 4


solution
SHOWBOXes bbb when showing POSSibles, only those boxes (BBB...) specified
4 6 5 8 3 1 2 7 9
have their possible digits shown, where B is the box
7 8 2 4 9 6 3 1 5
number(s) and must be 1 ───► 9.
1 3 9 5 7 2 4 6 8
The boxes are numbered left to right, top to bottom, with the
top left-most box is 1, the middle box is 5, and the 1st box in
the middle row is box 4, the 1st box on the last row is box 7.
The default is: all boxes.


6 9 4 1 2 5 8 3 7
SHOWCOLs ccc when showing POSSibles, only those columns (CCC...) specified
3 2 8 6 4 7 5 9 1
have their possible digits shown, where C is the column
5 1 7 9 8 3 6 4 2
number(s) and must be 1 ───► 9.
The columns are numbered left to right.
The default is: all columns


8 4 1 2 6 9 7 5 3
SHOWROWs ccc when showing POSSibles, only those rows (CCC...) specified
2 5 3 7 1 4 9 8 6
have their possible digits shown, where R is the row
9 7 6 3 5 8 1 2 4
number(s) and must be 1 ───► 9.
The rows are numbered top to bottom.
The default is: all rows

SHOWCOMBinations shows the number of combinations of all the possible
values. The default is: NOSHOWCOMBinations

NOSHOWCOMBinations doesn't show the number of combinations of all the
possible values. The default is: NOSHOWCOMBinations

SHOWGrid shows the sudoku puzzle in a grid after the digits are
specified, after computing the possible values (if wanted),
after each pruning (if any). The default is: SHOWGrid

NOSHOWGrid doesn't show the grid. The default is: SHOWGrid

SHOWINFOmation shows various information messages such as screen titles,
action being taken, etc. The default is: SHOWINFOrmation

NOSHOWINFOmation doesn't show the informational messages.
The default is: SHOWINFOrmation

SHOWPOSSibles shows what digits are possible for each empty cell.
The SHOWGrid option must be ON, and the cells shown are
restricted (if given) by SHOWCELL, SHOWCOLs, and SHOWROWs.
The default is: NOSHOWPOSSibles

SHORTgrid shows a shortened versin of the grid.
The default is: NOSHORTGRID

NOSHORTgrid shows a full versin of the grid.
The default is: NOSHORTGRID

SHOWONELINE shows a the puzzle as speiified as line line of:
....dd....d.d.d..d.....d....d.dd...d.....d....d (for example).
Up to 81 characters may be shown, and any trailing periods
aren't shown. The default is: NOSHOWONELINE

+---+
SIMPle uses | | for the boxing characters. The default is: NOSIMPle
+---+

┌───┐
NOSIMPle uses │ │ for the boxing characters. The default is: NOSIMPle
└───┘

tops are any or all of the following $T .X=xxx options.


────────────────────────────────────────────────────────────────────────────────

Some (but not all) of the $T options are: (issue $T ? for more help)

──────── ──────────────────────────────────────────────────────────────────────

.I=nnn indents the messages nnn spaces, the default is 0.

.C=color sets the color of the messages, there is no default.

.H=color sets the highlight color of any parenthesized text, there is
no default.

.F=fff writes the information (in addition to typing it) to the file, fff
there is no default.

Ω
</pre>
</pre>


=== REXX Version 1 Errors ===
=== REXX version 3 ===
This is version 1 (thanks) cut to the essentials, restructured, and modified
The &nbsp; '''$ERR.REX''' &nbsp; (REXX) program is used to issue various formatted error messages from other REXX programs.
<syntaxhighlight lang="rexx">
<br><br>The &nbsp; '''$ERR.REX''' &nbsp; program makes use of the &nbsp; '''$T.REX''' &nbsp; program to issue the error messages in red (if available).
/* REXX ---------------------------------------------------------------
<br><br>The help for the &nbsp; '''$ERR''' &nbsp; REXX program is included here ──► [[$ERR.HEL]].
* program to solve nearly every SUDOKU puzzle
<lang rexx>/*REXX*/ trace off /*turn off all REXX cmd err msgs.*/
* using a number of strategies learned from REXX version 1
parse arg ! /*obtain the original arguments. */
* and one rather efficient algorithm created by me: prunewalt
if !all(arg()) then exit /*if a request for doc, then exit*/
* see solve: for details
if !cms then address '' /*handle ADDRESS for CMS. */
* Tested with Regina and ooRexx
signal on halt /*setup label for HALT condition.*/
* See version 2 for a program that solves every valid SUDOKU
signal on noValue /* " " " NOVALUE " */
*--------------------------------------------------------------------*/
signal on syntax /* " " " SYNTAX " */
Signal on Halt
numeric digits 100 /*what the hell, support big 'uns*/
Signal on Novalue
/*══════list of external commands*/
Signal on Syntax
@ctty = 'CTTY' /*point to the CTTY command.*/
Parse Arg fid debug
@globalv = 'GLOBALV' /* " " " GLOBALV " */
Select
@finis = 'FINIS' /* " " " FINIS " */
When fid='?' Then Do
@subcom = 'SUBCOM' /* " " " SUBCOM " */
Say 'This program solves many (nearly every?) SUDOKU puzzle'
@cpset = 'CP SET' /* " " " CP SET " */
Say 'rexx sudoku file [DEBUG]'
@conwait = 'CONWAIT' /* " " " CONWAIT " */
Say 'Input: file.in'
@cpspool = 'CP SPOOL' /* " " " CP SPOOL " */
Say 'Debug: file.dbg'
@cmstype = 'SET CMSTYPE' /* " " " SET CMSTYPE " */
Say 'Known: file.sol'
Say 'Incomplete solution (if applicable): fileF.in'
Say 'Output: on screen'
Say 'Adapt subroutine get_input if necessary!'
Say 'See version 2 for a brute force program',
'solving EVERY valid SUDOKU'
Exit
End
When fid='' Then Do
Say 'Input file not specified'
Say 'Enter "rexx sudoku ?" for help'
Exit
End
Otherwise
Nop
End


g.=0
if !cms | !dos then @ = '────────' /*use hyphens for dashes in msgs*/
g.0debug=(translate(debug)='DEBUG')
else @ = '--------' /* " minuses " " " " */


parse var !! !! ' ..F=' ftops /*is $ERR to write errors to file*/
Call get_input fid /* get input and set up file names */
if ftops\=='' then ftops='.F='ftops /*Yes, then add to FTOPS var. */
/* Please adapt to your environment */
Numeric Digits 50 /* because of huge # of combinations */
etops=strip(ftops '.C=red .END=1') /*also, add to ETOPS variable. */
g.1=space(!!) /*a version with no extra blanks.*/
pblank='05'x /*use pseudoBlank as "true" blank*/


Call set_geometry
do j=2 to 9 /*process some possible shortcuts*/
k=j-1 /*point to the previous variable.*/
parse var g.k a.k g.j /*get the "G" version (= "all"). */
if a.k==',' then a.k= /*if omitted, then use a null. */
g.k=translate(g.k,,pblank) /*translate to a true blank. */
a.k=translate(a.k,,pblank) /* " " " " " */
aU.k=a.k; upper aU.k /*get an uppercase version of a.k*/
L.k=length(a.k) /*get the length of the a.k var.*/
c.k=comma(a.k) /*add a comma (,) to the number. */
w.k=length(c.k) /*get the length of commatized #.*/
end /*j*/
/* [↓] shortcut versions of a. */
a2=a.2; a3=a.3; a4=a.4; a5=a.5; a6=a.6; a7=a.7; a8=a.8
g3=g.3; g4=g.4; g5=g.5; g6=g.6; g7=g.7; g8=g.8
aa5=a.5
if isNum(aa5) then aa5=abs(aa5) /*if it's a number, use ABS value*/
i=a.1 /*this is the error number. */
errmsgto=
errmsgnt=
xedit=0 /*indicate no XEDIT (so far). */


if !cms then do /*if CMS, then do some housework.*/
Call show_aa 'the puzzle' /* show the grid to screen */
Call build_poss /* build possible values */
@globalv 'SELECT' !fn 'GET ERRMSGTO ERRMSGNT'
g.0todo_init=g.0todo
@finis '* * *'
Call show_poss 'puzzle possibles' /* show 1st possibles */
@cmstype 'RT'
@conwait
@cpspool 'CON TERM'
@cpset' IMSG ON'
@cpset' EMSG ON'
@subcom 'XEDIT'
xedit=\rc & \cmsflag('SUBSET')
ufid=a3 a4 a5
end


if !dos then do /*if COS, then do some housework.*/
Call solve /* now try to solve it */
if \!nt then @ctty 'con' /*Not Windows NT? Use CTTY cmd*/
_=a4
if _\=='' & right(_,1)\=="\" then _=_'\'
ufid=_ || a2"."a3
end


If g.0todo=0 Then Do /* no cell left empty */
i=space(translate(i,,'-'),0) /*remove all minus signs from str*/
if i=='' then call erb 57 /*Is it null? Oops-say message.*/
Call o g.0fid 'puzzle solved.' /* tell it */
Call o left(g.0fid,12) 'puzzle solved.'
Call show_aa 'solved' /* show the solution */
End
Else Do /* some cells couldn't be filled */
Call show_poss 'failed' /* show the possibilities left */
Call o left(g.0fid,12) 'puzzle failed g.0todo='g.0todo
Call show_aa 'failed','.' /* show the partly solved puzzle */
End


Call write_summary
if i=0 then do /*if "error" is zero, show author*/
_= /*start with a clean slate. */
iL=length(i) /*use # of zeroes for more info. */
if iL>1 then _=@'author'@"÷÷÷÷Gerard J. Schildberger"
if iL>2 then _=_ '÷÷phone (701)-242-8238'
if iL>3 then _=_ '÷÷E-mail gerardS@rrt.net'
if iL>5 then _=_ '÷÷9411 West Ridge Road,'
if iL>5 then _=_ '÷÷Hankinson, ND 58041'
atops=strip(ftops '.A=-2 .X=-2 .E=2 .C=yell .J=c .BOX= .KD=÷')
if _\=='' then call $t atops _ /*tell if more than 1 zero*/
exit 0 /*exit with a return code of zero*/
end


Exit
if i==14000 |, /*is this a message for a HALT ? */
i=='14.1' then do /* ··· or in some cases, 14.1 */
htops=strip(ftops '.X=-1 .C=red .J=c .BOX=')
call $t htops 'The REXX program' @ a2 @ "has been halted !"
exit 14000 /* ··· and indicate a HALT cond· */
end


build_poss: Procedure Expose g. s. aa. poss.,
box. boxr. boxc. boxlr. boxlc.
/*---------------------------------------------------------------------
* aa.r.c contains the known digits
* we determine which digits are possible for empty positions
* and put them into poss.r.c
*--------------------------------------------------------------------*/
all='123456789'
Parse Value '' With dr. dc. db. /* initialize strings built here */
poss.=''
Do r=1 To 9
Do c=1 To 9
dr.r=dr.r||aa.r.c /* all digits in row r */
End
End
Do c=1 To 9
Do r=1 To 9
dc.c=dc.c||aa.r.c /* all digits in col c */
End
End
Do b=1 To 9
Do r=boxlr.b For 3
Do c=boxlc.b For 3
db.b=db.b||aa.r.c /* all digits in box b */
End
End
End


g.0tot=0 /* total # of possible digits */
if \isInt(i) then call erb 53,i "error_code" /*Hmmm, an "internal" err*/
oi=i /*keep the original value around.*/
g.0todo=0 /* number of cells to be filled */
xedit= xedit & i>0 /*inside the XEDIT program? */
g.0comb=1 /* # of possible combinations */
i=abs(i) /*use the absolute value of I. */
if i<1400 | i>1499 then call erb 99,oi /*check for a legal range of I. */
k=i-1400 /*from now on, use a shorter I. */
if xedit then address 'XEDIT' "SET MSGM ON LONG" /*allow XEDIT msgs.*/
call sy /*write blank line.*/
call sy "($$$"i") *error*:" /*write a hdr line.*/


Do r=1 To 9
if k==0 then call sy "some commands can't or shouldn't be executed while in" g3
Do c=1 To 9 /* do this for every r.c */
if k==1 then call sy "the" g3 'was previously specified or specified more than once'
b=box.r.c /* the box this cell is in */
if k==2 then call sy "the" a4 "argument can't be" choose("negative",g5)":" a3
If aa.r.c='' Then Do /* cell not yet known */
if k==3 then call sy 'the (disk) filemode' a3 "can't have any read-only extensions" g4
used=compress(dr.r||dc.c||db.b) /* all digits already used */
if k==4 then call sy 'the' a4 "filemode/address can't be" choose('RELEASEd',g5)":" a3
poss.r.c=diff(all,used) /* all others are still possible */
if k==5 then do
call sy "illegal compator operator" @ a3 'specified,'
g.0todo=g.0todo+1 /* number of cells yet to fill */
g.0tot=g.0tot+length(poss.r.c)
call sy "it must be one of: = \= < <= > >= \< \>"
g.0comb=g.0comb*length(poss.r.c)
end
End
if k==6 then call sy "no special characters are allowed in the" g4':' a3
End
if k==7 then call sy "fixed-point underflow or overflow (result is too small or too large)"
End
if k==8 then call sy "illegal filemode" @ a3 @ g4
If g.0sol<>'' Then /* if we know the solution */
if k==9 then call sy "a terminal screen (CRT) is required with the" @ a3 @ 'feature'
Call check_all /* check if everything fits */
if k==10 then if a3=='' then call sy "missing fileid for" g4
Return
else call sy "illegal fileid" @ space(a3 a4 a5) @ g6
if k==11 then call sy "comparand operand must be an = or \= when using *xxx* type comparisons"
if k==12 then call sy "not enough" choose('virtual storage',g4)", at least" a3 'are needed'
if k==13 then do
call sy "REXX syntax error"
if isInt(a.6) then call sy errortext(a.6)
call syline
end
if k==14 then call sy 'the' a5 "argument" a3 "can't be" choose('greater',a.7) "than" a6 a4
if k==15 then do
if a3=='' then call sy "division by zero"
else do
call sy 'raising a negative number' @ a3 @
call sy "to a negative or an odd fractional power" @ a4 @
call fto g5
end
end
if k==16 then do
call sy "illegal MDISK" g4 'address:' a3","
call sy 'it must be exactly three hexadecimal characters (but not 000), or it may be'
call sy "preceeded by an asterisk (*) followed by three decimal characters"
end
if k==17 then do
call sy "undefined REXX variable referenced" a.6
call syline
end
if k==18 then do
call sy "illegal MDISK address or filemode,"
call sy "the 191 A MDISK address is reserved for the CMS user's private MDISK"
end
if k==19 then call sy 'numeric digits ('comma(a6)") isn't sufficient to" a4 a5 'to' a3
if k==20 then call sy "the" a3 @ a4 'and' g5 @ "aren't alike"
if k==21 then call sy choose("increment",a3) 'must be preceeded by a plus (+) or a minus (-)'
if k==22 then do
_='combination of characters:'
if L.4==1 then _="character:"
call sy a3 'contains an invalid' _ g4
end
if k==23 then call sy "the" a3 choose("option",a5) "requires the" a4 choose('option or feature',g6)
if k==24 then call sy "illegal" choose('volume',a4) "serial:" a3 ' (it must be six or less characters)'
if k==25 then do
call sy "you must be in the" a3 'mode/program to use the'
call sy "specified command (or it's" g4 "option)"
end
if k==26 then do
call sy "illegal MDISK" g4 'address:' a3","
call sy 'it must be exactly three hexadecimal characters (but not 000)'
end
if k==27 then call sy choose('number',g4) "can't be negative or zero (must be positive):" a3
if k==28 then call sy "duplicate" a3 'defined or specified:' g4
if k==29 then call sy "illegal filemode:" a3', it must be one character'
if k==30 then do
call say30
if a5==a6 | a6=='' | a6=="," then call sy "it must be" space(aa5 g8 _b)
else do
_to='to'
if a6==aa5+1 then _to="or"
call sy 'it must be from' aa5 _to a6 _b
end
end
if k==31 then call sy "no lines (or incorrect lines) were put in the program stack" g3
if k==32 then call sy 'the command' a3 "exited, but it isn't supposed to exit or stop"
if k==33 then call sy 'the' a3 "MDISK isn't a CMS MDISK, it's in the wrong format"
if k==34 then call sy @ a3 a4 @ "can't be executed from the" a5 'MDISK'
if k==35 then do
call sy "no" choose('argument',a4) 'was specified after or'
call fto a3 g5
end
if k==36 then call sy 'file' @ g3 @ "can't exist on the" a5 'MDISK'
if k==37 then do
y=a3
_=pos(a3,'''"`{[(«')
if _\==0 then y=translate(word('single_quote double_quote grave_accent left_brace left_bracket left_parenthesis left_double_carrot',_),,"_") a3
call sy 'unmatched' y g4
end
if k==38 then call sy 'file' @ space(a3 a4 a5) @ choose("can't be located or is empty",g6)
if k==39 then call sy "the" a3 choose('argument',a8) 'must be' a4 a5 "the" a6 choose('argument',a7)
if k==40 then do
call sy 'argument' @ a3 @ "isn't a valid hexadecimal string/number"
call sy "(it contains a character other than 0123456789ABCDEFabcdef or a blank)"
call fto g4
end
if k==41 then do
call sy "VM userid" @ g3 @ "doesn't exist or"
call sy 'is illegal (it may have an illegal character in it)'
end
if k==42 then call sy "the MDISK" a4 'for the user' a3 "doesn't exist"
if k==43 then call sy "illegal password for the" a3 a5 'MDISK was specified'
if k==44 then do
call sy "a CMS command is being used out of context, or"
call sy 'a command was renamed, or the FSTs have been altered'
_='DOS'
if !cms then _="CMS";call sy '(you may have to IPL' _")"
end
if k==45 then call sy 'VM userid' @ g3 @ "isn't logged on"
if k==46 then call sy "the file's" @ g4 "LRECL can't exceed" a3
if k==47 then call sy a3 @ a4 @ "not found" g5
if k==48 then do
_=
L=1
if L.4==1 | right(aU.4,1)=='X' then _=" an"
if _=='' then L=0
call sy @ a3 g5 @ 'contains'_ "invalid character"s(L)':' a4
end
if k==49 then call sy "CP LINK error for MDISK" a4 'userid' a3
if k==50 then do
call sy 'illegal/invalid' a3 "specified" @ a4 @
call fto g5
end
if k==51 then call sy choose("documentation",a5) 'for' a3 a4 "couldn't be located"
if k==52 then do
call sy "arguments aren't permitted"
call fto a4
end
if k==53 then do
call sy 'argument' @ a3 @ "isn't numeric" g5
call fto a4
end
if k==54 then do
call sy "not enough" choose('arguments',a3) "were specified" g5
call fto a4
end
if k==55 then do
call sy "illegal argument" @ a3 @ g5
call fto a4
end
if k==56 then call sy "illegal number of" choose('arguments',a4) "were specified" g5 a3
if k==57 then do
y=choose("arguments",a3)
z='was'
if translate(right(y,1))=="S" then z='were'
call sy "no" y z "specified"
end
if k==58 then call sy "only" g3 'argument's(a3) 'are accepted'
if k==59 then do
call sy "too many" choose('arguments',a3) "were specified" g5
call fto a4
end
if k==60 then call sy "argument#" a4 @ a3 @ 'must be an * or numeric'
if k==61 then call sy "conflicting arguments:" g3
if k==62 then call sy choose('fileid1',a3) "and" choose('fileid2',a4) "can't be identical" g5
if k==63 then do
call sy "no" 'argument was specified after or'
call fto g3
end
if k==64 then call sy "up to" g3 'argument's(a3) 'are accepted'
if k==65 then call sy "bad argument" @ a3 @ "illegal use of" g4
if k==66 then call sy "only" a3 'to' a4 "arguments are accepted"
if k==67 then call sy "unable to parse" a3 'from the results of:' g4
if k==68 then do
call sy "return code" a3 'doing:'
call sy g4
i=a3
end
if k==69 then call sy 'user' @ a3 @ "can't be logged on while the command" @ a2 @ 'is running'
if k==70 then do
if a3==2 then call sy "the" @ a2 @ 'command must be executed under the' a4 "userid"
if a3==1 then call sy "the" @ a2 @ "command must be executed from the A MDISK"
call sy "illegal use of the" @ a2 @ "command, subrc="a3
end
if k==71 then call sy "can't attach a" g3
if k==72 then do
call sy 'argument' @ a3 @ "isn't alphabetic" g5
call fto a4
end
if k==73 then do
call sy "an attempt was made to execute an unauthorized or restricted command"
if g3\=='' then call sy g3
end
if k==74 then call sy "the user" @ a3 @ 'must be in' a4 "mode"
if k==75 then call sy "no" choose('write',a4) "access to the" @ choose('A',space(left(a3),1)) @ "MDISK"
if k==76 then call sy a3 g5 "isn't known or supported:" a4
if k==77 then call sy space('error' a3 "in writing to disk file" @ g4 @)
if k==78 then call sy choose("file",g6) @ a3 a4 a5 @ 'not found'
if k==79 then call sy "the time window for execution is" a3 'through' a4
if k==80 then call sy @ a3 @ "isn't a known userid"
if k==81 then do
call sy 'argument' @ a5 space(@ g7) "is out of range"
_=max(w.3,w.4)
if L.3\==0 then call sy 'the lower limit is:' right(c.3,_)
if L.4\==0 then call sy 'the upper limit is:' right(c.4,_)
call fto a6
end
if k==82 then call sy g4 @ a3 @ "can't be located"
if k==83 then call sy "the" @ g3 @ 'option is required'
if k==84 then call sy "file" @ g4 @ 'had a syntax error for' a3
if k==85 then call sy "illegal combination of arguments:" g4
if k==86 then do
call sy "the" choose(a3,a2) 'command is being invoked out of context'
if g4\=='' then call sy g4
end
if k==87 then do
call sy 'argument' @ a3 @ "isn't a valid" choose('bit digit',a4)
call sy '(it contains more than one binary digit)'
call fto g5
end
if k==88 then call sy g4 @ a3 @ "doesn't exist"
if k==89 then call sy 'the' a3 "command can't be found"
if k==90 then do
call sy 'evaluation of' a3 "contains a zero divisor and"
call sy 'the result is infinite' g4
end
if k==91 then do
call sy 'argument' @ a3 @ "isn't a valid" choose('bit string',a4)
call sy '(it contains a non-binary character other than 0 or 1)'
call fto g5
end
if k==92 then do
call sy choose('argument',a4) @ a3 @ "isn't a whole number (integer)" g7
call fto a5
end
if k==93 then call sy "file" @ g3 @ 'already exists'
if k==94 then call sy "the T-DISK requested can't be obtained"
if k==95 then call sy "not enough free storage can be obtained"
if k==96 then call sy "illegal file" @ g3 @ 'or it was incorrectly modified'
if k==97 then do
call sy "a command failed,"
if a3\=='' then call sy "sub-command" @ g3 @','
call sy "it's all or partially restricted to authorized users"
end
if k==98 then do
call sy "an attempt was made to execute the" @ a2 @ 'command while'
call sy "the user" @ userid() @ "was in disconnected mode"
end
if k==99 then call sy "illegal error number for the" !fn 'REXX EXEC' ":" g3
if a2\=='' then call sy "for the" @ a2 @ 'command or function.'
call sy
if errmsgnt\=='' & errmsgto\=='' then call sy "A notification (via $M) of this error has been sent to" errmsgto
if !cms then @globalv 'SELECT' !fn "PURGE"
if \isInt(i) then call er 53,i
exit sign(oi)*i


solve:
/*---------------------------------------------------------------------
* Use several algorithms to determine which cell(s) can safely be set
* prunewalt: if a digit occurs just once
* in a row's, col's or box's list of possible digits
* prunesing: if there is only one possible digit in a cell
* pruneexcl ) Algorithms of version 1 only partly understood (by me!)
* prunemats ) but faithfully restructured to avoid many Iterate
* pruneline ) instructions.
*--------------------------------------------------------------------*/
Call build_poss /* re-build the possibles */
Do g.0pass=1 By 1 Until g.0todo=0
Call o g.0fn 'is starting prune pass #' g.0pass
found_pass=0


found=prunewalt() /* find any singles ? */
/*═════════════════════════════general 1-line subs════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════*/
found_pass=found_pass+found
!all: !!=!;!=space(!);upper !;call !fid;!nt=right(!var('OS'),2)=='NT';!cls=word('CLS VMFCLEAR CLRSCREEN',1+!cms+!tso*2);if arg(1)\==1 then return 0;if wordpos(!,'? ?SAMPLES ?AUTHOR ?FLOW')==0 then return 0;!call=']$H';call '$H' !fn !;!call=;return 1
If g.0todo=0 Then Leave
!cal: if symbol('!CALL')\=="VAR" then !call=; return !call
If found>0 Then
!env: !env='ENVIRONMENT'; if !sys=='MSDOS' | !brexx | !r4 | !roo then !env='SYSTEM'; if !os2 then !env='OS2'!env; !ebcdic=1=='f0'x; if !crx then !env='DOS'; return
Call show_grid 'after prunewalt'
!fid: parse upper source !sys !fun !fid . 1 . . !fn !ft !fm .; call !sys; if !dos then do; _=lastpos('\',!fn); !fm=left(!fn,_); !fn=substr(!fn,_+1); parse var !fn !fn '.' !ft; end; return word(0 !fn !ft !fm,1+('0'arg(1)))
!rex: parse upper version !ver !vernum !verdate .; !brexx='BY'==!vernum; !kexx='KEXX'==!ver; !pcrexx='REXX/PERSONAL'==!ver|'REXX/PC'==!ver; !r4='REXX-R4'==!ver; !regina='REXX-REGINA'==left(!ver,11); !roo='REXX-ROO'==!ver; call !env; return
!sys: !cms=!sys=='CMS'; !os2=!sys=='OS2'; !tso=!sys=='TSO' | !sys=='MVS'; !vse=!sys=='VSE'; !dos=pos('DOS',!sys)\==0 | pos('WIN',!sys)\==0 | !sys=='CMD'; !crx=left(!sys,6)=='DOSCRX'; call !rex; return
!var: call !fid; if !kexx then return space(dosenv(arg(1))); return space(value(arg(1),,!env))
$t: !call=']$T'; call "$T" arg(1); call=; return
choose: parse arg c1,c2; if c2=='' | c2=="," then return c1; return c2
comma: procedure; parse arg _,c,p,t; c=pickBlank(c,","); o=p(p 3); p=abs(o); t=p(t 999999999); if \isInt(p) | \isInt(t) | p==0 | arg()>4 then return _; n=_'.9'; #=123456789; k=0; return comma_()
comma_: if o<0 then do; b=verify(_,' '); if b==0 then return _; e=length(_)-verify(reverse(_),' ')+1; end; else do; b=verify(n,#,"M"); e=verify(n,#'0',,verify(n,#"0.",'M'))-p-1; end; do j=e to b by -p while k<t; _=insert(c,_,j); k=k+1;end;return _
er: parse arg _1,_2; call '$ERR' "14"p(_1) p(word(_1,2) !fid(1)) _2; if _1<0 then return _1; exit result
erb: call sy; if a2\=="" then call sy '('!fn "was invoked by the" @ a2 @ 'EXEC)'; call er arg(1),arg(2)
fto: parse arg fto ftox; ftoo='option'; if right(fto,2)=='()' then ftoo='function'; if fto\=='' then call sy "for the" ftoo @ space(fto ftox) @; return
halt: call er .1
isInt: return datatype(arg(1),'W')
isNum: return datatype(arg(1),'N')
noValue: !sigl=sigl; call er 17,!fid(2) !fid(3) !sigl condition('D') sourceline(!sigl)
opf: if right(arg(1),2)=='()' then return "function"; return 'option'
p: return word(arg(1),1)
pickBlank: procedure; parse arg x,y; arg xu; if xu=='BLANK' then return ' '; return p(x y)
s: if arg(1)==1 then return arg(3); return p(arg(2) 's')
say30: if a5==-1 then call sy 'illegal' a4":" a3; else call sy "illegal length of" a4":" a3; _t=p(a7 'character'); _b=_t || s(p(a6 aa5))" in length"; return
sy: sy=arg(1); if length(sy)<81 then do; call syit sy; return; end; sysy=; do forever while sy\==''; parse var sy _t sy; if length(sysy _t)<80 then do;sysy=sysy _t;iterate;end; call syitb;sysy=_t;end; if strip(sysy)\=='' then call syitb;return
syfunc: if left(a6,1)==']' then do; _sl=g8; call sy "invocation of an undefined REXX function/subroutine" substr(a6,2); end; return
syit: syit=arg(1); if xedit then address 'XEDIT' "EMSG" syit; else if a2=='$T' then say syit; else call $t etops syit; if errmsgto\=='' & syit\=='' then call '$M' errmsgto syit; return
syitb: if left(sysy,1)==' ' then sysy=substr(sysy,2); call syit sysy; return
syline: if a5\==0 then call sy 'on line' a5 "of" ufid; _sl=g7; call syfunc; if _sl\=='' then do; call sy; call sy "REXX sourceline is:"; call sy; call sy _sl; call sy; end; if !cms then do;'EXECSTAT' a2 a3;if rc==0 then "EXECDROP" a2 a3;end;return
syntax: !sigl=sigl; call er 13,!fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl)</lang>


found=prunesing() /* find any singles ? */
=== REXX Version 1 Messages ===
found_pass=found_pass+found
This is the &nbsp; '''$SUDOKU.REX''' &nbsp; (REXX) program and is used to solve the Rosetta Code task of "sudoku".
If g.0todo=0 Then Leave
<br><br>This REXX program was originally written to assist in sudoku puzzle solving (by giving strong hints), and not to solve the puzzle outright.
If found>0 Then
<br>The REXX program was written to give increasing better hints and also show the possibilities (of what is possible solution for any cell),
Call show_grid 'after prunesing'
<br>and to partially solve the puzzle using distinct strategies (separately or in combination). &nbsp; One option is to solve the puzzle.
<br><br>The help for the &nbsp; '''$SUDOKU''' &nbsp; REXX program is included here ──► [[$SUDOKU.HEL]].
<br>The &nbsp; '''$SUDOKU.REX''' &nbsp; REXX program makes use of &nbsp; '''$ERR.REX''' &nbsp; REXX program which is used to display error messages (via &nbsp; '''$T.REX''').
<br>The &nbsp; '''$ERR.REX''' &nbsp; REXX program is included here ──► [[$ERR.REX]].
<br>The &nbsp; '''$SUDOKU.REX''' &nbsp; REXX program makes use of &nbsp; '''$T.REX''' &nbsp; REXX program which is used to display text messages.
<br>The &nbsp; '''$T.REX''' &nbsp; REXX program is included here ──► [[$T.REX]].
<br>Some older REXXes don't have a &nbsp; '''changestr''' &nbsp; BIF, so one is included here ──► [[CHANGESTR.REX]].
<br>REXX programs not included are &nbsp; '''$H''' &nbsp; which shows '''help''' and other documentation.
<lang rexx>/*REXX program displays, can give hints, and/or solve a sudoku puzzle. */
trace off
parse arg !
if !all(arg()) then exit
if !cms then address ''
signal on halt
signal on noValue
signal on syntax


ops=! /*remove extraneous blanks.*/
found=pruneexcl() /* find any excluives ? */
found_pass=found_pass+found
numeric digits 20
If g.0todo=0 Then Leave
combos=1
If found>0 Then
@.=' ' /*initialize grid to blanks*/
Call show_grid 'after pruneexcl'
!.= /*nullify valid empty# list*/
@abc='abcdefghijklmnopqrstuvwxyz'
@abcU=@abc
upper @abcU
colors=!cms | !pcrexx | !r4 | !roo /*Are colors supported ? */
clear=1 /*option: clear the screen.*/
highLight=0 /*option: highlight singles*/
pruneall=0 /*option: prune all. */
prunemats=0 /*option: prune matches. */
prunesing=0 /*option: prune singles. */
pruneexcl=0 /*option: prune exclusives.*/
pruneline=0 /*option: prune lines. */
pruneonly=0 /*option: prune onlys. */
simple=0 /*option: show simple boxes*/
showoneline=0 /*option: show grid as1line*/
showgrid=1 /*option: show the grid. */
showinfo=1 /*option: show informatiion*/
showposs=0 /*option: show possible val*/
showcomb=0 /*option: show combinations*/
showrow= /*option: SHOWPOSS for rowN*/
showcol= /*option: SHOWPOSS for colN*/
showbox= /*option: SHOWPOSS for boxN*/
showcell= /*option: SHOWPOSS cellRC */
short=0
solve=0 /*option: solve the puzzle.*/
sod=lower(translate(!fn,,'$')) /*name of the puzzle. */
tellinvalid=1 /*tell err msg if invalid X*/
tops= /*option: used for $T opts.*/


gridindents=3 /*# spaces grid is indented*/
found=prunemats(2) /* find any matches (len=2) */
found_pass=found_pass+found
gridindent=left('',gridindents) /*spaces indented for grid.*/
If g.0todo=0 Then Leave
gridwidth=7 /*grid cell interior width.*/
If found>0 Then
gridbar='b3'x /*bar for the grid (cells).*/
Call show_grid 'after prunemats'
gridlt='da'x /*grid cell left top. */
gridrt='bf'x /*grid cell right top. */
gridlb='c0'x /*grid cell left bottom. */
gridrb='d9'x /*grid cell right bottom. */
gridline='c4'x /*grid cell line (hyphen). */
gridlin=copies(gridline,gridwidth) /*grid cell total line. */
gridemp=left('',gridwidth) /*grid cell empty (spaces).*/
griddj='c2'x /*grid cell down junction.*/
griduj='c1'x /*grid cell up junction.*/
gridlj='c3'x /*grid cell left junction.*/
gridrj='b4'x /*grid cell right junction.*/
gridcross='c5'x /*grid cell cross junction.*/


do while ops\=='' /*parse any and all options*/
found=pruneline() /* find 2 or more on a line? */
found_pass=found_pass+found
parse var ops _1 2 1 _ . 1 _o ops
If g.0todo=0 Then Leave
upper _
If found>0 Then
Call show_grid 'after pruneline'


If found_pass>0 Then Do
select
Call o found_pass 'hits in g.0pass' g.0pass
when _==',' then nop
If g.0debug Then
when _1=='.' & pos("=",_)\==0 then tops=tops _o
Call write_summary
End
Else Do
Call o 'Nothing found in g.0pass' g.0pass
Leave
End
End /* prunes */
Return


prunewalt: Call o '>>>>>> prunewalt tot='g.0tot 'todo='g.0todo
when abb('PUZzle') then /*do PUZZ (whole) placement*/
/*---------------------------------------------------------------------
do
* find digits that have only one occurrence in a row or column
puzz=na()
* row_poss.r digits in row r
if length(puzz)>81 then call er 30,puzz 'PUZZLE 1───►81'
* col_poss.c digits in column c
* box_poss.b digits in box b
*--------------------------------------------------------------------*/
foundwalt=0 /* no matches found so far. */
Do Until changed=0 /* keep searching ... */
changed=0 /* changes made in this routine */
row_poss.='' /* build str for each row */
col_poss.='' /* build str for each column */
box_poss.='' /* build str for each box */


Do r=1 To 9
do j=1 for length(puzz)
Do c=1 To 9
q=substr(puzz,j,1)
b=box.r.c
if q=='.' then iterate
If poss.r.c\=='' Then Do
call vern q,'PUZZLE_digit'
c=j//9
row_poss.r=row_poss.r poss.r.c
if c==0 then c=9
col_poss.c=col_poss.c poss.r.c
r=(j-1)%9 + 1
box_poss.b=box_poss.b poss.r.c
@.r.c=q
End
end /*j*/
End
end
End
rl=''
Do r=1 To 9
ol='row'r':'
Do d=1 To 9
cnt=count(d,row_poss.r)
ol=ol cnt
If cnt=1 Then Do
rl=rl r
dr.r=d
End
End
End
cl=''
Do c=1 To 9
ol='col'c':'
Do d=1 To 9
cnt=count(d,col_poss.c)
ol=ol cnt
If cnt=1 Then Do
dc.c=d
cl=cl c
End
End
End


bl=''
when _=='CELL' then /*do CELL (grid) placement.*/
do
Do b=1 To 9
rc=nai()
ol='box'||b':'
Do d=1 To 9
if length(rc)\==2 then call er 30,y 'CELL'rc 2
y=na()
cnt=count(d,box_poss.b)
ol=ol cnt
if length(y)>1 then call er 30,y 'CELL'rc 1
r=left(rc,1)
If cnt=1 Then Do
c=right(rc,1)
z=r'.'c
call vern r,'CELLrow'
db.z=d
call vern c,'CELLcolumn'
bl=bl z
call vern y,'CELLdigit'
End
@.r.c=y
End
end
End


Do While rl<>''
when abb('COLumn') then /*do ROW (grid) placement. */
do
Parse Var rl r rl
n=nai()
Do c=1 To 9
y=na()
If pos(dr.r,poss.r.c)>0 Then Do
call vern n,'column'
Call set_aa r,c,dr.r,'prunewalt new R'
ly=length(y)
changed=changed+1
foundwalt=foundwalt+1
if ly>9 then call er 30,y 'column'n '1───>9'
Call build_poss /* re-build the possibles */
End
End
End
Do While cl<>''
Parse Var cl c cl
Do r=1 To 9
If pos(dc.c,poss.r.c)>0 Then Do
Call set_aa r,c,dc.c,'prunewalt new C'
changed=changed+1
foundwalt=foundwalt+1
Call build_poss /* re-build the possibles */
End
End
End
Do While bl<>''
Parse Var bl z cb bl
Parse Var z rb '.' cb
Do r=boxlr.b For 3
Do c=boxlc.b For 3
If r=rb &,
c=cb &,
pos(db.z,poss.r.c)>0 Then Do
Say 'z='r 'c='c 'poss.'r'.'c'='poss.r.c 'db.b='db.b
Call set_aa r,c,db.b,'prunewalt new B'
changed=changed+1
foundwalt=foundwalt+1
Call build_poss /* re-build the possibles */
End
End
End
End
End
Call show_poss 'after prunewalt'


If foundwalt>0 Then
do j=1 for ly
Call o '>>>>>> prunewalt foundwalt='foundwalt
x=substr(y,j,1)
Else
if x=='' | x=="_" | x=='*' | x=="." then iterate
Call o '>>>>>> prunewalt found nothing'
if \isInt(x) then call er 92,x 'cell_for_column'n
g.0foundwalt=g.0foundwalt+foundwalt
@.j.n=x
Return foundwalt
end /*j*/
end


prunesing: Call o '>>>>>> prunesing tot='g.0tot 'todo='g.0todo
when abb('ROW') then /*do ROW (grid) placement. */
/*---------------------------------------------------------------------
do
* look if there are cells with a single possible digit and put these
n=nai()
* into the grid. Return the number of changes made.
y=na()
*--------------------------------------------------------------------*/
call vern n,'row'
foundsing=0
ly=length(y)
Do r=1 To 9
if ly>9 then call er 30,y 'row'n '1───>9'
Do c=1 To 9
If length(poss.r.c)=1 Then Do /* only possible digit */
Call set_aa r,c,poss.r.c,'prunesing' /* put it into the cell */
foundsing=foundsing+1 /* indicate success */
End
End
End
If foundsing>0 Then Do
Call build_poss /* re-build the possibles */
Call o '>>>>>> prunesing foundsing='foundsing
End
Else
Call o '>>>>>> prunesing found nothing'
g.0foundsing=g.0foundsing+foundsing
Return foundsing


pruneexcl: Call o '>>>>>> pruneexcl tot='g.0tot 'todo='g.0todo
do j=1 for ly
/*---------------------------------------------------------------------
x=substr(y,j,1)
*
if x=='' | x=="_" | x=='*' | x=="." then iterate
*--------------------------------------------------------------------*/
if \isInt(x) then call er 92,x 'cell_for_row_'n
foundexcl=0
@.n.j=x
end /*j*/
Do exclusives=1 /* keep building possibles. */
end
Do r=1 For 9
Do c=1 For 9
z=poss.r.c
lz=length(z) /* get length of possible. */
If lz>0 Then Do
y=''
b=box.r.c
Do br=boxr.b For 3
Do bc=boxc.b For 3 /* for every cell in box b */
If br'.'bc<>r'.'c Then
y=y||aa.br.bc||poss.br.bc
End
End
Do t=1 For lz
q=substr(z,t,1)
If pos(q,y)==0 Then Do
foundexcl=foundexcl+1
If aa.r.c=q Then
Call o 'pruneexcl ??? aa.'r'.'c'='q 'already set'
Call o 'foundexcl='foundexcl
Call set_aa r,c,q,'pruneexcl' /* a singularity, a sol */
Call o 'pruneexcl found the digit' q,
'by exclusiveness at cell' drc(r,c,z)
Call build_poss /* re-build the possibles */
Iterate exclusives
End
End
End
End
End
Leave
End
If foundexcl>0 Then Do
Call o '>>>>>> pruneexcl foundexcl='foundexcl
End
Else
Call o '>>>>>> prunesing found nothing'
g.0foundexcl=g.0foundexcl+foundexcl
Return foundexcl


prunemats: Call o '>>>>>> prunemats tot='g.0tot 'todo='g.0todo
when abbn('CLearscreen') then clear=no()
/*---------------------------------------------------------------------
when abbn('HIGHLightsingles') then highLight=no()
* This example illustrates the working of this strategy:
when abbn('PRUNEALL') then pruneall=no()
* Column 1 2 3 4 5 6 7 8 9
when abbn('PRUNEONLYs') then pruneonly=no()
* Row 7: . . 1369 29 26 29 137 . 136
when abbn('PRUNEEXclusives') then pruneexcl=no()
* remove 29 from drc 7.3=1369 giving drc 7.3=136 (matches 7.4 7.6)
when abbn('PRUNELINEs') then pruneline=no()
* Row 7: . . 136 29 26 29 137 . 136
when abbn('PRUNEMATches') then prunemats=no()
* remove 29 from drc 7.5=26 giving drc 7.5=6 (matches 7.4 7.6) HIT
when abbn('PRUNESINGles') then prunesing=no()
when abbn('SIMPle') then simple=no()
* Row 7: . . 136 29 6 29 137 . 136
* Row 7: . . 139 29 . 29 137 . 13
when abb('SHOWBOXes')|,
* remove 29 from drc 7.3=139 giving drc 7.3=13 (matches 7.4 7.6)
abb('SHOWBOXs') then showbox=nai()
when abb('SHOWCELLs') then showcell=translate(na(),,',')
* Row 7: . . 13 29 . 29 137 . 13
* remove 13 from drc 7.7=137 giving drc 7.7=7 (matches 7.9 7.3) HIT
when abb('SHOWCOLs') then showcol=nai()
* Row 7: . . 13 29 . 29 7 . 13
when abbn('SHOWCOMBinations') then showcomb=no()
when abbn('SHOWGrid') then showgrid=no()
* Row 7: . . 139 29 . 29 . . 13
*--------------------------------------------------------------------*/
when abbn('SHOWINFOrmation') then showinfo=no()
setmats=0
when abbn('SHOWONELINE') then showoneline=no()
foundmats=0 /* no matches found so far. */
when abbn('SHOWPOSSibles') then showposs=no()
when abb('SHOWROWs') then showrow=nai()
Parse Arg l /* length of match, L=2,pair */
Do matches=1
when abbn('SHortgrid') then short=no()
Do r=1 For 9
when abbn('SOLvepuzzle') then solve=no()
Do c=1 For 9
_=length(poss.r.c) /* get length of possible. */
If _=l Then Do
qq=poss.r.c
m=0 /* count of matches so far. */
mla=r'.'c
Do _c=1 For 9 /* a match in same row? */
If _c<>c &,
qq==poss.r._c Then Do
m=m+1 /* up count if it's a match. */
mla=mla r'.'_c
End
End
If m>0 Then Do
Call o 'AAAA mla='mla
Call show_poss_r r
Do pc=1 For 9 /* remove other possibles. */
old=poss.r.pc /* save the "old" value. */
If old<>qq & old<>'' Then Do
new=diff(old,qq) /* remove mat's digs from X. */
Call o 'AAAA' r'.'pc':'old '-' qq '-->' new
If new<>old Then Do
If length(new)=1 Then tag='HIT'; Else tag=''
Call o 'remove' qq 'from' drc(r,pc,old),
'giving' drc(r,pc,new) '(matches' mla')' tag
poss.r.pc=new /* store new value into old. */
Call show_poss 'AAAA1'
Call show_poss_r r
setmats=setmats+1 /* indicate match was found. */
If length(new)==1 Then Do /*reduce if L=1*/
Call set_aa r,pc,new,'prunemats R' /*store single*/
foundmats=foundmats+1 /* indicate match was found*/
Call build_poss /* re-build the possibles */
Call show_poss 'AAAA2'
Call show_poss_r r
Iterate matches /* start over. */
End
End
End
End
End
m=0
mlb=r'.'c
Do _r=1 For 9
If _r<>r &,
qq==poss._r.c Then Do
m=m+1
mlb=_r'.'c
End
End


otherwise call er 55,_o
If m>0 Then Do
Call o 'BBBB mlb='mlb
end /*select*/
Call show_poss_r r
end /*while ops¬==''*/
Do pr=1 For 9
old=poss.pr.c
If old<>qq & old<>'' Then Do
new=diff(old,qq)
Call o 'BBBB' pr'.'c':'old '-' qq '-->' new
If new<>old Then Do
If length(new)=1 Then tag='HIT'; Else tag=''
Call o 'remove' qq 'from' drc(pr,c,old),
'giving' drc(pr,c,new) '(matches' mlb')' tag
poss.pr.c=new
Call show_poss_r r
Call show_poss 'BBBB1'
setmats=setmats+1
If length(new)==1 Then Do
foundmats=foundmats+1
Call set_aa pr,c,new,'prunemats C'
Call build_poss /* re-build the possibles */
Call show_poss 'BBBB2'
Call show_poss_r r
Iterate matches
End
End
End
End
End
End
End
End
Leave
End


If foundmats>0 Then Do
if solve then pruneall=1 /*if solving, use PRUNEALL.*/
Call o '>>>>>> prunemats foundmats='foundmats
End
Else
Call o '>>>>>> prunesing found nothing'
g.0foundmats=g.0foundmats+foundmats
Return setmats


pruneline: Call o '>>>>>> pruneline tot='g.0tot 'todo='g.0todo
if pruneall then do /*if pruneAll, set ON other*/
/*---------------------------------------------------------------------
pruneexcl=1
*
pruneonly=1
*--------------------------------------------------------------------*/
pruneline=1
Call show_poss ' vor pruneline'
prunemats=1
pruned=0
prunesing=1
end
foundline=0 /* no matches found so far. */
Do Until changes=0 /* terminate if no changes made */
changes=0 /* initialize number of changes */
poss_boxr.='' /* build str for each boxrow */
poss_boxc.='' /* build str for each boxcol */
Do r=1 To 9
Do c=1 To 9
b=box.r.c
If poss.r.c\=='' Then Do
poss_boxr.r.b=strip(poss_boxr.r.b poss.r.c)
poss_boxc.c.b=strip(poss_boxc.c.b poss.r.c)
End
End
End
Do r=1 To 9 /* search all rows for twins */
Do cb=1 To 7 By 3 /* 3 boxes containing row r */
b=box.r.cb
aline=poss_boxr.r.b /* all poss strings: row r box b */
If words(aline)>=2 Then Do /* more than one */
Call o 'aline' r'.'||b'='aline '(cb='cb')'
Do k=1 To 9 /* search for each digit. */
If count(k,aline)>=2 Then Do /* more than one occurrence */
Do jr=rowlb.r For 3 /* look at the other 2 rows. */
If jr<>r &,
pos(k,poss_boxr.jr.b)>0 Then /* digit k found */
Iterate k /* continue with the next digit */
End
Do jb=rowlb.r For 3 /* search boxes of row R for K. */
If jb<>b &,
pos(k,poss_boxr.r.jb)>0 Then Do
Do kc=1 To 9 /* find which cell K is in. */
If box.r.kc<>b Then Do
If poss.r.kc<>'' &,
pos(k,poss.r.kc)>0 Then Do
old=drc(r,kc,poss.r.kc)
row_a=poss_r(r)
poss.r.kc=diff(poss.r.kc,k) /* remove digit k*/
Call o g.0fn 'row' r': removing' k 'from' old,
'resulting in' drc(r,kc,poss.r.kc)
row_b=poss_r(r)
Call o ' ' row_a
Call o '>>' row_b
pruned=pruned+1
If length(poss.r.kc)==1 Then Do
Call set_aa r,kc,poss.r.kc,'pruneline R'
foundline=foundline+1
Call build_poss /* re-build the possibles */
changes=changes+1
End
End
End
End
End
End
End
End
End
End
End


aprune = , /*is there a PRUNExxx on ? */
Do c=1 To 9 /* search all cols for twins */
pruneexcl |,
Do b=collb.c By 3 For 3 /* for each col, search box. */
pruneonly |,
aline=poss_boxc.c.b
pruneline |,
If words(aline)>=2 Then Do
prunemats |,
Do k=1 To 9 /* search for each digit. */
prunesing
If count(k,aline)>=2 Then Do
Do jc=boxlc.b For 3 /* look at the other 2 cols. */
If jc<>c&pos(k,poss_boxc.jc.b)<>0 Then
Iterate k /* if no digit K, ignore */
End /* jc */
/*found 2 Ks in col C box B */
Do jb=collb.c By 3 For 3 /*search boxes col C for K. */
If jb<>b&pos(k,poss_boxc.c.jb)<>0 Then Do
Do kr=1 To 9 /* find which cell K is in. */
If box.kr.c<>b Then Do
If poss.kr.c>''&,
pos(k,poss.kr.c)>0 Then Do
old=drc(kr,c,poss.kr.c)
col_a=poss_c(c)
poss.kr.c=diff(poss.kr.c,k) /* remove digit k*/
Call o g.0fn 'col' c': removing' k 'from' old,
'resulting in' drc(kr,c,poss.kr.c)
col_b=poss_c(c)
Call o ' ' col_a
Call o '>>' col_b
pruned=pruned+1
If length(poss.kr.c)==1 Then Do
Call set_aa kr,c,poss.kr.c,'pruneline C'
foundline=foundline+1
Call build_poss /* re-build the possibles */
changes=changes+1
End
End
End
End
End
End
End
End
End
End
End
End
Call show_poss 'nach pruneline'
If foundline>0 Then
Call o '>>>>>> pruneline new foundline='foundline 'pruned='pruned
Else
Call o '>>>>>> pruneline new found nothing' 'pruned='pruned
g.0foundline=g.0foundline+foundline
Return foundline


show_grid:
if highLight then do /*HIGHLIGHTSINGLES opt on? */
/*---------------------------------------------------------------------
hLl='-'
* show what's known so far
hLr='-'
* and what's still to be done
*--------------------------------------------------------------------*/
Parse Arg title
Call show_aa title
Call show_poss title
Return


show_aa: Procedure Expose g. aa. s.
if colors then do
/*---------------------------------------------------------------------
hLl='('
* Show all cells that are known already
hLr=')'
* and determine the number of cells yet to be filled (g.0todo)
tops='.H=yell' tops
*--------------------------------------------------------------------*/
end
Parse Arg txt
end
blank='.'
Select
When txt='the puzzle' |, /* initial call */
txt='solved' Then /* final call (success) */
g.0say=1 /* show on screen */
When txt='failed' Then Do /* final call (failure) */
g.0say=1 /* show on screen */
g.0fail=1 /* write to incomplete solution */
End
Otherwise
g.0say=0 /* don't show on screen */
End
Call o txt /* write to dbg/screen/inco */
g.0todo=0
Do r=1 To 9 /* for all rows */
ol=''
Do c=1 To 9 /* build a line */
If aa.r.c='' Then Do
g.0todo=g.0todo+1
ol=ol blank
End
Else
ol=ol aa.r.c
If c//3=0 Then /* a blank column */
ol=ol' '
End
Call o ol
If r//3=0 Then /* a blank line */
Call o ' '
End
g.0say=0 /* reset the flags */
g.0fail=0
If g.0todo>0 Then
Call o right('to be done:',40) g.0todo
Else
Call o 'all done'
Return


show_poss: Procedure Expose poss. g. s.
tops=space(tops)
/*---------------------------------------------------------------------
box.=
* show all possible digits of the grid
*--------------------------------------------------------------------*/
Parse Arg txt
If g.0todo=0 Then
Return
Call o copies('-',70) 'todo='g.0todo
Call o txt
Do r=1 To 9
ol=r
Do c=1 To 9
ol=ol left(poss.r.c,7)
If c//3=0 Then
ol=ol '|'
End
Call o ol
If r//3=0 Then
Call o ' '
End
Call o ' tot='g.0tot 'todo='g.0todo
Call o 'combinations:' g.0comb
Return


show_poss_r: Procedure Expose g. poss.
do j=1 for 9 /*build the box bounds. */
/*---------------------------------------------------------------------
rr=(((j*3)%10)+1)*3-2 /*compute row lower bound. */
* show possible digits in row r
cc=(((j-1)//3)+1)*3-2 /*compute col lower bound. */
'--------------------------------------------------------------------*/
boxr.j=rr
Parse Arg r
boxc.j=cc
Call o poss_r(r)
Return


poss_r: Procedure Expose g. poss.
do r=rr to rr+2 /*build boxes with cell #s.*/
/*---------------------------------------------------------------------
do c=cc to cc+2
* compute possible digits in row r
rc=r || c
'--------------------------------------------------------------------*/
box.j=box.j rc
Parse Arg r
box.rc=j
ol='Row' r':'
end /*c*/
Do c=1 To 9
end /*r*/
prc=poss.r.c
If prc='' Then prc='.'
ol=ol left(prc,6)
End
Return ol


show_poss_c: Procedure Expose g. poss.
box.j=strip(box.j)
/*---------------------------------------------------------------------
end /*j*/
* show possible digits in column c
'--------------------------------------------------------------------*/
Parse Arg c
Call o poss_c(c)
Return


poss_c: Procedure Expose g. poss.
rowlb.=10 /*row R, low box number=b.*/
/*---------------------------------------------------------------------
collb.=10 /*col R, low box number=b.*/
* compute possible digits in column c
boxlr.=10 /*box B, low row number=r.*/
'--------------------------------------------------------------------*/
boxlc.=10 /*box B, low col number=c.*/
Parse Arg c
ol='Col' c':'
Do r=1 To 9
prc=poss.r.c
If prc='' Then prc='.'
ol=ol left(prc,6)
End
Return ol


compress: Procedure
do r=1 for 9
/*---------------------------------------------------------------------
do c=1 for 9
* build a string containing the digits found in s
rc=r || c
* Example: compress('11 9 33 55') -> '1359'
b=box.rc /*what box is this R,C in ?*/
*--------------------------------------------------------------------*/
rowlb.r=min(rowlb.r,b) /*find min box # for row R.*/
Parse Arg s
collb.c=min(collb.c,b) /*find min box # for col C.*/
res=''
boxlr.b=min(boxlr.b,r) /*find min row # for box B.*/
Do d=1 To 9
boxlc.b=min(boxlc.b,c) /*find min col # for box B.*/
end /*c*/
If pos(d,s)>0 Then
end /*r*/
res=res||d
End
Return left(res,9)


diff:
do j=1 to 9 /*for each box, row, col...*/
/*---------------------------------------------------------------------
rowhb.j=rowlb.j+2 /*compute row's high box #.*/
* build the 'difference' of two strings (same as squish in version 1)
colhb.j=collb.j+6 /*compute col's high box #.*/
* Return a string of digits contained in arg(1) not existant in arg(2)
boxhr.j=boxlr.j+2 /*compute box's high row #.*/
* Example: diff('13895','35') -> '189'
boxhc.j=boxlc.j+6 /*compute box's high col #.*/
*--------------------------------------------------------------------*/
end /*j*/
Return space(translate(arg(1),,word(arg(2) ',',1)),0)


check_all:
if showgrid then call showgrid 'the puzzle' /*show the grid to screen ?*/
/*---------------------------------------------------------------------
if \validall() then exit /*validate specified digits*/
* check the current status against the target (if this is known)
tellinvalid=0 /*don't tell err messages. */
*--------------------------------------------------------------------*/
!.= /*nullify valid empty# list*/
error=0
call buildposs /*build possible values. */
Do r=1 To 9
if showposs then call showgrid 'puzzle possibles' /*show 1st possibles?*/
Do c=1 To 9
if \validate(1) then exit /*validate the puzzle. */
If aa.r.c=''|aa.r.c=s.r.c Then
Nop
Else Do
Call o 'r='r 'c='c 'soll='s.r.c 'ist='aa.r.c
error=1
End
End
End
Do r=1 To 9
Do c=1 To 9
Select
When poss.r.c='' Then
Nop
When pos(s.r.c,poss.r.c)>0 Then
Nop
Otherwise Do
Call o 'r='r 'c='c aa.r.c 'not in poss:'poss.r.c
error=1
End
End
End
End
If error Then
Call exit 'an error in check_all'
Return


o:
if showoneline then do /*show grid as line line ? */
/*---------------------------------------------------------------------
_= /*start with a clean slate.*/
do r=1 for 9
* write to the debug file (when g.0debug is true)
* and, if applicable, to the screen (when g.0say is true)
do c=1 for 9
* and to the incomplete solution (when g.0fail is true)
_=_ || @.r.c /*build the string ... */
*--------------------------------------------------------------------*/
end /*c*/
If g.0say Then
end /*r*/
Say arg(1)
If g.0fail Then
Call lineout g.0inco,arg(1)
If g.0debug Then
Call lineout g.0dbg,arg(1)
Return


set_aa: Procedure Expose g. aa. poss. box. boxr. boxc. boxlr. boxlc.,
_=translate(strip(_,'T'),".",' ')
if showinfo then call $T 'one-line grid:'
s. sigl
/*---------------------------------------------------------------------
call $T _
* put a digit into the cell r.c and show the text given
end
*--------------------------------------------------------------------*/
Parse Arg r,c,d,text
from=sigl
If s.r.c<>'*' &,
d<>s.r.c Then Do
call o 'Trying t set aa.'r'.'c 'to' d 'but should be' s.r.c
Call o 'from='from
Exit
End


Call o 'setting aa.'r'.'c' to d='d '('text')'
if aprune |,
If g.0done.r.c=1 Then Do
showposs then do
Call o 'cell' r'.'c'='aa.r.c '>' d '?????' 'called_from='sigl,
call pruneposs /*go build poss, then prune*/
if showposs then call showgrid 'possibles' /*show grid.*/
'in pass' g.0pass
End
if \validate(1) then exit /*validate the puzzle. */
end
aa.r.c=d /* put the digit into the cell */
poss.r.c='' /* remove cell's possible digits */
g.0done.r.c=1 /* note that cell was set */
Return


count: Procedure
if combos==1 then call $t sod 'puzzle solved.'
/*---------------------------------------------------------------------
else if showcomb then call $t 'combinations='comma(combos)
* Return the number of occurrences of d in s (all digits)
exit /*stick a fork in it, we're done.*/
* Example: count(3,'123 567 399 13') -> 3
*--------------------------------------------------------------------*/
Parse Arg d,s
s=translate(s,'*',d)
s=translate(s,'','123456789')
s=space(s,0)
Return length(s)


drc: Procedure
/*─────────────────────────────vern subroutine──────────────────────────*/
/*---------------------------------------------------------------------
vern: parse arg v,w /*verify a digit for an opt*/
* return coordinates and contents of a cell as r.c=string
if v=='' then call er 35,v w
*--------------------------------------------------------------------*/
if \isInt(v) then call er 92,v w
Parse Arg r,c,s
if v<1 | v>9 then call er 81,1 9 v w
Return 'drc' r'.'c'='s
return


set_geometry:
/*─────────────────────────────buildposs subroutine─────────────────────*/
/*---------------------------------------------------------------------
buildposs: !.= /*nullify possibilities. */
* set miscellaneous relations and limits
combos=1
*--------------------------------------------------------------------*/
box.=''
Do b=1 For 9 /* build the box bounds. */
rr=(((b*3)%10)+1)*3-2 /* compute row lower bound. */
cc=(((b-1)//3)+1)*3-2 /* compute col lower bound. */
boxr.b=rr
boxc.b=cc
Do r=rr To rr+2 /* build boxes with cell #s. */
Do c=cc To cc+2
rc=r||c
box.b=box.b rc
box.r.c=b
End
End
box.b=strip(box.b)
End


do rp=1 for 9 /*build table of valid #s. */
rowlb.=9 /* row R, low box number=b. */
do cp=1 for 9 /*step through each column.*/
collb.=9 /* col R, low box number=b. */
if @.rp.cp\==' ' then iterate /*not blank? Keep looking.*/
boxlr.=9 /* box B, low row number=r. */
boxlc.=9 /* box B, low col number=c. */
Do r=1 To 9
Do c=1 To 9
b=box.r.c /* what box is this R,C in ? */
rowlb.r=min(rowlb.r,b) /* find min box # for row R. */
collb.c=min(collb.c,b) /* find min box # for col C. */
boxlr.b=min(boxlr.b,r) /* find min row # for box B. */
boxlc.b=min(boxlc.b,c) /* find min col # for box B. */
End /* c */
End /* r */
Return


get_input: Procedure Expose g. aa. s.
do jd=1 for 9 /*try each digit. */
/*---------------------------------------------------------------------
@.rp.cp=jd
* get the given puzzle
if validx(rp,cp) then !.rp.cp=!.rp.cp || jd
* 9 rows with 9 columns each containing a digit or a place holder (.x0)
end /*jd*/
* set the miscellaneous file-ids
* and get the known solution (if available) for checking in get_sol
*--------------------------------------------------------------------*/
Parse Arg g.0fid
Parse Var g.0fid g.0fn '.'
If g.0debug Then Do
g.0dbg=g.0fn'.dbg' /* file to contain debug output */
/*********************************
Call lineout g.0dbg
If lines(g.0dbg)>0 Then /* if the file exists */
'erase' g.0dbg /* erase it */
*********************************/
End
If pos('.',g.0fid)=0 Then
g.0fid=g.0fid'.in'
digits='123456789'
g.0fidx=g.0fid
Say 'process file' g.0fidx
If lines(g.0fidx)=0 Then
Call exit 'Input file does not exist'
instr=''
Do While lines(g.0fidx)>0
instr=instr linein(g.0fidx)
End
Call lineout g.0fidx
instr=translate(instr,digits'000',digits'.x0'||xrange('00'x,'ff'x))
instr=space(instr,0)
Select
When length(instr)<81 Then Do
Say 'instr='instr'<'
Call exit 'Incorrect input - not enough data'
End
When length(instr)>81 Then Do
Say 'instr='instr'<'
Call exit 'Incorrect input - too much data'
End
Otherwise Do
Call o ' instr='instr'<'
instr=translate(instr,' ','0')
End
End
Do r=1 To 9
Do c=1 To 9
Parse Var instr aa.r.c +1 instr
End
End
g.0inco=g.0fn'f.in' /* file to contain failed res */
if lines(g.0inco)>0 Then /* if the file exists */
'erase' g.0inco /* erase it */
g.0summ='sudoku.summary' /* file to get statistics */
g.0sol= 'sol\'g.0fn'.sol' /* known solution for checking */
If lines(g.0sol)>0 Then /* if that file is found */
Call get_sol /* get its data */
Else Do /* otherwise */
g.0sol='' /* don't check */
s.='*'
End
Say 'Input from ' g.0fidx
Say 'Debug output to ' g.0dbg
If lines(g.0sol)>0 Then /* if that file is found */
Say 'Given solution from' g.0sol
Say 'Statistics to ' g.0summ
Say 'Incomplete solution' g.0inco '(if applicable)'
Say 'Hit enter to proceed'
Return


get_sol: Procedure Expose g. s.
combos=combos*length(!.rp.cp) /*calculate # combinations.*/
/*---------------------------------------------------------------------
@.rp.cp=' ' /*restore the point (blank)*/
* get the known solution
end /*cp*/
* (9 rows with 9 columns each containing a digit)
end /*rp*/
*--------------------------------------------------------------------*/
solvstr=''
If lines(g.0sol)>0 Then Do
Do While lines(g.0sol)>0
solvstr=solvstr linein(g.0sol)
End
Call lineout g.0sol
solvstr=space(solvstr,0)
Call o 'solution='solvstr
Do r=1 To 9
Do c=1 To 9
Parse Var solvstr s.r.c +1 solvstr
End
End
Do r=1 To 9
ol=s.r.1
Do c=2 To 9
ol=ol s.r.c
If c//3=0 Then ol=ol' '
End
Call o ol
If r//3=0 Then
Call o ' '
End
End
Return


exit: Say 'EXIT' arg(1)
return
Exit


write_summary: Procedure Expose g.
/*─────────────────────────────showgrid subroutine──────────────────────*/
/*---------------------------------------------------------------------
showgrid: parse arg title
* add a line to the statistics
if clear then !cls /*clear the screen ? */
* file init walt sing excl mats line todo pass
if title\=='' & showinfo then call $t !fn 'is showing' title
* sdk002.in 56 56 0 0 0 0 0 1
gtail=copies3(gridlb || gridlin || copies2(griduj || gridlin) || gridrb)
* sdk007.in 61 16 0 0 1 5 39 1 <---
ghead=copies3(gridlt || gridlin || copies2(griddj || gridlin) || gridrt)
* sdk007.in 61 55 0 0 1 5 0 2 solved
call tg ghead
* sdk088.in 50 14 2 34 0 0 0 1
gemp=copies3(copies3(gridbar || gridemp)gridbar)
* sdk093.in 55 2 2 1 0 0 50 2 <---
grid=copies3(gridlj || gridlin || copies2(gridcross || gridlin)gridrj)
* sdk093.in 55 2 2 1 0 0 50 2 <--- no success
anyshow= \ ((showcell || showcol || showrow || showbox)\=='')
*--------------------------------------------------------------------*/
If lines(g.0summ)=0 Then /* write header line */
Call lineout g.0summ,,
'file init walt sing excl mats line todo pass'
If g.0todo>0 Then tag='<---' /* mark a failure */
Else tag=''
/* show # of hits for each strategy */
summline=left(g.0fid,10) right(g.0todo_init,4),
right(g.0foundwalt,4),
right(g.0foundsing,4),
right(g.0foundexcl,4),
right(g.0foundline,4),
right(g.0foundmats,4),
right(g.0todo,4),
right(g.0pass,4) tag
/*
Say summline
*/
Call lineout g.0summ,summline
Call lineout g.0summ /* close the file */
Return


novalue:
do jr=1 for 9
Say 'Novalue raised in line' sigl
if \short then call tg gemp
Say sourceline(sigl)
gnum=
Say 'Variable' condition('D')
Signal lookaround


syntax:
do jc=1 for 9
Say 'Syntax raised in line' sigl
_=@.jr.jc
Say sourceline(sigl)
if _\==' ' & highLight then _=hLl || _ || hLr
Say 'rc='rc '('errortext(rc)')'


halt:
if _==' ' & ,
lookaround:
showposs then do
If fore() Then Do
jrjc=jr || jc
Say 'You can look around now.'
showit=anyshow
Trace ?R
if showcell\=='' then if wordpos(jrjc,showcell)\==0 then showit=1
Nop
if showcol\=='' then if pos(jc,showcol)\==0 then showit=1
End
if showrow\=='' then if pos(jr,showrow)\==0 then showit=1
Exit 12
</syntaxhighlight>
{{out}}
<pre>
process file sdk087.in
Input from sdk087.in
Debug output to 0
Given solution from
Statistics to sudoku.summary
Incomplete solution sdk087f.in (if applicable)
Hit enter to proceed
the puzzle
. . . . . . 3 . .
. . . . 7 1 5 . .
. . 2 4 . 6 . 1 8


. . . . . 9 . 4 6
do jb=1 while showbox\==''
. 9 . 6 1 8 . 3 .
b=substr(showbox,jb,1)
6 1 . 7 . . . . 9
if b==' ' then leave
if wordpos(jrjc,box.b)\==0 then showit=1
end /*jb*/


4 3 . 8 . 7 6 . .
if showit then _=strip(left(!.jr.jc,gridwidth),'T')
end
. . 8 1 4 . . . .
. . 9 . . . . . .


solved
gnum=gnum || gridbar || centre(_,gridwidth)
if jc//3==0 then gnum=gnum || gridbar
7 4 1 9 8 5 3 6 2
end /*jc*/
3 8 6 2 7 1 5 9 4
9 5 2 4 3 6 7 1 8


8 2 7 3 5 9 1 4 6
call tg gnum
if \short then call tg gemp
5 9 4 6 1 8 2 3 7
6 1 3 7 2 4 8 5 9


4 3 5 8 9 7 6 2 1
if jr//3==0 then do
call tg gtail
2 6 8 1 4 3 9 7 5
1 7 9 5 6 2 4 8 3
if jr\==9 then call tg ghead
</pre>
end
else call tg grid
end /*jr*/

call $t
return

/*─────────────────────────────validate subroutine──────────────────────*/
validate: /*are all empties possible?*/

do r=1 for 9 /*step through each row. */
do c=1 for 9 /*step through each column.*/

if @.r.c==' ' & ,
!.r.c=='' then do /*no legal digit here. */
if arg(1)==1 then call $t sod "puzzle isn't valid !"
return 0
end
end /*c*/
end /*r*/ /*sub requires possibles. */

return 1 /*indicate puzzle is valid.*/

/*─────────────────────────────validall subroutine──────────────────────*/
validall: /*validate all Q specified.*/

do r=1 for 9 /*step through each row. */
do c=1 for 9 /*step through each column.*/
if @.r.c==' ' then iterate /*if blank, then it's ok. */
y= /*the rest of the row. */
rc=r||c
do kc=1 for 9 /*compare to #s in column. */
if kc\==c then y=y|| @.r.kc /*build the rest of the row*/
end /*kc*/
q=@.r.c
if pos(q,y)\==0 then return tem(r,c,'row') /*same # in same row?*/
y= /*the rest of the column. */
do kr=1 for 9 /*compare to #s in column. */
if kr\==r then y=y || @.kr.c /*build the rest of the col*/
end /*kr*/

if pos(q,y)\==0 then return tem(r,c,'col') /*same # in same col?*/
y= /*the rest of the box. */
b=box.rc

do br=boxr.b to boxr.b+2 /*compare to #s of the box.*/
do bc=boxc.b to boxc.b+2 /*build the rest of the box*/
if br\==r & bc\==c then y=y || @.br.bc
end /*bc*/
end /*br*/

if pos(q,y)\==0 then return tem(r,c,'box') /*same # in same box?*/
end /*c*/
end /*r*/

return 1 /*indicate all are valid.*/

/*─────────────────────────────validx subroutine────────────────────────*/
validx: arg r,c
rc=r || c
y= /*the rest of the row. */
do kc=1 for 9 /*compare to #s in column. */
if kc\==c then y=y || @.r.kc /*build the rest of the row*/
end /*kc*/

q=@.r.c /*get the digit at r,c */
if pos(q,y)\==0 then return tem(r,c,'row') /*same number in same row ?*/
y= /*the rest of the column. */
do kr=1 for 9 /*compare to #s in column. */
if kr\==r then y=y || @.kr.c /*build the rest of the col*/
end /*kr*/

if pos(q,y)\==0 then return tem(r,c,'col') /*same # in same column ?*/
y= /*the rest of the box. */
b=box.rc

do br=boxr.b to boxr.b+2 /*compare to #s of the box.*/
do bc=boxc.b to boxc.b+2 /*build the rest of the box*/
if br==r & bc==c then iterate
y=y || @.br.bc
end /*br*/
end /*bc*/

if pos(q,y)\==0 then return tem(r,c,'box') /*same # in same box ? */
return 1 /*indicate X (r,c) is valid*/

/*─────────────────────────────pruneposs subroutine─────────────────────*/
pruneposs: if \(prunesing | pruneexcl | prunemats | pruneline) then return
call buildposs

do prunes=1
call $t !fn 'is starting prune pass #' prunes
found=0 /*indicate no prunes so far*/

if prunesing then do /*prune puzzle for singles.*/
_=prunesing() /*find any singles ? */
found=found | _ /*track if anything found. */
if _ then if showgrid then call showgrid /*show grid*/
end

if pruneexcl then do /*prune puzzle for singles.*/
_=pruneexcl() /*find any excluives ? */
found=found | _ /*track if anything found. */
if _ then if showgrid then call showgrid /*show grid*/
end

if pruneonly then do /*prune puzzle for onlys. */
_=pruneonly() /*find any onlys ? */
found=found | _ /*track if anything found. */
if _ then if showgrid then call showgrid /*show grid*/
end

if prunemats then do jpm=2 to 8 /*prune puzzle for matches.*/
_=prunemats(jpm) /*find any matches (len=j)?*/
found=found | _ /*track if anything found. */
if _ then if showgrid then call showgrid /*show grid*/
end

if pruneline then do /*prune puzzle for lines. */
_=pruneline() /*find 2 or more on a line?*/
found=found | _ /*track if anything found. */
if _ then if showgrid then call showgrid /*show grid*/
end

if \found then leave /*nothing found this time ?*/
end /*prunes*/

return

/*─────────────────────────────prunesing subroutine─────────────────────*/
prunesing: foundsing=0

do r=1 for 9
do c=1 for 9
_=length(!.r.c) /*get length of possible. */
if _==0 then iterate /*if null, then ignore it. */
if _\==1 then iterate /*if not one digit, ignore.*/
@.r.c=!.r.c /*it's 1 digit, a solution.*/
!.r.c= /*erase the old possible. */
foundsing=1
call $t !fn 'found a single digit at cell' drc(r,c,@.r.c)
end /*c*/
end /*r*/

if foundsing then call buildposs /*re-build the possibles. */
return foundsing

/*─────────────────────────────pruneexcl subroutine─────────────────────*/
pruneexcl: foundexcl=0

do exclusives=1 /*keep building possibles. */
do r=1 for 9
do c=1 for 9
z=!.r.c
lz=length(z) /*get length of possible. */
if lz==0 then iterate /*if null, then ignore it. */
y=
rc=r || c
b=box.rc

do br=boxr.b to boxr.b+2 /*compare to #s of the box.*/
do bc=boxc.b to boxc.b+2 /*build the rest of the box*/
if br==r & bc==c then iterate
y=y || @.br.bc || !.br.bc
end /*bc*/
end /*br*/

/*test for reduction. */
do t=1 for lz
q=substr(z,t,1)

if pos(q,y)==0 then do
foundexcl=1
@.r.c=q /*it's a singularity, a sol*/
!.r.c= /*erase old possibleity. */
call $t !fn 'found the digit' q,
"by exclusiveness at cell" drc(r,c,z)
call buildposs /*re-build the possibles. */
iterate exclusives
end
end /*t*/
end /*c*/
end /*r*/

leave
end /*exclusives*/

return foundexcl

/*─────────────────────────────prunemats subroutine─────────────────────*/
prunemats: foundmatch=0 /*no matches found so far. */
parse arg L /*length of match, L=2,pair*/

do matches=1
do r=1 for 9
do c=1 for 9
_=length(!.r.c) /*get length of possible. */
if _==0 then iterate /*if null, then ignore it. */
if _\==L then iterate /*not right length, ignore.*/
qq=!.r.c
m=0 /*count of matches so far. */
do _c=1 for 9 /*nother match in same row?*/
if qq==!.r._c then m=m+1 /*up count if it's a match.*/
end /*_c*/

if m>=L then do pc=1 for 9 /*squish other possibles. */
old=!.r.pc /*save the "old" value. */
if old==qq then iterate /*if match, then ignore it.*/
if old=='' then iterate /*if null poss, then ignore*/
new=squish(old,qq) /*remove mat's digs from X.*/
if new==old then iterate /*if no change,keep looking*/
!.r.pc=new /*store new value into old.*/
foundmatch=1 /*indicate match was found.*/
call $t !fn 'is removing a' old "from" drc(r,pc,old),
'because of a match at' drc(r,c,qq)
if length(new)==1 then do /*reduce if L=1*/
@.r.pc=new /*store single.*/
!.r.pc= /*delete poss. */
call buildposs /*re-build poss*/
iterate matches /*start over.*/
end
end /*pc*/
m=0 /*count of matches so far. */

do _r=1 for 9 /*nother match in same col?*/
if qq==!._r.c then m=m+1 /*up count if it's a match.*/
end /*_r*/

if m>=L then do pr=1 for 9 /*squish other possibles. */
old=!.pr.c /*save the "old" value. */
if old==qq then iterate /*if match, then ignore it.*/
if old=='' then iterate /*if null poss, then ignore*/
new=squish(old,qq) /*remove mat's digs from X.*/
if new==old then iterate /*if no change,keep looking*/
!.pr.c=new /*store new value into old.*/
foundmatch=1 /*indicate match was found.*/
call $t !fn 'is removing a' old "from" drc(pr,c,old),
'because of a match at' drc(r,c,qq)
if length(new)==1 then do /*reduce if L=1*/
@.pr.c=new /*store single.*/
!.pr.c= /*delete poss. */
call buildposs /*re-build poss*/
iterate matches /*start over.*/
end
end /*pr*/
end /*c*/
end /*r*/

leave
end /*matches*/

return foundmatch

/*─────────────────────────────pruneonly subroutine─────────────────────*/
pruneonly: foundmatch=0 /*no matches found so far. */

do findonlys=1 /*keep searching ... */
_row.= /*build str for each row . */

do r=1 for 9
do c=1 for 9
if !.r.c\=='' then _row.r=_row.r !.r.c
end /*c*/
end /*r*/

_col.= /*build str for each boxcol*/

do c=1 for 9
do r=1 for 9
if !.r.c\=='' then _col.c=_col.c !.r.c
end /*r*/
end /*c*/

do r=1 for 9
do c=1 for 9
q=!.r.c
if q=='' then iterate /*if empty, then ignore it.*/

do j=1 to length(q) /*step through each digit. */
k=substr(q,j,1)

if kount1(k,_row.r) |, /*is this the ONLY digit K?*/
kount1(k,_col.c) then do i=1 to length(q) /*prune others.*/
foundmatch=1
_=substr(q,i,1)
if _==k then iterate /*if=K, ignore.*/
o=squish(q,_) /*remove others*/
!.r.c=o
call $t !fn 'removed part of an only',
_ "from cell" drc(r,c,q)
if length(o)==1 then /*reduce if L=1*/
do
@.r.c=o /*store single.*/
!.r.c= /*delete poss. */
call buildposs /*re-build poss*/
iterate findonlys /*start over. */
end
end /*i*/
end /*j*/
end /*c*/
end /*r*/

leave
end /*findonlys*/

return foundmatch

/*─────────────────────────────pruneline subroutine─────────────────────*/
pruneline: foundmatch=0 /*no matches found so far. */

do findlines=1 /*keep searching ... */
_boxr.= /*build str for each boxrow*/

do r=1 for 9
do c=1 for 9
rc=r || c
b=box.rc
if !.r.c\=='' then _boxr.r.b=strip(_boxr.r.b !.r.c)
end /*c*/
end /*r*/

_boxc.= /*build str for each boxcol*/

do c=1 for 9
do r=1 for 9
rc=r || c
b=box.rc
if !.r.c\=='' then _boxc.c.b=strip(_boxc.c.b !.r.c)
end /*r*/
end /*c*/

do r=1 for 9 /*search all rows for twins*/

do b=rowlb.r to rowhb.r /*for each row, search box.*/
aline=_boxr.r.b /*get a row in the box. */
if aline=='' then iterate /*if empty, ignore the line*/
w=words(aline) /*W is # of words in aline*/
if w<2 then iterate /*if < 2 words, ignore line*/

do k=1 for 9 /*search for each digit. */
f=pos(k,aline) /*pos of the 1st digit: k */
if f==0 then iterate /*no dig k, so keep looking*/
s=pos(k,aline,f+1) /*pos of the 2nd digit: k */
if s==0 then iterate /*no 2nd k, so keep looking*/

do jr=rowlb.r to rowhb.r /*look at the other 2 rows.*/
if jr==r then iterate /*if the same row, ignore. */
if pos(k,_boxr.jr.b)\==0 then iterate k /*if no digit K, ignore*/
end /*jr*/
/*found 2 Ks in row R box B*/
do jb=rowlb.r to rowhb.r /*search boxes row R for K.*/
if jb==b then iterate /*ignore if in the same box*/
if pos(k,_boxr.r.jb)==0 then iterate
foundmatch=1 /*found a K in col C box JB*/

do kc=1 for 9 /*find which cell K is in.*/
rc=r || kc
if box.rc==b then iterate /*ignore if in the same box*/
_=!.r.kc
if _=='' then iterate /*ignore if no possible. */
if pos(k,_)==0 then iterate /*if no digit K, ignore. */
call $t !fn 'is row-line pruning digit' k,
'from cell' drc(r,kc,!.r.kc)
!.r.kc=squish(_,k) /*remove mat's digs from X.*/
if length(!.r.kc)==1 then do /*pruned down to one digit?*/
@.r.kc=!.r.kc /*make a true digit*/
!.r.kc= /*erase possibility*/
call buildposs /*rebuild possibles*/.
iterate findlines
end
end /*kc*/
end /*jb*/
end /*k*/
end /*b*/
end /*r*/

do c=1 for 9 /*search all cols for twins*/

do b=collb.c to colhb.c by 3 /*for each col, search box.*/
aline=_boxc.c.b /*get a column in the box.*/
if aline=='' then iterate /*if empty, ignore line*/
w=words(aline)
if w<2 then iterate /*if < 2 words, ignore line*/

do k=1 for 9 /*search for each digit. */
f=pos(k,aline) /*pos of the 1st digit: k */
if f==0 then iterate /*no dig k, so keep looking*/
s=pos(k,aline,f+1) /*pos of the 2nd digit: k */
if s==0 then iterate /*no 2nd k, so keep looking*/

do jc=boxlc.b to boxhc.b /*look at the other 2 cols.*/
if jc==c then iterate /*if the same col, ignore. */
if pos(k,_boxc.jc.b)\==0 then iterate k /*if no digit K, ignore*/
end /*jc*/
/*found 2 Ks in col C box B*/
do jb=collb.c to colhb.c by 3 /*search boxes col C for K.*/
if jb==b then iterate /*ignore if in the same box*/
if pos(k,_boxc.c.jb)==0 then iterate
foundmatch=1 /*found a K in col C box JB*/

do kr=1 for 9 /*find which cell K is in.*/
rc=kr || c
if box.rc==b then iterate /*ignore if in the same box*/
_=!.kr.c
if _=='' then iterate /*ignore if no possible. */
if pos(k,_)==0 then iterate /*if no digit K, ignore. */
call $t !fn 'is col-line pruning digit' k,
'from cell' drc(kr,c,!.kr.c)
!.kr.c=squish(_,k) /*remove mat's digs from X.*/
if length(!.kr.c)==1 then do /*pruned down to one digit?*/
@.kr.c=!.kr.c /*make a true digit*/
!.kr.c= /*erase possibility*/
call buildposs /*rebuild possibles*/.
iterate findlines
end
end /*kr*/
end /*jb*/
end /*k*/
end /*b*/
end /*c*/

leave
end /*findlines*/

return foundmatch

/*═════════════════════════════general 1-line subs════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════*/
!all:!!=!;!=space(!);upper !;call !fid;!nt=right(!var('OS'),2)=='NT';!cls=word('CLS VMFCLEAR CLRSCREEN',1+!cms+!tso*2);if arg(1)\==1 then return 0;if wordpos(!,'? ?SAMPLES ?AUTHOR ?FLOW')==0 then return 0;!call=']$H';call '$H' !fn !;!call=;return 1
!cal: if symbol('!CALL')\=="VAR" then !call=; return !call
!env: !env='ENVIRONMENT'; if !sys=='MSDOS' | !brexx | !r4 | !roo then !env='SYSTEM'; if !os2 then !env='OS2'!env; !ebcdic=1=='f0'x; if !crx then !env='DOS'; return
!fid: parse upper source !sys !fun !fid . 1 . . !fn !ft !fm .; call !sys; if !dos then do; _=lastpos('\',!fn); !fm=left(!fn,_); !fn=substr(!fn,_+1); parse var !fn !fn '.' !ft; end; return word(0 !fn !ft !fm,1+('0'arg(1)))
!rex: parse upper version !ver !vernum !verdate .; !brexx='BY'==!vernum; !kexx='KEXX'==!ver; !pcrexx='REXX/PERSONAL'==!ver | 'REXX/PC'==!ver; !r4='REXX-R4'==!ver; !regina='REXX-REGINA'==left(!ver,11); !roo='REXX-ROO'==!ver; call !env; return
!sys: !cms=!sys=='CMS'; !os2=!sys=='OS2'; !tso=!sys=='TSO' | !sys=='MVS'; !vse=!sys=='VSE'; !dos=pos('DOS',!sys)\==0 | pos('WIN',!sys)\==0 | !sys=='CMD'; !crx=left(!sys,6)=='DOSCRX'; call !rex; return
!var: call !fid; if !kexx then return space(dosenv(arg(1))); return space(value(arg(1),,!env))
$fact!: procedure; parse arg x _ .; l=length(x); n=l-length(strip(x,'T',"!")); if n<=-n | _\=='' | arg()\==1 then return x; z=left(x,l-n); if z<0 | \isInt(z) then return x; return $fact(z,n)
$fact: procedure; parse arg x _ .; arg ,n ! .; n=p(n 1); if \isInt(n) then n=0; if x<-n | \isInt(x) | n<1 | _ || !\=='' | arg()>2 then return x || copies("!",max(1,n)); !=1; s=x//n; if s==0 then s=n; do j=s to x by n; !=!*j; end; return !
$sfxa: parse arg ,s,m; arg u,c; if pos(left(s,2),u)\==0 then do j=length(s) to compare(s,c)-1 by -1; if right(u,j)\==left(c,j) then iterate; _=left(u,length(u)-j); if isNum(_) then return m*_; leave; end; return arg(1)
$sfxf: parse arg y; if right(y,1)=='!' then y=$fact!(y); if \isNum(y) then y=$sfxz(); if isNum(y) then return y; return $sfxm(y)
$sfxm: parse arg z; arg w; b=1000; if right(w,1)=='I' then do; z=shorten(z); w=z; upper w; b=1024; end; p=pos(right(w,1),'KMGTPEZYXWVU'); if p==0 then return arg(1); n=shorten(z); r=num(n,f,1); if isNum(r) then return r*b**p; return arg(1)
$sfxz: return $sfxa($sfxa($sfxa($sfxa($sfxa($sfxa(y,'PAIRs',2),'DOZens',12),'SCore',20),'GREATGRoss',1728),'GRoss',144),'GOOGOLs',1e100)
$t: if tops=='' then say arg(1); else do; !call=']$T'; call "$T" tops arg(1); !call=; end; return
ab: arg ab,abl; return abbrev(ab,_,abl)
abb: arg abbu; parse arg abb; return abbrev(abbu,_,abbl(abb))
abbl: return verify(arg(1)'a',@abc,'M')-1
abbn: parse arg abbn; return abb(abbn) | abb('NO'abbn)
abn: arg ab,abl; return abbrev(ab,_,abl) | abbrev('NO'ab,_,abl+2)
comma: procedure; parse arg _,c,p,t; c=pickBlank(c,","); o=p(p 3); p=abs(o); t=p(t 999999999); if \isInt(p) | \isInt(t) | p==0 | arg()>4 then return _; n=_'.9'; #=123456789; k=0; return comma_()
comma_: if o<0 then do; b=verify(_,' '); if b==0 then return _; e=length(_)-verify(reverse(_),' ')+1; end; else do; b=verify(n,#,"M"); e=verify(n,#'0',,verify(n,#"0.",'M'))-p-1; end; do j=e to b by -p while k<t; _=insert(c,_,j); k=k+1; end; return _
copies2: return copies(arg(1),2)
copies3: return copies(arg(1),3)
drc: procedure; parse arg r,c,p; _=r","c; if p\=='' then _=_ "("p')'; return _
er: parse arg _1,_2; call '$ERR' "14"p(_1) p(word(_1,2) !fid(1)) _2; if _1<0 then return _1; exit result
err: call er '-'arg(1),arg(2); return ''
erx: call er '-'arg(1),arg(2); exit ''
halt: call er .1
int: int=num(arg(1),arg(2)); if \isInt(int) then call er 92,arg(1) arg(2); return int/1
isInt: return datatype(arg(1),'W')
isNum: return datatype(arg(1),'N')
kount1: parse arg qd,string; k1=pos(qd,string); if k1==0 then return 0; return pos(qd,string,k1+1)==0
lower: return translate(arg(1),@abc,translate(@abc))
na: if arg(1)\=='' then call er 01,arg(2); parse var ops na ops; if na=='' then call er 35,_o; return na
nai: return int(na(),_o)
nail: return squish(int(translate(na(),0,','),_o))
nan: return num(na(),_o)
no: if arg(1)\=='' then call er 01,arg(2); return left(_,2)\=='NO'
noValue:!sigl=sigl; call er 17,!fid(2) !fid(3) !sigl condition('D') sourceline(!sigl)
num: procedure; parse arg x .,f,q; if x=='' then return x; if isNum(x) then return x/1; x=space(translate(x,,','),0); if \isNum(x) then x=$sfxf(x); if isNum(x) then return x/1; if q==1 then return x; if q=='' then call er 53,x f; call erx 53,x f
p: return word(arg(1),1)
pickBlank: procedure; parse arg x,y; arg xu; if xu=='BLANK' then return ' '; return p(x y)
shorten:procedure; parse arg a,n; return left(a,max(0,length(a)-p(n 1)))
simple: return translate(arg(1),'.||--%<>AV'copies('+',25),"·│║─═☼◄►↑↓┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣")
squish: return space(translate(arg(1),,word(arg(2) ',',1)),0)
syntax: !sigl=sigl; call er 13,!fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl)
tem: parse arg r,c,w; if tellinvalid then say '***error!*** row' r", col" c '('@.r.c") is a duplicate of another in the same" w'.'; return 0
tg: arg tg; if simple then tg=simple(tg); call $t gridindent || tg; return</lang>

=== REXX CHANGESTR function ===
This version of the &nbsp; '''changestr''' &nbsp; BIF has more functionality than the standard BIF.

<lang rexx>/*REXX program emulates the CHANGESTR built-in function for older REXXes*/
/*──── This version has more functionality: limit the number of changes.*/
/*──── start of change occurrence#.*/
/*──── start of change position. */

/*╔══════════════════════════ CHANGESTR function ══════════════════════╗
╔═╩════════════════════════════════════════════════════════════════════╩═╗
║ The CHANGESTR function is used to replace some or all occurrences of an║
║ (old) string in a haystack with a new string. The changed string is ║
║ returned. If the haystack doesn't contain the old string, the ║
║ original haystack is returned. If the old string is a null string, ║
║ then the original string is prefixed with the new string. ║
║ ║
║ new string to be used►──────────┐ ┌─────◄limit of # changes (times).║
║ original string (haystack)►──────┐ │ │ [default: ≈ one billion]║
║ old string to be replaced►──┐ │ │ │ ┌────◄begin at this occurrence #║
║ {O, H, and N can be null.} │ │ │ │ │ ┌──◄start position (default=1)║
╚═╦════════════════════════════╗ │ │ │ │ │ │ ╔═════════════════════════╦═╝
╚════════════════════════════╝ │ │ │ │ │ │ ╚═════════════════════════╝
↓ ↓ ↓ ↓ ↓ ↓ */
changestr: parse arg o,h,n,t,b,p,$ f /*T,B,P are optional.*/
t=word(t 999999999 , 1) /*maybe use the default? */
b=word(b 1 , 1) /* " " " " */
p=word(p 1 , 1) /* " " " " */
if arg() < 3 then signal syntax /*not enough arguments. */
if arg() > 6 then signal syntax /*too many arguments. */
if \datatype(t,'W') then signal syntax /*4th arg not an integer. */
if \datatype(b,'W') then signal syntax /*5th " " " " */
if \datatype(p,'W') then signal syntax /*5th arg " " " */
if t<0 then signal syntax /*4th arg not non-negative*/
if b<1 then signal syntax /*5th arg not positive. */
if p<1 then signal syntax /*6th " " " */
L=length(o) /*length of OLD string. */
if L==0 & t\=0 then return n || h /*changing a null char? */
if p\=1 then do /*if P ¬= 1, adjust F & H.*/
f=left(h, min(p-1, length(h))) /*keep first part intact. */
h=substr(h,p) /*only use this part of H.*/
end /*now, proceed as usual. */
#=0 /*# of changed occurrences*/
do j=1 while # < t /*keep changing, T times. */
parse var h y (o) _ +(L) h /*parse the haystack ··· */
if _=='' then return f || $ || y /*no more left, return. */
$=$ || y /*append the residual txt.*/
if j<b then $=$ || o /*append OLD if too soon. */
else do /*met the occurrence test.*/
$=$ || n /*append the NEW string.*/
#=#+1 /*bump occurrence number.*/
end
end /*j*/ /*Note: most REXX ··· */
/* CHANGESTR BIFs only ···*/
return f || $ || h /* support three options. */</lang>

==REXX: Version 2==

==REXX: Version 3==

Latest revision as of 14:11, 7 August 2023

Sudoku/REXX is part of Sudoku. You may find other members of Sudoku at Category:Sudoku.

REXX

REXX version 1

This is the $SUDOKU.REX (REXX) program and is used to solve the Rosetta Code task of "sudoku".

This REXX program was originally written to assist in sudoku puzzle solving (by giving strong hints), and not to solve the puzzle outright.

The REXX program was written to give increasing better hints and also show the possibilities (of what is possible solution for any cell),
and to partially solve the puzzle using distinct strategies (separately or in combination).   One option is to solve the puzzle.

The help for the $SUDOKU REXX program is included here ───► $SUDOKU.HEL.

The $SUDOKU.REX REXX program makes use of $ERR.REX REXX program which is used to display error messages (via $T.REX).

The $ERR.REX REXX program is included here ───► $ERR.REX.

The $SUDOKU.REX REXX program makes use of $T.REX REXX program which is used to display text messages.

The $T.REX REXX program is included here ───► $T.REX.

Some older REXXes don't have a   changestr   BIF, so one is included here ───► CHANGESTR.REX.

REXX programs not included are $H which shows/displays help and other documentation. 

/*REXX program displays, can give hints, and/or solve a sudoku puzzle.  */
trace off
parse arg !
if !all(arg())  then exit
if !cms         then address ''
signal on halt
signal on noValue
signal on syntax

ops=!                                        /*remove extraneous blanks.*/
numeric digits 20
combos=1
@.=' '                                       /*initialize grid to blanks*/
!.=                                          /*nullify valid empty# list*/
@abc='abcdefghijklmnopqrstuvwxyz'
@abcU=@abc
upper @abcU
colors=!cms | !pcrexx | !r4 | !roo           /*Are colors supported ?   */
clear=1                                      /*option: clear the screen.*/
highLight=0                                  /*option: highlight singles*/
pruneall=0                                   /*option: prune all.       */
prunemats=0                                  /*option: prune matches.   */
prunesing=0                                  /*option: prune singles.   */
pruneexcl=0                                  /*option: prune exclusives.*/
pruneline=0                                  /*option: prune lines.     */
pruneonly=0                                  /*option: prune onlys.     */
simple=0                                     /*option: show simple boxes*/
showoneline=0                                /*option: show grid as1line*/
showgrid=1                                   /*option: show the grid.   */
showinfo=1                                   /*option: show informatiion*/
showposs=0                                   /*option: show possible val*/
showcomb=0                                   /*option: show combinations*/
showrow=                                     /*option: SHOWPOSS for rowN*/
showcol=                                     /*option: SHOWPOSS for colN*/
showbox=                                     /*option: SHOWPOSS for boxN*/
showcell=                                    /*option: SHOWPOSS cellRC  */
short=0
solve=0                                      /*option: solve the puzzle.*/
sod=lower(translate(!fn,,'$'))               /*name of the puzzle.      */
tellinvalid=1                                /*tell err msg if invalid X*/
tops=                                        /*option: used for $T opts.*/

gridindents=3                                /*# spaces grid is indented*/
gridindent=left('',gridindents)              /*spaces indented for grid.*/
gridwidth=7                                  /*grid cell interior width.*/
gridbar='b3'x                                /*bar for the grid (cells).*/
gridlt='da'x                                 /*grid cell  left top.     */
gridrt='bf'x                                 /*grid cell right top.     */
gridlb='c0'x                                 /*grid cell  left bottom.  */
gridrb='d9'x                                 /*grid cell right bottom.  */
gridline='c4'x                               /*grid cell line (hyphen). */
gridlin=copies(gridline,gridwidth)           /*grid cell total line.    */
gridemp=left('',gridwidth)                   /*grid cell empty (spaces).*/
griddj='c2'x                                 /*grid cell  down junction.*/
griduj='c1'x                                 /*grid cell    up junction.*/
gridlj='c3'x                                 /*grid cell  left junction.*/
gridrj='b4'x                                 /*grid cell right junction.*/
gridcross='c5'x                              /*grid cell cross junction.*/

  do  while ops\==''                         /*parse any and all options*/
  parse var ops _1 2 1 _ . 1 _o ops
  upper _

    select
    when _==','                    then nop
    when _1=='.' & pos("=",_)\==0  then tops=tops _o

    when  abb('PUZzle')            then      /*do PUZZ (whole) placement*/
         do
         puzz=na()
         if length(puzz)>81  then call er 30,puzz 'PUZZLE 1───►81'

                         do j=1  for length(puzz)
                         q=substr(puzz,j,1)
                         if q=='.'  then iterate
                         call vern q,'PUZZLE_digit'
                         c=j//9
                         if c==0  then c=9
                         r=(j-1)%9 + 1
                         @.r.c=q
                         end   /*j*/
         end

    when _=='CELL' then                      /*do CELL (grid) placement.*/
         do
         rc=nai()
         if length(rc)\==2                   then call er 30,y 'CELL'rc 2
         y=na()
         if length(y)>1                      then call er 30,y 'CELL'rc 1
         r=left(rc,1)
         c=right(rc,1)
         call vern r,'CELLrow'
         call vern c,'CELLcolumn'
         call vern y,'CELLdigit'
         @.r.c=y
         end

    when  abb('COLumn')  then                /*do ROW (grid) placement. */
         do
         n=nai()
         y=na()
         call vern n,'column'
         ly=length(y)
         if ly>9  then call er 30,y 'column'n '1───>9'

                         do j=1  for ly
                         x=substr(y,j,1)
                         if x=='' | x=="_" | x=='*' | x=="."  then iterate
                         if \isInt(x)  then call er 92,x 'cell_for_column'n
                         @.j.n=x
                         end   /*j*/
         end

    when  abb('ROW')  then                   /*do ROW (grid) placement. */
         do
         n=nai()
         y=na()
         call vern n,'row'
         ly=length(y)
         if ly>9  then call er 30,y 'row'n '1───>9'

                         do j=1  for ly
                         x=substr(y,j,1)
                         if x=='' | x=="_" | x=='*' | x=="."  then iterate
                         if \isInt(x)  then call er 92,x 'cell_for_row_'n
                         @.n.j=x
                         end   /*j*/
         end

    when abbn('CLearscreen')        then clear=no()
    when abbn('HIGHLightsingles')   then highLight=no()
    when abbn('PRUNEALL')           then pruneall=no()
    when abbn('PRUNEONLYs')         then pruneonly=no()
    when abbn('PRUNEEXclusives')    then pruneexcl=no()
    when abbn('PRUNELINEs')         then pruneline=no()
    when abbn('PRUNEMATches')       then prunemats=no()
    when abbn('PRUNESINGles')       then prunesing=no()
    when abbn('SIMPle')             then simple=no()
    when  abb('SHOWBOXes')|,
          abb('SHOWBOXs')           then showbox=nai()
    when  abb('SHOWCELLs')          then showcell=translate(na(),,',')
    when  abb('SHOWCOLs')           then showcol=nai()
    when abbn('SHOWCOMBinations')   then showcomb=no()
    when abbn('SHOWGrid')           then showgrid=no()
    when abbn('SHOWINFOrmation')    then showinfo=no()
    when abbn('SHOWONELINE')        then showoneline=no()
    when abbn('SHOWPOSSibles') then showposs=no()
    when  abb('SHOWROWs')           then showrow=nai()
    when abbn('SHortgrid')          then short=no()
    when abbn('SOLvepuzzle')        then solve=no()

    otherwise                       call er 55,_o
    end   /*select*/
  end     /*while ops¬==''*/

if solve  then pruneall=1                    /*if solving, use PRUNEALL.*/

if pruneall  then do                         /*if pruneAll, set ON other*/
                  pruneexcl=1
                  pruneonly=1
                  pruneline=1
                  prunemats=1
                  prunesing=1
                  end

aprune = ,                                   /*is there a PRUNExxx on ? */
                  pruneexcl |,
                  pruneonly |,
                  pruneline |,
                  prunemats |,
                  prunesing

if highLight  then do                         /*HIGHLIGHTSINGLES opt on? */
                   hLl='-'
                   hLr='-'

                   if colors  then do
                                   hLl='('
                                   hLr=')'
                                   tops='.H=yell' tops
                                   end
                   end

tops=space(tops)
box.=

  do j=1  for 9                              /*build the box bounds.    */
  rr=(((j*3)%10)+1)*3-2                      /*compute row lower bound. */
  cc=(((j-1)//3)+1)*3-2                      /*compute col lower bound. */
  boxr.j=rr
  boxc.j=cc

                        do   r=rr  to rr+2   /*build boxes with cell #s.*/
                          do c=cc  to cc+2
                          rc=r || c
                          box.j=box.j rc
                          box.rc=j
                          end   /*c*/
                        end     /*r*/

  box.j=strip(box.j)
  end   /*j*/

rowlb.=10                                    /*row R,  low box number=b.*/
collb.=10                                    /*col R,  low box number=b.*/
boxlr.=10                                    /*box B,  low row number=r.*/
boxlc.=10                                    /*box B,  low col number=c.*/

  do   r=1  for 9
    do c=1  for 9
    rc=r || c
    b=box.rc                                 /*what box is this R,C in ?*/
    rowlb.r=min(rowlb.r,b)                   /*find min box # for row R.*/
    collb.c=min(collb.c,b)                   /*find min box # for col C.*/
    boxlr.b=min(boxlr.b,r)                   /*find min row # for box B.*/
    boxlc.b=min(boxlc.b,c)                   /*find min col # for box B.*/
    end   /*c*/
  end     /*r*/

 do j=1  to 9                                /*for each box, row, col...*/
 rowhb.j=rowlb.j+2                           /*compute row's high box #.*/
 colhb.j=collb.j+6                           /*compute col's high box #.*/
 boxhr.j=boxlr.j+2                           /*compute box's high row #.*/
 boxhc.j=boxlc.j+6                           /*compute box's high col #.*/
 end   /*j*/

if showgrid  then call showgrid 'the puzzle' /*show the grid to screen ?*/
if \validall()  then exit                    /*validate specified digits*/
tellinvalid=0                                /*don't tell err messages. */
!.=                                          /*nullify valid empty# list*/
call buildposs                               /*build possible values.   */
if showposs  then call showgrid 'puzzle possibles' /*show 1st possibles?*/
if \validate(1)  then exit                   /*validate the puzzle.     */

if showoneline  then do                      /*show grid as line line ? */
                     _=                      /*start with a clean slate.*/
                           do   r=1  for 9
                             do c=1  for 9
                             _=_ || @.r.c    /*build the string ...     */
                             end   /*c*/
                           end     /*r*/

                     _=translate(strip(_,'T'),".",' ')
                     if showinfo  then call $T 'one-line grid:'
                     call $T _
                     end

if aprune |,
   showposs then do
                 call pruneposs              /*go build poss, then prune*/
                 if showposs then call showgrid 'possibles' /*show grid.*/
                 if \validate(1) then exit   /*validate the puzzle.     */
                 end

if combos==1  then call $t sod 'puzzle solved.'
              else  if showcomb  then call $t 'combinations='comma(combos)
exit                                   /*stick a fork in it, we're done.*/

/*─────────────────────────────vern subroutine──────────────────────────*/
vern: parse arg v,w                          /*verify a digit for an opt*/
if v==''      then call er 35,v w
if \isInt(v)  then call er 92,v w
if v<1 | v>9  then call er 81,1 9 v w
return

/*─────────────────────────────buildposs subroutine─────────────────────*/
buildposs: !.=                               /*nullify possibilities.   */
combos=1

  do   rp=1  for 9                           /*build table of valid #s. */
    do cp=1  for 9                           /*step through each column.*/
    if @.rp.cp\==' '  then iterate           /*not blank?  Keep looking.*/

                          do jd=1  for 9     /*try each digit.          */
                          @.rp.cp=jd
                          if validx(rp,cp) then !.rp.cp=!.rp.cp || jd
                          end   /*jd*/

    combos=combos*length(!.rp.cp)            /*calculate # combinations.*/
    @.rp.cp=' '                              /*restore the point (blank)*/
    end      /*cp*/
  end        /*rp*/

return

/*─────────────────────────────showgrid subroutine──────────────────────*/
showgrid: parse arg title
if clear  then !cls                          /*clear the screen ?       */
if title\=='' & showinfo  then call $t !fn 'is showing' title
gtail=copies3(gridlb || gridlin || copies2(griduj || gridlin) || gridrb)
ghead=copies3(gridlt || gridlin || copies2(griddj || gridlin) || gridrt)
call tg ghead
gemp=copies3(copies3(gridbar || gridemp)gridbar)
grid=copies3(gridlj || gridlin || copies2(gridcross || gridlin)gridrj)
anyshow= \ ((showcell || showcol || showrow || showbox)\=='')

  do jr=1  for 9
  if \short  then call tg gemp
  gnum=

    do jc=1  for 9
    _=@.jr.jc
    if _\==' ' & highLight  then _=hLl || _ || hLr

    if _==' ' & ,
       showposs  then do
                      jrjc=jr || jc
                      showit=anyshow
                      if showcell\=='' then if wordpos(jrjc,showcell)\==0 then showit=1
                      if showcol\==''  then if pos(jc,showcol)\==0  then showit=1
                      if showrow\==''  then if pos(jr,showrow)\==0  then showit=1

                             do jb=1  while  showbox\==''
                             b=substr(showbox,jb,1)
                             if b==' '                   then leave
                             if wordpos(jrjc,box.b)\==0  then showit=1
                             end   /*jb*/

                      if showit  then _=strip(left(!.jr.jc,gridwidth),'T')
                      end

    gnum=gnum || gridbar || centre(_,gridwidth)
    if jc//3==0  then gnum=gnum || gridbar
    end   /*jc*/

  call tg gnum
  if \short  then call tg gemp

  if jr//3==0 then do
                   call tg gtail
                   if jr\==9  then call tg ghead
                   end
              else call tg grid
  end   /*jr*/

call $t
return

/*─────────────────────────────validate subroutine──────────────────────*/
validate:                                    /*are all empties possible?*/

  do   r=1  for 9                            /*step through each row.   */
    do c=1  for 9                            /*step through each column.*/

    if @.r.c==' ' & ,
       !.r.c==''  then do                     /*no legal digit here.     */
                       if arg(1)==1  then call $t sod "puzzle isn't valid !"
                       return 0
                       end
    end   /*c*/
  end     /*r*/                              /*sub requires possibles.  */

return 1                                     /*indicate puzzle is valid.*/

/*─────────────────────────────validall subroutine──────────────────────*/
validall:                                    /*validate all Q specified.*/

  do   r=1  for 9                            /*step through each row.   */
    do c=1  for 9                            /*step through each column.*/
    if @.r.c==' '  then iterate              /*if blank, then it's ok.  */
    y=                                       /*the rest of the row.     */
    rc=r||c
                do kc=1  for 9               /*compare to #s in column. */
                if kc\==c  then y=y|| @.r.kc /*build the rest of the row*/
                end   /*kc*/
    q=@.r.c
    if pos(q,y)\==0  then return tem(r,c,'row')    /*same # in same row?*/
    y=                                       /*the rest of the column.  */
                do kr=1  for 9               /*compare to #s in column. */
                if kr\==r then y=y || @.kr.c /*build the rest of the col*/
                end      /*kr*/

    if pos(q,y)\==0  then return tem(r,c,'col')    /*same # in same col?*/
    y=                                       /*the rest of the box.     */
    b=box.rc

      do   br=boxr.b  to boxr.b+2            /*compare to #s of the box.*/
        do bc=boxc.b  to boxc.b+2            /*build the rest of the box*/
        if br\==r & bc\==c  then y=y || @.br.bc
        end  /*bc*/
      end    /*br*/

    if pos(q,y)\==0  then return tem(r,c,'box')    /*same # in same box?*/
    end   /*c*/
  end     /*r*/

return 1                                     /*indicate  all  are valid.*/

/*─────────────────────────────validx subroutine────────────────────────*/
validx: arg r,c
rc=r || c
y=                                           /*the rest of the row.     */
           do kc=1  for 9                    /*compare to #s in column. */
           if kc\==c  then y=y || @.r.kc     /*build the rest of the row*/
           end   /*kc*/

q=@.r.c                                      /*get the digit at  r,c    */
if pos(q,y)\==0 then return tem(r,c,'row')   /*same number in same row ?*/
y=                                           /*the rest of the column.  */
      do kr=1  for 9                         /*compare to #s in column. */
      if kr\==r  then y=y || @.kr.c          /*build the rest of the col*/
      end   /*kr*/

if pos(q,y)\==0  then return tem(r,c,'col')  /*same  #  in same column ?*/
y=                                           /*the rest of the box.     */
b=box.rc

           do   br=boxr.b  to boxr.b+2       /*compare to #s of the box.*/
             do bc=boxc.b  to boxc.b+2       /*build the rest of the box*/
             if br==r & bc==c  then iterate
             y=y || @.br.bc
             end   /*br*/
           end     /*bc*/

if pos(q,y)\==0 then return tem(r,c,'box')   /*same # in same box ? */
return 1                                     /*indicate X (r,c) is valid*/

/*─────────────────────────────pruneposs subroutine─────────────────────*/
pruneposs: if \(prunesing | pruneexcl | prunemats | pruneline) then return
call buildposs

  do prunes=1
  call $t !fn 'is starting prune pass #' prunes
  found=0                                    /*indicate no prunes so far*/

  if prunesing then do                       /*prune puzzle for singles.*/
                    _=prunesing()            /*find any singles ?       */
                    found=found | _          /*track if anything found. */
                    if _ then if showgrid then call showgrid /*show grid*/
                    end

  if pruneexcl then do                       /*prune puzzle for singles.*/
                    _=pruneexcl()            /*find any excluives ?     */
                    found=found | _          /*track if anything found. */
                    if _ then if showgrid then call showgrid /*show grid*/
                    end

  if pruneonly then do                       /*prune puzzle for onlys.  */
                    _=pruneonly()            /*find any onlys ?         */
                    found=found | _          /*track if anything found. */
                    if _ then if showgrid then call showgrid /*show grid*/
                    end

  if prunemats then do jpm=2 to 8            /*prune puzzle for matches.*/
                    _=prunemats(jpm)         /*find any matches (len=j)?*/
                    found=found | _          /*track if anything found. */
                    if _ then if showgrid then call showgrid /*show grid*/
                    end

  if pruneline then do                       /*prune puzzle for lines.  */
                    _=pruneline()            /*find 2 or more on a line?*/
                    found=found | _          /*track if anything found. */
                    if _ then if showgrid then call showgrid /*show grid*/
                    end

  if \found then leave                       /*nothing found this time ?*/
  end    /*prunes*/

return

/*─────────────────────────────prunesing subroutine─────────────────────*/
prunesing: foundsing=0

    do   r=1  for 9
      do c=1  for 9
      _=length(!.r.c)                        /*get length of possible.  */
      if _==0   then iterate                 /*if null, then ignore it. */
      if _\==1  then iterate                 /*if not one digit, ignore.*/
      @.r.c=!.r.c                            /*it's 1 digit, a solution.*/
      !.r.c=                                 /*erase the old possible.  */
      foundsing=1
      call $t !fn 'found a single digit at cell' drc(r,c,@.r.c)
      end   /*c*/
    end     /*r*/

if foundsing  then call buildposs            /*re-build the possibles.  */
return foundsing

/*─────────────────────────────pruneexcl subroutine─────────────────────*/
pruneexcl: foundexcl=0

  do exclusives=1                            /*keep building possibles. */
    do   r=1  for 9
      do c=1  for 9
      z=!.r.c
      lz=length(z)                           /*get length of possible.  */
      if lz==0  then iterate                 /*if null, then ignore it. */
      y=
      rc=r || c
      b=box.rc

                do   br=boxr.b  to boxr.b+2  /*compare to #s of the box.*/
                  do bc=boxc.b  to boxc.b+2  /*build the rest of the box*/
                  if br==r & bc==c  then iterate
                  y=y || @.br.bc || !.br.bc
                  end   /*bc*/
                end     /*br*/

                                             /*test for reduction.      */
       do t=1  for lz
       q=substr(z,t,1)

       if pos(q,y)==0 then do
                           foundexcl=1
                           @.r.c=q           /*it's a singularity, a sol*/
                           !.r.c=            /*erase old possibleity.   */
                           call $t !fn 'found the digit' q,
                                  "by exclusiveness at cell" drc(r,c,z)
                           call buildposs    /*re-build the possibles.  */
                           iterate exclusives
                           end
       end  /*t*/
      end   /*c*/
    end     /*r*/

  leave
  end       /*exclusives*/

return foundexcl

/*─────────────────────────────prunemats subroutine─────────────────────*/
prunemats: foundmatch=0                      /*no matches found so far. */
parse arg L                                  /*length of match, L=2,pair*/

  do matches=1
    do   r=1  for 9
      do c=1  for 9
      _=length(!.r.c)                        /*get length of possible.  */
      if _==0   then iterate                 /*if null, then ignore it. */
      if _\==L  then iterate                 /*not right length, ignore.*/
      qq=!.r.c
      m=0                                    /*count of matches so far. */
             do _c=1  for 9                  /*nother match in same row?*/
             if qq==!.r._c  then m=m+1       /*up count if it's a match.*/
             end  /*_c*/

      if m>=L then do pc=1  for 9            /*squish other possibles.  */
                   old=!.r.pc                /*save the "old" value.    */
                   if old==qq   then iterate /*if match, then ignore it.*/
                   if old==''   then iterate /*if null poss, then ignore*/
                   new=squish(old,qq)        /*remove mat's digs from X.*/
                   if new==old  then iterate /*if no change,keep looking*/
                   !.r.pc=new                /*store new value into old.*/
                   foundmatch=1              /*indicate match was found.*/
                   call $t !fn 'is removing a'  old "from"  drc(r,pc,old),
                               'because of a match at'     drc(r,c,qq)
                   if length(new)==1 then do             /*reduce if L=1*/
                                          @.r.pc=new     /*store single.*/
                                          !.r.pc=        /*delete poss. */
                                          call buildposs /*re-build poss*/
                                          iterate matches  /*start over.*/
                                          end
                   end    /*pc*/
      m=0                                    /*count of matches so far. */

             do _r=1  for 9                  /*nother match in same col?*/
             if qq==!._r.c  then m=m+1       /*up count if it's a match.*/
             end   /*_r*/

      if m>=L then do pr=1  for 9            /*squish other possibles.  */
                   old=!.pr.c                /*save the "old" value.    */
                   if old==qq then iterate   /*if match, then ignore it.*/
                   if old=='' then iterate   /*if null poss, then ignore*/
                   new=squish(old,qq)        /*remove mat's digs from X.*/
                   if new==old then iterate  /*if no change,keep looking*/
                   !.pr.c=new                /*store new value into old.*/
                   foundmatch=1              /*indicate match was found.*/
                   call $t !fn 'is removing a'  old  "from" drc(pr,c,old),
                               'because of a match at' drc(r,c,qq)
                   if length(new)==1 then do             /*reduce if L=1*/
                                          @.pr.c=new     /*store single.*/
                                          !.pr.c=        /*delete poss. */
                                          call buildposs /*re-build poss*/
                                          iterate matches  /*start over.*/
                                          end
                   end   /*pr*/
      end                /*c*/
    end                  /*r*/

  leave
  end                    /*matches*/

return foundmatch

/*─────────────────────────────pruneonly subroutine─────────────────────*/
pruneonly: foundmatch=0                      /*no matches found so far. */

  do findonlys=1                             /*keep searching ...       */
  _row.=                                     /*build str for each row . */

           do   r=1  for 9
             do c=1  for 9
             if !.r.c\==''  then _row.r=_row.r !.r.c
             end   /*c*/
           end     /*r*/

  _col.=                                     /*build str for each boxcol*/

           do   c=1  for 9
             do r=1  for 9
             if !.r.c\==''  then _col.c=_col.c !.r.c
             end   /*r*/
           end     /*c*/

    do   r=1  for 9
      do c=1  for 9
      q=!.r.c
      if q==''  then iterate                 /*if empty, then ignore it.*/

        do j=1  to length(q)                 /*step through each digit. */
        k=substr(q,j,1)

        if kount1(k,_row.r) |,               /*is this the ONLY digit K?*/
           kount1(k,_col.c) then do i=1  to length(q)    /*prune others.*/
                                 foundmatch=1
                                 _=substr(q,i,1)
                                 if _==k  then iterate   /*if=K, ignore.*/
                                 o=squish(q,_)           /*remove others*/
                                 !.r.c=o
                                 call $t !fn  'removed part of an only',
                                              _   "from cell"   drc(r,c,q)
                                 if length(o)==1  then   /*reduce if L=1*/
                                   do
                                   @.r.c=o               /*store single.*/
                                   !.r.c=                /*delete poss. */
                                   call buildposs        /*re-build poss*/
                                   iterate findonlys     /*start over.  */
                                   end
                                 end   /*i*/
        end   /*j*/
      end     /*c*/
    end       /*r*/

  leave
  end     /*findonlys*/

return foundmatch

/*─────────────────────────────pruneline subroutine─────────────────────*/
pruneline: foundmatch=0                      /*no matches found so far. */

 do findlines=1                              /*keep searching ...       */
 _boxr.=                                     /*build str for each boxrow*/

           do   r=1  for 9
             do c=1  for 9
             rc=r || c
             b=box.rc
             if !.r.c\==''  then _boxr.r.b=strip(_boxr.r.b !.r.c)
             end   /*c*/
           end     /*r*/

  _boxc.=                                    /*build str for each boxcol*/

           do   c=1  for 9
             do r=1  for 9
             rc=r || c
             b=box.rc
             if !.r.c\==''  then _boxc.c.b=strip(_boxc.c.b !.r.c)
             end   /*r*/
           end     /*c*/

  do r=1  for 9                              /*search all rows for twins*/

    do b=rowlb.r  to rowhb.r                 /*for each row, search box.*/
    aline=_boxr.r.b                          /*get a  row  in the box.  */
    if aline==''  then iterate               /*if empty, ignore the line*/
    w=words(aline)                           /*W  is # of words in aline*/
    if w<2        then iterate               /*if < 2 words, ignore line*/

      do k=1  for 9                          /*search for each digit.   */
      f=pos(k,aline)                         /*pos of the 1st digit:  k */
      if f==0  then  iterate                 /*no dig k, so keep looking*/
      s=pos(k,aline,f+1)                     /*pos of the 2nd digit:  k */
      if s==0  then  iterate                 /*no 2nd k, so keep looking*/

        do jr=rowlb.r  to rowhb.r            /*look at the other 2 rows.*/
        if jr==r  then  iterate              /*if the same row, ignore. */
        if pos(k,_boxr.jr.b)\==0  then iterate k /*if no digit K, ignore*/
        end   /*jr*/
                                             /*found 2 Ks in row R box B*/
         do jb=rowlb.r  to rowhb.r           /*search boxes row R for K.*/
         if jb==b  then iterate              /*ignore if in the same box*/
         if pos(k,_boxr.r.jb)==0  then iterate
         foundmatch=1                        /*found a K in col C box JB*/

           do kc=1  for 9                    /*find which cell  K is in.*/
           rc=r || kc
           if box.rc==b        then iterate  /*ignore if in the same box*/
           _=!.r.kc
           if _==''            then iterate  /*ignore if no possible.   */
           if pos(k,_)==0      then iterate  /*if no digit  K,  ignore. */
           call $t  !fn   'is row-line pruning digit' k,
                          'from cell'    drc(r,kc,!.r.kc)
           !.r.kc=squish(_,k)                /*remove mat's digs from X.*/
           if length(!.r.kc)==1  then do     /*pruned down to one digit?*/
                                      @.r.kc=!.r.kc  /*make a true digit*/
                                      !.r.kc=        /*erase possibility*/
                                      call buildposs /*rebuild possibles*/.
                                      iterate findlines
                                      end
           end   /*kc*/
         end     /*jb*/
      end        /*k*/
    end          /*b*/
  end            /*r*/

  do c=1  for 9                              /*search all cols for twins*/

    do b=collb.c  to colhb.c  by 3           /*for each col, search box.*/
    aline=_boxc.c.b                          /*get a  column in the box.*/
    if aline==''  then iterate               /*if empty, ignore line*/
    w=words(aline)
    if w<2  then iterate                     /*if < 2 words, ignore line*/

      do k=1  for 9                          /*search for each digit.   */
      f=pos(k,aline)                         /*pos of the 1st digit:  k */
      if f==0  then iterate                  /*no dig k, so keep looking*/
      s=pos(k,aline,f+1)                     /*pos of the 2nd digit:  k */
      if s==0  then iterate                  /*no 2nd k, so keep looking*/

        do jc=boxlc.b  to boxhc.b            /*look at the other 2 cols.*/
        if jc==c  then iterate               /*if the same col, ignore. */
        if pos(k,_boxc.jc.b)\==0  then iterate k /*if no digit K, ignore*/
        end   /*jc*/
                                             /*found 2 Ks in col C box B*/
         do jb=collb.c  to colhb.c by 3      /*search boxes col C for K.*/
         if jb==b  then iterate              /*ignore if in the same box*/
         if pos(k,_boxc.c.jb)==0  then iterate
         foundmatch=1                        /*found a K in col C box JB*/

           do kr=1  for 9                    /*find which cell  K is in.*/
           rc=kr || c
           if box.rc==b       then iterate   /*ignore if in the same box*/
           _=!.kr.c
           if _==''           then iterate   /*ignore if no possible.   */
           if pos(k,_)==0     then iterate   /*if no digit  K,  ignore. */
           call $t !fn  'is col-line pruning digit'  k,
                        'from cell'    drc(kr,c,!.kr.c)
           !.kr.c=squish(_,k)                /*remove mat's digs from X.*/
           if length(!.kr.c)==1  then do     /*pruned down to one digit?*/
                                      @.kr.c=!.kr.c  /*make a true digit*/
                                      !.kr.c=        /*erase possibility*/
                                      call buildposs /*rebuild possibles*/.
                                      iterate findlines
                                      end
           end   /*kr*/
         end     /*jb*/
      end        /*k*/
    end          /*b*/
  end            /*c*/

 leave
 end     /*findlines*/

return foundmatch

/*────────────────────────────────────────────────────────────────────────────*/
commas: procedure;  parse arg _;   n=_'.9';    #=123456789;    b=verify(n,#,"M")
        e=verify(n,#'0',,verify(n,#"0.",'M'))-4
           do j=e  to b  by -3;   _=insert(',',_,j);    end  /*j*/;     return _
/*═════════════════════════════general 1-line subs══════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════*/
!all:  !!=!;!=space(!);upper !;call !fid;!nt=right(!var('OS'),2)=='NT';!cls=word('CLS VMFCLEAR CLRSCREEN',1+!cms+!tso*2);if arg(1)\==1 then return 0;if wordpos(!,'? ?SAMPLES ?AUTHOR ?FLOW')==0 then return 0;!call=']$H';call '$H' !fn !;!call=;return 1
!cal:   if symbol('!CALL')\=="VAR"  then !call=;   return !call
!env:   !env='ENVIRONMENT'; if !sys=='MSDOS' | !brexx | !r4 | !roo  then !env='SYSTEM'; if !os2  then !env='OS2'!env; !ebcdic=1=='f0'x; if !crx  then !env='DOS'; return
!fid:   parse upper source !sys !fun !fid . 1 . . !fn !ft !fm .; call !sys; if !dos  then do;  _=lastpos('\',!fn); !fm=left(!fn,_); !fn=substr(!fn,_+1); parse var !fn !fn '.' !ft; end;   return word(0 !fn !ft !fm,1+('0'arg(1)))
!rex:   parse upper version !ver !vernum !verdate .; !brexx='BY'==!vernum; !kexx='KEXX'==!ver; !pcrexx='REXX/PERSONAL'==!ver | 'REXX/PC'==!ver; !r4='REXX-R4'==!ver; !regina='REXX-REGINA'==left(!ver,11); !roo='REXX-ROO'==!ver; call !env; return
!sys:   !cms=!sys=='CMS'; !os2=!sys=='OS2'; !tso=!sys=='TSO' | !sys=='MVS'; !vse=!sys=='VSE'; !dos=pos('DOS',!sys)\==0 | pos('WIN',!sys)\==0 | !sys=='CMD'; !crx=left(!sys,6)=='DOSCRX'; call !rex; return
!var:   call !fid; if !kexx  then return space(dosenv(arg(1))); return space(value(arg(1),,!env))
$fact!: procedure; parse arg x _ .; l=length(x); n=l-length(strip(x,'T',"!")); if n<=-n | _\=='' | arg()\==1  then return x; z=left(x,l-n); if z<0 | \isInt(z) then return x; return $fact(z,n)
$fact:  procedure; parse arg x _ .; arg ,n ! .; n=p(n 1); if \isInt(n)  then n=0; if x<-n | \isInt(x) | n<1 | _ || !\=='' | arg()>2 then return x || copies("!",max(1,n)); !=1; s=x//n; if s==0  then s=n;  do j=s  to x  by n; !=!*j; end;  return !
$sfxa:  parse arg ,s,m; arg u,c; if pos(left(s,2),u)\==0  then do j=length(s) to compare(s,c)-1 by -1; if right(u,j)\==left(c,j) then iterate; _=left(u,length(u)-j); if isNum(_)  then return m*_; leave; end;  return arg(1)
$sfxf:  parse arg y; if right(y,1)=='!'  then y=$fact!(y); if \isNum(y)  then y=$sfxz(); if isNum(y) then return y; return $sfxm(y)
$sfxm:  parse arg z; arg w; b=1000; if right(w,1)=='I'  then do; z=shorten(z); w=z; upper w; b=1024; end; p=pos(right(w,1),'KMGTPEZYXWVU'); if p==0 then return arg(1); n=shorten(z); r=num(n,f,1); if isNum(r)  then return r*b**p; return arg(1)
$sfxz:  return $sfxa($sfxa($sfxa($sfxa($sfxa($sfxa(y,'PAIRs',2),'DOZens',12),'SCore',20),'GREATGRoss',1728),'GRoss',144),'GOOGOLs',1e100)
$t:     if tops==''  then say arg(1);  else do; !call=']$T'; call "$T" tops arg(1); !call=; end;   return
ab:     arg ab,abl; return abbrev(ab,_,abl)
abb:    arg abbu; parse arg abb; return abbrev(abbu,_,abbl(abb))
abbl:   return verify(arg(1)'a',@abc,'M')-1
abbn:   parse arg abbn; return abb(abbn) | abb('NO'abbn)
abn:    arg ab,abl; return abbrev(ab,_,abl) | abbrev('NO'ab,_,abl+2)
copies2: return copies(arg(1),2)
copies3: return copies(arg(1),3)
drc:    procedure; parse arg r,c,p; _=r","c; if p\==''  then _=_ "("p')';   return _
er:     parse arg _1,_2; call '$ERR' "14"p(_1) p(word(_1,2) !fid(1)) _2; if _1<0  then return _1;   exit result
err:    call er '-'arg(1),arg(2); return ''
erx:    call er '-'arg(1),arg(2); exit ''
halt:   call er .1
int:    int=num(arg(1),arg(2)); if \isInt(int)  then call er 92,arg(1) arg(2);    return int/1
isInt:  return datatype(arg(1),'W')
isNum:  return datatype(arg(1),'N')
kount1: parse arg qd,string; k1=pos(qd,string); if k1==0  then return 0;   return pos(qd,string,k1+1)==0
lower:  return translate(arg(1),@abc,translate(@abc))
na:     if arg(1)\==''  then call er 01,arg(2); parse var ops na ops;    if na==''  then call er 35,_o;   return na
nai:    return int(na(),_o)
nail:   return squish(int(translate(na(),0,','),_o))
no:     if arg(1)\==''  then call er 01,arg(2); return left(_,2)\=='NO'
noValue:!sigl=sigl; call er 17,!fid(2) !fid(3) !sigl condition('D') sourceline(!sigl)
num:    procedure; parse arg x .,f,q; if x=='' then return x; if isNum(x) then return x/1; x=space(translate(x,,','),0); if \isNum(x) then x=$sfxf(x); if isNum(x) then return x/1; if q==1  then return x; if q==''  then call er 53,x f; call erx 53,x f
p:      return word(arg(1),1)
shorten:procedure; parse arg a,n; return left(a,max(0,length(a)-p(n 1)))
simple: return translate(arg(1),'.||--%<>AV'copies('+',25),"·│║─═☼◄►↑↓┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣")
squish: return space(translate(arg(1),,word(arg(2) ',',1)),0)
syntax: !sigl=sigl; call er 13,!fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl)
tem:    parse arg r,c,w; if tellInvalid  then say '***error!*** row' r", col" c '('@.r.c") is a duplicate of another in the same" w'.';   return 0
tg:     arg tg; if simple  then tg=simple(tg); call $t gridindent || tg;   return


This REXX program makes use of   $ERR.REX   REXX program which is used to write (display) error messages to the terminal screen, with supplemental text that identifies what program issued the error, and in some cases, also identifies the failing REXX statement and some particulars about the failure.

The   $ERR.T.REX   REXX program can be found here   ───►   $ERR.REX.

changestr $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$@@@@@@@@@@@@@@@@@@@@@@@@##############%%%%%%%%%%%%%%%%%%%

output:
$SUDOKU is showing the puzzle
   ┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐
   │       │       │       ││       │       │       ││       │       │       │
   │       │   5   │       ││       │   7   │       ││   8   │   9   │       │
   │       │       │       ││       │       │       ││       │       │       │
   ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
   │       │       │       ││       │       │       ││       │       │       │
   │   9   │       │       ││       │   3   │       ││       │       │       │
   │       │       │       ││       │       │       ││       │       │       │
   ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
   │       │       │       ││       │       │       ││       │       │       │
   │   1   │       │       ││       │   8   │   9   ││       │   4   │       │
   │       │       │       ││       │       │       ││       │       │       │
   └───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘
   ┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐
   │       │       │       ││       │       │       ││       │       │       │
   │       │       │   9   ││       │       │       ││       │       │   1   │
   │       │       │       ││       │       │       ││       │       │       │
   ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
   │       │       │       ││       │       │       ││       │       │       │
   │       │       │   1   ││   3   │       │   5   ││   2   │       │       │
   │       │       │       ││       │       │       ││       │       │       │
   ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
   │       │       │       ││       │       │       ││       │       │       │
   │   6   │       │       ││       │       │       ││   5   │       │       │
   │       │       │       ││       │       │       ││       │       │       │
   └───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘
   ┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐
   │       │       │       ││       │       │       ││       │       │       │
   │       │   6   │       ││   8   │   9   │       ││       │       │   3   │
   │       │       │       ││       │       │       ││       │       │       │
   ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
   │       │       │       ││       │       │       ││       │       │       │
   │       │       │       ││       │   5   │       ││       │       │   7   │
   │       │       │       ││       │       │       ││       │       │       │
   ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
   │       │       │       ││       │       │       ││       │       │       │
   │       │   9   │   8   ││       │   2   │       ││       │   5   │       │
   │       │       │       ││       │       │       ││       │       │       │
   └───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘

$SUDOKU is starting prune pass # 1
$SUDOKU found the digit 8 by exclusiveness at cell 2,2 (2478)
$SUDOKU found the digit 3 by exclusiveness at cell 3,7 (367)
$SUDOKU found the digit 5 by exclusiveness at cell 4,1 (234578)
$SUDOKU found the digit 8 by exclusiveness at cell 5,1 (478)
$SUDOKU found the digit 9 by exclusiveness at cell 6,4 (12479)
$SUDOKU found the digit 9 by exclusiveness at cell 5,9 (469)
$SUDOKU found the digit 5 by exclusiveness at cell 7,3 (2457)
$SUDOKU found the digit 1 by exclusiveness at cell 8,2 (1234)
$SUDOKU found the digit 9 by exclusiveness at cell 8,7 (469)
$SUDOKU found the digit 8 by exclusiveness at cell 8,8 (268)
$SUDOKU found the digit 8 by exclusiveness at cell 6,9 (48)
$SUDOKU found the digit 8 by exclusiveness at cell 4,6 (24678)
$SUDOKU found the digit 4 by exclusiveness at cell 4,7 (467)
$SUDOKU found the digit 2 by exclusiveness at cell 7,8 (12)
$SUDOKU found the digit 4 by exclusiveness at cell 9,9 (46)
$SUDOKU found the digit 6 by exclusiveness at cell 9,7 (16)
$SUDOKU found the digit 1 by exclusiveness at cell 7,7 (1)
$SUDOKU found the digit 1 by exclusiveness at cell 2,8 (167)
$SUDOKU found the digit 7 by exclusiveness at cell 2,7 (7)
 ∙
 ∙
 ∙
   some output elided ∙∙∙
 ∙
 ∙
 ∙ 
   ┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐
   │       │       │       ││       │       │       ││       │       │       │
   │   4   │   5   │   3   ││   1   │   7   │   6   ││   8   │   9   │   2   │
   │       │       │       ││       │       │       ││       │       │       │
   ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
   │       │       │       ││       │       │       ││       │       │       │
   │   9   │   8   │   6   ││   4   │   3   │   2   ││   7   │   1   │   5   │
   │       │       │       ││       │       │       ││       │       │       │
   ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
   │       │       │       ││       │       │       ││       │       │       │
   │   1   │   2   │   7   ││   5   │   8   │   9   ││   3   │   4   │   6   │
   │       │       │       ││       │       │       ││       │       │       │
   └───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘
   ┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐
   │       │       │       ││       │       │       ││       │       │       │
   │   5   │   3   │   9   ││   2   │   6   │   8   ││   4   │   7   │   1   │
   │       │       │       ││       │       │       ││       │       │       │
   ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
   │       │       │       ││       │       │       ││       │       │       │
   │   8   │   7   │   1   ││   3   │   4   │   5   ││   2   │   6   │   9   │
   │       │       │       ││       │       │       ││       │       │       │
   ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
   │       │       │       ││       │       │       ││       │       │       │
   │   6   │   4   │   2   ││   9   │   1   │   7   ││   5   │   3   │   8   │
   │       │       │       ││       │       │       ││       │       │       │
   └───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘
   ┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐
   │       │       │       ││       │       │       ││       │       │       │
   │   7   │   6   │   5   ││   8   │   9   │   4   ││   1   │   2   │   3   │
   │       │       │       ││       │       │       ││       │       │       │
   ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
   │       │       │       ││       │       │       ││       │       │       │
   │   2   │   1   │   4   ││   6   │   5   │   3   ││   9   │   8   │   7   │
   │       │       │       ││       │       │       ││       │       │       │
   ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤
   │       │       │       ││       │       │       ││       │       │       │
   │   3   │   9   │   8   ││   7   │   2   │   1   ││   6   │   5   │   4   │
   │       │       │       ││       │       │       ││       │       │       │
   └───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘

$SUDOKU is starting prune pass # 4
 sudoku puzzle solved.

REXX version 2

Translation of: PL/I
  Parse Arg g.0fid
  Select
    When g.0fid='?' Then Do
      Say 'This program solves any (valid) SUDOKU puzzle'
      Say 'Specify the name of the file containing the puzzle as argument'
      Exit
      End
    When g.0fid='' Then
      Call exit 'no input specified'
    When lines(g.0fid)=0 Then
      Call exit 'specified input does not exist'
    Otherwise
      Nop
    End
  instr=''
  Do While lines(g.0fid)>0
    instr=instr||linein(g.0fid)
    End
  Call lineout g.0fid
  digits='123456789'
  buffer=translate(instr,digits'000',digits'0.x'||xrange('00'x,'ff'x))
  buffer=space(buffer,0)
  If length(buffer)<>81 Then
    Call exit 'invalid input from file' g.0fid
  Call set_geometry

  posbit.=copies('0',9)
  z=posbit.0
  d.z=0

  Do i=1 To 9
    posbit.i=overlay('1',posbit.i,i,1)
    z=posbit.i
    d.z=i
    End

  Do r=1 To 9
    Do c=1 To 9
      Parse Var buffer d +1 buffer
      matrix.r.c=posbit.d
      End
    End

  nn=0
  Call show_matrix 'input from' g.0fid
  res=solve()
  If res Then Do
    Call dbg 'nn='format(nn,5) 'res='res
    Call show_matrix 'solution'
    End
  Else
    Say 'impossible'
  Exit

solve: Procedure Expose g. matrix. posbit. nn box. boxlr. boxlc.
  nn=nn+1
  Call dbg 'solve nn='format(nn,5)
  do i = 1 to 9
    do j = 1 to 9
      if matrix.i.j=posbit.0 Then
        Leave i
      End
    End
  If i>9 Then Do
    do i = 1 to 9
      do j = 1 to 9
        k = pos('1',matrix.i.j)
        Call dbg 'sudoku',
                       Format(nn,9) Format(i,9) Format(j,9) Format(k,9)
        matrix.i.j=posbit.0
        result_=neg(or(any_col(i),any_row(j),any_box(i,j)))
        If substr(result_,k,1)=0 Then
          Return 0
        matrix.i.j=posbit.k
        End
      End
    Return 1
    End
  Else Do
    result_=neg(or(any_col(i),any_row(j),any_box(i,j)))
    Call dbg 'resulta='result_
    k=0;
    do Until k=0
      Call dbg 'resultb='result_
      k=pos('1',result_,k+1)
      Call dbg 'k='Format(k,2)Format(i,2)Format(j,2)
      if k>0 then Do;
        matrix.i.j=posbit.k
        Call dbg 'setting matrix('i','j')->'k
        res=solve()
        Call dbg 'A nn='format(nn,5) 'res='res
        if res then
          return 1
        else Do;
          matrix.i.j=posbit.0
          Call dbg 'setting matrix('i','j')->'0
          End;
        end;
      end;
    return 0
    end;

set_geometry:
  box.=''
  Do j=1 To 9                       /* build the box bounds.         */
    rr=(((j*3)%10)+1)*3-2           /* compute row lower bound.      */
    cc=(((j-1)//3)+1)*3-2           /* compute col lower bound.      */
    boxr.j=rr
    boxc.j=cc
    Do r=rr To rr+2                 /* build boxes with cell #s.     */
      Do c=cc To cc+2
        box.r.c=j
        End
      End
    End                             /* j                             */
  rowlb.=10                         /* row R,  low box number=b.     */
  collb.=10                         /* col R,  low box number=b.     */
  boxlr.=10                         /* box B,  low row number=r.     */
  boxlc.=10                         /* box B,  low col number=c.     */

  Do r=1 To 9
    Do c=1 To 9
      b=box.r.c                     /* what box is this R,C in ?     */
      rowlb.r=min(rowlb.r,b)        /* find min box # for row R.     */
      collb.c=min(collb.c,b)        /* find min box # for col C.     */
      boxlr.b=min(boxlr.b,r)        /* find min row # for box B.     */
      boxlc.b=min(boxlc.b,c)        /* find min col # for box B.     */
      End
    End
Return

any_col: Procedure Expose matrix.
  Parse Arg r
  res='000000000'
  Do c=1 To 9
    p=pos('1',matrix.r.c)
    If p>0 Then
      res=overlay('1',res,p,1)
    End
  Return res

any_row: Procedure Expose matrix.
  Parse Arg c
  res='000000000'
  Do r=1 To 9
    p=pos('1',matrix.r.c)
    If p>0 Then
      res=overlay('1',res,p,1)
    End
  Return res

any_box: Procedure Expose matrix. box. boxlr. boxlc.
  Parse Arg r,c
  b=box.r.c
  res='000000000'
  Do r=boxlr.b For 3
    Do c=boxlc.b For 3
      p=pos('1',matrix.r.c)
      If p>0 Then
        res=overlay('1',res,p,1)
      End
    End
  Return res

or: Procedure
  res='000000000'
  Do ia=1 To 3
    a=arg(ia)
    Do p=1 To 9
      If substr(a,p,1)=1 Then
        res=overlay('1',res,p,1)
      End
    End
  Return res

neg: Procedure
  Parse Arg s
  res=''
  Do p=1 To 9
    If substr(s,p,1)=1 Then
      res=res'0'
    Else
      res=res'1'
    End
  Return res

o: Say arg(1)
   Return

show_matrix:
  Call o arg(1)
  Do r=1 To 9
    ol=''
    Do c=1 To 9
      m=matrix.r.c
      ol=ol||d.m' '
      If c//3=0 Then
        ol=ol' '
      End
    Call o ol
    If r//3=0 Then
      Call o ' '
    End
  Return

dbg:
  If debug=1 Then
    Say arg(1)
  Return

exit: Say '*ERROR*' arg(1)
Output:
input from d:\_sudoku\in\sdk001.in
4 6 0  0 0 1  0 0 0
0 0 2  0 9 6  0 0 0
0 3 0  0 0 0  0 6 8

0 0 0  0 0 0  0 3 7
0 0 0  6 0 7  0 0 0
5 1 0  0 0 0  0 0 0

8 4 0  0 0 0  0 5 0
0 0 0  7 1 0  9 0 0
0 0 0  3 0 0  0 2 4

solution
4 6 5  8 3 1  2 7 9
7 8 2  4 9 6  3 1 5
1 3 9  5 7 2  4 6 8

6 9 4  1 2 5  8 3 7
3 2 8  6 4 7  5 9 1
5 1 7  9 8 3  6 4 2

8 4 1  2 6 9  7 5 3
2 5 3  7 1 4  9 8 6
9 7 6  3 5 8  1 2 4

REXX version 3

This is version 1 (thanks) cut to the essentials, restructured, and modified 

/* REXX ---------------------------------------------------------------
* program to solve nearly every SUDOKU puzzle
* using a number of strategies learned from REXX version 1
*           and one rather efficient algorithm created by me: prunewalt
* see solve: for details
* Tested with Regina and ooRexx
* See version 2 for a program that solves every valid SUDOKU
*--------------------------------------------------------------------*/
  Signal on Halt
  Signal on Novalue
  Signal on Syntax
  Parse Arg fid debug
  Select
    When fid='?' Then Do
      Say 'This program solves many (nearly every?) SUDOKU puzzle'
      Say 'rexx sudoku file [DEBUG]'
      Say 'Input: file.in'
      Say 'Debug: file.dbg'
      Say 'Known: file.sol'
      Say 'Incomplete solution (if applicable): fileF.in'
      Say 'Output: on screen'
      Say 'Adapt subroutine get_input if necessary!'
      Say 'See version 2 for a brute force program',
                                           'solving EVERY valid SUDOKU'
      Exit
      End
    When fid='' Then Do
      Say 'Input file not specified'
      Say 'Enter "rexx sudoku ?" for help'
      Exit
      End
    Otherwise
      Nop
    End

  g.=0
  g.0debug=(translate(debug)='DEBUG')

  Call get_input fid            /* get input and set up file names   */
                                /* Please adapt to your environment  */
  Numeric Digits 50             /* because of huge # of combinations */

  Call set_geometry

  Call show_aa 'the puzzle'         /* show the grid to screen       */
  Call build_poss                   /* build possible values         */
  g.0todo_init=g.0todo
  Call show_poss 'puzzle possibles' /* show 1st possibles            */

  Call solve                        /* now try to solve it           */

  If g.0todo=0 Then Do              /* no cell left empty            */
    Call o g.0fid 'puzzle solved.'  /* tell it                       */
    Call o left(g.0fid,12) 'puzzle solved.'
    Call show_aa 'solved'           /* show the solution             */
    End
  Else Do                           /* some cells couldn't be filled */
    Call show_poss 'failed'         /* show the possibilities left   */
    Call o left(g.0fid,12) 'puzzle failed g.0todo='g.0todo
    Call show_aa 'failed','.'       /* show the partly solved puzzle */
    End

  Call write_summary

  Exit

build_poss: Procedure Expose g. s. aa. poss.,
                                         box. boxr. boxc. boxlr. boxlc.
/*---------------------------------------------------------------------
* aa.r.c contains the known digits
* we determine which digits are possible for empty positions
* and put them into poss.r.c
*--------------------------------------------------------------------*/
  all='123456789'
  Parse Value '' With dr. dc. db.   /* initialize strings built here */
  poss.=''
  Do r=1 To 9
    Do c=1 To 9
      dr.r=dr.r||aa.r.c             /* all digits in row r           */
      End
    End
  Do c=1 To 9
    Do r=1 To 9
      dc.c=dc.c||aa.r.c             /* all digits in col c           */
      End
    End
  Do b=1 To 9
    Do r=boxlr.b For 3
      Do c=boxlc.b For 3
        db.b=db.b||aa.r.c           /* all digits in box b           */
        End
      End
    End

  g.0tot=0                          /* total # of possible digits    */
  g.0todo=0                         /* number of cells to be filled  */
  g.0comb=1                         /* # of possible combinations    */

  Do r=1 To 9
    Do c=1 To 9                     /* do this for every r.c         */
      b=box.r.c                     /* the box this cell is in       */
      If aa.r.c='' Then Do          /* cell not yet known            */
        used=compress(dr.r||dc.c||db.b) /* all digits already used   */
        poss.r.c=diff(all,used)     /* all others are still possible */
        g.0todo=g.0todo+1           /* number of cells yet to fill   */
        g.0tot=g.0tot+length(poss.r.c)
        g.0comb=g.0comb*length(poss.r.c)
        End
      End
    End
  If g.0sol<>'' Then                /* if we know the solution       */
    Call check_all                  /* check if everything fits      */
  Return

solve:
/*---------------------------------------------------------------------
* Use several algorithms to determine which cell(s) can safely be set
* prunewalt: if a digit occurs just once
*                    in a row's, col's or box's list of possible digits
* prunesing: if there is only one possible digit in a cell
* pruneexcl ) Algorithms of version 1 only partly understood (by me!)
* prunemats ) but faithfully restructured to avoid many Iterate
* pruneline )                                             instructions.
*--------------------------------------------------------------------*/
  Call build_poss                   /* re-build the possibles        */
  Do g.0pass=1 By 1 Until g.0todo=0
    Call o g.0fn 'is starting prune pass #' g.0pass
    found_pass=0

    found=prunewalt()               /* find any singles ?            */
    found_pass=found_pass+found
    If g.0todo=0 Then Leave
    If found>0 Then
      Call show_grid 'after prunewalt'

    found=prunesing()               /* find any singles ?            */
    found_pass=found_pass+found
    If g.0todo=0 Then Leave
    If found>0 Then
      Call show_grid 'after prunesing'

    found=pruneexcl()               /* find any excluives ?          */
    found_pass=found_pass+found
    If g.0todo=0 Then Leave
    If found>0 Then
      Call show_grid 'after pruneexcl'

    found=prunemats(2)              /* find any matches (len=2)      */
    found_pass=found_pass+found
    If g.0todo=0 Then Leave
    If found>0 Then
      Call show_grid 'after prunemats'

    found=pruneline()               /* find 2 or more on a line?     */
    found_pass=found_pass+found
    If g.0todo=0 Then Leave
    If found>0 Then
      Call show_grid 'after pruneline'

    If found_pass>0 Then Do
      Call o found_pass 'hits in g.0pass' g.0pass
      If g.0debug Then
        Call write_summary
      End
    Else Do
      Call o 'Nothing found in g.0pass' g.0pass
      Leave
      End
    End                             /* prunes                        */
  Return

prunewalt: Call o '>>>>>> prunewalt tot='g.0tot 'todo='g.0todo
/*---------------------------------------------------------------------
* find digits that have only one occurrence in a row or column
* row_poss.r digits in row r
* col_poss.c digits in column c
* box_poss.b digits in box b
*--------------------------------------------------------------------*/
  foundwalt=0                       /* no matches found so far.      */
  Do Until changed=0                /* keep searching ...            */
    changed=0                       /* changes made in this routine  */
    row_poss.=''                    /* build str for each row        */
    col_poss.=''                    /* build str for each column     */
    box_poss.=''                    /* build str for each box        */

    Do r=1 To 9
      Do c=1 To 9
        b=box.r.c
        If poss.r.c\=='' Then Do
          row_poss.r=row_poss.r poss.r.c
          col_poss.c=col_poss.c poss.r.c
          box_poss.b=box_poss.b poss.r.c
          End
        End
      End
    rl=''
    Do r=1 To 9
      ol='row'r':'
      Do d=1 To 9
        cnt=count(d,row_poss.r)
        ol=ol cnt
        If cnt=1 Then Do
          rl=rl r
          dr.r=d
          End
        End
      End
    cl=''
    Do c=1 To 9
      ol='col'c':'
      Do d=1 To 9
        cnt=count(d,col_poss.c)
        ol=ol cnt
        If cnt=1 Then Do
          dc.c=d
          cl=cl c
          End
        End
      End

    bl=''
    Do b=1 To 9
      ol='box'||b':'
      Do d=1 To 9
        cnt=count(d,box_poss.b)
        ol=ol cnt
        If cnt=1 Then Do
          z=r'.'c
          db.z=d
          bl=bl z
          End
        End
      End

    Do While rl<>''
      Parse Var rl r rl
      Do c=1 To 9
        If pos(dr.r,poss.r.c)>0 Then Do
          Call set_aa r,c,dr.r,'prunewalt new R'
          changed=changed+1
          foundwalt=foundwalt+1
          Call build_poss           /* re-build the possibles        */
          End
        End
      End
    Do While cl<>''
      Parse Var cl c cl
      Do r=1 To 9
        If pos(dc.c,poss.r.c)>0 Then Do
          Call set_aa r,c,dc.c,'prunewalt new C'
          changed=changed+1
          foundwalt=foundwalt+1
          Call build_poss           /* re-build the possibles        */
          End
        End
      End
    Do While bl<>''
      Parse Var bl z cb bl
      Parse Var z rb '.' cb
      Do r=boxlr.b For 3
        Do c=boxlc.b For 3
          If r=rb &,
             c=cb &,
             pos(db.z,poss.r.c)>0 Then Do
            Say 'z='r 'c='c 'poss.'r'.'c'='poss.r.c 'db.b='db.b
            Call set_aa r,c,db.b,'prunewalt new B'
            changed=changed+1
            foundwalt=foundwalt+1
            Call build_poss         /* re-build the possibles        */
            End
          End
        End
      End
    End
  Call show_poss 'after prunewalt'

  If foundwalt>0 Then
    Call o '>>>>>> prunewalt foundwalt='foundwalt
  Else
    Call o '>>>>>> prunewalt found nothing'
  g.0foundwalt=g.0foundwalt+foundwalt
  Return foundwalt

prunesing: Call o '>>>>>> prunesing tot='g.0tot 'todo='g.0todo
/*---------------------------------------------------------------------
* look if there are cells with a single possible digit and put these
* into the grid. Return the number of changes made.
*--------------------------------------------------------------------*/
  foundsing=0
  Do r=1 To 9
    Do c=1 To 9
      If length(poss.r.c)=1 Then Do /* only possible digit           */
        Call set_aa r,c,poss.r.c,'prunesing' /* put it into the cell */
        foundsing=foundsing+1       /* indicate success              */
        End
      End
    End
  If foundsing>0 Then Do
    Call build_poss                 /* re-build the possibles        */
    Call o '>>>>>> prunesing foundsing='foundsing
    End
  Else
    Call o '>>>>>> prunesing found nothing'
  g.0foundsing=g.0foundsing+foundsing
  Return foundsing

pruneexcl: Call o '>>>>>> pruneexcl tot='g.0tot 'todo='g.0todo
/*---------------------------------------------------------------------
*
*--------------------------------------------------------------------*/
  foundexcl=0
  Do exclusives=1                   /* keep building possibles.      */
    Do r=1 For 9
      Do c=1 For 9
        z=poss.r.c
        lz=length(z)                /* get length of possible.       */
        If lz>0 Then Do
          y=''
          b=box.r.c
          Do br=boxr.b For 3
            Do bc=boxc.b For 3      /* for every cell in box b       */
              If br'.'bc<>r'.'c Then
                y=y||aa.br.bc||poss.br.bc
              End
            End
          Do t=1 For lz
            q=substr(z,t,1)
            If pos(q,y)==0 Then Do
              foundexcl=foundexcl+1
              If aa.r.c=q Then
                Call o 'pruneexcl ??? aa.'r'.'c'='q 'already set'
              Call o 'foundexcl='foundexcl
              Call set_aa r,c,q,'pruneexcl' /* a singularity, a sol  */
              Call o 'pruneexcl found the digit' q,
                                  'by exclusiveness at cell' drc(r,c,z)
              Call build_poss       /* re-build the possibles        */
              Iterate exclusives
              End
            End
          End
        End
      End
    Leave
    End
  If foundexcl>0 Then Do
    Call o '>>>>>> pruneexcl foundexcl='foundexcl
    End
  Else
    Call o '>>>>>> prunesing found nothing'
  g.0foundexcl=g.0foundexcl+foundexcl
  Return foundexcl

prunemats: Call o '>>>>>> prunemats tot='g.0tot 'todo='g.0todo
/*---------------------------------------------------------------------
* This example illustrates the working of this strategy:
* Column 1    2    3    4    5    6    7    8    9
* Row 7: .    .    1369 29   26   29   137  .    136
* remove 29 from drc 7.3=1369 giving drc 7.3=136 (matches 7.4 7.6)
* Row 7: .    .    136  29   26   29   137  .    136
* remove 29 from drc 7.5=26   giving drc 7.5=6   (matches 7.4 7.6) HIT
* Row 7: .    .    136  29   6    29   137  .    136
* Row 7: .    .    139  29   .    29   137  .    13
* remove 29 from drc 7.3=139  giving drc 7.3=13  (matches 7.4 7.6)
* Row 7: .    .    13   29   .    29   137  .    13
* remove 13 from drc 7.7=137  giving drc 7.7=7   (matches 7.9 7.3) HIT
* Row 7: .    .    13   29   .    29   7    .    13
* Row 7: .    .    139  29   .    29   .    .    13
*--------------------------------------------------------------------*/
  setmats=0
  foundmats=0                       /* no matches found so far.      */
  Parse Arg l                       /* length of match, L=2,pair     */
  Do matches=1
    Do r=1 For 9
      Do c=1 For 9
        _=length(poss.r.c)          /* get length of possible.       */
        If _=l Then Do
          qq=poss.r.c
          m=0                       /* count of matches so far.      */
          mla=r'.'c
          Do _c=1 For 9             /* a match in same row?          */
            If _c<>c &,
               qq==poss.r._c Then Do
              m=m+1                 /* up count if it's a match.     */
              mla=mla r'.'_c
              End
            End
          If m>0 Then Do
            Call o 'AAAA mla='mla
            Call show_poss_r r
            Do pc=1 For 9           /* remove other possibles.       */
              old=poss.r.pc         /* save the "old" value.         */
              If old<>qq & old<>'' Then Do
                new=diff(old,qq)    /* remove mat's digs from X.     */
                Call o 'AAAA' r'.'pc':'old '-' qq '-->' new
                If new<>old Then Do
                  If length(new)=1 Then tag='HIT'; Else tag=''
                  Call o 'remove' qq 'from' drc(r,pc,old),
                           'giving' drc(r,pc,new) '(matches' mla')' tag
                  poss.r.pc=new     /* store new value into old.     */
                  Call show_poss 'AAAA1'
                  Call show_poss_r r
                  setmats=setmats+1 /* indicate match was found.     */
                  If length(new)==1 Then Do /*reduce if L=1*/
                    Call set_aa r,pc,new,'prunemats R' /*store single*/
                    foundmats=foundmats+1 /* indicate match was found*/
                    Call build_poss /* re-build the possibles        */
                    Call show_poss 'AAAA2'
                    Call show_poss_r r
                    Iterate matches       /* start over.             */
                    End
                  End
                End
              End
            End
          m=0
          mlb=r'.'c
          Do _r=1 For 9
            If _r<>r &,
               qq==poss._r.c Then Do
              m=m+1
              mlb=_r'.'c
              End
            End

          If m>0 Then Do
            Call o 'BBBB mlb='mlb
            Call show_poss_r r
            Do pr=1 For 9
              old=poss.pr.c
              If old<>qq & old<>'' Then Do
                new=diff(old,qq)
                Call o 'BBBB' pr'.'c':'old '-' qq '-->' new
                If new<>old Then Do
                  If length(new)=1 Then tag='HIT'; Else tag=''
                  Call o 'remove' qq 'from' drc(pr,c,old),
                           'giving' drc(pr,c,new) '(matches' mlb')' tag
                  poss.pr.c=new
                  Call show_poss_r r
                  Call show_poss 'BBBB1'
                  setmats=setmats+1
                  If length(new)==1 Then Do
                    foundmats=foundmats+1
                    Call set_aa pr,c,new,'prunemats C'
                    Call build_poss /* re-build the possibles        */
                    Call show_poss 'BBBB2'
                    Call show_poss_r r
                    Iterate matches
                    End
                  End
                End
              End
            End
          End
        End
      End
    Leave
    End

  If foundmats>0 Then Do
    Call o '>>>>>> prunemats foundmats='foundmats
    End
  Else
    Call o '>>>>>> prunesing found nothing'
  g.0foundmats=g.0foundmats+foundmats
  Return setmats

pruneline: Call o '>>>>>> pruneline tot='g.0tot 'todo='g.0todo
/*---------------------------------------------------------------------
*
*--------------------------------------------------------------------*/
  Call show_poss ' vor pruneline'
  pruned=0
  foundline=0                       /* no matches found so far.      */
  Do Until changes=0                /* terminate if no changes made  */
    changes=0                       /* initialize number of changes  */
    poss_boxr.=''                   /* build str for each boxrow     */
    poss_boxc.=''                   /* build str for each boxcol     */
    Do r=1 To 9
      Do c=1 To 9
        b=box.r.c
        If poss.r.c\=='' Then Do
          poss_boxr.r.b=strip(poss_boxr.r.b poss.r.c)
          poss_boxc.c.b=strip(poss_boxc.c.b poss.r.c)
          End
        End
      End
    Do r=1 To 9                     /* search all rows for twins     */
      Do cb=1 To 7 By 3             /* 3 boxes containing row r      */
        b=box.r.cb
        aline=poss_boxr.r.b         /* all poss strings: row r box b */
        If words(aline)>=2 Then Do  /* more than one                 */
          Call o 'aline' r'.'||b'='aline '(cb='cb')'
          Do k=1 To 9               /* search for each digit.        */
            If count(k,aline)>=2 Then Do /* more than one occurrence */
              Do jr=rowlb.r For 3   /* look at the other 2 rows.     */
                If jr<>r &,
                   pos(k,poss_boxr.jr.b)>0 Then /* digit k found     */
                  Iterate k         /* continue with the next digit  */
                End
              Do jb=rowlb.r For 3   /* search boxes of row R for K.  */
                If jb<>b &,
                   pos(k,poss_boxr.r.jb)>0 Then Do
                  Do kc=1 To 9      /* find which cell  K is in.     */
                    If box.r.kc<>b Then Do
                      If poss.r.kc<>'' &,
                         pos(k,poss.r.kc)>0 Then Do
                        old=drc(r,kc,poss.r.kc)
                        row_a=poss_r(r)
                        poss.r.kc=diff(poss.r.kc,k) /* remove digit k*/
                        Call o g.0fn 'row' r': removing' k 'from' old,
                                     'resulting in' drc(r,kc,poss.r.kc)
                        row_b=poss_r(r)
                        Call o '  ' row_a
                        Call o '>>' row_b
                        pruned=pruned+1
                        If length(poss.r.kc)==1 Then Do
                          Call set_aa r,kc,poss.r.kc,'pruneline R'
                          foundline=foundline+1
                          Call build_poss /* re-build the possibles  */
                          changes=changes+1
                          End
                        End
                      End
                    End
                  End
                End
              End
            End
          End
        End
      End

    Do c=1 To 9                     /* search all cols for twins     */
      Do b=collb.c By 3 For 3       /* for each col, search box.     */
        aline=poss_boxc.c.b
        If words(aline)>=2 Then Do
          Do k=1 To 9               /* search for each digit.        */
            If count(k,aline)>=2 Then Do
              Do jc=boxlc.b For 3   /* look at the other 2 cols.     */
                If jc<>c&pos(k,poss_boxc.jc.b)<>0 Then
                  Iterate k         /* if no digit K, ignore         */
                End                 /* jc                            */
                                    /*found 2 Ks in col C box B      */
              Do jb=collb.c By 3 For 3 /*search boxes col C for K.   */
                If jb<>b&pos(k,poss_boxc.c.jb)<>0 Then Do
                  Do kr=1 To 9      /* find which cell  K is in.     */
                    If box.kr.c<>b Then Do
                      If poss.kr.c>''&,
                         pos(k,poss.kr.c)>0 Then Do
                        old=drc(kr,c,poss.kr.c)
                        col_a=poss_c(c)
                        poss.kr.c=diff(poss.kr.c,k) /* remove digit k*/
                        Call o g.0fn 'col' c': removing' k 'from' old,
                                     'resulting in' drc(kr,c,poss.kr.c)
                        col_b=poss_c(c)
                        Call o '  ' col_a
                        Call o '>>' col_b
                        pruned=pruned+1
                        If length(poss.kr.c)==1 Then Do
                          Call set_aa kr,c,poss.kr.c,'pruneline C'
                          foundline=foundline+1
                          Call build_poss /* re-build the possibles  */
                          changes=changes+1
                          End
                        End
                      End
                    End
                  End
                End
              End
            End
          End
        End
      End
    End
  Call show_poss 'nach pruneline'
  If foundline>0 Then
    Call o '>>>>>> pruneline new foundline='foundline 'pruned='pruned
  Else
    Call o '>>>>>> pruneline new found nothing' 'pruned='pruned
  g.0foundline=g.0foundline+foundline
  Return foundline

show_grid:
/*---------------------------------------------------------------------
* show what's known so far
* and what's still to be done
*--------------------------------------------------------------------*/
  Parse Arg title
  Call show_aa title
  Call show_poss title
  Return

show_aa: Procedure Expose g. aa. s.
/*---------------------------------------------------------------------
* Show all cells that are known already
* and determine the number of cells yet to be filled (g.0todo)
*--------------------------------------------------------------------*/
  Parse Arg txt
  blank='.'
  Select
    When txt='the puzzle' |,        /* initial call                  */
         txt='solved' Then          /* final call (success)          */
      g.0say=1                      /* show on screen                */
    When txt='failed' Then Do       /* final call (failure)          */
      g.0say=1                      /* show on screen                */
      g.0fail=1                     /* write to incomplete solution  */
      End
    Otherwise
      g.0say=0                      /* don't show on screen          */
    End
  Call o txt                        /* write to dbg/screen/inco      */
  g.0todo=0
  Do r=1 To 9                       /* for all rows                  */
    ol=''
    Do c=1 To 9                     /* build a line                  */
      If aa.r.c='' Then Do
        g.0todo=g.0todo+1
        ol=ol blank
        End
      Else
        ol=ol aa.r.c
      If c//3=0 Then                /* a blank column                */
        ol=ol' '
      End
    Call o ol
    If r//3=0 Then                  /* a blank line                  */
     Call o ' '
    End
  g.0say=0                          /* reset the flags               */
  g.0fail=0
  If g.0todo>0 Then
    Call o right('to be done:',40) g.0todo
  Else
    Call o 'all done'
  Return

show_poss: Procedure Expose poss. g. s.
/*---------------------------------------------------------------------
* show all possible digits of the grid
*--------------------------------------------------------------------*/
  Parse Arg txt
  If g.0todo=0 Then
    Return
  Call o copies('-',70) 'todo='g.0todo
  Call o txt
  Do r=1 To 9
    ol=r
    Do c=1 To 9
      ol=ol left(poss.r.c,7)
      If c//3=0 Then
        ol=ol '|'
      End
    Call o ol
    If r//3=0 Then
      Call o ' '
    End
  Call o '       tot='g.0tot 'todo='g.0todo
  Call o 'combinations:' g.0comb
  Return

show_poss_r: Procedure Expose g. poss.
/*---------------------------------------------------------------------
* show possible digits in row r
'--------------------------------------------------------------------*/
  Parse Arg r
  Call o poss_r(r)
  Return

poss_r: Procedure Expose g. poss.
/*---------------------------------------------------------------------
* compute possible digits in row r
'--------------------------------------------------------------------*/
  Parse Arg r
  ol='Row' r':'
  Do c=1 To 9
    prc=poss.r.c
    If prc='' Then prc='.'
    ol=ol left(prc,6)
    End
  Return ol

show_poss_c: Procedure Expose g. poss.
/*---------------------------------------------------------------------
* show possible digits in column c
'--------------------------------------------------------------------*/
  Parse Arg c
  Call o poss_c(c)
  Return

poss_c: Procedure Expose g. poss.
/*---------------------------------------------------------------------
* compute possible digits in column c
'--------------------------------------------------------------------*/
  Parse Arg c
  ol='Col' c':'
  Do r=1 To 9
    prc=poss.r.c
    If prc='' Then prc='.'
    ol=ol left(prc,6)
    End
  Return ol

compress: Procedure
/*---------------------------------------------------------------------
* build a string containing the digits found in s
* Example: compress('11 9 33 55') -> '1359'
*--------------------------------------------------------------------*/
  Parse Arg s
  res=''
  Do d=1 To 9
    If pos(d,s)>0 Then
      res=res||d
    End
  Return left(res,9)

diff:
/*---------------------------------------------------------------------
* build the 'difference' of two strings  (same as squish in version 1)
* Return a string of digits contained in arg(1) not existant in arg(2)
* Example: diff('13895','35') -> '189'
*--------------------------------------------------------------------*/
  Return space(translate(arg(1),,word(arg(2) ',',1)),0)

check_all:
/*---------------------------------------------------------------------
* check the current status against the target (if this is known)
*--------------------------------------------------------------------*/
  error=0
  Do r=1 To 9
    Do c=1 To 9
      If aa.r.c=''|aa.r.c=s.r.c Then
        Nop
      Else Do
        Call o 'r='r 'c='c 'soll='s.r.c 'ist='aa.r.c
        error=1
        End
      End
    End
  Do r=1 To 9
    Do c=1 To 9
      Select
        When poss.r.c='' Then
          Nop
        When pos(s.r.c,poss.r.c)>0 Then
          Nop
        Otherwise Do
          Call o 'r='r 'c='c aa.r.c 'not in poss:'poss.r.c
          error=1
          End
        End
      End
    End
  If error Then
    Call exit 'an error in check_all'
  Return

o:
/*---------------------------------------------------------------------
* write to the debug file           (when g.0debug is true)
* and, if applicable, to the screen (when g.0say is true)
* and to the incomplete solution    (when g.0fail is true)
*--------------------------------------------------------------------*/
   If g.0say Then
     Say arg(1)
   If g.0fail Then
     Call lineout g.0inco,arg(1)
   If g.0debug Then
     Call lineout g.0dbg,arg(1)
   Return

set_aa: Procedure Expose g. aa. poss. box. boxr. boxc. boxlr. boxlc.,
                         s. sigl
/*---------------------------------------------------------------------
* put a digit into the cell r.c and show the text given
*--------------------------------------------------------------------*/
  Parse Arg r,c,d,text
  from=sigl
  If s.r.c<>'*' &,
     d<>s.r.c Then Do
    call o 'Trying t set aa.'r'.'c 'to' d 'but should be' s.r.c
    Call o 'from='from
    Exit
    End

  Call o 'setting aa.'r'.'c' to d='d '('text')'
  If g.0done.r.c=1 Then Do
    Call o 'cell' r'.'c'='aa.r.c '>' d '?????' 'called_from='sigl,
                                                      'in pass' g.0pass
    End
  aa.r.c=d                          /* put the digit into the cell   */
  poss.r.c=''                       /* remove cell's possible digits */
  g.0done.r.c=1                     /* note that cell was set        */
  Return

count: Procedure
/*---------------------------------------------------------------------
* Return the number of occurrences of d in s (all digits)
* Example: count(3,'123 567 399 13') -> 3
*--------------------------------------------------------------------*/
  Parse Arg d,s
  s=translate(s,'*',d)
  s=translate(s,'','123456789')
  s=space(s,0)
  Return length(s)

drc: Procedure
/*---------------------------------------------------------------------
* return coordinates and contents of a cell as r.c=string
*--------------------------------------------------------------------*/
  Parse Arg r,c,s
  Return 'drc' r'.'c'='s

set_geometry:
/*---------------------------------------------------------------------
* set miscellaneous relations and limits
*--------------------------------------------------------------------*/
  box.=''
  Do b=1 For 9                      /* build the box bounds.         */
    rr=(((b*3)%10)+1)*3-2           /* compute row lower bound.      */
    cc=(((b-1)//3)+1)*3-2           /* compute col lower bound.      */
    boxr.b=rr
    boxc.b=cc
    Do r=rr To rr+2                 /* build boxes with cell #s.     */
      Do c=cc To cc+2
        rc=r||c
        box.b=box.b rc
        box.r.c=b
        End
      End
    box.b=strip(box.b)
    End

  rowlb.=9                          /* row R,  low box number=b.     */
  collb.=9                          /* col R,  low box number=b.     */
  boxlr.=9                          /* box B,  low row number=r.     */
  boxlc.=9                          /* box B,  low col number=c.     */
  Do r=1 To 9
    Do c=1 To 9
      b=box.r.c                     /* what box is this R,C in ?     */
      rowlb.r=min(rowlb.r,b)        /* find min box # for row R.     */
      collb.c=min(collb.c,b)        /* find min box # for col C.     */
      boxlr.b=min(boxlr.b,r)        /* find min row # for box B.     */
      boxlc.b=min(boxlc.b,c)        /* find min col # for box B.     */
      End                           /* c                             */
    End                             /* r                             */
  Return

get_input: Procedure Expose g. aa. s.
/*---------------------------------------------------------------------
* get the given puzzle
* 9 rows with 9 columns each containing a digit or a place holder (.x0)
* set the miscellaneous file-ids
* and get the known solution (if available) for checking in get_sol
*--------------------------------------------------------------------*/
  Parse Arg g.0fid
  Parse Var g.0fid g.0fn '.'
  If g.0debug Then Do
    g.0dbg=g.0fn'.dbg'              /* file to contain debug output  */
    /*********************************
    Call lineout g.0dbg
    If lines(g.0dbg)>0 Then         /* if the file exists            */
      'erase' g.0dbg                /*   erase it                    */
    *********************************/
    End
  If pos('.',g.0fid)=0 Then
    g.0fid=g.0fid'.in'
  digits='123456789'
  g.0fidx=g.0fid
  Say 'process file' g.0fidx
  If lines(g.0fidx)=0 Then
    Call exit 'Input file does not exist'
  instr=''
  Do While lines(g.0fidx)>0
    instr=instr linein(g.0fidx)
    End
  Call lineout g.0fidx
  instr=translate(instr,digits'000',digits'.x0'||xrange('00'x,'ff'x))
  instr=space(instr,0)
  Select
    When length(instr)<81 Then Do
      Say 'instr='instr'<'
      Call exit 'Incorrect input - not enough data'
      End
    When length(instr)>81 Then Do
      Say 'instr='instr'<'
      Call exit 'Incorrect input - too much data'
      End
    Otherwise Do
      Call o '   instr='instr'<'
      instr=translate(instr,' ','0')
      End
    End
  Do r=1 To 9
    Do c=1 To 9
      Parse Var instr aa.r.c +1 instr
      End
    End
  g.0inco=g.0fn'f.in'               /* file to contain failed res    */
  if lines(g.0inco)>0 Then          /* if the file exists            */
    'erase' g.0inco                 /*   erase it                    */
  g.0summ='sudoku.summary'          /* file to get statistics        */
  g.0sol= 'sol\'g.0fn'.sol'         /* known solution for checking   */
  If lines(g.0sol)>0 Then           /* if that file is found         */
    Call get_sol                    /*   get its data                */
  Else Do                           /* otherwise                     */
    g.0sol=''                       /*   don't check                 */
    s.='*'
    End
  Say 'Input from         ' g.0fidx
  Say 'Debug output to    ' g.0dbg
  If lines(g.0sol)>0 Then           /* if that file is found         */
    Say 'Given solution from' g.0sol
  Say 'Statistics to      ' g.0summ
  Say 'Incomplete solution' g.0inco '(if applicable)'
  Say 'Hit enter to proceed'
  Return

get_sol: Procedure Expose g. s.
/*---------------------------------------------------------------------
* get the known solution
* (9 rows with 9 columns each containing a digit)
*--------------------------------------------------------------------*/
  solvstr=''
  If lines(g.0sol)>0 Then Do
    Do While lines(g.0sol)>0
      solvstr=solvstr linein(g.0sol)
      End
    Call lineout g.0sol
    solvstr=space(solvstr,0)
    Call o 'solution='solvstr
    Do r=1 To 9
      Do c=1 To 9
        Parse Var solvstr s.r.c +1 solvstr
        End
      End
    Do r=1 To 9
      ol=s.r.1
      Do c=2 To 9
        ol=ol s.r.c
        If c//3=0 Then ol=ol' '
        End
      Call o ol
      If r//3=0 Then
        Call o ' '
      End
    End
  Return

exit: Say 'EXIT' arg(1)
      Exit

write_summary: Procedure Expose g.
/*---------------------------------------------------------------------
* add a line to the statistics
* file       init walt sing excl mats line todo pass
* sdk002.in    56   56    0    0    0    0    0    1
* sdk007.in    61   16    0    0    1    5   39    1 <---
* sdk007.in    61   55    0    0    1    5    0    2 solved
* sdk088.in    50   14    2   34    0    0    0    1
* sdk093.in    55    2    2    1    0    0   50    2 <---
* sdk093.in    55    2    2    1    0    0   50    2 <---  no success
*--------------------------------------------------------------------*/
  If lines(g.0summ)=0 Then          /* write header line             */
    Call lineout g.0summ,,
                   'file       init walt sing excl mats line todo pass'
  If g.0todo>0 Then tag='<---'      /* mark a failure                */
               Else tag=''
                                 /* show # of hits for each strategy */
  summline=left(g.0fid,10) right(g.0todo_init,4),
                           right(g.0foundwalt,4),
                           right(g.0foundsing,4),
                           right(g.0foundexcl,4),
                           right(g.0foundline,4),
                           right(g.0foundmats,4),
                           right(g.0todo,4),
                           right(g.0pass,4) tag
  /*
  Say summline
  */
  Call lineout g.0summ,summline
  Call lineout g.0summ              /* close the file                */
  Return

novalue:
  Say 'Novalue raised in line' sigl
  Say sourceline(sigl)
  Say 'Variable' condition('D')
  Signal lookaround

syntax:
  Say 'Syntax raised in line' sigl
  Say sourceline(sigl)
  Say 'rc='rc '('errortext(rc)')'

halt:
lookaround:
  If fore() Then Do
    Say 'You can look around now.'
    Trace ?R
    Nop
    End
  Exit 12
Output:
process file sdk087.in
Input from          sdk087.in
Debug output to     0
Given solution from
Statistics to       sudoku.summary
Incomplete solution sdk087f.in (if applicable)
Hit enter to proceed
the puzzle
 . . .  . . .  3 . .
 . . .  . 7 1  5 . .
 . . 2  4 . 6  . 1 8

 . . .  . . 9  . 4 6
 . 9 .  6 1 8  . 3 .
 6 1 .  7 . .  . . 9

 4 3 .  8 . 7  6 . .
 . . 8  1 4 .  . . .
 . . 9  . . .  . . .

solved
 7 4 1  9 8 5  3 6 2
 3 8 6  2 7 1  5 9 4
 9 5 2  4 3 6  7 1 8

 8 2 7  3 5 9  1 4 6
 5 9 4  6 1 8  2 3 7
 6 1 3  7 2 4  8 5 9

 4 3 5  8 9 7  6 2 1
 2 6 8  1 4 3  9 7 5
 1 7 9  5 6 2  4 8 3
Retrieved from "https://rosettacode.org/wiki/Sudoku/REXX?oldid=347669"