aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Just another update

Browse source
This commit is contained in:
Ingy döt Net 2015-02-20 00:35:01 -05:00
parent a25938f123
commit 00a190b0a6
6591 changed files with 94363 additions and 23227 deletions
Download patch file Download diff file Expand all files Collapse all files

5
Task/24-game-Solve/00DESCRIPTION
View file

@ -1,6 +1,5 @@
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
Write a program that takes four digits, either from user input or by random generation, and computes arithmetic expressions following the rules of the [[24 game]].
Show examples of solutions generated by the program.
C.F: [[Arithmetic Evaluator]]

90
Task/24-game-Solve/C++/24-game-solve.cpp Normal file
View file

@ -0,0 +1,90 @@
#include <iostream>
#include <ratio>
#include <array>
#include <algorithm>
#include <random>
typedef short int Digit; // Typedef for the digits data type.
constexpr Digit nDigits{4}; // Amount of digits that are taken into the game.
constexpr Digit maximumDigit{9}; // Maximum digit that may be taken into the game.
constexpr short int gameGoal{24}; // Desired result.
typedef std::array<Digit, nDigits> digitSet; // Typedef for the set of digits in the game.
digitSet d;
void printTrivialOperation(std::string operation) { // Prints a commutative operation taking all the digits.
bool printOperation(false);
for(const Digit& number : d) {
if(printOperation)
std::cout << operation;
else
printOperation = true;
std::cout << number;
}
std::cout << std::endl;
}
void printOperation(std::string prefix, std::string operation1, std::string operation2, std::string operation3, std::string suffix = "") {
std::cout << prefix << d[0] << operation1 << d[1] << operation2 << d[2] << operation3 << d[3] << suffix << std::endl;
}
int main() {
std::mt19937_64 randomGenerator;
std::uniform_int_distribution<Digit> digitDistro{1, maximumDigit};
// Let us set up a number of trials:
for(int trial{10}; trial; --trial) {
for(Digit& digit : d) {
digit = digitDistro(randomGenerator);
std::cout << digit << " ";
}
std::cout << std::endl;
std::sort(d.begin(), d.end());
// We start with the most trivial, commutative operations:
if(std::accumulate(d.cbegin(), d.cend(), 0) == gameGoal)
printTrivialOperation(" + ");
if(std::accumulate(d.cbegin(), d.cend(), 1, std::multiplies<Digit>{}) == gameGoal)
printTrivialOperation(" * ");
// Now let's start working on every permutation of the digits.
do {
// Operations with 2 symbols + and one symbol -:
if(d[0] + d[1] + d[2] - d[3] == gameGoal) printOperation("", " + ", " + ", " - "); // If gameGoal is ever changed to a smaller value, consider adding more operations in this category.
// Operations with 2 symbols + and one symbol *:
if(d[0] * d[1] + d[2] + d[3] == gameGoal) printOperation("", " * ", " + ", " + ");
if(d[0] * (d[1] + d[2]) + d[3] == gameGoal) printOperation("", " * ( ", " + ", " ) + ");
if(d[0] * (d[1] + d[2] + d[3]) == gameGoal) printOperation("", " * ( ", " + ", " + ", " )");
// Operations with one symbol + and 2 symbols *:
if((d[0] * d[1] * d[2]) + d[3] == gameGoal) printOperation("( ", " * ", " * ", " ) + ");
if(d[0] * d[1] * (d[2] + d[3]) == gameGoal) printOperation("( ", " * ", " * ( ", " + ", " )");
if((d[0] * d[1]) + (d[2] * d[3]) == gameGoal) printOperation("( ", " * ", " ) + ( ", " * ", " )");
// Operations with one symbol - and 2 symbols *:
if((d[0] * d[1] * d[2]) - d[3] == gameGoal) printOperation("( ", " * ", " * ", " ) - ");
if(d[0] * d[1] * (d[2] - d[3]) == gameGoal) printOperation("( ", " * ", " * ( ", " - ", " )");
if((d[0] * d[1]) - (d[2] * d[3]) == gameGoal) printOperation("( ", " * ", " ) - ( ", " * ", " )");
// Operations with one symbol +, one symbol *, and one symbol -:
if(d[0] * d[1] + d[2] - d[3] == gameGoal) printOperation("", " * ", " + ", " - ");
if(d[0] * (d[1] + d[2]) - d[3] == gameGoal) printOperation("", " * ( ", " + ", " ) - ");
if(d[0] * (d[1] - d[2]) + d[3] == gameGoal) printOperation("", " * ( ", " - ", " ) + ");
if(d[0] * (d[1] + d[2] - d[3]) == gameGoal) printOperation("", " * ( ", " + ", " - ", " )");
if(d[0] * d[1] - (d[2] + d[3]) == gameGoal) printOperation("", " * ", " - ( ", " + ", " )");
// Operations with one symbol *, one symbol /, one symbol +:
if(d[0] * d[1] == (gameGoal - d[3]) * d[2]) printOperation("( ", " * ", " / ", " ) + ");
if(((d[0] * d[1]) + d[2]) == gameGoal * d[3]) printOperation("(( ", " * ", " ) + ", " ) / ");
if((d[0] + d[1]) * d[2] == gameGoal * d[3]) printOperation("(( ", " + ", " ) * ", " ) / ");
if(d[0] * d[1] == gameGoal * (d[2] + d[3])) printOperation("( ", " * ", " ) / ( ", " + ", " )");
// Operations with one symbol *, one symbol /, one symbol -:
if(d[0] * d[1] == (gameGoal + d[3]) * d[2]) printOperation("( ", " * ", " / ", " ) - ");
if(((d[0] * d[1]) - d[2]) == gameGoal * d[3]) printOperation("(( ", " * ", " ) - ", " ) / ");
if((d[0] - d[1]) * d[2] == gameGoal * d[3]) printOperation("(( ", " - ", " ) * ", " ) / ");
if(d[0] * d[1] == gameGoal * (d[2] - d[3])) printOperation("( ", " * ", " ) / ( ", " - ", " )");
// Operations with 2 symbols *, one symbol /:
if(d[0] * d[1] * d[2] == gameGoal * d[3]) printOperation("", " * ", " * ", " / ");
if(d[0] * d[1] == gameGoal * d[2] * d[3]) printOperation("", " * ", " / ( ", " * ", " )");
// Operations with 2 symbols /, one symbol -:
if(d[0] * d[3] == gameGoal * (d[1] * d[3] - d[2])) printOperation("", " / ( ", " - ", " / ", " )");
// Operations with 2 symbols /, one symbol *:
if(d[0] * d[1] == gameGoal * d[2] * d[3]) printOperation("( ", " * ", " / ", " ) / ", "");
} while(std::next_permutation(d.begin(), d.end())); // All operations are repeated for all possible permutations of the numbers.
}
return 0;
}

