open System

let rec gcd x y = if x = y || x = 0 then y else if x < y then gcd y x else gcd y (x-y)
let abs (x : int) = Math.Abs x
let sign (x: int) = Math.Sign x
let cint s = Int32.Parse(s)

type Rat(x : int, y : int) =
    let g = if y = 0 then 0 else gcd (abs x) (abs y)
    member this.n = if g = 0 then sign y * sign x else sign y * x / g   // store a minus sign in the numerator
    member this.d =
        if y = 0 then 0 else sign y * y / g
    static member (~-) (x : Rat) = Rat(-x.n, x.d)
    static member (+) (x : Rat, y : Rat) = Rat(x.n * y.d + y.n * x.d, x.d * y.d)
    static member (-) (x : Rat, y : Rat) = x + Rat(-y.n, y.d)
    static member (*) (x : Rat, y : Rat) = Rat(x.n * y.n, x.d * y.d)
    static member (/) (x : Rat, y : Rat) = x * Rat(y.d, y.n)
    interface System.IComparable with
      member this.CompareTo o =
        match o with
        | :? Rat as that -> compare (this.n * that.d) (that.n * this.d)
        | _ -> invalidArg "o" "cannot compare values of differnet types."
    override this.Equals(o) =
        match o with
        | :? Rat as that -> this.n = that.n && this.d = that.d
        | _ -> false
    override this.ToString() =
        if this.d = 1 then this.n.ToString()
        else sprintf @"<%d,%d>" this.n this.d
    new(x : string, y : string) = if y = "" then Rat(cint x, 1) else Rat(cint x, cint y)

type expression =
    | Const of Rat
    | Sum  of expression * expression
    | Diff of expression * expression
    | Prod of expression * expression
    | Quot of expression * expression

let rec eval = function
    | Const c -> c
    | Sum (f, g) -> eval f + eval g
    | Diff(f, g) -> eval f - eval g
    | Prod(f, g) -> eval f * eval g
    | Quot(f, g) -> eval f / eval g

let print_expr expr =
    let concat (s : seq<string>) = System.String.Concat s
    let paren p prec op_prec = if prec > op_prec then p else ""
    let rec print prec = function
    | Const c -> c.ToString()
    | Sum(f, g) ->
        concat [ (paren "(" prec 0); (print 0 f); " + "; (print 0 g); (paren ")" prec 0) ]
    | Diff(f, g) ->
        concat [ (paren "(" prec 0); (print 0 f); " - "; (print 1 g); (paren ")" prec 0) ]
    | Prod(f, g) ->
        concat [ (paren "(" prec 2); (print 2 f); " * "; (print 2 g); (paren ")" prec 2) ]
    | Quot(f, g) ->
        concat [ (paren "(" prec 2); (print 2 f); " / "; (print 3 g); (paren ")" prec 2) ]
    print 0 expr

let rec normal expr =
    let norm epxr =
        match expr with
        | Sum(x, y) -> if eval x <= eval y then expr else Sum(normal y, normal x)
        | Prod(x, y) -> if eval x <= eval y then expr else Prod(normal y, normal x)
        | _ -> expr
    match expr with
    | Const c -> expr
    | Sum(x, y) -> norm (Sum(normal x, normal y))
    | Prod(x, y) -> norm (Prod(normal x, normal y))
    | Diff(x, y) -> Diff(normal x, normal y)
    | Quot(x, y) -> Quot(normal x, normal y)

let rec insert v = function
    | [] -> [[v]]
    | x::xs as li -> (v::li) :: (List.map (fun y -> x::y) (insert v xs))

let permutations li =
    List.foldBack (fun x z -> List.concat (List.map (insert x) z)) li [[]]

let rec comp expr rest = seq {
    match rest with
    | x::xs ->
        yield! comp (Sum (expr, x)) xs;
        yield! comp (Diff(x, expr)) xs;
        yield! comp (Diff(expr, x)) xs;
        yield! comp (Prod(expr, x)) xs;
        yield! comp (Quot(x, expr)) xs;
        yield! comp (Quot(expr, x)) xs;
    | [] -> if eval expr = Rat(24,1) then yield print_expr (normal expr)
}

[<EntryPoint>]
let main argv =
    let digits = List.init 4 (fun i -> Const (Rat(argv.[i],"")))
    let solutions =
        permutations digits
        |> Seq.groupBy (sprintf "%A")
        |> Seq.map snd |> Seq.map Seq.head
        |> Seq.map (fun x -> comp (List.head x) (List.tail x))
        |> Seq.choose (fun x -> if Seq.isEmpty x then None else Some x)
        |> Seq.concat
    if Seq.isEmpty solutions then
        printfn "No solutions."
    else
        solutions
        |> Seq.groupBy id
        |> Seq.iter (fun x -> printfn "%s" (fst x))
    0


USING: continuations grouping io kernel math math.combinatorics
prettyprint quotations random sequences sequences.deep ;
IN: rosetta-code.24-game

: 4digits ( -- seq ) 4 9 random-integers [ 1 + ] map ;

: expressions ( digits -- exprs )
    all-permutations [ [ + - * / ] 3 selections
    [ append ] with map ] map flatten 7 group ;

: 24= ( exprs -- )
    >quotation dup call( -- x ) 24 = [ . ] [ drop ] if ;

: 24-game ( -- )
    4digits dup "The numbers: " write . "The solutions: "
    print expressions [ [ 24= ] [ 2drop ] recover ] each ;

24-game


program solve_24
  use helpers
  implicit none
  real                 :: vector(4), reals(4), p, q, r, s
  integer              :: numbers(4), n, i, j, k, a, b, c, d
  character, parameter :: ops(4) = (/ '+', '-', '*', '/' /)
  logical              :: last
  real,parameter       :: eps = epsilon(1.0)

  do n=1,12
    call random_number(vector)
    reals   = 9 * vector + 1
    numbers = int(reals)
    call Insertion_Sort(numbers)

    permutations: do
      a = numbers(1); b = numbers(2); c = numbers(3); d = numbers(4)
      reals = real(numbers)
      p = reals(1);   q = reals(2);   r = reals(3);   s = reals(4)
      ! combinations of operators:
      do i=1,4
        do j=1,4
          do k=1,4
            if      ( abs(op(op(op(p,i,q),j,r),k,s)-24.0) < eps ) then
              write (*,*) numbers, ' : ', '((',a,ops(i),b,')',ops(j),c,')',ops(k),d
              exit permutations
            else if ( abs(op(op(p,i,op(q,j,r)),k,s)-24.0) < eps ) then
              write (*,*) numbers, ' : ', '(',a,ops(i),'(',b,ops(j),c,'))',ops(k),d
              exit permutations
            else if ( abs(op(p,i,op(op(q,j,r),k,s))-24.0) < eps ) then
              write (*,*) numbers, ' : ', a,ops(i),'((',b,ops(j),c,')',ops(k),d,')'
              exit permutations
            else if ( abs(op(p,i,op(q,j,op(r,k,s)))-24.0) < eps ) then
              write (*,*) numbers, ' : ', a,ops(i),'(',b,ops(j),'(',c,ops(k),d,'))'
              exit permutations
            else if ( abs(op(op(p,i,q),j,op(r,k,s))-24.0) < eps ) then
              write (*,*) numbers, ' : ', '(',a,ops(i),b,')',ops(j),'(',c,ops(k),d,')'
              exit permutations
            end if
          end do
        end do
      end do
      call nextpermutation(numbers,last)
      if ( last ) then
        write (*,*) numbers, ' : no solution.'
        exit permutations
      end if
    end do permutations

  end do

contains

  pure real function op(x,c,y)
    integer, intent(in) :: c
    real, intent(in)    :: x,y
    select case ( ops(c) )
      case ('+')
        op = x+y
      case ('-')
        op = x-y
      case ('*')
        op = x*y
      case ('/')
        op = x/y
    end select
  end function op

end program solve_24


# Solution in '''RPN'''
check := function(x, y, z)
	local r, c, s, i, j, k, a, b, p;
	i := 0;
	j := 0;
	k := 0;
	s := [ ];
	r := "";
	for c in z do
		if c = 'x' then
			i := i + 1;
			k := k + 1;
			s[k] := x[i];
			Append(r, String(x[i]));
		else
			j := j + 1;
			b := s[k];
			k := k - 1;
			a := s[k];
			p := y[j];
			r[Size(r) + 1] := p;
			if p = '+' then
				a := a + b;
			elif p = '-' then
				a := a - b;
			elif p = '*' then
				a := a * b;
			elif p = '/' then
				if b = 0 then
					continue;
				else
					a := a / b;
				fi;
			else
				return fail;
			fi;
			s[k] := a;
		fi;
	od;
	if s[1] = 24 then
		return r;
	else
		return fail;
	fi;
end;

Player24 := function(digits)
	local u, v, w, x, y, z, r;
	u := PermutationsList(digits);
	v := Tuples("+-*/", 3);
	w := ["xx*x*x*", "xx*xx**", "xxx**x*", "xxx*x**", "xxxx***"];
	for x in u do
		for y in v do
			for z in w do
				r := check(x, y, z);
				if r <> fail then
					return r;
				fi;
			od;
		od;
	od;
	return fail;
end;

Player24([1,2,7,7]);
# "77*1-2/"
Player24([9,8,7,6]);
# "68*97-/"
Player24([1,1,7,7]);
# fail

# Solutions with only one distinct digit are found only for 3, 4, 5, 6:
Player24([3,3,3,3]);
# "33*3*3-"
Player24([4,4,4,4]);
# "44*4+4+"
Player24([5,5,5,5]);
# "55*55/-"
Player24([6,6,6,6]);
# "66*66+-"

# A tricky one:
Player24([3,3,8,8]);
"8383/-/"


package main

import (
	"fmt"
	"math/rand"
	"time"
)

const (
	op_num = iota
	op_add
	op_sub
	op_mul
	op_div
)

type frac struct {
	num, denom int
}

// Expression: can either be a single number, or a result of binary
// operation from left and right node
type Expr struct {
	op          int
	left, right *Expr
	value       frac
}

var n_cards = 4
var goal = 24
var digit_range = 9

