Jump to content

24 game/Solve: Difference between revisions

→‎{{header|REXX}}: fixed program to generate all manner of groupings.
m (→‎{{header|REXX}}: Oddly fails to find solutions in some instances.)
(→‎{{header|REXX}}: fixed program to generate all manner of groupings.)
Line 5,841:
 
=={{header|REXX}}==
<lang rexx>/*REXX program helps the user find solutions to the game of 24. */
/* start-of-help
┌───────────────────────────────────────────────────────────────────────┐
│ Argument is either of three forms: (blank) │~
│ ssss │~
│ ssss,tot │~
│ ssss-ffff │~
│ ssss-ffff,tot │~
│ -ssss │~
│ +ssss │~
│ │~
│ where SSSS and/or FFFF must be exactly four numerals (digits) │~
│ comprised soley of the numerals (digits) 1 ──> 9 (no zeroes). │~
│ │~
│ SSSS is the start, │~
│ FFFF is the start. │~
│ │~
│ │~
│ If ssss has a leading plus (+) sign, it is used as the number, and │~
│ the user is prompted to find a solution. │~
│ │~
│ If ssss has a leading minus (-) sign, a solution is looked for and │~
│ the user is told there is a solution (but no solutions are shown). │~
│ │~
│ If no argument is specified, this program finds a four digits (no │~
│ zeroes) which has at least one solution, and shows the digits to │~
│ the user, requesting that they enter a solution. │~
│ │~
│ If tot is entered, it is the desired answer. The default is 24. │~
│ │~
│ A solution to be entered can be in the form of: │
│ │
│ digit1 operator digit2 operator digit3 operator digit4 │
│ │
│ where DIGITn is one of the digits shown (in any order), and │
│ OPERATOR can be any one of: + - * / │
│ │
│ Parentheses () may be used in the normal manner for grouping, as │
│ well as brackets [] or braces {}. Blanks can be used anywhere. │
│ │
│ I.E.: for the digits 3448 the following could be entered. │
│ │
│ 3*8 + (4-4) │
└───────────────────────────────────────────────────────────────────────┘
end-of-help */
parse arg orig /*get the guess from the command line*/
orig= space(orig, 0) /*remove all blanks from ORIG. */
negatory= left(orig,1)=='-' /*=1, suppresses showing. */
pository= left(orig,1)=='+' /*=1, force $24 to use specific number.*/
if pository | negatory then orig=substr(orig,2) /*now, just use the absolute vaue. */
parse var orig orig ',' ?? /*get ?? (if specified, def=24). */
parse var orig start '-' finish /*get start and finish (maybe). */
opers= '*' || "/+-" /*legal arith. opers;order is important*/
ops= length(opers) /*the number of arithmetic operators. */
groupsym= '()[]{}' /*allowed grouping symbols. */
indent= left('', 30) /*indents display of solutions. */
show= 1 /*=1, shows solutions (semifore). */
digs= 123456789 /*numerals/digs that can be used. */
abuttals = 0 /*=1, allows digit abutal: 12+12 */
if ??=='' then ??= 24 /*the name of the game. */
??= ?? / 1 /*normalize the answer. */
@abc= 'abcdefghijklmnopqrstuvwxyz' /*the Latin alphabet in order. */
@abcu= @abc; upper @abcu /*an uppercase version of @abc. */
x.= 0 /*method used to not re-interpret. */
do j=1 for ops; o.j=substr(opers, j, 1)
end /*j*/ /*used for fast execution. */
y= ??
if \datatype(??,'N') then do; call ger "isn't numeric"; exit 13; end
if start\=='' & \pository then do; call ranger start,finish; exit 13; end
show= 0 /*stop SOLVE blabbing solutions. */
do forever while \negatory /*keep truckin' until a solution. */
x.= 0 /*way to hold unique expressions. */
rrrr= random(1111, 9999) /*get a random set of digits. */
if pos(0, rrrr)\==0 then iterate /*but don't the use of zeroes. */
if solve(rrrr)\==0 then leave /*try to solve for these digits. */
end /*forever*/
 
