September 2017 Update
This commit is contained in:
Ingy döt Net
parent
bba7bfd280
commit
ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
|
|
@ -1,17 +1,14 @@
|
|||
/*REXX program supports a human to play the game of 24 (twenty-four) with error checking*/
|
||||
numeric digits 15 /*allow more leeway when computing #s. */
|
||||
parse arg yyy /*get the optional arguments from C.L. */
|
||||
yyy = space(yyy, 0) /*remove extraneous blanks from YYY. */
|
||||
parse arg yyy; yyy=space(yyy, 0) /*get optional CL args; elide blanks. */
|
||||
parse var yyy start '-' fin /*get the START and FINish (maybe). */
|
||||
fin = word(fin start, 1) /*if no FINish specified, use START.*/
|
||||
ops = '+-*/' ; Lops = length(0ps) /*define the legal arithmetic operators*/
|
||||
groupSym = '()[]{}' /*legal grouping symbols for this game.*/
|
||||
indent = left('', 30) /*used to indent display of solutions. */
|
||||
Lpar = '(' ; Rpar = ')' /*strings to make the output prettier.*/
|
||||
digs = 123456789 /*numerals (digits) that can be used. */
|
||||
show = 1 /*flag used show solutions (0 = not). */
|
||||
do j=1 for Lops; @.j=substr(ops,j,1) /*define a version for fast execution. */
|
||||
end /*j*/
|
||||
fin= word(fin start, 1) /*if no FINish specified, use START.*/
|
||||
ops= '+-*/' ; Lops= length(0ps) /*define the legal arithmetic operators*/
|
||||
groupSym= '()[]{}' /*legal grouping symbols for this game.*/
|
||||
pad= left('', 30) /*used to indent display of solutions. */
|
||||
Lpar= '(' ; Rpar= ')' /*strings to make the output prettier.*/
|
||||
digs= 123456789 /*numerals (digits) that can be used. */
|
||||
show= 1 /*flag used show solutions (0 = not). */
|
||||
do j=1 for Lops; @.j=substr(ops,j,1); end /*for fast execution. */
|
||||
signal on syntax /*enable program to trap syntax errors.*/
|
||||
if yyy\=='' then do; sols=solve(start, fin) /*solve from START ───► FINish. */
|
||||
if sols <0 then exit 13 /*Was there a problem with the input? */
|
||||
|
|
@ -30,11 +27,10 @@ $.=0
|
|||
do j=1 for Lrrrr; _=substr(rrrr,j,1) /*digit count for each digit in RRRR. */
|
||||
$._= countDigs(rrrr, _) /*define the count for this digit. */
|
||||
end /*j*/ /* [↑] counts duplicates twice, no harm*/
|
||||
|
||||
__ = copies('─', 9) /*used for output highlighting. */
|
||||
__ = copies('─', 9) /*used for output highlighting. */
|
||||
prompt= 'Using the digits ' rrrr", enter an expression that equals 24 (or QUIT):"
|
||||
/* [↓] ITERATE needs a variable name.*/
|
||||
do prompter=0; say; say __ prompt /*display blank line and the prompt (P)*/
|
||||
do prompter=0 by 0; say; say __ prompt /*display blank line and the prompt (P)*/
|
||||
pull y; y=space(y, 0) /*get Y from CL, then remove all blanks*/
|
||||
if abbrev('QUIT', y, 1) then exit 0 /*Does the user want to quit this game?*/
|
||||
_v=verify(y, digs || ops || groupSym); a=substr(y, max(1,_v), 1)
|
||||
|
|
@ -43,33 +39,29 @@ prompt= 'Using the digits ' rrrr", enter an expression that equals 24 (or
|
|||
if pos('//', y) then do; call ger "invalid // operator"; iterate; end
|
||||
Ly=length(y)
|
||||
if y=='' then do; call validate y; iterate; end
|
||||
|
||||
do j=1 for Ly-1; if \datatype(substr(y, j , 1), 'W') then iterate
|
||||
if \datatype(substr(y, j+1, 1), 'W') then iterate
|
||||
call ger 'invalid use of "digit abuttal".'
|
||||
iterate prompter
|
||||
end /*j*/
|
||||
|
||||
yd=countDigs(y, digs) /*count of the digits 1──►9 (123456789)*/
|
||||
do j=1 for Ly-1; if \datatype(substr(y,j ,1), 'W') then iterate
|
||||
if \datatype(substr(y,j+1,1), 'W') then iterate
|
||||
call ger 'invalid use of "digit abuttal".'
|
||||
iterate prompter
|
||||
end /*j*/
|
||||
yd=countDigs(y,digs) /*count of the digits 1──►9 (123456789)*/
|
||||
if yd<4 then do; call ger 'not enough digits entered.'; iterate /*prompter*/; end
|
||||
if yd>4 then do; call ger 'too many digits entered.' ; iterate /*prompter*/; end
|
||||
|
||||
do j=1 for 9; if $.j==0 then iterate
|
||||
_d=countDigs(y, j); if $.j==_d then iterate
|
||||
if _d<$.j then call ger 'not enough' j "digits, must be" $.j
|
||||
else call ger 'too many' j "digits, must be" $.j
|
||||
iterate prompter
|
||||
end /*j*/
|
||||
|
||||
do j=1 for 9; if $.j==0 then iterate
|
||||
_d=countDigs(y, j); if $.j==_d then iterate
|
||||
if _d<$.j then call ger 'not enough' j "digits, must be" $.j
|
||||
else call ger 'too many' j "digits, must be" $.j
|
||||
iterate prompter
|
||||
end /*j*/
|
||||
interpret 'ans=' translate(y, '()()', "[]{}"); ans=ans/1
|
||||
if ans==24 then leave prompter; say 'incorrect, ' y"="ans
|
||||
end /*prompter*/
|
||||
|
||||
say; say center('┌─────────────────────┐', 79)
|
||||
say center('│ │', 79)
|
||||
say center('│ congratulations ! │', 79)
|
||||
say center('│ │', 79)
|
||||
say center('└─────────────────────┘', 79)
|
||||
say; say center('┌─────────────────────┐', 79)
|
||||
say center('│ │', 79)
|
||||
say center('│ congratulations ! │', 79)
|
||||
say center('│ │', 79)
|
||||
say center('└─────────────────────┘', 79)
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
countDigs: arg ?; return length(?) - length(space(translate(?, , arg(2)), 0))
|
||||
|
|
@ -79,18 +71,12 @@ s: if arg(1)==1 then return ''; return "s" /*a simple plu
|
|||
syntax: call ger 'illegal syntax in' y; exit
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
solve: parse arg ssss, ffff /*parse the argument passed to SOLVE. */
|
||||
if ffff=='' then ffff=ssss /*create a FFFF if necessary. */
|
||||
if \validate(ssss) then return -1 /*validate the SSSS field. */
|
||||
if \validate(ffff) then return -1 /* " " FFFF " */
|
||||
#=0 /*number of found solutions (so far). */
|
||||
!.=0 /*a method to hold unique expressions. */
|
||||
/*alternative: indent=copies(' ',30) */
|
||||
if ffff=='' then ffff=ssss /*create a FFFF if necessary. */
|
||||
if \validate(ssss) | \validate(ffff) then return -1 /*validate SSSS & FFFF*/
|
||||
!.=0; #=0 /*holds unique expressions; # solutions*/
|
||||
do g=ssss to ffff /*process a (possible) range of values.*/
|
||||
if pos(0, g)\==0 then iterate /*ignore values with zero in them. */
|
||||
|
||||
do j=1 for 4; g.j=substr(g, j, 1) /*define a version for fast execution. */
|
||||
end /*j*/
|
||||
|
||||
do j=1 for 4; g.j=substr(g,j,1); end /*for fast execution.*/
|
||||
do i =1 for Lops /*insert an operator after 1st number. */
|
||||
do j =1 for Lops /* " " " " 2nd " */
|
||||
do k =1 for Lops /* " " " " 3rd " */
|
||||
|
|
@ -108,14 +94,13 @@ solve: parse arg ssss, ffff /*parse the argument passed to
|
|||
interpret 'x=' e /*have REXX do all the heavy lifting */
|
||||
if x\=24 then iterate /*Is the result incorrect? Try again. */
|
||||
#=#+1 /*bump number of found solutions. */
|
||||
if show then say indent 'a solution:' translate(yyyE, '][', ")(")
|
||||
if show then say pad 'a solution for' g": " translate(yyyE,'][',")(")
|
||||
end /*n*/ /* [↑] display a (single) solution. */
|
||||
end /*m*/
|
||||
end /*k*/
|
||||
end /*j*/
|
||||
end /*i*/
|
||||
end /*g*/
|
||||
|
||||
return #
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
sort: procedure; parse arg #; L=length(#); !.= /*this is a modified bin sort.*/
|
||||
|
|
@ -130,5 +115,4 @@ validate: parse arg y; OK=1; _v=verify(y,digs); DE='digits entered, there must
|
|||
when pos(0,y)\==0 then call ger "can't use the digit 0 (zero)."
|
||||
when _v\==0 then call ger "illegal character: " substr(y, _v, 1)
|
||||
otherwise nop
|
||||
end /*select*/
|
||||
return OK
|
||||
end /*select*/; return OK
|
||||
|
|
|
|||
|
|
@ -1,25 +0,0 @@
|
|||
changestr: Procedure
|
||||
/* change needle to newneedle in haystack (as often as specified */
|
||||
/* or all of them if count is omitted */
|
||||
Parse Arg needle,haystack,newneedle,count
|
||||
If count>'' Then Do
|
||||
If count=0 Then Do
|
||||
Say 'chstr count must be > 0'
|
||||
Signal Syntax
|
||||
End
|
||||
End
|
||||
res=""
|
||||
changes=0
|
||||
px=1
|
||||
do Until py=0
|
||||
py=pos(needle,haystack,px)
|
||||
if py>0 then Do
|
||||
res=res||substr(haystack,px,py-px)||newneedle
|
||||
px=py+length(needle)
|
||||
changes=changes+1
|
||||
If count>'' Then
|
||||
If changes=count Then Leave
|
||||
End
|
||||
end
|
||||
res=res||substr(haystack,px)
|
||||
Return res
|
||||
Loading…
Add table
Add a link
Reference in a new issue