121 lines
4.1 KiB
Text
121 lines
4.1 KiB
Text
--
|
|
-- 24_game_solve.exw
|
|
-- =================
|
|
--
|
|
-- Write a function that given four digits subject to the rules of the 24 game, computes an expression to solve the game if possible.
|
|
-- Show examples of solutions generated by the function
|
|
--
|
|
-- The following 5 parse expressions are possible.
|
|
-- Obviously numbers 1234 represent 24 permutations from
|
|
-- {1,2,3,4} to {4,3,2,1} of indexes to the real numbers.
|
|
-- Likewise "+-*" is like "123" representing 64 combinations
|
|
-- from {1,1,1} to {4,4,4} of indexes to "+-*/".
|
|
-- Both will be replaced if/when the strings get printed.
|
|
--
|
|
constant OPS = "+-*/"
|
|
constant expressions = {"1+(2-(3*4))",
|
|
"1+((2-3)*4)",
|
|
"(1+2)-(3*4)",
|
|
"(1+(2-3))*4",
|
|
"((1+2)-3)*4"} -- (equivalent to "1+2-3*4")
|
|
--TODO: I'm sure there is a simple (recursive) way to programatically
|
|
-- generate the above (for n=2..9) but I'm not seeing it yet...
|
|
|
|
-- The above represented as three sequential operations (the result gets
|
|
-- left in <(map)1>, ie vars[perms[operations[i][3][1]]] aka vars[lhs]):
|
|
constant operations = {{{3,'*',4},{2,'-',3},{1,'+',2}}, --3*=4; 2-=3; 1+=2
|
|
{{2,'-',3},{2,'*',4},{1,'+',2}}, --2-=3; 2*=4; 1+=2
|
|
{{1,'+',2},{3,'*',4},{1,'-',3}}, --1+=2; 3*=4; 1-=3
|
|
{{2,'-',3},{1,'+',2},{1,'*',4}}, --2-=3; 1+=2; 1*=4
|
|
{{1,'+',2},{1,'-',3},{1,'*',4}}} --1+=2; 1-=3; 1*=4
|
|
--TODO: ... and likewise for parsing "expressions" to yield "operations".
|
|
|
|
function evalopset(sequence opset, sequence perms, sequence ops, sequence vars)
|
|
-- invoked 5*24*64 = 7680 times, to try all possible expressions/vars/operators
|
|
-- (btw, vars is copy-on-write, like all parameters not explicitly returned, so
|
|
-- we can safely re-use it without clobbering the callee version.)
|
|
integer lhs,op,rhs
|
|
atom inf
|
|
for i=1 to length(opset) do
|
|
{lhs,op,rhs} = opset[i]
|
|
lhs = perms[lhs]
|
|
op = ops[find(op,OPS)]
|
|
rhs = perms[rhs]
|
|
if op='+' then
|
|
vars[lhs] += vars[rhs]
|
|
elsif op='-' then
|
|
vars[lhs] -= vars[rhs]
|
|
elsif op='*' then
|
|
vars[lhs] *= vars[rhs]
|
|
elsif op='/' then
|
|
if vars[rhs]=0 then inf = 1e300*1e300 return inf end if
|
|
vars[lhs] /= vars[rhs]
|
|
end if
|
|
end for
|
|
return vars[lhs]
|
|
end function
|
|
|
|
integer nSolutions
|
|
sequence xSolutions
|
|
|
|
procedure success(string expr, sequence perms, sequence ops, sequence vars, atom r)
|
|
integer ch
|
|
for i=1 to length(expr) do
|
|
ch = expr[i]
|
|
if ch>='1' and ch<='9' then
|
|
expr[i] = vars[perms[ch-'0']]+'0'
|
|
else
|
|
ch = find(ch,OPS)
|
|
if ch then
|
|
expr[i] = ops[ch]
|
|
end if
|
|
end if
|
|
end for
|
|
if not find(expr,xSolutions) then
|
|
-- avoid duplicates for eg {1,1,2,7} because this has found
|
|
-- the "same" solution but with the 1st and 2nd 1s swapped,
|
|
-- and likewise whenever an operator is used more than once.
|
|
printf(1,"success: %s = %s\n",{expr,sprint(r)})
|
|
nSolutions += 1
|
|
xSolutions = append(xSolutions,expr)
|
|
end if
|
|
end procedure
|
|
|
|
procedure tryperms(sequence perms, sequence ops, sequence vars)
|
|
atom r
|
|
for i=1 to length(operations) do
|
|
-- 5 parse expressions
|
|
r = evalopset(operations[i], perms, ops, vars)
|
|
if r=24 then
|
|
success(expressions[i], perms, ops, vars, r)
|
|
end if
|
|
end for
|
|
end procedure
|
|
|
|
include builtins/factorial.e
|
|
include builtins/permute.e
|
|
|
|
procedure tryops(sequence ops, sequence vars)
|
|
for p=1 to factorial(4) do
|
|
-- 24 var permutations
|
|
tryperms(permute(p,{1,2,3,4}),ops, vars)
|
|
end for
|
|
end procedure
|
|
|
|
global procedure solve24(sequence vars)
|
|
nSolutions = 0
|
|
xSolutions = {}
|
|
for op1=1 to 4 do
|
|
for op2=1 to 4 do
|
|
for op3=1 to 4 do
|
|
-- 64 operator combinations
|
|
tryops({OPS[op1],OPS[op2],OPS[op3]},vars)
|
|
end for
|
|
end for
|
|
end for
|
|
|
|
printf(1,"\n%d solutions\n",{nSolutions})
|
|
end procedure
|
|
|
|
solve24({1,1,2,7})
|
|
if getc(0) then end if
|