if left(orig,1)=='+' then rrrr=start /*use what's specified. */
{{improve|REXX|Finds no solution for some combinations that obviously have one: EG. 1157 ──► [1 + 1] * [5 + 7]}}
show= 1 /*enable SOLVE to show solutions. */
rrrr= sortc(rrrr) /*sort four elements. */
rd.= 0
do j=1 for 9 /*count for each digit in RRRR. */
_= substr(rrrr, j, 1); rd._= countchars(rrrr, _)
end
do guesses=1; say
say 'Using the digits' rrrr", enter an expression that equals" ?? ' (? or QUIT):'
pull y; y= space(y, 0)
if countchars(y, @abcu)>2 then exit /*the user must be desperate. */
helpstart= 0
if y=='?' then do j=1 for sourceline() /*use a lazy way to show help. */
_= sourceline(j)
if p(_)=='start-of-help' then do; helpstart=1; iterate; end
if p(_)=='end-of-help' then iterate guesses
if \helpstart then iterate
if right(_,1)=='~' then iterate
say ' ' _
end
 
_v= verify(y, digs || opers || groupsym) /*any illegal characters? */
<lang rexx>/*REXX program to help the user find solutions to the game of 24. */
if _v\==0 then do; call ger 'invalid character:' substr(y, _v, 1); iterate; end
/* ┌──────────────────────────────────────────────────────────────────┐
if y='' then do; call validate y; iterate; end
│ Argument is either of two forms: ssss ==or== ssss-ffff │
│ │
│ where one or both strings must be exactly four numerals (digits) │
│ comprised soley of the numerals (digits) 1 ──► 9 (no zeroes). │
│ │
│ In SSSS-FFFF SSSS is the start, │
│ FFFF is the start. │
└──────────────────────────────────────────────────────────────────┘ */
parse arg orig /*get the guess from the argument. */
parse var orig start '-' finish /*get the start and finish (maybe). */
start=space(start,0) /*remove any blanks from the START. */
finish=space(finish,0) /*remove any blanks from the FINISH. */
finish=word(finish start,1) /*if no FINISH specified, use START.*/
digs=123456789 /*numerals (digits) that can be used. */
call validate start
call validate finish
opers='+-*/' /*define the legal arithmetic operators*/
ops=length(opers) /* ··· and the count of them (length). */
do j=1 for ops /*define a version for fast execution. */
o.j=substr(opers,j,1)
end /*j*/
finds=0 /*number of found solutions (so far). */
x.=0 /*a method to hold unique expressions. */
indent=left('',30) /*used to indent display of solutions. */
/*alternative: indent=copies(' ',30) */
Lpar='(' /*a string to make REXX code prettier. */
Rpar=')' /*ditto. */
 
do gj=start1 to finish for length(y)-1 while \abuttals /*processcheck afor (possible)two rangedigits of valuesadjacent. */
if pos\datatype(0substr(y,gj,1)\==0, 'W') then iterate /*ignore values with zero in them. */
if datatype(substr(y,j+1,1),'W') then do
call ger 'invalid use of digit abuttal' substr(y,j,2)
iterate guesses
end
end /*j*/
 
yd= countchars(y, digs) do _=1 for 4 /*definecount of legal digits 123456789 versions for faster execution.*/
if yd<4 then do; call ger 'not enough digits entered.'; iterate guesses; end
g._=substr(g,_,1)
if yd>4 then do; call ger 'too many digits entered.' ; iterate guesses; end
end /*_*/
 
do ij=1 for ops /*insert an operator afterlength(groupsym) 1st number.by */2
if countchars(y,substr(groupsym,j ,1))\==,
do j=1 for ops /*insert an operator after 2nd number. */
countchars(y,substr(groupsym,j+1,1)) then do
do k=1 for ops /*insert an operator after 2nd number. */
do m=0 for 4; L.= /*assume no left parenthesis so far. */ call ger 'mismatched' substr(groupsym,j,2)
do n=m+1 to 4 /*match left paren with a right paren. */ iterate guesses
L.m=Lpar /*define a left paren, m=0 means ignore*/ end
end /*j*/
R.= /*un-define all right parenthesis. */
if m==1 & n==2 then L.= /*special case: (n)+ ··· */
else if m\==0 then R.n=Rpar /*no (, no )*/
e= L.1 g.1 o.i L.2 g.2 o.j L.3 g.3 R.3 o.k g.4 R.4
e=space(e,0) /*remove all blanks from the expression*/
 
