Rosetta Code

Sudoku/REXX: Difference between revisions

Page Discussion

Sudoku/REXX (view source)

Revision as of 23:34, 3 October 2014

36,048 bytes added ,  9 years ago
→‎REXX: Version 3: Moved.
Line 2,651:
 
==REXX: Version 3==
This is version 1 (thanks) cut to the essentials, restructured, and modified
<lang rexx>/* 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
*--------------------------------------------------------------------*/
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</lang>
{{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
&nbsp;
. . . . . 9 . 4 6
. 9 . 6 1 8 . 3 .
6 1 . 7 . . . . 9
&nbsp;
4 3 . 8 . 7 6 . .
. . 8 1 4 . . . .
. . 9 . . . . . .
&nbsp;
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
&nbsp;
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
&nbsp;
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</pre>
Anonymous user
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/223723"