func (x *Expr) String() string {
	if x.op == op_num {
		return fmt.Sprintf("%d", x.value.num)
	}

	var bl1, br1, bl2, br2, opstr string
	switch {
	case x.left.op == op_num:
	case x.left.op >= x.op:
	case x.left.op == op_add && x.op == op_sub:
		bl1, br1 = "", ""
	default:
		bl1, br1 = "(", ")"
	}

	if x.right.op == op_num || x.op < x.right.op {
		bl2, br2 = "", ""
	} else {
		bl2, br2 = "(", ")"
	}

	switch {
	case x.op == op_add:
		opstr = " + "
	case x.op == op_sub:
		opstr = " - "
	case x.op == op_mul:
		opstr = " * "
	case x.op == op_div:
		opstr = " / "
	}

	return bl1 + x.left.String() + br1 + opstr +
		bl2 + x.right.String() + br2
}

func expr_eval(x *Expr) (f frac) {
	if x.op == op_num {
		return x.value
	}

	l, r := expr_eval(x.left), expr_eval(x.right)

	switch x.op {
	case op_add:
		f.num = l.num*r.denom + l.denom*r.num
		f.denom = l.denom * r.denom
		return

	case op_sub:
		f.num = l.num*r.denom - l.denom*r.num
		f.denom = l.denom * r.denom
		return

	case op_mul:
		f.num = l.num * r.num
		f.denom = l.denom * r.denom
		return

	case op_div:
		f.num = l.num * r.denom
		f.denom = l.denom * r.num
		return
	}
	return
}

func solve(ex_in []*Expr) bool {
	// only one expression left, meaning all numbers are arranged into
	// a binary tree, so evaluate and see if we get 24
	if len(ex_in) == 1 {
		f := expr_eval(ex_in[0])
		if f.denom != 0 && f.num == f.denom*goal {
			fmt.Println(ex_in[0].String())
			return true
		}
		return false
	}

	var node Expr
	ex := make([]*Expr, len(ex_in)-1)

	// try to combine a pair of expressions into one, thus reduce
	// the list length by 1, and recurse down
	for i := range ex {
		copy(ex[i:len(ex)], ex_in[i+1:len(ex_in)])

		ex[i] = &node
		for j := i + 1; j < len(ex_in); j++ {
			node.left = ex_in[i]
			node.right = ex_in[j]

			// try all 4 operators
			for o := op_add; o <= op_div; o++ {
				node.op = o
				if solve(ex) {
					return true
				}
			}

			// also - and / are not commutative, so swap arguments
			node.left = ex_in[j]
			node.right = ex_in[i]

			node.op = op_sub
			if solve(ex) {
				return true
			}

			node.op = op_div
			if solve(ex) {
				return true
			}

			if j < len(ex) {
				ex[j] = ex_in[j]
			}
		}
		ex[i] = ex_in[i]
	}
	return false
}

func main() {
	cards := make([]*Expr, n_cards)
	rand.Seed(time.Now().Unix())

	for k := 0; k < 10; k++ {
		for i := 0; i < n_cards; i++ {
			cards[i] = &Expr{op_num, nil, nil,
				frac{rand.Intn(digit_range-1) + 1, 1}}
			fmt.Printf(" %d", cards[i].value.num)
		}
		fmt.Print(":  ")
		if !solve(cards) {
			fmt.Println("No solution")
		}
	}
}


uses java.lang.Integer
uses java.lang.Double
uses java.lang.System
uses java.util.ArrayList
uses java.util.LinkedList
uses java.util.List
uses java.util.Scanner
uses java.util.Stack

function permutations<T>( lst : List<T> ) : List<List<T>> {
    if( lst.size() == 0 ) return {}
    if( lst.size() == 1 ) return { lst }

    var pivot = lst.get(lst.size()-1)

    var sublist = new ArrayList<T>( lst )
    sublist.remove( sublist.size() - 1 )

    var subPerms = permutations( sublist )

    var ret = new ArrayList<List<T>>()
    for( x in subPerms ) {
        for( e in x index i ) {
            var next = new LinkedList<T>( x )
            next.add( i, pivot )
            ret.add( next )
        }
        x.add( pivot )
        ret.add( x )
    }
    return ret
}

function readVals() : List<Integer> {
    var line = new java.io.BufferedReader( new java.io.InputStreamReader( System.in ) ).readLine()
    var scan = new Scanner( line )

    var ret = new ArrayList<Integer>()
    for( i in 0..3 ) {
        var next = scan.nextInt()
        if( 0 >= next || next >= 10 ) {
            print( "Invalid entry: ${next}" )
            return null
        }
        ret.add( next )
    }
    return ret
}

function getOp( i : int ) : char[] {
    var ret = new char[3]
    var ops = { '+', '-', '*', '/' }
    ret[0] = ops[i / 16]
    ret[1] = ops[(i / 4) % 4 ]
    ret[2] = ops[i % 4 ]
    return ret
}

function isSoln( nums : List<Integer>, ops : char[] ) : boolean {
    var stk = new Stack<Double>()
    for( n in nums ) {
        stk.push( n )
    }

    for( c in ops ) {
        var r = stk.pop().doubleValue()
        var l = stk.pop().doubleValue()
        if( c == '+' ) {
            stk.push( l + r )
        } else if( c == '-' ) {
            stk.push( l - r )
        } else if( c == '*' ) {
            stk.push( l * r )
        } else if( c == '/' ) {
            // Avoid division by 0
            if( r == 0.0 ) {
                return false
            }
            stk.push( l / r )
        }
    }

    return java.lang.Math.abs( stk.pop().doubleValue() - 24.0 ) < 0.001
}

function printSoln( nums : List<Integer>, ops : char[] ) {
    // RPN: a b c d + - *
    // Infix (a * (b - (c + d)))
    print( "Found soln: (${nums.get(0)} ${ops[0]} (${nums.get(1)} ${ops[1]} (${nums.get(2)} ${ops[2]} ${nums.get(3)})))" )
}

System.out.print( "#> " )
var vals = readVals()

var opPerms = 0..63
var solnFound = false

for( i in permutations( vals ) ) {
    for( j in opPerms ) {
        var opList = getOp( j )
        if( isSoln( i, opList ) ) {
            printSoln( i, opList )
            solnFound = true
        }
    }
}

if( ! solnFound ) {
    print( "No solution!" )
}


import Data.List
import Data.Ratio
import Control.Monad
import System.Environment (getArgs)

data Expr = Constant Rational |
    Expr :+ Expr | Expr :- Expr |
    Expr :* Expr | Expr :/ Expr
    deriving (Eq)

ops = [(:+), (:-), (:*), (:/)]

instance Show Expr where
    show (Constant x) = show $ numerator x
      -- In this program, we need only print integers.
    show (a :+ b)     = strexp "+" a b
    show (a :- b)     = strexp "-" a b
    show (a :* b)     = strexp "*" a b
    show (a :/ b)     = strexp "/" a b

strexp :: String -> Expr -> Expr -> String
strexp op a b = "(" ++ show a ++ " " ++ op ++ " " ++ show b ++ ")"

templates :: [[Expr] -> Expr]
templates = do
    op1 <- ops
    op2 <- ops
    op3 <- ops
    [\[a, b, c, d] -> op1 a $ op2 b $ op3 c d,
     \[a, b, c, d] -> op1 (op2 a b) $ op3 c d,
     \[a, b, c, d] -> op1 a $ op2 (op3 b c) d,
     \[a, b, c, d] -> op1 (op2 a $ op3 b c) d,
     \[a, b, c, d] -> op1 (op2 (op3 a b) c) d]

eval :: Expr -> Maybe Rational
eval (Constant c) = Just c
eval (a :+ b)     = liftM2 (+) (eval a) (eval b)
eval (a :- b)     = liftM2 (-) (eval a) (eval b)
eval (a :* b)     = liftM2 (*) (eval a) (eval b)
eval (a :/ b)     = do
    denom <- eval b
    guard $ denom /= 0
    liftM (/ denom) $ eval a

solve :: Rational -> [Rational] -> [Expr]
solve target r4 = filter (maybe False (== target) . eval) $
    liftM2 ($) templates $
    nub $ permutations $ map Constant r4

main = getArgs >>= mapM_ print . solve 24 . map (toEnum . read)


invocable all
link strings   # for csort, deletec, permutes