do k=1 for 2 /*(below)check changefor expression: ** and // */
_= copies( substr( opers, k, 1), 2)
/* /(yyy) ===> /div(yyy) */
if pos(_, y)\==0 then do; call ger 'illegal operator:' _; iterate guesses; end
/*Enables to check for division by zero*/
origE=e end /*keep old version for the display. k*/
if pos('/(',e)\==0 then e=changestr('/(', e, "/div(")
/*The above could be replaced by: */
/* e=changestr('/(',e,"/div(") */
 
do j=1 for 9; if rd.j==0 then iterate; _d= /*INTERPRET stresses REXX's groincountchars(y, so */j)
if _d==rd.j then iterate
/* try to avoid repeated heavy lifting.*/
if _d<rd.j then call ger if'not x.eenough' then iterate j /*was the expression"digits, alreadymust used?be" */rd.j
x.e=1 else call ger 'too many' j /*mark this expression"digits, asmust unique.be" */rd.j
iterate guesses
/*have REXX do the heavy lifting (ugh).*/
end /*j*/
interpret 'x=' e /*··· strain··· */
 
x=x/1 /*remove trailing decimal points(maybe)*/
y= translate(y, '()()', "[]{}")
if x\==24 then iterate /*Not correct? Try again. */
interpret 'ans=(' y ") / 1"
finds=finds+1 /*bump number of found solutions. */
if ans==?? then leave guesses
_=translate(origE, '][', ")(") /*show [], not (). */
say right('incorrect, ' y'='ans, 50)
say indent 'a solution:' _ /*display a solution. */
end /*nguesses*/
 
say; say center('┌─────────────────────┐', 79)
say center('│ │', 79)
say center('│ congratulations ! │', 79)
say center('│ │', 79)
say center('└─────────────────────┘', 79)
say
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
countchars: procedure; arg x,c /*count of characters in X. */
return length(x) - length( space( translate(x, ,c ), 0) )
/*──────────────────────────────────────────────────────────────────────────────────────*/
ranger: parse arg ssss,ffff /*parse args passed to this sub. */
ffff= p(ffff ssss) /*create a FFFF if necessary. */
do g=ssss to ffff /*process possible range of values. */
if pos(0, g)\==0 then iterate /*ignore any G with zeroes. */
sols= solve(g); wols= sols
if sols==0 then wols= 'No' /*un-geek number of solutions (if any).*/
if negatory & sols\==0 then wols='A' /*found only the first solution? */
say
say commas(wols) 'solution's(sols) "found for" g
if ??\==24 then say 'for answers that equal' ??
end
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
solve: parse arg qqqq; finds= 0 /*parse args passed to this sub. */
if \validate(qqqq) then return -1
parse value '( (( )) )' with L LL RR R /*assign some static variables. */
nq.= 0
do jq=1 for 4; _= substr(qqqq,jq,1) /*count the number of each digit. */
nq._= nq._ + 1
end /*jq*/
gLO= 1111
gHI= 9999
if ??==24 then do; gLO= 1118; gHI=9993; end /*24: lowest poss.# that has solutions*/
 