49
Task/24-game-Solve/Clojure/24-game-solve.clj
View file

@ -1,30 +1,25 @@
(use 'clojure.contrib.combinatorics)
(ns rosettacode.24game.solve
(:require [clojure.math.combinatorics :as c]
[clojure.walk :as w]))
(defn nested-replace [l m]
(cond
(= l '()) '()
(m (first l)) (concat (list (m (first l))) (nested-replace (rest l) m))
(seq? (first l)) (concat (list (nested-replace (first l) m)) (nested-replace (rest l) m))
true (concat (list (first l)) (nested-replace (rest l) m))))
(def ^:private op-maps
(map #(zipmap [:o1 :o2 :o3] %) (c/selections '(* + - /) 3)))
(defn format-solution [sol]
(cond
(number? sol) sol
(seq? sol)
(list (format-solution (second sol)) (first sol) (format-solution (nth sol 2)))))
(def ^:private patterns '(
(:o1 (:o2 :n1 :n2) (:o3 :n3 :n4))
(:o1 :n1 (:o2 :n2 (:o3 :n3 :n4)))
(:o1 (:o2 (:o3 :n1 :n2) :n3) :n4)))
(defn play24 [& digits] (count (map #(-> % format-solution println)
(let [operator-map-list (map (fn [a] {:op1 (nth a 0) :op2 (nth a 1) :op3 (nth a 2)})
(selections '(* + - /) 3))
digits-map-list
(map (fn [a] {:num1 (nth a 0) :num2 (nth a 1) :num3 (nth a 2) :num4 (nth a 3)})
(permutations digits))
patterns-list (list
'(:op1 (:op2 :num1 :num2) (:op3 :num3 :num4))
'(:op1 :num1 (:op2 :num2 (:op3 :num3 :num4))))
;other patterns can be added here, e.g. '(:op1 (:op2 (:op3 :num1 :num2) :num3) :num4)
op-subbed (reduce concat '()
(map (fn [a] (map #(nested-replace a % ) operator-map-list)) patterns-list))
full-subbed (reduce concat '()
(map (fn [a] (map #(nested-replace % a) op-subbed)) digits-map-list))]
(filter #(= (try (eval %) (catch Exception e nil)) 24) full-subbed)))))
(defn play24 [& digits]
{:pre (and (every? #(not= 0 %) digits)
(= (count digits) 4))}
(->> (for [:let [digit-maps
(->> digits sort c/permutations
(map #(zipmap [:n1 :n2 :n3 :n4] %)))]
om op-maps, dm digit-maps]
(w/prewalk-replace dm
(w/prewalk-replace om patterns)))
(filter #(= (eval %) 24))
(map println)
doall
count))

87
Task/24-game-Solve/CoffeeScript/24-game-solve.coffee Normal file
View file

@ -0,0 +1,87 @@
# This program tries to find some way to turn four digits into an arithmetic
# expression that adds up to 24.
#
# Example solution for 5, 7, 8, 8:
# (((8 + 7) * 8) / 5)
solve_24_game = (digits...) ->
# Create an array of objects for our helper functions
arr = for digit in digits
{
val: digit
expr: digit
}
combo4 arr...
combo4 = (a, b, c, d) ->
arr = [a, b, c, d]
# Reduce this to a three-node problem by combining two
# nodes from the array.
permutations = [
[0, 1, 2, 3]
[0, 2, 1, 3]
[0, 3, 1, 2]
[1, 2, 0, 3]
[1, 3, 0, 2]
[2, 3, 0, 1]
]
for permutation in permutations
[i, j, k, m] = permutation
for combo in combos arr[i], arr[j]
answer = combo3 combo, arr[k], arr[m]
return answer if answer
null
combo3 = (a, b, c) ->
arr = [a, b, c]
permutations = [
[0, 1, 2]
[0, 2, 1]
[1, 2, 0]
]
for permutation in permutations
[i, j, k] = permutation
for combo in combos arr[i], arr[j]
answer = combo2 combo, arr[k]
return answer if answer
null
combo2 = (a, b) ->
for combo in combos a, b
return combo.expr if combo.val == 24
null
combos = (a, b) ->
[
val: a.val + b.val
expr: "(#{a.expr} + #{b.expr})"
,
val: a.val * b.val
expr: "(#{a.expr} * #{b.expr})"
,
val: a.val - b.val
expr: "(#{a.expr} - #{b.expr})"
,
val: b.val - a.val
expr: "(#{b.expr} - #{a.expr})"
,
val: a.val / b.val
expr: "(#{a.expr} / #{b.expr})"
,
val: b.val / a.val
expr: "(#{b.expr} / #{a.expr})"
,
]
# test
do ->
rand_digit = -> 1 + Math.floor (9 * Math.random())
for i in [1..15]
a = rand_digit()
b = rand_digit()
c = rand_digit()
d = rand_digit()
solution = solve_24_game a, b, c, d
console.log "Solution for #{[a,b,c,d]}: #{solution ? 'no solution'}"

63
Task/24-game-Solve/D/24-game-solve.d
View file

@ -1,47 +1,36 @@
import std.stdio, std.algorithm, std.range, std.typecons, std.conv,
std.string, permutations2, arithmetic_rational;
import std.stdio, std.algorithm, std.range, std.conv, std.string,
std.concurrency, permutations2, arithmetic_rational;
string solve(in int target, in int[] problem) {
static struct ComputeAllOperations {
//static struct T { Rational r; string e; }
alias T = Tuple!(Rational,"r", string,"e");
Rational[] L;
static struct T { Rational r; string e; }
int opApply(in int delegate(ref T) dg) {
int result;
if (!L.empty) {
auto x = L[0];
auto xs = L[1 .. $];
if (L.length == 1) {
T aux = T(x, text(x));
result = dg(aux);
} else {
OUTER: foreach (o; ComputeAllOperations(xs)) {
auto y = o.r;
auto sub = [T(x * y, "*"), T(x + y, "+"), T(x - y, "-")];
if (y) sub ~= [T(x/y, "/")];
foreach (e; sub) {
auto aux = T(e.r, format("(%s%s%s)", x, e.e, o.e));
result = dg(aux); if (result) break OUTER;
Generator!T computeAllOperations(in Rational[] L) {
return new typeof(return)({
if (!L.empty) {
immutable x = L[0];
if (L.length == 1) {
yield(T(x, x.text));
} else {
foreach (const o; computeAllOperations(L.dropOne)) {
immutable y = o.r;
auto sub = [T(x * y, "*"), T(x + y, "+"), T(x - y, "-")];
if (y) sub ~= [T(x / y, "/")];
foreach (const e; sub)
yield(T(e.r, format("(%s%s%s)", x, e.e, o.e)));
}
}
}
}
}
}
return result;
});
}
}
foreach (p; problem.map!Rational.array.permutations)
foreach (sol; ComputeAllOperations(p))
if (sol.r == target)
return sol.e;
return "No solution";
foreach (const p; problem.map!Rational.array.permutations!false)
foreach (const sol; computeAllOperations(p))
if (sol.r == target)
return sol.e;
return "No solution";
}
void main() {
foreach (prob; [[6, 7, 9, 5], [3, 3, 8, 8], [1, 1, 1, 1]])
writeln(prob, ": ", solve(24, prob));
foreach (const prob; [[6, 7, 9, 5], [3, 3, 8, 8], [1, 1, 1, 1]])
writeln(prob, ": ", solve(24, prob));
}

10
Task/24-game-Solve/Go/24-game-solve.go
View file

@ -73,23 +73,23 @@ func expr_eval(x *Expr) (f frac) {
l, r := expr_eval(x.left), expr_eval(x.right)
switch {
case x.op == op_add:
switch x.op {
case op_add:
f.num = l.num*r.denom + l.denom*r.num
f.denom = l.denom * r.denom
return
case x.op == op_sub:
case op_sub:
f.num = l.num*r.denom - l.denom*r.num
f.denom = l.denom * r.denom
return
case x.op == op_mul:
case op_mul:
f.num = l.num * r.num
f.denom = l.denom * r.denom
return
case x.op == op_div:
case op_div:
f.num = l.num * r.denom
f.denom = l.denom * r.num
return

96
Task/24-game-Solve/Haskell/24-game-solve-2.hs
View file

@ -1,76 +1,42 @@
invocable all
link strings # for csort, deletec, permutes
import Control.Applicative
import Data.List
import Text.PrettyPrint
procedure main()
static eL
initial {
eoP := [] # set-up expression and operator permutation patterns
every ( e := !["a@b#c$d", "a@(b#c)$d", "a@b#(c$d)", "a@(b#c$d)", "a@(b#(c$d))"] ) &
( o := !(opers := "+-*/") || !opers || !opers ) do
put( eoP, map(e,"@#$",o) ) # expr+oper perms
eL := [] # all cases
every ( e := !eoP ) & ( p := permutes("wxyz") ) do
put(eL, map(e,"abcd",p))
data Expr = C Int | Op String Expr Expr
}
toDoc (C x ) = int x
toDoc (Op op x y) = parens $ toDoc x <+> text op <+> toDoc y
write("This will attempt to find solutions to 24 for sets of numbers by\n",
"combining 4 single digits between 1 and 9 to make 24 using only + - * / and ( ).\n",
"All operations have equal precedence and are evaluated left to right.\n",
"Enter 'use n1 n2 n3 n4' or just hit enter (to use a random set),",
"'first'/'all' shows the first or all solutions, 'quit' to end.\n\n")
ops :: [(String, Int -> Int -> Int)]
ops = [("+",(+)), ("-",(-)), ("*",(*)), ("/",div)]
repeat {
e := trim(read()) | fail
e ? case tab(find(" ")|0) of {
"q"|"quit" : break
"u"|"use" : e := tab(0)
"f"|"first": first := 1 & next
"a"|"all" : first := &null & next
"" : e := " " ||(1+?8) || " " || (1+?8) ||" " || (1+?8) || " " || (1+?8)
}
writes("Attempting to solve 24 for",e)
solve :: Int -> [Int] -> [Expr]
solve res = filter ((Just res ==) . eval) . genAst
where
genAst [x] = [C x]
genAst xs = do
(ys,zs) <- split xs
let f (Op op _ _) = op `notElem` ["+","*"] || ys <= zs
filter f $ Op <$> map fst ops <*> genAst ys <*> genAst zs
e := deletec(e,' \t') # no whitespace
if e ? ( tab(many('123456789')), pos(5), pos(0) ) then
write(":")
else write(" - invalid, only the digits '1..9' are allowed.") & next
eval (C x ) = Just x
eval (Op "/" _ y) | Just 0 <- eval y = Nothing
eval (Op op x y) = lookup op ops <*> eval x <*> eval y
eS := set()
every ex := map(!eL,"wxyz",e) do {
if member(eS,ex) then next # skip duplicates of final expression
insert(eS,ex)
if ex ? (ans := eval(E()), pos(0)) then # parse and evaluate
if ans = 24 then {
write("Success ",image(ex)," evaluates to 24.")
if \first then break
}
}
}
write("Quiting.")
end
procedure eval(X) #: return the evaluated AST
if type(X) == "list" then {
x := eval(get(X))
while o := get(X) do
if y := get(X) then
x := o( real(x), (o ~== "/" | fail, eval(y) ))
else write("Malformed expression.") & fail
}
return \x | X
end
select :: Int -> [Int] -> [[Int]]
select 0 _ = [[]]
select n xs = [x:zs | k <- [0..length xs - n]
, let (x:ys) = drop k xs
, zs <- select (n - 1) ys
]
procedure E() #: expression
put(lex := [],T())
while put(lex,tab(any('+-*/'))) do
put(lex,T())
suspend if *lex = 1 then lex[1] else lex # strip useless []
end
split :: [Int] -> [([Int],[Int])]
split xs = [(ys, xs \\ ys) | n <- [1..length xs - 1]
, ys <- nub . sort $ select n xs
]
procedure T() #: Term
suspend 2(="(", E(), =")") | # parenthesized subexpression, or ...
tab(any(&digits)) # just a value
end
main = mapM_ (putStrLn . render . toDoc) $ solve 24 [2,3,8,9]

76
Task/24-game-Solve/Haskell/24-game-solve-3.hs Normal file
View file

@ -0,0 +1,76 @@
invocable all
link strings # for csort, deletec, permutes
procedure main()
static eL
initial {
eoP := [] # set-up expression and operator permutation patterns
every ( e := !["a@b#c$d", "a@(b#c)$d", "a@b#(c$d)", "a@(b#c$d)", "a@(b#(c$d))"] ) &
( o := !(opers := "+-*/") || !opers || !opers ) do
put( eoP, map(e,"@#$",o) ) # expr+oper perms
eL := [] # all cases
every ( e := !eoP ) & ( p := permutes("wxyz") ) do
put(eL, map(e,"abcd",p))
}
write("This will attempt to find solutions to 24 for sets of numbers by\n",
"combining 4 single digits between 1 and 9 to make 24 using only + - * / and ( ).\n",
"All operations have equal precedence and are evaluated left to right.\n",
"Enter 'use n1 n2 n3 n4' or just hit enter (to use a random set),",
"'first'/'all' shows the first or all solutions, 'quit' to end.\n\n")
repeat {
e := trim(read()) | fail
e ? case tab(find(" ")|0) of {
"q"|"quit" : break
"u"|"use" : e := tab(0)
"f"|"first": first := 1 & next
"a"|"all" : first := &null & next
"" : e := " " ||(1+?8) || " " || (1+?8) ||" " || (1+?8) || " " || (1+?8)
}
writes("Attempting to solve 24 for",e)
e := deletec(e,' \t') # no whitespace
if e ? ( tab(many('123456789')), pos(5), pos(0) ) then
write(":")
else write(" - invalid, only the digits '1..9' are allowed.") & next
eS := set()
every ex := map(!eL,"wxyz",e) do {
if member(eS,ex) then next # skip duplicates of final expression
insert(eS,ex)
if ex ? (ans := eval(E()), pos(0)) then # parse and evaluate
if ans = 24 then {
write("Success ",image(ex)," evaluates to 24.")
if \first then break
}
}
}
write("Quiting.")
end
procedure eval(X) #: return the evaluated AST
if type(X) == "list" then {
x := eval(get(X))
while o := get(X) do
if y := get(X) then
x := o( real(x), (o ~== "/" | fail, eval(y) ))
else write("Malformed expression.") & fail
}
return \x | X
end
procedure E() #: expression
put(lex := [],T())
while put(lex,tab(any('+-*/'))) do
put(lex,T())
suspend if *lex = 1 then lex[1] else lex # strip useless []
end
procedure T() #: Term
suspend 2(="(", E(), =")") | # parenthesized subexpression, or ...
tab(any(&digits)) # just a value
end

264
Task/24-game-Solve/Java/24-game-solve.java Normal file
View file

@ -0,0 +1,264 @@
import java.util.*;
public class Game24Player {
final String[] patterns = {"nnonnoo", "nnonono", "nnnoono", "nnnonoo",
"nnnnooo"};
final String ops = "+-*/^";
String solution;
List<Integer> digits;
public static void main(String[] args) {
new Game24Player().play();
}
void play() {
digits = getSolvableDigits();
Scanner in = new Scanner(System.in);
while (true) {
System.out.print("Make 24 using these digits: ");
System.out.println(digits);
System.out.println("(Enter 'q' to quit, 's' for a solution)");
System.out.print("> ");
String line = in.nextLine();
if (line.equalsIgnoreCase("q")) {
System.out.println("\nThanks for playing");
return;
}
if (line.equalsIgnoreCase("s")) {
System.out.println(solution);
digits = getSolvableDigits();
continue;
}
char[] entry = line.replaceAll("[^*+-/)(\\d]", "").toCharArray();
try {
validate(entry);
if (evaluate(infixToPostfix(entry))) {
System.out.println("\nCorrect! Want to try another? ");
digits = getSolvableDigits();
} else {
System.out.println("\nNot correct.");
}
} catch (Exception e) {
System.out.printf("%n%s Try again.%n", e.getMessage());
}
}
}
void validate(char[] input) throws Exception {
int total1 = 0, parens = 0, opsCount = 0;
for (char c : input) {
if (Character.isDigit(c))
total1 += 1 << (c - '0') * 4;
else if (c == '(')
parens++;
else if (c == ')')
parens--;
else if (ops.indexOf(c) != -1)
opsCount++;
if (parens < 0)
throw new Exception("Parentheses mismatch.");
}
if (parens != 0)
throw new Exception("Parentheses mismatch.");
if (opsCount != 3)
throw new Exception("Wrong number of operators.");
int total2 = 0;
for (int d : digits)
total2 += 1 << d * 4;
if (total1 != total2)
throw new Exception("Not the same digits.");
}
boolean evaluate(char[] line) throws Exception {
Stack<Float> s = new Stack<>();
try {
for (char c : line) {
if ('0' <= c && c <= '9')
s.push((float) c - '0');
else
s.push(applyOperator(s.pop(), s.pop(), c));
}
} catch (EmptyStackException e) {
throw new Exception("Invalid entry.");
}
return (Math.abs(24 - s.peek()) < 0.001F);
}
float applyOperator(float a, float b, char c) {
switch (c) {
case '+':
return a + b;
case '-':
return b - a;
case '*':
return a * b;
case '/':
return b / a;
default:
return Float.NaN;
}
}
List<Integer> randomDigits() {
Random r = new Random();
List<Integer> result = new ArrayList<>(4);
for (int i = 0; i < 4; i++)
result.add(r.nextInt(9) + 1);
return result;
}
List<Integer> getSolvableDigits() {
List<Integer> result;
do {
result = randomDigits();
} while (!isSolvable(result));
return result;
}
boolean isSolvable(List<Integer> digits) {
Set<List<Integer>> dPerms = new HashSet<>(4 * 3 * 2);
permute(digits, dPerms, 0);
int total = 4 * 4 * 4;
List<List<Integer>> oPerms = new ArrayList<>(total);
permuteOperators(oPerms, 4, total);
StringBuilder sb = new StringBuilder(4 + 3);
for (String pattern : patterns) {
char[] patternChars = pattern.toCharArray();
for (List<Integer> dig : dPerms) {
for (List<Integer> opr : oPerms) {
int i = 0, j = 0;
for (char c : patternChars) {
if (c == 'n')
sb.append(dig.get(i++));
else
sb.append(ops.charAt(opr.get(j++)));
}
String candidate = sb.toString();
try {
if (evaluate(candidate.toCharArray())) {
solution = postfixToInfix(candidate);
return true;
}
} catch (Exception ignored) {
}
sb.setLength(0);
}
}
}
return false;
}
String postfixToInfix(String postfix) {
class Expression {
String op, ex;
int prec = 3;
Expression(String e) {
ex = e;
}
Expression(String e1, String e2, String o) {
ex = String.format("%s %s %s", e1, o, e2);
op = o;
prec = ops.indexOf(o) / 2;
}
}
Stack<Expression> expr = new Stack<>();
for (char c : postfix.toCharArray()) {
int idx = ops.indexOf(c);
if (idx != -1) {
Expression r = expr.pop();
Expression l = expr.pop();
int opPrec = idx / 2;
if (l.prec < opPrec)
l.ex = '(' + l.ex + ')';
if (r.prec <= opPrec)
r.ex = '(' + r.ex + ')';
expr.push(new Expression(l.ex, r.ex, "" + c));
} else {
expr.push(new Expression("" + c));
}
}
return expr.peek().ex;
}
char[] infixToPostfix(char[] infix) throws Exception {
StringBuilder sb = new StringBuilder();
Stack<Integer> s = new Stack<>();
try {
for (char c : infix) {
int idx = ops.indexOf(c);
if (idx != -1) {
if (s.isEmpty())
s.push(idx);
else {
while (!s.isEmpty()) {
int prec2 = s.peek() / 2;
int prec1 = idx / 2;
if (prec2 >= prec1)
sb.append(ops.charAt(s.pop()));
else
break;
}
s.push(idx);
}
} else if (c == '(') {
s.push(-2);
} else if (c == ')') {
while (s.peek() != -2)
sb.append(ops.charAt(s.pop()));
s.pop();
} else {
sb.append(c);
}
}
while (!s.isEmpty())
sb.append(ops.charAt(s.pop()));
} catch (EmptyStackException e) {
throw new Exception("Invalid entry.");
}
return sb.toString().toCharArray();
}
void permute(List<Integer> lst, Set<List<Integer>> res, int k) {
for (int i = k; i < lst.size(); i++) {
Collections.swap(lst, i, k);
permute(lst, res, k + 1);
Collections.swap(lst, k, i);
}
if (k == lst.size())
res.add(new ArrayList<>(lst));
}
void permuteOperators(List<List<Integer>> res, int n, int total) {
for (int i = 0, npow = n * n; i < total; i++)
res.add(Arrays.asList((i / npow), (i % npow) / n, i % n));
}
}

35
Task/24-game-Solve/ProDOS/24-game-solve.dos Normal file
View file

@ -0,0 +1,35 @@
editvar /modify -random- = <10
:a
editvar /newvar /withothervar /value=-random- /title=1
editvar /newvar /withothervar /value=-random- /title=2
editvar /newvar /withothervar /value=-random- /title=3
editvar /newvar /withothervar /value=-random- /title=4
printline These are your four digits: -1- -2- -3- -4-
printline Use an algorithm to make the number 24.
editvar /newvar /value=a /userinput=1 /title=Algorithm:
do -a-
if -a- /hasvalue 24 printline Your algorithm worked! & goto :b (
) else printline Your algorithm did not work.
editvar /newvar /value=b /userinput=1 /title=Do you want to see how you could have done it?
if -b- /hasvalue y goto :c else goto :b
:b
editvar /newvar /value=c /userinput=1 /title=Do you want to play again?
if -c- /hasvalue y goto :a else exitcurrentprogram
:c
editvar /newvar /value=do -1- + -2- + -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- - -2- + -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- / -2- + -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- * -2- + -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- + -2- - -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- + -2- / -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- + -2- * -3- + -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- + -2- + -3- - -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- + -2- + -3- / -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- + -2- + -3- * -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- - -2- - -3- - -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- / -2- / -3- / -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
editvar /newvar /value=do -1- * -2- * -3- * -4- /title=c & do -c- >d & if -d- /hasvalue 24 goto :solve
:solve
printline you could have done it by doing -c-
stoptask
goto :b

0
Task/24-game-Solve/Prolog/24-game-solve.pro → Task/24-game-Solve/Prolog/24-game-solve-1.pro
View file

22
Task/24-game-Solve/Prolog/24-game-solve-2.pro Normal file
View file

@ -0,0 +1,22 @@
:- initialization(main).
solve(N,Xs,Ast) :-
Err = evaluation_error(zero_divisor)
, gen_ast(Xs,Ast), catch(Ast =:= N, error(Err,_), fail)
.
gen_ast([N],N) :- between(1,9,N).
gen_ast(Xs,Ast) :-
Ys = [_|_], Zs = [_|_], split(Xs,Ys,Zs)
, ( member(Op, [(+),(*)]), Ys @=< Zs ; member(Op, [(-),(//)]) )
, gen_ast(Ys,A), gen_ast(Zs,B), Ast =.. [Op,A,B]
.
split(Xs,Ys,Zs) :- sublist(Ys,Xs), select_all(Ys,Xs,Zs).
% where
select_all([],Xs,Xs).
select_all([Y|Ys],Xs,Zs) :- select(Y,Xs,X1), !, select_all(Ys,X1,Zs).
test(T) :- solve(24, [2,3,8,9], T).
main :- forall(test(T), (write(T), nl)), halt.

40
Task/24-game-Solve/REXX/24-game-solve.rexx
View file

@ -3,7 +3,7 @@
│ 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). │
│ comprised soley of the numerals (digits) 1 ──► 9 (no zeroes). │
│ │
│ In SSSS-FFFF SSSS is the start, │
│ FFFF is the start. │
@ -17,8 +17,8 @@ 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. */
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). */
@ -28,22 +28,22 @@ indent=left('',30) /*used to indent display of solutions. */
Lpar='(' /*a string to make REXX code prettier. */
Rpar=')' /*ditto. */
do g=start to finish /*process a (possible) range of values.*/
if pos(0,g)\==0 then iterate /*ignore values with zero in them. */
do g=start to finish /*process a (possible) range of values.*/
if pos(0,g)\==0 then iterate /*ignore values with zero in them. */
do _=1 for 4 /*define versions for faster execution.*/
do _=1 for 4 /*define versions for faster execution.*/
g._=substr(g,_,1)
end /*_*/
do i=1 for ops /*insert an operator after 1st number. */
do j=1 for ops /*insert an operator after 2nd number. */
do k=1 for ops /*insert an operator after 2nd number. */
do m=0 to 3; L.= /*assume no left parenthesis so far. */
do n=m+1 to 4 /*match left paren with a right paren. */
do m=0 for 4; L.= /*assume no left parenthesis so far. */
do n=m+1 to 4 /*match left paren with a right paren. */
L.m=Lpar /*define a left paren, m=0 means ignore*/
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 )*/
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*/
@ -51,7 +51,7 @@ Rpar=')' /*ditto. */
/* /(yyy) ===> /div(yyy) */
/*Enables to check for division by zero*/
origE=e /*keep old version for the display. */
if pos('/(',e)\==0 then e=changestr('/(',e,"/div(")
if pos('/(',e)\==0 then e=changestr('/(', e, "/div(")
/*The above could be replaced by: */
/* e=changestr('/(',e,"/div(") */
@ -60,12 +60,12 @@ Rpar=')' /*ditto. */
if x.e then iterate /*was the expression already used? */
x.e=1 /*mark this expression as unique. */
/*have REXX do the heavy lifting (ugh).*/
interpret 'x=' e /*... strain... */
interpret 'x=' e /*··· strain··· */
x=x/1 /*remove trailing decimal points(maybe)*/
if x\==24 then iterate /*Not correct? Try again. */
if x\==24 then iterate /*Not correct? Try again. */
finds=finds+1 /*bump number of found solutions. */
_=translate(origE, '][', ")(") /*show [], not (). */
say indent 'a solution:' _ /*display a solution. */
say indent 'a solution:' _ /*display a solution. */
end /*n*/
end /*m*/
end /*k*/
@ -79,15 +79,15 @@ say; say sols 'unique solution's(finds) "found for" orig /*pluralize.*/
exit
/*───────────────────────────DIV subroutine─────────────────────────────*/
div: procedure; parse arg q /*tests if dividing by 0 (zero). */
if q=0 then q=1e9 /*if dividing by zero, change divisor. */
if q=0 then q=1e9 /*if dividing by zero, change divisor. */
return q /*changing Q invalidates the expression*/
/*───────────────────────────GER subroutine─────────────────────────────*/
ger: say; say '*** error! ***'; if _\=='' then say 'guess=' _
say arg(1); say; exit 13
ger: say; say '*** error! ***'; if _\=='' then say 'guess=' _
say arg(1); say; exit 13
/*───────────────────────────S subroutine───────────────────────────────*/
s: if arg(1)==1 then return ''; return 's' /*simple pluralizer.*/
s: if arg(1)==1 then return ''; return 's' /*simple pluralizer.*/
/*───────────────────────────validate subroutine────────────────────────*/
validate: parse arg y; errCode=0; _v=verify(y,digs)
validate: parse arg y; errCode=0; _v=verify(y,digs)
select
when y=='' then call ger 'no digits entered.'
when length(y)<4 then call ger 'not enough digits entered, must be 4'

12
Task/24-game-Solve/Tcl/24-game-solve.tcl
View file

@ -2,10 +2,10 @@ package require struct::list
# Encoding the various expression trees that are possible
set patterns {
{((A x B) y C) z D}
{(A x (B y C)) z D}
{(A x B) y (C z D)}
{A x ((B y C) z D)}
{A x (B y (C z D))}
{(A x (B y C)) z D}
{(A x B) y (C z D)}
{A x ((B y C) z D)}
{A x (B y (C z D))}
}
# Encoding the various permutations of digits
set permutations [struct::list map [struct::list permutations {a b c d}] \
@ -13,8 +13,8 @@ set permutations [struct::list map [struct::list permutations {a b c d}] \
# The permitted operations
set operations {+ - * /}
# Given a list of four integers (precondition not checked!) return a list of
# solutions to the 24 game using those four integers.
# Given a list of four integers (precondition not checked!)
# return a list of solutions to the 24 game using those four integers.
proc find24GameSolutions {values} {
global operations patterns permutations
set found {}