Sudoku/REXX: Difference between revisions
→REXX version 3
m (→REXX: Version 1: corrected the link to two pointers to REXX routines.) |
|||
(10 intermediate revisions by 3 users not shown) | |||
Line 1:
{{collection|Sudoku}}
==[[REXX
=== REXX version 1 ===
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). One option is to solve the puzzle.
The help for the <code>$SUDOKU</code> REXX program is included here ───► [[$SUDOKU.HEL]].
The <code>$ERR.REX</code> REXX program is included here ───► [[$ERR.REX]].
The <code>$SUDOKU.REX</code> REXX program makes use of <code>$T.REX</code> REXX program which is used to display text messages.
The <code>$T.REX</code> 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 <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
parse arg !
Line 770 ⟶ 781:
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
Line 784 ⟶ 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)
$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))
Line 790 ⟶ 805:
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
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 $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$@@@@@@@@@@@@@@@@@@@@@@@@##############%%%%%%%%%%%%%%%%%%%
{{out|output| 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>}}
<pre style="height:130ex">
$SUDOKU is showing the puzzle
Line 936 ⟶ 957:
</pre>
=== REXX
{{trans|PL/I}}
<syntaxhighlight lang="rexx"> Parse Arg g.0fid
Select
When g.0fid='?' Then Do
Line 2,724 ⟶ 1,169:
Return
exit: Say '*ERROR*' arg(1)
</syntaxhighlight>
{{out}}
<pre>input from d:\_sudoku\in\sdk001.in
Line 2,750 ⟶ 1,197:
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
</pre>
=== REXX
This is version 1 (thanks) cut to the essentials, restructured, and modified
<syntaxhighlight lang="rexx">
/* REXX ---------------------------------------------------------------
* program to solve nearly every SUDOKU puzzle
* using a number of strategies learned from REXX version 1
Line 3,756 ⟶ 2,205:
Nop
End
Exit 12
</syntaxhighlight>
{{out}}
<pre>
process file sdk087.in
Input from sdk087.in
Debug output to 0
Line 3,769 ⟶ 2,220:
. . . . 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>
|