do gggg=gLO to gHI
if pos(0, gggg)\==0 then iterate /*ignore values with zeroes. */
if verify(gggg, qqqq)\==0 then iterate
if verify(qqqq, gggg)\==0 then iterate
ng.= 0
do jg=1 for 4; _= substr(gggg, jg, 1) /*count the number of each digit. */
g.jg= _; ng._= ng._ + 1
end /*jg*/
do kg=1 for 9 /*verify each number has same # digits.*/
if nq.kg\==ng.kg then iterate gggg
end /*kg*/
do i =1 for ops /*insert operator after 1st numeral. */
do j =1 for ops /* " " " 2nd " */
do k=1 for ops /* " " " 3rd " */
do m=0 for 10; !.= /*nullify all grouping symbols (parens)*/
select
when m==1 then do; !.1=L; !.3=R; end
when m==2 then do; !.1=L; !.5=R; end
when m==3 then do; !.1=L; !.3=R; !.4=L; !.6=R; end
when m==4 then do; !.1=L; !.2=L; !.6=RR; end
when m==5 then do; !.1=LL; !.5=R; !.6=R; end
when m==6 then do; !.2=L; !.5=R; end
when m==7 then do; !.2=L; !.6=R; end
when m==8 then do; !.2=L; !.4=L; !.6=RR; end
when m==9 then do; !.2=LL; !.5=R; !.6=R; end
otherwise nop
end /*select*/
 
e= space(!.1 g.1 o.i !.2 g.2 !.3 o.j !.4 g.3 !.5 o.k g.4 !.6, 0)
if x.e then iterate /*was the expression already used? */
x.e= 1 /*mark this expression as being used. */
/*(below) change the expression: /(yyy) ===> /div(yyy) */
origE= e /*keep original version for the display*/
pd= pos('/(', e) /*find pos of /( in E. */
if pd\==0 then do /*Found? Might have possible ÷ by zero*/
eo= e
lr= lastpos(')', e) /*find last right ) */
lm= pos('-', e, pd+1) /*find - after ( */
if lm>pd & lm<lr then e= changestr('/(',e,"/div(") /*change*/
if eo\==e then if x.e then iterate /*expression already used?*/
x.e= 1 /*mark this expression as being used. */
end
interpret 'x=(' e ") / 1" /*have REXX do the heavy lifting here. */
if x\==?? then iterate /*Not correct? Then try again. */
finds= finds + 1 /*bump number of found solutions. */
if \show | negatory then return finds
_= translate(origE, '][', ")(") /*show [], not (). */
if show then say indent 'a solution for' g':' ??"=" _ /*show solution.*/
end /*m*/
end /*k*/
end /*j*/
end /*i*/
end /*ggggg*/
return finds
/*──────────────────────────────────────────────────────────────────────────────────────*/
sortc: procedure; arg nnnn; L= length(nnnn) /*sorts the chars NNNN */
do i=1 for L /*build array of digs from NNNN, */
a.i= substr(nnnn, i, 1) /*enabling SORT to sort an array. */
end /*i*/
 
