Sudoku/REXX: Difference between revisions
Content added Content deleted
(→REXX: Version 2: Moved.) |
(→REXX: Version 3: Moved.) |
||
Line 2,651: | Line 2,651: | ||
==REXX: Version 3== |
==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 |
|||
|
|||
. . . . . 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</pre> |