Sudoku/REXX
$SUDOKU.REX
This is the $SUDOKU.REX (REXX) program and is used to solve the Rosetta Code task of "sudoku".
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 help and other documentation.
<lang rexx>/*REXX program displays, can give hints, and/or solve a sudoku puzzle. */
/*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' L "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' L "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>