do j=1 for L /*very simple sort, it's a small array*/
sols=finds
if sols==0 then sols='No' /*make the sentence not_= so geek-likea. */j
do k=j+1 to L
say; say sols 'unique solution's(finds) "found for" orig /*pluralize.*/
if a.k<_ then do; a.j= a.k; a.k= _; _= a.k; end
exit
end /*k*/
/*───────────────────────────DIV subroutine─────────────────────────────*/
div: procedure; parse arg q /*tests if dividing by 0 (zero). end /*j*/
v= a.1
if q=0 then q=1e9 /*if dividing by zero, change divisor. */
return q do m=2 to L; v= v || a.m /*changingbuild a string of digs from A.m Q invalidates the expression*/
end /*m*/
/*───────────────────────────GER subroutine─────────────────────────────*/
return v
ger: say; say '*** error! ***'; if _\=='' then say 'guess=' _
/*──────────────────────────────────────────────────────────────────────────────────────*/
say arg(1); say; exit 13
validate: parse arg y; errCode= 0; _v= verify(y, digs)
/*───────────────────────────S subroutine───────────────────────────────*/
s: if arg(1)==1 then return ''; return 's' /*simple pluralizer.*/ select
when y=='' then call ger 'no digits entered.'
/*───────────────────────────validate subroutine────────────────────────*/
validate: parse arg y; errCode=0; when length(y)<4 _v=verify(ythen call ger 'not enough digits entered,digs) must be 4'
when length(y)>4 then call ger 'too many digits entered, must be 4'
select
when y=='' when pos(0,y)\==0 then call ger "can'not digitsuse entered.'the digit 0 (zero)"
when _v\==0 then call ger 'illegal character:' substr(y,_v,1)
when length(y)<4 then call ger 'not enough digits entered, must be 4'
otherwise nop
when length(y)>4 then call ger 'too many digits entered, must be 4'
end /*select*/
when pos(0,y)\==0 then call ger "can't use the digit 0 (zero)"
return \errCode
when _v\==0 then call ger 'illegal character:' substr(y,_v,1)
/*──────────────────────────────────────────────────────────────────────────────────────*/
otherwise nop
commas: parse arg _; do j=length(_)-3 to 1 by -3; _= insert(',', _, j); end; return _
end /*select*/
div: procedure; parse arg q; if q=0 then q=1e9; return q /*tests if dividing by zero.*/
return \errCode</lang>
ger: say= '***error*** for argument:' y; say arg(1); errCode= 1; return 0
p: return word( arg(1), 1)
s: if arg(1)==1 then return arg(3); return word( arg(2) 's', 1)</lang>
Some older REXXes don't have a &nbsp; '''changestr''' &nbsp; BIF, so one is included here ──► &nbsp; &nbsp; [[CHANGESTR.REX]].
<br><br>
'''{{out|output'''|text=&nbsp; when using the following input is usedof: &nbsp; &nbsp; <tt> 11111156-12341162 </tt>}}
<pre style="height:30ex95ex">
a solution for 1156: 24= [1+1+*5-1]*86
a solution for 1156: 24= [[1+*5-1+2]*6]
a solution for 1156: [1+24= 1*2[5-1]*86
a solution for 1156: [24= 1*[[5-1+2]*86]
a solution for 1156: 24= [1*6]*[5-1+2]*8
a solution for 1156: 24= 1*[6*[5-1/1+2]*8]
a solution for 1156: 24= [5*1+-1*3]*6
a solution for 1156: 24= [1[5*1+3-1]*6]
a solution for 1156: 1*24= [5/1-1+3]*6
a solution for 1156: 24= [1[5/1+3-1]*6]
a solution for 1156: 124= [5-1+3]*1*86
a solution for 1156: 24= [15-1+3*1]*86
a solution for 1156: 24= [15-1+3]*[1*86]
a solution for 1156: 124= [[5-1+[3*81]*6]
a solution for 1156: 1-24= [15-3*81]/1*6
a solution for 1156: 24= [5-1*/1]*3*86
a solution for 1156: 24= [[5-1*/1*3]*86]
a solution for 1156: 24= [5-1*]/[1*3*8/6]
a solution for 1156: 1*24= [5-1*3]*86*1
a solution for 1156: 24= [5-1]*[16*3*81]
a solution for 1156: 24= [5-1]*6/1*[3*8]
a solution for 1156: 24= [5-1]*[6/1*3*8]
a solution for 1156: 24= 5*[6-1/1*3]*8-1
a solution for 1156: 24= [6*1/1]*3*8[5-1]
a solution for 1156: 1/124= [6*[31*85-1]]
a solution for 1156: 1/24= 6*[1/3]*85-1]
a solution for 1156: 24= 6*[1/*[5-1/3/8]]
a solution for 1156: 24= 6*[[1+*5]-1+4]*4
a solution for 1156: 24= [6/1]*[5-1+4*6]
a solution for 1156: 24= 6/[1/[5-1+4]*6]
a solution for 1156: 24= [16-1+4*6]*5-1
a solution for 1156: 24= [6*[5*1-1+[4*6]]
a solution for 1156: 1-24= 6*[5*1-4*61]
a solution for 1156: 124= 6*1[[5*4*61]-1]
a solution for 1156: 24= [16*[5/1-1*4]*6]
a solution for 1156: 24= 6*[5/1*-1*4*6]
a solution for 1156: 124= 6*[[5/1]-1*4]*6
a solution for 1156: 124= [6*[5-1*4*61]]
a solution for 1156: 1*124= 6*[4*65-1]*1
a solution for 1156: 1/24= 6*[5-1*4*61]
a solution for 1156: 24= 6*[5-[1/1*41]]*6
a solution for 1156: 24= 6*[[5-1/1]*4*61]
a solution for 1156: 24= [6*[5-1/1*[4*6]]
a solution for 1156: 1/24= 6*[5-1/4]*6/1
a solution for 1156: 1/24= 6*[5-1/4/61]
a solution for 1156: 24= 6*[5-[1+/1*5]*4]
a solution for 1156: 24= 6*[[5-1*]/1+5]*4
 
a solution: 1*[1+5]*4
47 solutions found for 1156
a solution: [1/1+5]*4
a solution for 1157: 24= [1+1+6]*3[5+7]
a solution for 1157: 1-24= [1+61]*4[7+5]
a solution for 1157: 24= [1-1+65]*4[1-7]
a solution for 1157: 24= [1-1+67]*4[1-5]
a solution for 1157: 124= [5-1+[6]*4[7-1]
a solution for 1157: 1-24= [1-65+7]*4[1+1]
a solution for 1157: 24= [7-1]*[5-1*6*4]
a solution for 1157: 24= [17+5]*[1+1*6]*4
 
a solution: [1*1*6*4]
8 solutions found for 1157
a solution: 1*[1*6]*4
a solution for 1158: 1*24= [5-1-1*6*4]*8
a solution for 1158: 24= [[5-1*-1]*[6*48]
a solution for 1158: 24= 8*[5-[1/+1*6*4]]
a solution for 1158: 24= [8*[5-1/-1*6]*4]
a solution for 1158: 24= 8*[5-1/-1*6*4]
a solution for 1158: 1/124= 8*[6*4[5-1]-1]
 
a solution: 1/[1/6]*4
6 solutions found for 1158
a solution: [1+1*7]*3
 
a solution: [1*1+7]*3
No solutions found for 1159
a solution: 1*[1+7]*3
 
a solution: [1/1+7]*3
No solutions found for 1161
a solution: 1-1+8*3
a solution for 1162: 24= [1-1+81]*32*6
a solution for 1162: 24= [1-1+81]*[2*36]
a solution for 1162: 24= [1-+1+[8*32]*6
a solution for 1162: 1-24= [[1+1-8+2]*36]
a solution for 1162: 24= [1*+1]*86*32
a solution for 1162: 24= [1*+1*8]*3[6*2]
a solution for 1162: 24= [1*+2+1*8*3]*6
a solution for 1162: 1*24= [[1*8+2+1]*36]
a solution for 1162: 124= 2*[1*8*3+1]*6
a solution for 1162: 1*124= 2*[8[1+1]*36]
a solution for 1162: 24= [2+1/+1]*8*36
a solution for 1162: 24= [[2+1/+1*8]*36]
a solution for 1162: 24= [1/12*86]*3[1+1]
a solution for 1162: 1/124= 2*[86*3[1+1]]
a solution for 1162: 1/24= 6*[1/8+1]*32
a solution for 1162: 1/24= 6*[[1+1/8/3]*2]
a solution for 1162: 24= [6*[1+2+1+2]]*6
a solution for 1162: 24= 6*[1+2*1+2]*8
a solution for 1162: 24= 6*[1+2/[1+2]]*8
a solution for 1162: 24= 6*[[1*2+1]*8+2]
a solution for 1162: 124= [6*[1+2+1]*8]
a solution for 1162: 24= 6*[1*2+2+1]*6
a solution for 1162: 124= 6*[21+[2+1]]*6
a solution for 1162: 124= 6*[[1+2*2*6]+1]
a solution for 1162: 24= [1*26*2]*6[1+1]
a solution for 1162: [124= 6*[2*2*6[1+1]]
a solution for 1162: 124= [6*[2*2+1+1]]*6
a solution for 1162: 124= 6*[2*2*6+1+1]
a solution for 1162: 1*224= 6*[2*6+[1+1]]
a solution for 1162: 24= 6*[[1+2+31]+1]*4
a solution: 1*2*3*4
a solution: [1*2*3]*4
a solution: [1*2*3*4]
a solution: 1*[2*3]*4
a solution: 1*[2*3*4]
a solution: 1*2*[3*4]
 
107 unique30 solutions found for 1111-12341162
</pre>
 
Cookies help us deliver our services. By using our services, you agree to our use of cookies.