procedure main()
static eL
initial {
   eoP := []  # set-up expression and operator permutation patterns
   every ( e := !["[email protected]#c$d", "[email protected](b#c)$d", "[email protected]#(c$d)", "[email protected](b#c$d)", "[email protected](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


perm=: (A.&i.~ !) 4
ops=: ' ',.'+-*%' {~ >,{i.each 4 4 4
cmask=: 1 + 0j1 * [email protected]{:@[email protected][ e. ]
left=:  [ #!.'('~"1 cmask
right=: [ #!.')'~"1 cmask
paren=: 2 :'[: left&m right&n'
parens=: ], 0 paren 3, 0 paren 5, 2 paren 5, [: 0 paren 7 (0 paren 3)
all=: [: parens [:,/ ops ,@,."1/ perm { [:;":each
answer=: ({[email protected]#~ 24 = ".)@all


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));
    }
}


var ar=[],order=[0,1,2],op=[],val=[];
var NOVAL=9999,oper="+-*/",out;

function rnd(n){return Math.floor(Math.random()*n)}

function say(s){
 try{document.write(s+"<br>")}
 catch(e){WScript.Echo(s)}
}

function getvalue(x,dir){
 var r=NOVAL;
 if(dir>0)++x;
 while(1){
  if(val[x]!=NOVAL){
   r=val[x];
   val[x]=NOVAL;
   break;
  }
  x+=dir;
 }
 return r*1;
}

function calc(){
 var c=0,l,r,x;
 val=ar.join('/').split('/');
 while(c<3){
  x=order[c];
  l=getvalue(x,-1);
  r=getvalue(x,1);
  switch(op[x]){
   case 0:val[x]=l+r;break;
   case 1:val[x]=l-r;break;
   case 2:val[x]=l*r;break;
   case 3:
   if(!r||l%r)return 0;
   val[x]=l/r;
  }
  ++c;
 }
 return getvalue(-1,1);
}

function shuffle(s,n){
 var x=n,p=eval(s),r,t;
 while(x--){
  r=rnd(n);
  t=p[x];
  p[x]=p[r];
  p[r]=t;
 }
}

function parenth(n){
 while(n>0)--n,out+='(';
 while(n<0)++n,out+=')';
}

function getpriority(x){
 for(var z=3;z--;)if(order[z]==x)return 3-z;
 return 0;
}

function showsolution(){
 var x=0,p=0,lp=0,v=0;
 while(x<4){
  if(x<3){
   lp=p;
   p=getpriority(x);
   v=p-lp;
   if(v>0)parenth(v);
  }
  out+=ar[x];
  if(x<3){
   if(v<0)parenth(v);
   out+=oper.charAt(op[x]);
  }
  ++x;
 }
 parenth(-p);
 say(out);
}

function solve24(s){
 var z=4,r;
 while(z--)ar[z]=s.charCodeAt(z)-48;
 out="";
 for(z=100000;z--;){
  r=rnd(256);
  op[0]=r&3;
  op[1]=(r>>2)&3;
  op[2]=(r>>4)&3;
  shuffle("ar",4);
  shuffle("order",3);
  if(calc()!=24)continue;
  showsolution();
  break;
 }
}

solve24("1234");
solve24("6789");
solve24("1127");


# Generate a stream of the permutations of the input array.
def permutations:
  if length == 0 then []
  else range(0;length) as $i
  | [.[$i]] + (del(.[$i])|permutations)
  end ;

# Generate a stream of arrays of length n,
# with members drawn from the input array.
def take(n):
  length as $l |
  if n == 1 then range(0;$l) as $i | [ .[$i] ]
  else take(n-1) + take(1)
  end;

# Emit an array with elements that alternate between those in the input array and those in short,
# starting with the former, and using nothing if "short" is too too short.
def intersperse(short):
 . as $in
 | reduce range(0;length) as $i
     ([]; . + [ $in[$i], (short[$i] // empty) ]);

# Emit a stream of all the nested triplet groupings of the input array elements,
# e.g. [1,2,3,4,5] =>
# [1,2,[3,4,5]]
# [[1,2,3],4,5]
#
def triples:
  . as $in
  | if   length == 3 then .
    elif length == 1 then $in[0]
    elif length < 3 then empty
    else
      (range(0; (length-1) / 2) * 2 + 1)  as $i
      | ($in[0:$i] | triples)  as $head
      | ($in[$i+1:] | triples) as $tail
      | [$head, $in[$i], $tail]
    end;


function solve24(nums)
    length(nums) != 4 && error("Input must be a 4-element Array")
    syms = [+,-,*,/]
    for x in syms, y in syms, z in syms
        for i = 1:24
            a,b,c,d = nthperm(nums,i)
            if round(x(y(a,b),z(c,d)),5) == 24
                return "($a$y$b)$x($c$z$d)"
            elseif round(x(a,y(b,z(c,d))),5) == 24
                return "$a$x($b$y($c$z$d))"
            elseif round(x(y(z(c,d),b),a),5) == 24
                return "(($c$z$d)$y$b)$x$a"
            elseif round(x(y(b,z(c,d)),a),5) == 24
                return "($b$y($c$z$d))$x$a"
            end
        end
    end
    return "0"
end


// version 1.1.3

import java.util.Random

const val N_CARDS = 4
const val SOLVE_GOAL = 24
const val MAX_DIGIT = 9

class Frac(val num: Int, val den: Int)

enum class OpType { NUM, ADD, SUB, MUL, DIV }

class Expr(
    var op:    OpType = OpType.NUM,
    var left:  Expr?  = null,
    var right: Expr?  = null,
    var value: Int    = 0
)

fun showExpr(e: Expr?, prec: OpType, isRight: Boolean) {
    if (e == null) return
    val op = when (e.op) {
        OpType.NUM -> { print(e.value); return }
        OpType.ADD -> " + "
        OpType.SUB -> " - "
        OpType.MUL -> " x "
        OpType.DIV -> " / "
    }

    if ((e.op == prec && isRight) || e.op < prec) print("(")
    showExpr(e.left, e.op, false)
    print(op)
    showExpr(e.right, e.op, true)
    if ((e.op == prec && isRight) || e.op < prec) print(")")
}

fun evalExpr(e: Expr?): Frac {
    if (e == null) return Frac(0, 1)
    if (e.op == OpType.NUM) return Frac(e.value, 1)
    val l = evalExpr(e.left)
    val r = evalExpr(e.right)
    return when (e.op) {
        OpType.ADD -> Frac(l.num * r.den + l.den * r.num, l.den * r.den)
        OpType.SUB -> Frac(l.num * r.den - l.den * r.num, l.den * r.den)
        OpType.MUL -> Frac(l.num * r.num, l.den * r.den)
        OpType.DIV -> Frac(l.num * r.den, l.den * r.num)
        else       -> throw IllegalArgumentException("Unknown op: ${e.op}")
    }
}

fun solve(ea: Array<Expr?>, len: Int): Boolean {
    if (len == 1) {
        val final = evalExpr(ea[0])
        if (final.num == final.den * SOLVE_GOAL && final.den != 0) {
            showExpr(ea[0], OpType.NUM, false)
            return true
        }
    }

    val ex = arrayOfNulls<Expr>(N_CARDS)
    for (i in 0 until len - 1) {
        for (j in i + 1 until len) ex[j - 1] = ea[j]
        val node = Expr()
        ex[i] = node
        for (j in i + 1 until len) {
            node.left = ea[i]
            node.right = ea[j]
            for (k in OpType.values().drop(1)) {
                node.op = k
                if (solve(ex, len - 1)) return true
            }
            node.left = ea[j]
            node.right = ea[i]
            node.op = OpType.SUB
            if (solve(ex, len - 1)) return true
            node.op = OpType.DIV
            if (solve(ex, len - 1)) return true
            ex[j] = ea[j]
        }
        ex[i] = ea[i]
    }
    return false
}

fun solve24(n: IntArray) =
    solve (Array(N_CARDS) { Expr(value = n[it]) }, N_CARDS)

fun main(args: Array<String>) {
    val r = Random()
    val n = IntArray(N_CARDS)
    for (j in 0..9) {
        for (i in 0 until N_CARDS) {
            n[i] = 1 + r.nextInt(MAX_DIGIT)
            print(" ${n[i]}")
        }
        print(":  ")
        println(if (solve24(n)) "" else "No solution")
    }
}


dim d(4)
input "Enter 4 digits: "; a$
nD=0
for i =1 to len(a$)
    c$=mid$(a$,i,1)
    if instr("123456789",c$) then
        nD=nD+1
        d(nD)=val(c$)
    end if
next
'for i = 1 to 4
'    print d(i);
'next

'precompute permutations. Dumb way.
nPerm = 1*2*3*4
dim perm(nPerm, 4)
n = 0
for i = 1 to 4
    for j = 1 to 4
        for k = 1 to 4
            for l = 1 to 4
            'valid permutation (no dupes?)
                if i<>j and i<>k and i<>l _
                    and j<>k and j<>l _
                        and k<>l then
                    n=n+1
                    '
'                    perm(n,1)=i
'                    perm(n,2)=j
'                    perm(n,3)=k
'                    perm(n,4)=l
                    'actually, we can as well permute given digits
                    perm(n,1)=d(i)
                    perm(n,2)=d(j)
                    perm(n,3)=d(k)
                    perm(n,4)=d(l)
                end if
            next
        next
    next
next
'check if permutations look OK. They are
'for i =1 to n
'    print i,
'    for j =1 to 4: print perm(i,j);:next
'    print
'next

'possible brackets
NBrackets = 11
dim Brakets$(NBrackets)
DATA "4#4#4#4"
DATA "(4#4)#4#4"
DATA "4#(4#4)#4"
DATA "4#4#(4#4)"
DATA "(4#4)#(4#4)"
DATA "(4#4#4)#4"
DATA "4#(4#4#4)"
DATA "((4#4)#4)#4"
DATA "(4#(4#4))#4"
DATA "4#((4#4)#4)"
DATA "4#(4#(4#4))"
for i = 1 to NBrackets
    read Tmpl$: Brakets$(i) = Tmpl$
next

'operations: full search
count = 0
Ops$="+ - * /"
dim Op$(3)
For op1=1 to 4
    Op$(1)=word$(Ops$,op1)
    For op2=1 to 4
        Op$(2)=word$(Ops$,op2)
        For op3=1 to 4
            Op$(3)=word$(Ops$,op3)
            'print "*"
            'substitute all brackets
            for t = 1 to NBrackets
                Tmpl$=Brakets$(t)
                'print , Tmpl$
                'now, substitute all digits: permutations.
                for p = 1 to nPerm
                    res$= ""
                    nOp=0
                    nD=0
                    for i = 1 to len(Tmpl$)
                        c$ = mid$(Tmpl$, i, 1)
                        select case c$
                        case "#"                'operations
                            nOp = nOp+1
                            res$ = res$+Op$(nOp)
                        case "4"                'digits
                            nD = nOp+1
                            res$ = res$; perm(p,nD)
                        case else               'brackets goes here
                            res$ = res$+ c$
                        end select
                    next
                    'print,, res$
                    'eval here
                    if evalWithErrCheck(res$) = 24 then
                        print "24 = ";res$
                        end 'comment it out if you want to see all versions
                    end if
                    count = count + 1
                next
            next
        Next
    Next
next

print "If you see this, probably task cannot be solved with these digits"
'print count
end

function evalWithErrCheck(expr$)
    on error goto [handler]
    evalWithErrCheck=eval(expr$)
    exit function
[handler]
end function


local SIZE = #arg[1]
local GOAL = tonumber(arg[2]) or 24

local input = {}
for v in arg[1]:gmatch("%d") do
	table.insert(input, v)
end
assert(#input == SIZE, 'Invalid input')

local operations = {'+', '-', '*', '/'}

local function BinaryTrees(vert)
	if vert == 0 then
		return {false}
	else
		local buf = {}
		for leften = 0, vert - 1 do
			local righten = vert - leften - 1
			for _, left in pairs(BinaryTrees(leften)) do
				for _, right in pairs(BinaryTrees(righten)) do
					table.insert(buf, {left, right})
				end
			end
		end
		return buf
	end
end
local trees = BinaryTrees(SIZE-1)
local c, opc, oper, str
local max = math.pow(#operations, SIZE-1)
local function op(a,b)
	opc = opc + 1
	local i = math.floor(oper/math.pow(#operations, opc-1))%#operations+1
	return '('.. a .. operations[i] .. b ..')'
end

local function EvalTree(tree)
	if tree == false then
		c = c + 1
		return input[c-1]
	else
		return op(EvalTree(tree[1]), EvalTree(tree[2]))
	end
end

local function printResult()
	for _, v in ipairs(trees) do
		for i = 0, max do
			c, opc, oper = 1, 0, i
			str = EvalTree(v)
			loadstring('res='..str)()
			if(res == GOAL) then print(str, '=', res) end
		end
	end
end

local uniq = {}
local function permgen (a, n)
	if n == 0 then
		local str = table.concat(a)
		if not uniq[str] then
			printResult()
			uniq[str] = true
		end
	else
		for i = 1, n do
			a[n], a[i] = a[i], a[n]
			permgen(a, n - 1)
			a[n], a[i] = a[i], a[n]
		end
	end
end

permgen(input, SIZE)


treeR[n_] := Table[o[trees[a], trees[n - a]], {a, 1, n - 1}]
treeR[1] := n
tree[n_] :=
 Flatten[treeR[n] //. {o[a_List, b_] :> (o[#, b] & /@ a),
    o[a_, b_List] :> (o[a, #] & /@ b)}]
game24play[val_List] :=
 Union[StringReplace[StringTake[ToString[#, InputForm], {10, -2}],
     "-1*" ~~ n_ :> "-" <> n] & /@ (HoldForm /@
      Select[[email protected]
        Flatten[Outer[# /. {o[q_Integer] :> #2[[q]],
             n[q_] :> #3[[q]]} &,
          Block[{O = 1, N = 1}, # /. {o :> o[O++], n :> n[N++]}] & /@
           tree[4], Tuples[{Plus, Subtract, Times, Divide}, 3],
          Permutations[Array[v, 4]], 1]],
       Quiet[(# /. v[q_] :> val[[q]]) == 24] &] /.
     Table[v[q] -> val[[q]], {q, 4}])]


import algorithm, sequtils, strformat

type
  Operation = enum
    opAdd = "+"
    opSub = "-"
    opMul = "*"
    opDiv = "/"

const Ops = @[opAdd, opSub, opMul, opDiv]

func opr(o: Operation, a, b: float): float =
  case o
  of opAdd: a + b
  of opSub: a - b
  of opMul: a * b
  of opDiv: a / b

func solve(nums: array[4, int]): string =
  func `~=`(a, b: float): bool =
    abs(a - b) <= 1e-5

  result = "not found"
  let sortedNums = nums.sorted.mapIt float it
  for i in product Ops.repeat 3:
    let (x, y, z) = (i[0], i[1], i[2])
    var nums = sortedNums
    while true:
      let (a, b, c, d) = (nums[0], nums[1], nums[2], nums[3])
      if x.opr(y.opr(a, b), z.opr(c, d)) ~= 24.0:
        return fmt"({a:0} {y} {b:0}) {x} ({c:0} {z} {d:0})"
      if x.opr(a, y.opr(b, z.opr(c, d))) ~= 24.0:
        return fmt"{a:0} {x} ({b:0} {y} ({c:0} {z} {d:0}))"
      if x.opr(y.opr(z.opr(c, d), b), a) ~= 24.0:
        return fmt"(({c:0} {z} {d:0}) {y} {b:0}) {x} {a:0}"
      if x.opr(y.opr(b, z.opr(c, d)), a) ~= 24.0:
        return fmt"({b:0} {y} ({c:0} {z} {d:0})) {x} {a:0}"
      if not nextPermutation(nums): break

proc main() =
  for nums in [
               [9, 4, 4, 5],
               [1, 7, 2, 7],
               [5, 7, 5, 4],
               [1, 4, 6, 6],
               [2, 3, 7, 3],
               [8, 7, 9, 7],
               [1, 6, 2, 6],
               [7, 9, 4, 1],
               [6, 4, 2, 2],
               [5, 7, 9, 7],
               [3, 3, 8, 8], # Difficult case requiring precise division
              ]:
    echo fmt"solve({nums}) -> {solve(nums)}"

when isMainModule: main()


type expression =
  | Const of float
  | Sum  of expression * expression   (* e1 + e2 *)
  | Diff of expression * expression   (* e1 - e2 *)
  | Prod of expression * expression   (* e1 * e2 *)
  | Quot of expression * expression   (* e1 / e2 *)

let rec eval = function
  | Const c -> c
  | Sum (f, g) -> eval f +. eval g
  | Diff(f, g) -> eval f -. eval g
  | Prod(f, g) -> eval f *. eval g
  | Quot(f, g) -> eval f /. eval g

let print_expr expr =
  let open_paren prec op_prec =
    if prec > op_prec then print_string "(" in
  let close_paren prec op_prec =
    if prec > op_prec then print_string ")" in
  let rec print prec = function   (* prec is the current precedence *)
    | Const c -> Printf.printf "%g" c
    | Sum(f, g) ->
        open_paren prec 0;
        print 0 f; print_string " + "; print 0 g;
        close_paren prec 0
    | Diff(f, g) ->
        open_paren prec 0;
        print 0 f; print_string " - "; print 1 g;
        close_paren prec 0
    | Prod(f, g) ->
        open_paren prec 2;
        print 2 f; print_string " * "; print 2 g;
        close_paren prec 2
    | Quot(f, g) ->
        open_paren prec 2;
        print 2 f; print_string " / "; print 3 g;
        close_paren prec 2
  in
  print 0 expr

let rec insert v = function
  | [] -> [[v]]
  | x::xs as li -> (v::li) :: (List.map (fun y -> x::y) (insert v xs))

let permutations li =
  List.fold_right (fun x z -> List.concat (List.map (insert x) z)) li [[]]

let rec comp expr = function
  | x::xs ->
      comp (Sum (expr, x)) xs;
      comp (Diff(expr, x)) xs;
      comp (Prod(expr, x)) xs;
      comp (Quot(expr, x)) xs;
  | [] ->
      if (eval expr) = 24.0
      then (print_expr expr; print_newline())
;;

let () =
  Random.self_init();
  let digits = Array.init 4 (fun _ -> 1 + Random.int 9) in
  print_string "Input digits: ";
  Array.iter (Printf.printf " %d") digits; print_newline();
  let digits = Array.to_list(Array.map float_of_int digits) in
  let digits = List.map (fun v -> Const v) digits in
  let all = permutations digits in
  List.iter (function
    | x::xs -> comp x xs
    | [] -> assert false
  ) all


# Fischer-Krause ordered permutation generator
# http://faq.perl.org/perlfaq4.html#How_do_I_permute_N_e
sub permute (&@) {
		my $code = shift;
		my @idx = 0..$#_;
		while ( $code->(@_[@idx]) ) {
			my $p = $#idx;
			--$p while $idx[$p-1] > $idx[$p];
			my $q = $p or return;
			push @idx, reverse splice @idx, $p;
			++$q while $idx[$p-1] > $idx[$q];
			@idx[$p-1,$q]=@idx[$q,$p-1];
		}
	}

@formats = (
	'((%d %s %d) %s %d) %s %d',
	'(%d %s (%d %s %d)) %s %d',
	'(%d %s %d) %s (%d %s %d)',
	'%d %s ((%d %s %d) %s %d)',
	'%d %s (%d %s (%d %s %d))',
	);

# generate all possible combinations of operators
@op = qw( + - * / );
@operators = map{ $a=$_; map{ $b=$_; map{ "$a $b $_" }@op }@op }@op;

while(1)
{
	print "Enter four integers or 'q' to exit: ";
	chomp($ent = <>);
	last if $ent eq 'q';

	if($ent !~ /^[1-9] [1-9] [1-9] [1-9]$/){ print "invalid input\n"; next }

	@n = split / /,$ent;
	permute { push @numbers,join ' ',@_ }@n;

	for $format (@formats)
	{
		for(@numbers)
		{
			@n = split;
			for(@operators)
			{
				@o = split;
				$str = sprintf $format,$n[0],$o[0],$n[1],$o[1],$n[2],$o[2],$n[3];
				$r = eval($str);
				print "$str\n" if $r == 24;
			}
		}
	}
}


-- demo\rosetta\24_game_solve.exw
with javascript_semantics
-- 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.
-- Last hint is because of no precedence, just parenthesis.
--
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")

-- 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

function evalopset(sequence opset, perms, ops, 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.)
-- (update: with js made that illegal and reported it correctly and forced the
--          addition of the deep_copy(), all exactly the way it should.)
    integer lhs,op,rhs
    vars = deep_copy(vars)
    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 return 1e300*1e300 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, ops, vars, atom r)
    for i=1 to length(expr) do
        integer 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, ops, vars)
    for i=1 to length(operations) do
        -- 5 parse expressions
        atom r = evalopset(operations[i], perms, ops, vars)
        r = round(r,1e9) -- fudge tricky 8/(3-(8/3)) case
        if r=24 then
            success(expressions[i], perms, ops, vars, r)
        end if
    end for
end procedure

procedure tryops(sequence ops, 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})
--solve24({6,4,6,1})
--solve24({3,3,8,8})
--solve24({6,9,7,4})
{} = wait_key()


main =>
    foreach (_ in 1..10)
        Nums = [D : _ in 1..4, D = random() mod 9 + 1],
        NumExps = [(D,D) : D in Nums],
        println(Nums),
        (solve(NumExps) -> true; println("No solution")),
        nl
    end.

solve([(Num,Exp)]), Num =:= 24 =>
    println(Exp).
solve(NumExps) =>
    select((Num1,Exp1),NumExps,NumExps1),
    select((Num2,Exp2),NumExps1,NumExps2),
    member(Op, ['+','-','*','/']),
    (Op == '/' -> Num2 =\= 0; true),
    Num3 = apply(Op,Num1,Num2),
    Exp3 =.. [Op,Exp1,Exp2],
    solve([(Num3,Exp3)|NumExps2]).


(be play24 (@Lst @Expr)                # Define Pilog rule
   (permute @Lst (@A @B @C @D))
   (member @Op1 (+ - * /))
   (member @Op2 (+ - * /))
   (member @Op3 (+ - * /))
   (or
      ((equal @Expr (@Op1 (@Op2 @A @B) (@Op3 @C @D))))
      ((equal @Expr (@Op1 @A (@Op2 @B (@Op3 @C @D))))) )
   (^ @ (= 24 (catch '("Div/0") (eval (-> @Expr))))) )

(de play24 (A B C D)                   # Define PicoLisp function
   (pilog
      (quote
         @L (list A B C D)
         (play24 @L @X) )
      (println @X) ) )

(play24 5 6 7 8)                       # Call 'play24' function


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


play24(Len, Range, Goal) :-
	game(Len, Range, Goal, L, S),
	maplist(my_write, L),
	format(': ~w~n', [S]).

game(Len, Range, Value, L, S) :-
	length(L, Len),
	maplist(choose(Range), L),
	compute(L, Value, [], S).

choose(Range, V) :-
	V is random(Range) + 1.

write_tree([M], [M]).

write_tree([+, M, N], S) :-
	write_tree(M, MS),
	write_tree(N, NS),
	append(MS, [+ | NS], S).

write_tree([-, M, N], S) :-
	write_tree(M, MS),
	write_tree(N, NS),
	(   is_add(N) -> append(MS, [-, '(' | NS], Temp), append(Temp, ')', S)
	;   append(MS, [- | NS], S)).

write_tree([Op, M, N], S) :-
	member(Op, [*, /]),
	write_tree(M, MS),
	write_tree(N, NS),
	(   is_add(M) -> append(['(' | MS], [')'], TempM)
	;  TempM = MS),
	(   is_add(N) -> append(['(' | NS], [')'], TempN)
	;   TempN = NS),
	append(TempM, [Op | TempN], S).

is_add([Op, _, _]) :-
	member(Op, [+, -]).

compute([Value], Value, [[_R-S1]], S) :-
	write_tree(S1, S2),
	with_output_to(atom(S), maplist(write, S2)).

compute(L, Value, CS, S) :-
	select(M, L, L1),
	select(N, L1, L2),
	next_value(M, N, R, CS, Expr),
	compute([R|L2], Value, Expr, S).

next_value(M, N, R, CS,[[R - [+, M1, N1]] | CS2]) :-
	R is M+N,
	(   member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM
	;   M1 = [M], CS1 = CS
	),
	(   member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN
	;   N1 = [N], CS2 = CS1
	).

next_value(M, N, R, CS,[[R - [-, M1, N1]] | CS2]) :-
	R is M-N,
	(   member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM
	;   M1 = [M], CS1 = CS
	),
	(   member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN
	;   N1 = [N], CS2 = CS1
	).

next_value(M, N, R, CS,[[R - [*, M1, N1]] | CS2]) :-
	R is M*N,
	(   member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM
	;   M1 = [M], CS1 = CS
	),
	(   member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN
	;   N1 = [N], CS2 = CS1
	).

next_value(M, N, R, CS,[[R - [/, M1, N1]] | CS2]) :-
	N \= 0,
	R is rdiv(M,N),
	(   member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM
	;   M1 = [M], CS1 = CS
	),
	(   member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN
	;   N1 = [N], CS2 = CS1
	).

my_write(V) :-
	format('~w ', [V]).


'''
 The 24 Game Player

 Given any four digits in the range 1 to 9, which may have repetitions,
 Using just the +, -, *, and / operators; and the possible use of
 brackets, (), show how to make an answer of 24.

 An answer of "q"  will quit the game.
 An answer of "!"  will generate a new set of four digits.
 An answer of "!!" will ask you for a new set of four digits.
 An answer of "?"  will compute an expression for the current digits.

 Otherwise you are repeatedly asked for an expression until it evaluates to 24

 Note: you cannot form multiple digit numbers from the supplied digits,
 so an answer of 12+12 when given 1, 2, 2, and 1 would not be allowed.

'''

from   __future__ import division, print_function
from   itertools  import permutations, combinations, product, \
                         chain
from   pprint     import pprint as pp
from   fractions  import Fraction as F
import random, ast, re
import sys

if sys.version_info[0] < 3:
    input = raw_input
    from itertools import izip_longest as zip_longest
else:
    from itertools import zip_longest

def choose4():
    'four random digits >0 as characters'
    return [str(random.randint(1,9)) for i in range(4)]

def ask4():
    'get four random digits >0 from the player'
    digits = ''
    while len(digits) != 4 or not all(d in '123456789' for d in digits):
        digits = input('Enter the digits to solve for: ')
        digits = ''.join(digits.strip().split())
    return list(digits)

def welcome(digits):
    print (__doc__)
    print ("Your four digits: " + ' '.join(digits))

def check(answer, digits):
    allowed = set('() +-*/\t'+''.join(digits))
    ok = all(ch in allowed for ch in answer) and \
         all(digits.count(dig) == answer.count(dig) for dig in set(digits)) \
         and not re.search('\d\d', answer)
    if ok:
        try:
            ast.parse(answer)
        except:
            ok = False
    return ok

def solve(digits):
    """\
    >>> for digits in '3246 4788 1111 123456 1127 3838'.split():
            solve(list(digits))

    Solution found: 2 + 3 * 6 + 4
    '2 + 3 * 6 + 4'
    Solution found: ( 4 + 7 - 8 ) * 8
    '( 4 + 7 - 8 ) * 8'
    No solution found for: 1 1 1 1
    '!'
    Solution found: 1 + 2 + 3 * ( 4 + 5 ) - 6
    '1 + 2 + 3 * ( 4 + 5 ) - 6'
    Solution found: ( 1 + 2 ) * ( 1 + 7 )
    '( 1 + 2 ) * ( 1 + 7 )'
    Solution found: 8 / ( 3 - 8 / 3 )
    '8 / ( 3 - 8 / 3 )'
    >>> """
    digilen = len(digits)
    # length of an exp without brackets
    exprlen = 2 * digilen - 1
    # permute all the digits
    digiperm = sorted(set(permutations(digits)))
    # All the possible operator combinations
    opcomb   = list(product('+-*/', repeat=digilen-1))
    # All the bracket insertion points:
    brackets = ( [()] + [(x,y)
                         for x in range(0, exprlen, 2)
                         for y in range(x+4, exprlen+2, 2)
                         if (x,y) != (0,exprlen+1)]
                 + [(0, 3+1, 4+2, 7+3)] ) # double brackets case
    for d in digiperm:
        for ops in opcomb:
            if '/' in ops:
                d2 = [('F(%s)' % i) for i in d] # Use Fractions for accuracy
            else:
                d2 = d
            ex = list(chain.from_iterable(zip_longest(d2, ops, fillvalue='')))
            for b in brackets:
                exp = ex[::]
                for insertpoint, bracket in zip(b, '()'*(len(b)//2)):
                    exp.insert(insertpoint, bracket)
                txt = ''.join(exp)
                try:
                    num = eval(txt)
                except ZeroDivisionError:
                    continue
                if num == 24:
                    if '/' in ops:
                        exp = [ (term if not term.startswith('F(') else term[2])
                               for term in exp ]
                    ans = ' '.join(exp).rstrip()
                    print ("Solution found:",ans)
                    return ans
    print ("No solution found for:", ' '.join(digits))
    return '!'

def main():
    digits = choose4()
    welcome(digits)
    trial = 0
    answer = ''
    chk = ans = False
    while not (chk and ans == 24):
        trial +=1
        answer = input("Expression %i: " % trial)
        chk = check(answer, digits)
        if answer == '?':
            solve(digits)
            answer = '!'
        if answer.lower() == 'q':
            break
        if answer == '!':
            digits = choose4()
            trial = 0
            print ("\nNew digits:", ' '.join(digits))
            continue
        if answer == '!!':
            digits = ask4()
            trial = 0
            print ("\nNew digits:", ' '.join(digits))
            continue
        if not chk:
            print ("The input '%s' was wonky!" % answer)
        else:
            if '/' in answer:
                # Use Fractions for accuracy in divisions
                answer = ''.join( (('F(%s)' % char) if char in '123456789' else char)
                                  for char in answer )
            ans = eval(answer)
            print (" = ", ans)
            if ans == 24:
                print ("Thats right!")
    print ("Thank you and goodbye")

main()


  [ ' [ 0 1 2 3 ]
    permutations ] constant          is numorders (         --> [ )

  [ []
    4 3 ** times
      [ [] i^
        3 times
          [ 4 /mod 4 +
            rot join swap ]
        drop
        nested join ] ] constant     is oporders  (         --> [ )

  [ [] numorders witheach
      [ oporders witheach
        [ dip dup join nested
          rot swap join swap ]
        drop ] ] constant            is allorders (         --> [ )

  [ [] unrot witheach
      [ dip dup peek
        swap dip [ nested join ] ]
    drop ]                           is reorder   (     [ [ --> [ )

  [ ' [ [ 0 1 4 2 5 3 6 ]
        [ 0 1 4 2 3 5 6 ]
        [ 0 1 2 4 3 5 6 ] ]
    witheach
      [ dip dup reorder swap ]
    4 pack ]                         is orderings (       [ --> [ )

  [ witheach
      [ dup number? iff n->v done
        dup ' + = iff
          [ drop v+ ] done
        dup ' - = iff
          [ drop v- ] done
            ' * = iff v* done
        v/ ]
    24 n->v v- v0= ]                 is 24=       (       [ --> b )

  [ 4 pack sort
    [] swap
    ' [ + - * / ] join
    allorders witheach
      [ dip dup reorder orderings
        witheach
          [ dup 24= iff
              [ rot swap
                nested join swap ]
            else drop ] ]
    drop
    uniquewith
      [ dip unbuild unbuild $> ]
    dup size
    dup 0 = iff
       [ 2drop say "No solutions." ]
       done
    dup 1 = iff
      [ drop say "1 solution." ]
    else
      [ echo say " solutions." ]
    unbuild
    2 split nip
    -2 split drop nest$ 90 wrap$ ]   is solve     ( n n n n -->   )


library(gtools)

solve24 <- function(vals=c(8, 4, 2, 1),
                    goal=24,
                    ops=c("+", "-", "*", "/")) {

  val.perms <- as.data.frame(t(
                  permutations(length(vals), length(vals))))

  nop <- length(vals)-1
  op.perms <- as.data.frame(t(
                  do.call(expand.grid,
                          replicate(nop, list(ops)))))

  ord.perms <- as.data.frame(t(
                   do.call(expand.grid,
                           replicate(n <- nop, 1:((n <<- n-1)+1)))))

  for (val.perm in val.perms)
    for (op.perm in op.perms)
      for (ord.perm in ord.perms)
        {
          expr <- as.list(vals[val.perm])
          for (i in 1:nop) {
            expr[[ ord.perm[i] ]] <- call(as.character(op.perm[i]),
                                          expr[[ ord.perm[i]   ]],
                                          expr[[ ord.perm[i]+1 ]])
            expr <- expr[ -(ord.perm[i]+1) ]
          }
          if (identical(eval(expr[[1]]), goal)) return(expr[[1]])
        }

  return(NA)
}


use MONKEY-SEE-NO-EVAL;

my @digits;
my $amount = 4;

# Get $amount digits from the user,
# ask for more if they don't supply enough
while @digits.elems < $amount {
    @digits.append: (prompt "Enter {$amount - @digits} digits from 1 to 9, "
    ~ '(repeats allowed): ').comb(/<[1..9]>/);
}
# Throw away any extras
@digits = @digits[^$amount];

# Generate combinations of operators
my @ops = [X,] <+ - * /> xx 3;

# Enough sprintf formats to cover most precedence orderings
my @formats = (
    '%d %s %d %s %d %s %d',
    '(%d %s %d) %s %d %s %d',
    '(%d %s %d %s %d) %s %d',
    '((%d %s %d) %s %d) %s %d',
    '(%d %s %d) %s (%d %s %d)',
    '%d %s (%d %s %d %s %d)',
    '%d %s (%d %s (%d %s %d))',
);

# Brute force test the different permutations
(unique @digits.permutations).race.map: -> @p {
    for @ops -> @o {
        for @formats -> $format {
            my $string = sprintf $format, flat roundrobin(|@p; |@o);
            my $result = EVAL($string);
            say "$string = 24" and last if $result and $result == 24;
        }
    }
}

# Only return unique sub-arrays
sub unique (@array) {
    my %h = map { $_.Str => $_ }, @array;
    %h.values;
}


/*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                                   */
numeric digits 12                                /*where rational arithmetic is needed. */
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.                */
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?              */
  if _v\==0  then do;   call ger 'invalid character:'  substr(y, _v, 1);   iterate;    end
  if y=''  then do;     call validate y;   iterate;    end

    do j=1  for length(y)-1  while \abuttals     /*check for two digits adjacent.       */
    if \datatype(substr(y,j,1),  'W') then iterate
    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)                        /*count of legal digits  123456789     */
  if yd<4  then do;  call ger 'not enough digits entered.'; iterate guesses; end
  if yd>4  then do;  call ger 'too many digits entered.'  ; iterate guesses; end

      do j=1  for length(groupsym)  by 2
      if countchars(y,substr(groupsym,j  ,1))\==,
         countchars(y,substr(groupsym,j+1,1))  then do
                                                    call ger 'mismatched' substr(groupsym,j,2)
                                                    iterate guesses
                                                    end
      end   /*j*/

        do k=1  for 2                            /*check for   **    and    //          */
        _= copies( substr( opers, k, 1), 2)
        if pos(_, y)\==0  then do;  call ger 'illegal operator:' _;  iterate guesses;  end
        end   /*k*/

    do j=1  for 9;    if rd.j==0  then iterate;     _d= countchars(y, j)
    if _d==rd.j  then iterate
    if _d<rd.j   then call ger  'not enough'   j   "digits, must be"   rd.j
                 else call ger  'too many'     j   "digits, must be"   rd.j
    iterate guesses
    end   /*j*/

  y= translate(y, '()()', "[]{}")
  interpret  'ans=('  y   ") / 1"
  if ans==??  then leave guesses
  say right('incorrect, ' y'='ans, 50)
  end   /*guesses*/

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 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*/

  do gggg=1111  to 9999
  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 do                     /*Not correct?   Then try again.       */
                          numeric digits 9;    x= x / 1              /*re-do evaluation.*/
                          numeric digits 12                          /*re-instate digits*/
                          if x\==?? then iterate /*Not correct?   Then try again.       */
                          end
          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             /*gggg*/
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*/
              _= a.j
                       do k=j+1  to L
                       if a.k<_  then  do;   a.j= a.k;     a.k= _;     _= a.k;    end
                       end   /*k*/
              end   /*j*/
       v= a.1
                       do m=2  to L;  v= v || a.m /*build a string of digs from  A.m    */
                       end   /*m*/
       return v
/*──────────────────────────────────────────────────────────────────────────────────────*/
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'
                   when length(y)>4   then call ger 'too many digits entered, must be 4'
                   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 \errCode
/*──────────────────────────────────────────────────────────────────────────────────────*/
div:  procedure; parse arg q; if q=0  then q=1e9; return q  /*tests if dividing by zero.*/
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)


class TwentyFourGame
  EXPRESSIONS = [
    '((%dr %s %dr) %s %dr) %s %dr',
    '(%dr %s (%dr %s %dr)) %s %dr',
    '(%dr %s %dr) %s (%dr %s %dr)',
    '%dr %s ((%dr %s %dr) %s %dr)',
    '%dr %s (%dr %s (%dr %s %dr))',
  ]

  OPERATORS = [:+, :-, :*, :/].repeated_permutation(3).to_a

  def self.solve(digits)
    solutions = []
    perms = digits.permutation.to_a.uniq
    perms.product(OPERATORS, EXPRESSIONS) do |(a,b,c,d), (op1,op2,op3), expr|
      # evaluate using rational arithmetic
      text = expr % [a, op1, b, op2, c, op3, d]
      value = eval(text)  rescue next                 # catch division by zero
      solutions << text.delete("r")  if value == 24
    end
    solutions
  end
end

# validate user input
digits = ARGV.map do |arg|
  begin
    Integer(arg)
  rescue ArgumentError
    raise "error: not an integer: '#{arg}'"
  end
end
digits.size == 4 or raise "error: need 4 digits, only have #{digits.size}"

solutions = TwentyFourGame.solve(digits)
if solutions.empty?
  puts "no solutions"
else
  puts "found #{solutions.size} solutions, including #{solutions.first}"
  puts solutions.sort
end


#[derive(Clone, Copy, Debug)]
enum Operator {
    Sub,
    Plus,
    Mul,
    Div,
}

#[derive(Clone, Debug)]
struct Factor {
    content: String,
    value: i32,
}

fn apply(op: Operator, left: &[Factor], right: &[Factor]) -> Vec<Factor> {
    let mut ret = Vec::new();
    for l in left.iter() {
        for r in right.iter() {
            use Operator::*;
            ret.push(match op {
                Sub if l.value > r.value => Factor {
                    content: format!("({} - {})", l.content, r.content),
                    value: l.value - r.value,
                },
                Plus => Factor {
                    content: format!("({} + {})", l.content, r.content),
                    value: l.value + r.value,
                },
                Mul => Factor {
                    content: format!("({} x {})", l.content, r.content),
                    value: l.value * r.value,
                },
                Div if l.value >= r.value && r.value > 0 && l.value % r.value == 0 => Factor {
                    content: format!("({} / {})", l.content, r.content),
                    value: l.value / r.value,
                },
                _ => continue,
            })
        }
    }
    ret
}

fn calc(op: [Operator; 3], numbers: [i32; 4]) -> Vec<Factor> {
    fn calc(op: &[Operator], numbers: &[i32], acc: &[Factor]) -> Vec<Factor> {
        use Operator::*;
        if op.is_empty() {
            return Vec::from(acc)
        }
        let mut ret = Vec::new();
        let mono_factor = [Factor {
            content: numbers[0].to_string(),
            value: numbers[0],
        }];
        match op[0] {
            Mul => ret.extend_from_slice(&apply(op[0], acc, &mono_factor)),
            Div => {
                ret.extend_from_slice(&apply(op[0], acc, &mono_factor));
                ret.extend_from_slice(&apply(op[0], &mono_factor, acc));
            },
            Sub => {
                ret.extend_from_slice(&apply(op[0], acc, &mono_factor));
                ret.extend_from_slice(&apply(op[0], &mono_factor, acc));
            },
            Plus => ret.extend_from_slice(&apply(op[0], acc, &mono_factor)),
        }
        calc(&op[1..], &numbers[1..], &ret)
    }
    calc(&op, &numbers[1..], &[Factor { content: numbers[0].to_string(), value: numbers[0] }])
}

fn solutions(numbers: [i32; 4]) -> Vec<Factor> {
    use std::collections::hash_set::HashSet;
    let mut ret = Vec::new();
    let mut hash_set = HashSet::new();

    for ops in OpIter(0) {
        for o in orders().iter() {
            let numbers = apply_order(numbers, o);
            let r = calc(ops, numbers);
            ret.extend(r.into_iter().filter(|&Factor { value, ref content }| value == 24 && hash_set.insert(content.to_owned())))
        }
    }
    ret
}

fn main() {
    let mut numbers = Vec::new();
    if let Some(input) = std::env::args().skip(1).next() {
        for c in input.chars() {
            if let Ok(n) = c.to_string().parse() {
                numbers.push(n)
            }
            if numbers.len() == 4 {
                let numbers = [numbers[0], numbers[1], numbers[2], numbers[3]];
                let solutions = solutions(numbers);
                let len = solutions.len();
                if len == 0 {
                    println!("no solution for {}, {}, {}, {}", numbers[0], numbers[1], numbers[2], numbers[3]);
                    return
                }
                println!("solutions for {}, {}, {}, {}", numbers[0], numbers[1], numbers[2], numbers[3]);
                for s in solutions {
                    println!("{}", s.content)
                }
                println!("{} solutions found", len);
                return
            }
        }
    } else {
        println!("empty input")
    }
}

struct OpIter (usize);

impl Iterator for OpIter {
    type Item = [Operator; 3];
    fn next(&mut self) -> Option<[Operator; 3]> {
        use Operator::*;
        const OPTIONS: [Operator; 4] = [Mul, Sub, Plus, Div];
        if self.0 >= 1 << 6 {
            return None
        }
        let f1 = OPTIONS[(self.0 & (3 << 4)) >> 4];
        let f2 = OPTIONS[(self.0 & (3 << 2)) >> 2];
        let f3 = OPTIONS[(self.0 & (3 << 0)) >> 0];
        self.0 += 1;
        Some([f1, f2, f3])
    }
}

fn orders() -> [[usize; 4]; 24] {
    [
        [0, 1, 2, 3],
        [0, 1, 3, 2],
        [0, 2, 1, 3],
        [0, 2, 3, 1],
        [0, 3, 1, 2],
        [0, 3, 2, 1],
        [1, 0, 2, 3],
        [1, 0, 3, 2],
        [1, 2, 0, 3],
        [1, 2, 3, 0],
        [1, 3, 0, 2],
        [1, 3, 2, 0],
        [2, 0, 1, 3],
        [2, 0, 3, 1],
        [2, 1, 0, 3],
        [2, 1, 3, 0],
        [2, 3, 0, 1],
        [2, 3, 1, 0],
        [3, 0, 1, 2],
        [3, 0, 2, 1],
        [3, 1, 0, 2],
        [3, 1, 2, 0],
        [3, 2, 0, 1],
        [3, 2, 1, 0]
    ]
}

fn apply_order(numbers: [i32; 4], order: &[usize; 4]) -> [i32; 4] {
    [numbers[order[0]], numbers[order[1]], numbers[order[2]], numbers[order[3]]]
}


def permute(l: List[Double]): List[List[Double]] = l match {
  case Nil => List(Nil)
  case x :: xs =>
    for {
      ys <- permute(xs)
      position <- 0 to ys.length
      (left, right) = ys splitAt position
    } yield left ::: (x :: right)
}

def computeAllOperations(l: List[Double]): List[(Double,String)] = l match {
  case Nil => Nil
  case x :: Nil => List((x, "%1.0f" format x))
  case x :: xs =>
    for {
      (y, ops) <- computeAllOperations(xs)
      (z, op) <-
        if (y == 0)
          List((x*y, "*"), (x+y, "+"), (x-y, "-"))
        else
          List((x*y, "*"), (x/y, "/"), (x+y, "+"), (x-y, "-"))
    } yield (z, "(%1.0f%s%s)" format (x,op,ops))
}

def hasSolution(l: List[Double]) = permute(l) flatMap computeAllOperations filter (_._1 == 24) map (_._2)


#!r6rs

(import (rnrs)
        (rnrs eval)
        (only (srfi :1 lists) append-map delete-duplicates iota))

(define (map* fn . lis)
  (if (null? lis)
      (list (fn))
      (append-map (lambda (x)
                    (apply map*
                           (lambda xs (apply fn x xs))
                           (cdr lis)))
                  (car lis))))

(define (insert x li n)
  (if (= n 0)
      (cons x li)
      (cons (car li) (insert x (cdr li) (- n 1)))))

(define (permutations li)
  (if (null? li)
      (list ())
      (map* insert (list (car li)) (permutations (cdr li)) (iota (length li)))))

(define (evaluates-to-24 expr)
  (guard (e ((assertion-violation? e) #f))
    (= 24 (eval expr (environment '(rnrs base))))))

(define (tree n o0 o1 o2 xs)
  (list-ref
   (list
    `(,o0 (,o1 (,o2 ,(car xs) ,(cadr xs)) ,(caddr xs)) ,(cadddr xs))
    `(,o0 (,o1 (,o2 ,(car xs) ,(cadr xs)) ,(caddr xs)) ,(cadddr xs))
    `(,o0 (,o1 ,(car xs) (,o2 ,(cadr xs) ,(caddr xs))) ,(cadddr xs))
    `(,o0 (,o1 ,(car xs) ,(cadr xs)) (,o2 ,(caddr xs) ,(cadddr xs)))
    `(,o0 ,(car xs) (,o1 (,o2 ,(cadr xs) ,(caddr xs)) ,(cadddr xs)))
    `(,o0 ,(car xs) (,o1 ,(cadr xs) (,o2 ,(caddr xs) ,(cadddr xs)))))
   n))

(define (solve a b c d)
  (define ops '(+ - * /))
  (define perms (delete-duplicates (permutations (list a b c d))))
  (delete-duplicates
   (filter evaluates-to-24
           (map* tree (iota 6) ops ops ops perms))))


var formats = [
    '((%d %s %d) %s %d) %s %d',
    '(%d %s (%d %s %d)) %s %d',
    '(%d %s %d) %s (%d %s %d)',
    '%d %s ((%d %s %d) %s %d)',
    '%d %s (%d %s (%d %s %d))',
]

var op = %w( + - * / )
var operators = op.map { |a| op.map {|b| op.map {|c| "#{a} #{b} #{c}" } } }.flat

loop {
    var input = read("Enter four integers or 'q' to exit: ", String)
    input == 'q' && break

    if (input !~ /^\h*[1-9]\h+[1-9]\h+[1-9]\h+[1-9]\h*$/) {
        say "Invalid input!"
        next
    }

    var n = input.split.map{.to_n}
    var numbers = n.permutations

    formats.each { |format|
        numbers.each { |n|
            operators.each { |operator|
                var o = operator.split;
                var str = (format % (n[0],o[0],n[1],o[1],n[2],o[2],n[3]))
                eval(str) == 24 && say str
            }
        }
    }
}


BEGIN

    CLASS EXPR;
    BEGIN

        REAL PROCEDURE POP;
        BEGIN
            IF STACKPOS > 0 THEN
            BEGIN STACKPOS := STACKPOS - 1; POP := STACK(STACKPOS); END;
        END POP;

        PROCEDURE PUSH(NEWTOP); REAL NEWTOP;
        BEGIN
            STACK(STACKPOS) := NEWTOP;
            STACKPOS := STACKPOS + 1;
        END PUSH;

        REAL PROCEDURE CALC(OPERATOR, ERR); CHARACTER OPERATOR; LABEL ERR;
        BEGIN
            REAL X, Y; X := POP; Y := POP;
            IF      OPERATOR = '+' THEN PUSH(Y + X)
            ELSE IF OPERATOR = '-' THEN PUSH(Y - X)
            ELSE IF OPERATOR = '*' THEN PUSH(Y * X)
            ELSE IF OPERATOR = '/' THEN BEGIN
                                            IF X = 0 THEN
                                            BEGIN
                                                EVALUATEDERR :- "DIV BY ZERO";
                                                GOTO ERR;
                                            END;
                                            PUSH(Y / X);
                                        END
            ELSE
            BEGIN
                EVALUATEDERR :- "UNKNOWN OPERATOR";
                GOTO ERR;
            END
        END CALC;

        PROCEDURE READCHAR(CH); NAME CH; CHARACTER CH;
        BEGIN
            IF T.MORE THEN CH := T.GETCHAR ELSE CH := EOT;
        END READCHAR;

        PROCEDURE SKIPWHITESPACE(CH); NAME CH; CHARACTER CH;
        BEGIN
            WHILE (CH = SPACE) OR (CH = TAB) OR (CH = CR) OR (CH = LF) DO
                READCHAR(CH);
        END SKIPWHITESPACE;

        PROCEDURE BUSYBOX(OP, ERR); INTEGER OP; LABEL ERR;
        BEGIN
            CHARACTER OPERATOR;
            REAL NUMBR;
            BOOLEAN NEGATIVE;

            SKIPWHITESPACE(CH);

            IF OP = EXPRESSION THEN
            BEGIN

                NEGATIVE := FALSE;
                WHILE (CH = '+') OR (CH = '-') DO
                BEGIN
                    IF CH = '-' THEN NEGATIVE :=  NOT NEGATIVE;
                    READCHAR(CH);
                END;

                BUSYBOX(TERM, ERR);

                IF NEGATIVE THEN
                BEGIN
                    NUMBR := POP; PUSH(0 - NUMBR);
                END;

                WHILE (CH = '+') OR (CH = '-') DO
                BEGIN
                    OPERATOR := CH; READCHAR(CH);
                    BUSYBOX(TERM, ERR); CALC(OPERATOR, ERR);
                END;

            END
            ELSE IF OP = TERM THEN
            BEGIN

                BUSYBOX(FACTOR, ERR);
                WHILE (CH = '*') OR (CH = '/') DO
                BEGIN
                    OPERATOR := CH; READCHAR(CH);
                    BUSYBOX(FACTOR, ERR); CALC(OPERATOR, ERR)
                END

            END
            ELSE IF OP = FACTOR THEN
            BEGIN

                IF (CH = '+') OR (CH = '-') THEN
                  BUSYBOX(EXPRESSION, ERR)
                ELSE IF (CH >= '0') AND (CH <= '9') THEN
                  BUSYBOX(NUMBER, ERR)
                ELSE IF CH = '(' THEN
                BEGIN
                    READCHAR(CH);
                    BUSYBOX(EXPRESSION, ERR);
                    IF CH = ')' THEN READCHAR(CH) ELSE GOTO ERR;
                END
                ELSE GOTO ERR;

            END
            ELSE IF OP = NUMBER THEN
            BEGIN

                NUMBR := 0;
                WHILE (CH >= '0') AND (CH <= '9') DO
                BEGIN
                    NUMBR := 10 * NUMBR + RANK(CH) - RANK('0'); READCHAR(CH);
                END;
                IF CH = '.' THEN
                BEGIN
                    REAL FAKTOR;
                    READCHAR(CH);
                    FAKTOR := 10;
                    WHILE (CH >= '0') AND (CH <= '9') DO
                    BEGIN
                        NUMBR := NUMBR + (RANK(CH) - RANK('0')) / FAKTOR;
                        FAKTOR := 10 * FAKTOR;
                        READCHAR(CH);
                    END;
                END;
                PUSH(NUMBR);

            END;

            SKIPWHITESPACE(CH);

        END BUSYBOX;

        BOOLEAN PROCEDURE EVAL(INP); TEXT INP;
        BEGIN
            EVALUATEDERR :- NOTEXT;
            STACKPOS := 0;
            T :- COPY(INP.STRIP);
            READCHAR(CH);
            BUSYBOX(EXPRESSION, ERRORLABEL);
            IF NOT T.MORE AND STACKPOS = 1 AND CH = EOT THEN
            BEGIN
                EVALUATED := POP;
                EVAL := TRUE;
                GOTO NOERRORLABEL;
            END;
    ERRORLABEL:
            EVAL := FALSE;
            IF EVALUATEDERR = NOTEXT THEN
                EVALUATEDERR :- "INVALID EXPRESSION: " & INP;
    NOERRORLABEL:
        END EVAL;

        REAL PROCEDURE RESULT;
            RESULT := EVALUATED;

        TEXT PROCEDURE ERR;
            ERR :- EVALUATEDERR;

        TEXT T;

        INTEGER EXPRESSION;
        INTEGER TERM;
        INTEGER FACTOR;
        INTEGER NUMBER;

        CHARACTER TAB;
        CHARACTER LF;
        CHARACTER CR;
        CHARACTER SPACE;
        CHARACTER EOT;

        CHARACTER CH;
        REAL ARRAY STACK(0:31);
        INTEGER STACKPOS;

        REAL EVALUATED;
        TEXT EVALUATEDERR;

        EXPRESSION := 1;
        TERM := 2;
        FACTOR := 3;
        NUMBER := 4;

        TAB := CHAR(9);
        LF := CHAR(10);
        CR := CHAR(13);
        SPACE := CHAR(32);
        EOT := CHAR(0);

    END EXPR;

    INTEGER ARRAY DIGITS(1:4);
    INTEGER SEED, I;
    REF(EXPR) E;

    INTEGER SOLUTION;
    INTEGER D1,D2,D3,D4;
    INTEGER O1,O2,O3;
    TEXT OPS;

    OPS :- "+-*/";

    E :- NEW EXPR;
    OUTTEXT("ENTER FOUR INTEGERS: ");
    OUTIMAGE;
    FOR I := 1 STEP 1 UNTIL 4 DO DIGITS(I) := ININT; !RANDINT(0, 9, SEED);

    ! DIGITS ;
    FOR D1 := 1 STEP 1 UNTIL 4 DO
    FOR D2 := 1 STEP 1 UNTIL 4 DO IF D2 <> D1 THEN
    FOR D3 := 1 STEP 1 UNTIL 4 DO IF D3 <> D2 AND
                                     D3 <> D1 THEN
    FOR D4 := 1 STEP 1 UNTIL 4 DO IF D4 <> D3 AND
                                     D4 <> D2 AND
                                     D4 <> D1 THEN
    ! OPERATORS ;
    FOR O1 := 1 STEP 1 UNTIL 4 DO
    FOR O2 := 1 STEP 1 UNTIL 4 DO
    FOR O3 := 1 STEP 1 UNTIL 4 DO
    BEGIN
        PROCEDURE P(FMT); TEXT FMT;
        BEGIN
            INTEGER PLUS;
            TRY.SETPOS(1);
            WHILE FMT.MORE DO
            BEGIN
                CHARACTER C;
                C := FMT.GETCHAR;
                IF (C >= '1') AND (C <= '4') THEN
                BEGIN
                    INTEGER DIG; CHARACTER NCH;
                    DIG := IF C = '1' THEN DIGITS(D1)
                      ELSE IF C = '2' THEN DIGITS(D2)
                      ELSE IF C = '3' THEN DIGITS(D3)
                                      ELSE DIGITS(D4);
                    NCH := CHAR( DIG + RANK('0') );
                    TRY.PUTCHAR(NCH);
                END
                ELSE IF C = '+' THEN
                BEGIN
                    PLUS := PLUS + 1;
                    OPS.SETPOS(IF PLUS = 1 THEN O1 ELSE
                               IF PLUS = 2 THEN O2
                                           ELSE O3);
                    TRY.PUTCHAR(OPS.GETCHAR);
                END
                ELSE IF (C = '(') OR (C = ')') OR (C = ' ') THEN
                    TRY.PUTCHAR(C)
                ELSE
                    ERROR("ILLEGAL EXPRESSION");
            END;
            IF E.EVAL(TRY) THEN
            BEGIN
                IF ABS(E.RESULT - 24) < 0.001 THEN
                BEGIN
                    SOLUTION := SOLUTION + 1;
                    OUTTEXT(TRY); OUTTEXT(" = ");
                    OUTFIX(E.RESULT, 4, 10);
                    OUTIMAGE;
                END;
            END
            ELSE
            BEGIN
                IF E.ERR <> "DIV BY ZERO" THEN
                BEGIN
                    OUTTEXT(TRY); OUTIMAGE;
                    OUTTEXT(E.ERR); OUTIMAGE;
                END;
            END;
        END P;
        TEXT TRY;
        TRY :- BLANKS(17);
        P("(1 + 2) + (3 + 4)");
        P("(1 + (2 + 3)) + 4");
        P("((1 + 2) + 3) + 4");
        P("1 + ((2 + 3) + 4)");
        P("1 + (2 + (3 + 4))");
    END;
    OUTINT(SOLUTION, 0);
    OUTTEXT(" SOLUTIONS FOUND");
    OUTIMAGE;
END.


import Darwin
import Foundation

var solution = ""

println("24 Game")
println("Generating 4 digits...")

func randomDigits() -> [Int] {
  var result = [Int]()
  for i in 0 ..< 4 {
    result.append(Int(arc4random_uniform(9)+1))
  }
  return result
}

// Choose 4 digits
let digits = randomDigits()

print("Make 24 using these digits : ")

for digit in digits {
  print("\(digit) ")
}
println()

// get input from operator
var input = NSString(data:NSFileHandle.fileHandleWithStandardInput().availableData, encoding:NSUTF8StringEncoding)!

var enteredDigits = [Double]()

var enteredOperations = [Character]()

let inputString = input as String

// store input in the appropriate table
for character in inputString {
  switch character {
  case "1", "2", "3", "4", "5", "6", "7", "8", "9":
    let digit = String(character)
    enteredDigits.append(Double(digit.toInt()!))
  case "+", "-", "*", "/":
    enteredOperations.append(character)
  case "\n":
    println()
  default:
    println("Invalid expression")
  }
}

// check value of expression provided by the operator
var value = 0.0

if enteredDigits.count == 4 && enteredOperations.count == 3 {
  value = enteredDigits[0]
  for (i, operation) in enumerate(enteredOperations) {
    switch operation {
    case "+":
      value = value + enteredDigits[i+1]
    case "-":
      value = value - enteredDigits[i+1]
    case "*":
      value = value * enteredDigits[i+1]
    case "/":
      value = value / enteredDigits[i+1]
    default:
      println("This message should never happen!")
    }
  }
}

func evaluate(dPerm: [Double], oPerm: [String]) -> Bool {
  var value = 0.0

  if dPerm.count == 4 && oPerm.count == 3 {
    value = dPerm[0]
    for (i, operation) in enumerate(oPerm) {
      switch operation {
      case "+":
        value = value + dPerm[i+1]
      case "-":
        value = value - dPerm[i+1]
      case "*":
        value = value * dPerm[i+1]
      case "/":
        value = value / dPerm[i+1]
      default:
        println("This message should never happen!")
      }
    }
  }
  return (abs(24 - value) < 0.001)
}

func isSolvable(inout digits: [Double]) -> Bool {

  var result = false
  var dPerms = [[Double]]()
  permute(&digits, &dPerms, 0)

  let total = 4 * 4 * 4
  var oPerms = [[String]]()
  permuteOperators(&oPerms, 4, total)

  for dig in dPerms {
    for opr in oPerms {
      var expression = ""

      if evaluate(dig, opr) {
        for digit in dig {
          expression += "\(digit)"
        }

        for oper in opr {
          expression += oper
        }

        solution = beautify(expression)
        result = true
      }
    }
  }
  return result
}

func permute(inout lst: [Double], inout res: [[Double]], k: Int) -> Void {
  for i in k ..< lst.count {
    swap(&lst[i], &lst[k])
    permute(&lst, &res, k + 1)
    swap(&lst[k], &lst[i])
  }
  if k == lst.count {
    res.append(lst)
  }
}

// n=4, total=64, npow=16
func permuteOperators(inout res: [[String]], n: Int, total: Int) -> Void {
  let posOperations = ["+", "-", "*", "/"]
  let npow = n * n
  for i in 0 ..< total {
    res.append([posOperations[(i / npow)], posOperations[((i % npow) / n)], posOperations[(i % n)]])
  }
}

func beautify(infix: String) -> String {
  let newString = infix as NSString

  var solution = ""

  solution += newString.substringWithRange(NSMakeRange(0, 1))
  solution += newString.substringWithRange(NSMakeRange(12, 1))
  solution += newString.substringWithRange(NSMakeRange(3, 1))
  solution += newString.substringWithRange(NSMakeRange(13, 1))
  solution += newString.substringWithRange(NSMakeRange(6, 1))
  solution += newString.substringWithRange(NSMakeRange(14, 1))
  solution += newString.substringWithRange(NSMakeRange(9, 1))

  return solution
}

if value != 24 {
  println("The value of the provided expression is \(value) instead of 24!")
  if isSolvable(&enteredDigits) {
    println("A possible solution could have been " + solution)
  } else {
    println("Anyway, there was no known solution to this one.")
  }
} else {
  println("Congratulations, you found a solution!")
}