/* Plays the game of 24. */

TWENTYFOUR: procedure options (main);            /* 14 August 2010 */

CTP: procedure (E) returns (character(50) varying);
   declare E character (*) varying;
   declare OUT character (length(E)) varying;
   declare S character (length(E)) varying controlled;
   declare c character (1);
   declare i fixed binary;

/* This procedure converts an arithmetic expression to Reverse Polish Form. */
/* A push-down pop-up stack is used for operators. */
priority: procedure (a) returns (fixed decimal (1));
   declare a character (1);
   declare ops character (10) initial ('#+-*/') varying static;
   declare pri(6) fixed decimal (1) initial (1,2,2,3,3,4) static;
   declare i fixed binary;

   i = index(ops,a);
   return (pri(i));
end priority;

   allocate S; S = '#'; out = '';
   do i = 1 to length(E);
      c = substr(E, i, 1);
      if index('+-*/', c) > 0 then
         do;
            /* Copy any higher priority operators on the stack to the output. */
            do while ( priority(c) <= priority((S)) );
               out = out || S;
               free S;
            end;
            /* Copy the input character to the stack. */
            allocate S; S = c;
         end;

      if index('123456789', c) > 0 then
         out = out || c;
   end;
   do while (allocation(S) > 1);
      out = out || s;
      free S;
   end;
   return (out);
end CTP;

/* Given a push-down pop-up stack, and an expresion in  */
/* Reverse Polish notation, evaluate the expression.    */
EVAL: procedure (E) returns (fixed decimal(15));
   declare E character (*) varying;
   declare S fixed decimal (15) controlled;
   declare (a, b) fixed decimal (15);
   declare c character (1);
   declare p fixed binary;
   declare (empty_stack, invalid_expression) condition;

   on condition (empty_stack) begin;
      put skip list ('Your expression is not valid.');
      stop;
   end;
   on condition (invalid_expression) begin;
      put skip list ('Your expression is not valid.');
      stop;
   end;

   do p = 1 to length(E);
      c = substr(E, p, 1);
      if index('123456789', c) > 0 then
         do; allocate S; S = c; end;
      else
         do;
            if allocation(S) = 0 then signal condition (empty_stack);
            b = S; free S;
            if allocation(S) = 0 then signal condition (empty_stack);
            a = S;
            select (c);
               when ('+') S = a + b;
               when ('-') S = a - b;
               when ('*') S = a * b;
               when ('/') S = a / b;
               when ('^') S = a ** b;
               otherwise signal condition (invalid_expression);
            end;
         end;
   end;
   if allocation(S) ^= 1 then signal condition (invalid_expression);
   return (S);
END eval;

/* Check that the player has used every digit and no others. */
VALIDATE: procedure (E);
   declare E character (*) varying;
   declare E2 character (length(E)), (i, j) fixed binary;
   declare digits(9) character (1) static initial
      ('1', '2', '3', '4', '5', '6', '7', '8', '9');

   E2 = translate(E, '    ', '+-*/' );
   do i = 1 to 4;
      j = index(E2, digits(k(i)));
      if j > 0 then
         substr(E2, j, 1) = ' ';
      else
         do; put skip list ('You must use the digits supplied.'); stop; end;
   end;
   if E2 ^= '' then
      do; put skip list ('You must use every digit supplied, and no others.'); stop; end;
end VALIDATE;

   declare E character (40) varying;
   declare k(4) fixed decimal;
   declare (time, random) builtin;
   declare V fixed decimal (15);

   k = random(TIME);
   k = 9*random() + 1;
   put skip edit ('Here are four integers:', k) (a);
   put skip list ('With these integers, make up an arithmetic expression' ||
      ' that evaluates to 24.');
   put skip list ('You can use any of the operators +, -, *, and /');
   put skip list ('E.g., Given the integers 1, 3, 7, and 6,' ||
      ' the expression 6*3+7-1 evaluates to 24.');

   put skip list ('Please type an arithmetic expression :');
   get edit (E) (L) COPY;

   CALL VALIDATE (E); /* Check that the player has used every digit and no others. */

   E = CTP(E);
   V = EVAL (E);
   if V = 24 then
      put skip list ('Congratulations: the expression evaluates to 24.');
   else
      put skip edit ('The result is ', trim(V), ' which is not correct') (a);

end TWENTYFOUR;


is_num = (s):
  x = s ord(0)
  if (x >= "0"ord && x <= "9"ord): true.
  else: false.
  .

nums = (s):
  res = ()
  0 to (s length, (b):
    c = s(b)
    if (is_num(c)):
      res push(c).
  .)
  res.

try = 1
while (true):
  r = rand string
  digits = (r(0),r(1),r(2),r(3))
  "\nMy next four digits: " print
  digits join(" ") say
  digit_s = digits ins_sort string

  ("Your expression to create 24 (try ", try, "): ") print
  entry = read slice(0,-1)
  expr = entry eval
  parse = nums(entry)
  parse_s = parse clone ins_sort string
  try++
  if (parse length != 4):
    ("Wrong number of digits:", parse) say.
  elsif (parse_s != digit_s):
    ("Wrong digits:", parse) say.
  elsif (expr == 24):
    "You won!" say
    entry print, " => 24" say
    return().
  else:
    (entry, " => ", expr string, " != 24") join("") say.
.


CLS

Function isNumeric ($x)
{
    $x2 = 0
    $isNum = [System.Int32]::TryParse($x,[ref]$x2)
Return $isNum
}

$NumberArray = @()
While( $NumberArray.Count -lt 4 ){
    $NumberArray += Random -Minimum 1 -Maximum 10
}

Write-Host @"
Welcome to the 24 game!

Here are your numbers: $($NumberArray -join ",").
Use division, multiplication, subtraction and addition to get 24 as a result with these 4 numbers.
"@

Do
{
$Wrong = 0
$EndResult = $null
$TempChar = $null
$TempChar2 = $null
$Count = $null

$AllowableCharacters = $NumberArray + "+-*/()".ToCharArray()
    $Result = Read-Host
        Foreach($Char in $Result.ToCharArray())
        {
            If( $AllowableCharacters -notcontains $Char ){ $Wrong = 1 }
        }

        If($Wrong -eq 1)
        {
            Write-Warning "Wrong input! Please use only the given numbers."
        }
        Foreach($Char in $Result.ToCharArray())
        {
            If((IsNumeric $TempChar) -AND (IsNumeric $Char))
            {
                Write-Warning "Wrong input! Combining two or more numbers together is not allowed!"
            }
            $TempChar = $Char
        }
        Foreach($Char in $Result.ToCharArray())
        {
            If(IsNumeric $Char)
            {
                $Count++
            }
        }
        If($Count -eq 4)
        {
            $EndResult = Invoke-Expression $Result
                If($EndResult -eq 24)
                {
                    Write-Host "`nYou've won the game!"
                }
                Else
                {
                    Write-Host "`n$EndResult is not 24! Too bad."
                }
        }
        Else
        {
            Write-Warning "Wrong input! You did not supply four numbers."
        }
}
While($EndResult -ne 24)


:a
editvar /modify -random- = <10
printline These are your four digits: -random- -random- -random- -random-
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.
:b
editvar /newvar /value=b /userinput=1 /title=Do you want to play again?
if -b- /hasvalue y goto :a else exitcurrentprogram


:- initialization(main).

answer(24).
play :- round, play ; true.

round :-
    prompt(Ns), get_line(Input), Input \= "stop"
  , ( phrase(parse(Ns,[]), Input) -> Result = 'correct'
                                   ; Result = 'wrong'
    ), write(Result), nl, nl
  . % where
    prompt(Ns)  :- length(Ns,4), maplist(random(1,10), Ns)
                 , write('Digits: '), write(Ns), nl
                 .

parse([],[X])     --> { answer(X) }.
parse(Ns,[Y,X|S]) --> "+", { Z is X  +  Y }, parse(Ns,[Z|S]).
parse(Ns,[Y,X|S]) --> "-", { Z is X  -  Y }, parse(Ns,[Z|S]).
parse(Ns,[Y,X|S]) --> "*", { Z is X  *  Y }, parse(Ns,[Z|S]).
parse(Ns,[Y,X|S]) --> "/", { Z is X div Y }, parse(Ns,[Z|S]).
parse(Ns,Stack)   --> " ", parse(Ns,Stack).
parse(Ns,Stack)   --> { select(N,Ns,Ns1), number_codes(N,[Code]) }
                    , [Code], parse(Ns1,[N|Stack])
                    .

get_line(Xs) :- get_code(X)
              , ( X == 10 -> Xs = [] ; Xs = [X|Ys], get_line(Ys) )
              .
main :- randomize, play, halt.


#digitCount = 4
Global Dim digits(#digitCount - 1) ;holds random digits

Procedure showDigits()
  Print(#CRLF$ + "These are your four digits: ")
  Protected i
  For i = 0 To #digitCount - 1
    Print(Str(digits(i)))
    If i < (#digitCount - 1)
      Print(", ")
    Else
      PrintN("")
    EndIf
  Next
  Print("24 = ")
EndProcedure

Procedure playAgain()
  Protected answer.s
  Repeat
    Print("Play again (y/n)? ")
    answer = LCase(Left(Trim(Input()), 1))
    Select answer
      Case "n"
        ProcedureReturn #False
      Case "y"
        ProcedureReturn #True
      Default
        PrintN("")
        Continue
    EndSelect
  ForEver
EndProcedure

Procedure allDigitsUsed()
  Protected i
  For i = 0 To #digitCount - 1
    If digits(i) <> 0
      ProcedureReturn #False
    EndIf
  Next
  ProcedureReturn #True
EndProcedure

Procedure isValidDigit(d)
  For i = 0 To #digitCount - 1
    If digits(i) = d
      digits(i) = 0
      ProcedureReturn #True
    EndIf
  Next
  ProcedureReturn #False
EndProcedure

Procedure doOperation(List op.c(), List operand.f())
  Protected x.f, y.f, op.c
  op = op(): DeleteElement(op())
  If op = '('
    ProcedureReturn #False ;end of sub-expression
  EndIf

  y = operand(): DeleteElement(operand())
  x = operand()
  Select op
    Case '+'
      x + y
    Case '-'
      x - y
    Case '*'
      x * y
    Case '/'
      x / y
  EndSelect
  operand() = x
  ProcedureReturn #True ;operation completed
EndProcedure

;returns error if present and the expression results in *result\f
Procedure.s parseExpression(expr.s, *result.Float)
  NewList op.c()
  NewList operand.f()
  expr = ReplaceString(expr, " ", "") ;remove spaces

  If Len(expr) = 0: *result\f = 0: ProcedureReturn "": EndIf ;no expression, return zero

  Protected *ech.Character = @expr, lastWasDigit, lastWasOper, parenCheck, c.c
  While *ech\c
    c = *ech\c
    Select c
      Case '*', '/', '-', '+'
        If Not lastWasDigit: ProcedureReturn "Improper syntax, need a digit between operators.": EndIf
        If ListSize(op()) And (FindString("*/", Chr(op()), 1) Or (FindString("+-", Chr(op()), 1) And FindString("+-", Chr(c), 1)))
          doOperation(op(), operand())
        EndIf
        AddElement(op()): op() = c
        lastWasOper = #True: lastWasDigit = #False
      Case '('
        If lastWasDigit: ProcedureReturn "Improper syntax, need an operator before left paren.": EndIf
        AddElement(op()): op() = c
        parenCheck + 1: lastWasOper = #False
      Case ')'
        parenCheck - 1: If parenCheck < 0: ProcedureReturn "Improper syntax, missing a left paren.": EndIf
        If Not lastWasDigit: ProcedureReturn "Improper syntax, missing a digit before right paren.": EndIf
        Repeat: Until Not doOperation(op(),operand())
        lastWasDigit = #True
      Case '1' To '9'
        If lastWasDigit: ProcedureReturn "Improper syntax, need an operator between digits.": EndIf
        AddElement(operand()): operand() = c - '0'
        If Not isValidDigit(operand()): ProcedureReturn "'" + Chr(c) + "' is not a valid digit.": EndIf
        lastWasDigit = #True: lastWasOper = #False
      Default
        ProcedureReturn "'" + Chr(c) + "' is not allowed in the expression."
    EndSelect
    *ech + SizeOf(Character)
  Wend

  If parenCheck <> 0 Or lastWasOper: ProcedureReturn "Improper syntax, missing a right paren or digit.": EndIf
  Repeat
    If Not ListSize(op()): Break: EndIf
  Until Not doOperation(op(),operand())
  *result\f = operand()
  ProcedureReturn "" ;no error
EndProcedure

Define success, failure, result.f, error.s, i
If OpenConsole()
  PrintN("The 24 Game" + #CRLF$)
  PrintN("Given four digits and using just the +, -, *, and / operators; and the")
  PrintN("possible use of brackets, (), enter an expression that equates to 24.")
  Repeat
    For i = 0 To #digitCount - 1
      digits(i) = 1 + Random(8)
    Next

    showDigits()
    error = parseExpression(Input(), @result)
    If error = ""
      If Not allDigitsUsed()
        PrintN( "Wrong! (you didn't use all digits)"): failure + 1
      ElseIf result = 24.0
        PrintN("Correct!"): success + 1
      Else
        Print("Wrong! (you got ")
        If result <> Int(result)
          PrintN(StrF(result, 2) + ")")
        Else
          PrintN(Str(result) + ")")
        EndIf
        failure + 1
      EndIf
    Else
      PrintN(error): failure + 1
    EndIf
  Until Not playAgain()

  PrintN("success:" + Str(success) + " failure:" + Str(failure) + " total:" + Str(success + failure))

  Print(#CRLF$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf


'''
 The 24 Game

 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.
 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
import random, ast, re
import sys

if sys.version_info[0] < 3: input = raw_input

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

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 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.lower() == 'q':
            break
        if answer == '!':
            digits = choose4()
            print ("New digits:", ' '.join(digits))
            continue
        if not chk:
            print ("The input '%s' was wonky!" % answer)
        else:
            ans = eval(answer)
            print (" = ", ans)
            if ans == 24:
                print ("Thats right!")
    print ("Thank you and goodbye")

if __name__ == '__main__': main()


  [ stack ]                                       is operators       (   --> s )

  0 $ "*/+-" witheach [ bit | ]
  operators put

  [ stack ]                                       is numbers         (   --> s )

  [ 0 swap
    witheach [ bit | ]
    numbers put ]                                 is putnumbers      ( $ -->   )

  [ $ "123456789" shuffle 4 split drop sort ]     is choosenumbers   (   --> $ )

  [ say "Using any of the operators * / + -" cr
    say "and each of the numbers "
    witheach [ emit sp ] say "once," cr
    say "enter an RPN expression equal to 24." cr
    $ "Spaces between characters are optional: "
    input ]                                       is getexpression   ( $ --> $ )

  [ $ "" swap witheach
      [ dup space = iff drop else join ] ]        is stripspaces     ( $ --> $ )

  [ stack ]                                       is opcount         (   --> s )
  [ stack ]                                       is numcount        (   --> s )
  [ stack ]                                       is numsused        (   --> s )

  [ true swap
    0 opcount put
    0 numcount put
    0 numsused put
    witheach
      [ bit dup numbers share & iff
          [ 1 numcount tally
            numsused take | numsused put ]
        else
          [ operators share & if
              [ 1 opcount tally ] ]
        opcount share numcount share < not if
          [ drop false conclude ] ]
    numsused take
    numbers share != if [ drop false ]
    numcount take 4 != if [ drop false ]
    opcount take 3 != if [ drop false ] ]         is checkexpression ( $ --> b )

  [ $ "" swap
    witheach
      [ dup char 0 char 9 1+ within iff
          [ join $ " n->v " join ] done
        [ switch
          char * case [ $ "v* " join ]
          char / case [ $ "v/ " join ]
          char + case [ $ "v+ " join ]
          char - case [ $ "v- " join ]
          otherwise [ $ "Error!" fail ] ] ] ]     is quackerise      ( $ --> [ )

    [ choosenumbers
      dup putnumbers
      [ dup getexpression
        stripspaces
        dup checkexpression not while
        cr
        say "Badly formed expression. Try again."
        cr cr
        drop again ]
      nip
      quackerise
      quackery
      cr
      say "Your expression is equal to "
      2dup 10 point$ echo$
      24 n->v v- v0= iff
      [ say ". :-)" ] else [ say ". :-(" ]
      numbers release ]                           is game            (   -->   )


twenty.four <- function(operators=c("+", "-", "*", "/", "("),
                        selector=function() sample(1:9, 4, replace=TRUE),
                        arguments=selector(),
                        goal=24) {
  newdigits <- function() {
    arguments <<- selector()
    cat("New digits:", paste(arguments, collapse=", "), "\n")
  }
  help <- function() cat("Make", goal,
      "out of the numbers",paste(arguments, collapse=", "),
      "and the operators",paste(operators, collapse=", "), ".",
      "\nEnter 'q' to quit, '!' to select new digits,",
      "or '?' to repeat this message.\n")
  help()
  repeat {
    switch(input <- readline(prompt="> "),
           q={ cat("Goodbye!\n"); break },
           `?`=help(),
           `!`=newdigits(),
           tryCatch({
             expr <- parse(text=input, n=1)[[1]]
             check.call(expr, operators, arguments)
             result <- eval(expr)
             if (isTRUE(all.equal(result, goal))) {
               cat("Correct!\n")
               newdigits()
             } else {
               cat("Evaluated to", result, "( goal", goal, ")\n")
             }
           },error=function(e) cat(e$message, "\n")))
  }
}

check.call <- function(expr, operators, arguments) {
  unexpr <- function(x) {
    if (is.call(x))
      unexpr(as.list(x))
    else if (is.list(x))
      lapply(x,unexpr)
    else x
  }
  leaves <- unlist(unexpr(expr))
  if (any(disallowed <-
          !leaves %in% c(lapply(operators, as.name),
                         as.list(arguments)))) {
    stop("'", paste(sapply(leaves[disallowed], as.character),
                    collapse=", "),
         "' not allowed. ")
  }
  numbers.used <- unlist(leaves[sapply(leaves, mode) == 'numeric'])

  if (! isTRUE(all.equal(sort(numbers.used), sort(arguments))))
   stop("Must use each number once.")
}


#lang racket

(define (interprete expr numbers)
  ;; the cashe for used numbers
  (define cashe numbers)

  ;; updating the cashe and handling invalid cases
  (define (update-cashe! x)
    (unless (member x numbers) (error "Number is not in the given set:" x))
    (unless (member x cashe)   (error "Number is used more times then it was given:" x))
    (set! cashe (remq x cashe)))

  ;; the parser
  (define parse
    (match-lambda
      ;; parsing arythmetics
      [`(,x ... + ,y ...) (+ (parse x) (parse y))]
      [`(,x ... - ,y ...) (- (parse x) (parse y))]
      [`(,x ... * ,y ...) (* (parse x) (parse y))]
      [`(,x ... / ,y ...) (/ (parse x) (parse y))]
      [`(,x ,op ,y ...)   (error "Unknown operator: " op)]
      ;; opening redundant brackets
      [`(,expr)           (parse expr)]
      ;; parsing numbers
      [(? number? x)      (update-cashe! x) x]
      ;; unknown token
      [x                  (error "Not a number: " x)]))

  ;; parse the expresion
  (define result (parse expr))

  ;; return the result if cashe is empty
  (if (empty? cashe)
      result
      (error "You didn`t use all numbers!")))


use MONKEY-SEE-NO-EVAL;

say "Here are your digits: ",
constant @digits = (1..9).roll(4)».Str;

grammar Exp24 {
    token TOP { ^ <exp> $ { fail unless EVAL($/) == 24 } }
    rule exp { <term>+ % <op> }
    rule term { '(' <exp> ')' | <@digits> }
    token op { < + - * / > }
}

while my $exp = prompt "\n24? " {
    if try Exp24.parse: $exp {
        say "You win :)";
        last;
    } else {
        say (
            'Sorry.  Try again.' xx 20,
            'Try harder.' xx 5,
            'Nope.  Not even close.' xx 2,
            'Are you five or something?',
            'Come on, you can do better than that.'
        ).flat.pick
    }
}


Red []
print "Evaluation from left to right with no precedence, unless you use parenthesis." print ""
a: "123456789"
guess: ""
valid: ""
sucess: false
random/seed now/time
loop 4 [append valid last random a]
print ["The numbers are: " valid/1 ", " valid/2 ", " valid/3 " and " valid/4]
sort valid
insert valid " "

expr:    [term ["+" | "-"] expr | term]
term:    [primary ["*" | "/"] term | primary]
primary: [some digit | "(" expr ")"]
digit:   charset valid

while [not sucess] [
	guess: ask "Enter your expression: "
	if guess = "q" [halt]
	numbers: copy guess
	sort numbers
	numbers: take/last/part numbers 4
	insert numbers " "
	either (parse guess expr) and (valid = numbers) [
		repeat i length? guess [insert at guess (i * 2) " "]
		result: do guess
		print ["The result of your expression is: " result]
		if (result = 24) [sucess: true]
	][
	print "Something is wrong with the expression, try again."
	]
]
print "You got it right!"


/*REXX program helps the user find solutions to the game of  24.

╔═════════════════════════════════════════════════════════════════════════════╗
║ Argument is either of these forms:     (blank)                              ║⌂
║                                         ssss                                ║⌂
║                                         ssss,total,limit                    ║⌂
║                                         ssss-ffff                           ║⌂
║                                         ssss-ffff,total,limit               ║⌂
║                                        -ssss                                ║⌂
║                                        +ssss                                ║⌂
║                                                                             ║⌂
║ where   SSSS   and/or  FFFF  must be exactly four numerals (decimal digits) ║⌂
║ comprised soley of the numerals (digits)   1 ──► 9     (no zeroes).         ║⌂
║                                                                             ║⌂
║         SSSS   is the start,   and     FFFF    is the  end   (inclusive).   ║⌂
║                                                                             ║⌂
║ If  ssss  has a leading plus (+) sign,  it's used as the digits,  and       ║⌂
║ the user is prompted to enter a solution  (using those decimal digits).     ║⌂
║                                                                             ║⌂
║ If  ssss  has a leading minus (-) sign,  a solution is searched for and     ║⌂
║ the user is told there is a solution (or not),  but no solutions are shown).║⌂
║                                                                             ║⌂
║ If no argument is specified,  this program generates four digits (no zeros) ║⌂
║ which has at least one solution,  and shows the sorted digits to the user,  ║⌂
║ requesting that they enter a solution (the digits used may be in any order).║⌂
║                                                                             ║⌂
║ If   TOTAL   is entered,  it's the desired answer.     The default is  24.  ║⌂
║ If   LIMIT   is entered,  it limits the number of solutions shown.          ║⌂
║                                                                             ║⌂
║ 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) ║
╚═════════════════════════════════════════════════════════════════════════════╝         */

numeric digits 30                                /*where rational arithmetic is needed. */
parse arg orig;              uargs= orig         /*get the  guess  from the command line*/
orig= space(orig, 0)                             /*remove all the blanks from  ORIG.    */
negatory=  left(orig, 1)=='-'                    /*=1, suppresses showing.              */
pository=  left(orig, 1)=='+'                    /*=1, force pgm to use specific number.*/
if pository | negatory  then orig=substr(orig,2) /*now, just use the absolute vaue.     */
parse var orig orig  ','   $  ","  limit         /*get optional total ($)  and/or  limit*/
parse var orig start '-' finish                  /*get start and finish  (maybe).       */
opers= '*'  ||  "/+-"                            /*arithmetic opers; order is important.*/
ops= length(opers)                               /*the number of arithmetic operators.  */
groupsym= space('  ( )   [ ]   { }   « »  ',  0) /*the allowable grouping symbols.      */
indent= left('', 30)                             /*indents the display of solutions.    */
show= 1                                          /*=1,  shows solutions  (a semifore).  */
digs= 123456789                                  /*numerals  (digits)  that can be used.*/
if $==''      then $= 24                         /*the name (goal) of the game:  (24)   */
if limit==''  then limit= 1                      /*=1,  shows only  one  solution.      */
__= copies('─', 8)                               /*used for output messages to the user.*/
abuttals = 0                                     /*=1,  allows digit abuttal:   12+12   */
      do j=1  for ops;  o.j= substr(opers, j, 1) /*these are used for fast execution.   */
      end  /*j*/
if \datatype(limit, 'N')   then do;  call ger  limit  "isn't numeric";   exit 13;    end
limit= limit / 1                                 /*normalize the number for limit.      */
if \datatype($, 'N')       then do;  call ger    $    "isn't numeric";   exit 13;    end
$= $ / 1                                         /*normalize the number for total.      */
if start\=='' & \pository  then do;  call ranger start,finish;           exit 1;     end
show= 0                                          /*stop blabbing solutions in SOLVE.    */
              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*/
show= 1                                          /*enable SOLVE to show solutions.      */
if pository  then rrrr= start                    /*use what's specified.                */
rrrr= sortc(rrrr)                                /*sort four elements.                  */
rd.= x.
                  do j=1  for 9;    _= substr(rrrr, j, 1);         rd._= #chrs(rrrr, _)
                  end   /*j*/                    /* [↑]  count for each digit in  RRRR. */
  do guesses=1;                 say
  say __   "Using the numerals (digits) "   rrrr", enter an expression that equals "   $
  say right('(or  ?  or  Quit):', 79)
  pull y;        uargs= y;      y= space(y, 0)   /*obtain user's response (expression). */
  if abbrev('QUIT', y, 1)  then exit 0           /*does the user want to quit this game?*/
  if y=='?'  then do j=2  for sourceline()-1;  _= sourceline(j)   /*get  a line of pgm. */
                  if right(_, 1)=='⌂'  then iterate               /*ignore this doc part*/
                  say '  '  strip( left(_, 79), 'T')              /*show "   "   " doc. */
                  if left(_, 1)=='╚'  then iterate guesses
                  end   /*j*/                    /* [↑]  use an in─line way to show help*/
  _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 adjacent decimal digits*/
    if datatype( substr(y, j, 1), 'W')   &   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*/

  yy= translate(y, ')))', "]}»")                 /*use a simlier form for the expression*/

    do j=1  for 9  while \abuttals               /*check for a dig following a group sym*/
    _= pos(')'j, yy)                             /*is there a string with:   )DIGIT   ? */
    if _>0  then do;  call ger 'invalid use of digit abuttal' substr(y, _, 2)
                      iterate guesses
                 end
    end   /*j*/

  yd= #chrs(y, digs)                             /*count of legal digits  123456789     */
  if yd<4  then do;  call ger 'not enough numerals were entered.';  iterate guesses;   end
  if yd>4  then do;  call ger 'too many numerals were entered.'  ;  iterate guesses;   end

      do j=1  for length(groupsym)  by 2
      if #chrs(y, substr(groupsym, j  , 1))\==,
         #chrs(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)      /*only examine the first two operators.*/
        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= #chrs(y, j)
    if _d==rd.j  then iterate
    if _d<rd.j   then call ger  'not enough'   j   "numerals were entered, must be"   rd.j
                 else call ger  'too many'     j   "numerals were entered, must be"   rd.j
    iterate guesses
    end   /*j*/

  y= translate(y, '()()', "[]{}")                /*change extended grouping symbols──►()*/
  interpret  'ans=('  y   ") / 1"                /*evalualte a normalized expression.   */
  oldDigs= digits()                              /*save current decimal digit setting.  */
  numeric digits digits()%2                      /*normalize expresssion to less digits.*/
  if ans/1=$  then leave guesses                 /*the expression calculates to  24.    */
  say __   "incorrect, "   y"="ans               /*issue an error message  (incorrect). */
  numeric digits oldDigs                         /*re─instate the decimal digs precision*/
  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. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
#chrs:procedure; parse arg x,c;  return length(x) - length( space( translate(x, , c), 0) )
div:  procedure; parse arg q; if q=0  then q=1e9; return q  /*tests if dividing by zero.*/
ger:  say __ '***error*** for argument: '  uargs;   say __  arg(1);  errCode= 1;  return 0
s:    if arg(1)==1  then return arg(3);           return word( arg(2) 's', 1)
/*──────────────────────────────────────────────────────────────────────────────────────*/
ranger: parse arg ssss,ffff                      /*parse args passed to this sub.       */
        ffff= word(ffff ssss, 1)                 /*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   number 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? */
               if sols==1  & limit==1  then wols= 'A'
               say;            say wols   'solution's(sols)    "found for"    g
               if $\==24  then say  'for answers that equal'    $
               end   /*g*/
       return
/*──────────────────────────────────────────────────────────────────────────────────────*/
solve: parse arg qqqq; finds= 0;  x.=0;  nq.= x. /*parse args passed to this function.  */
       if \validate(qqqq)  then return -1
       parse value '( (( )) )'   with  L LL RR R /*assign some static variables (fastly)*/

           do jq=1  for 4;  _= substr(qqqq,jq,1) /*count the   number   of each digit.  */
           nq._= nq._ + 1
           end   /*jq*/

                    gLO= 1111;  gHI= 9999
if $==24  then do;  gLO= 1118;  gHI= 9993;  end  /*24:  lowest poss.# that has solutions*/

  do gggg=gLO  to gHI;  if pos(0, gggg)\==0  then iterate   /*ignore values with zeroes.*/
  if verify(gggg, qqqq)\==0  then iterate
  if verify(qqqq, gggg)\==0  then iterate
  ng.= 0
         do jg=1  for 4;  _= substr(gggg, jg, 1);       g.jg= _;            ng._= ng._ + 1
         end   /*jg*/                            /* [↑]  count the number of each digit.*/
                          do kg=1  for 9;   if nq.kg\==ng.kg  then iterate gggg
                          end   /*kg*/           /* [↑]  verify number has same # digits*/
    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                               /*used to generate grouped expressions.*/
            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;          !.2=L;                     !.5=R;             end
            when m==5  then do;          !.2=L;                               !.6=R;   end
            when m==6  then do; !.1=LL;                             !.5=R;    !.6=R;   end
            when m==7  then do;          !.2=LL;                    !.5=R;    !.6=R;   end
            when m==8  then do; !.1=L;   !.2=L;                               !.6=RR;  end
            when m==9  then do;          !.2=L;           !.4=L;              !.6=RR;  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.  */
          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 the last right parenthesis.     */
                          lm= pos('-', e, pd+1)  /*find a minus sign (-)    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, '][', ")(")                      /*display  [],  not  (). */
          if show  then say indent   'a solution for'  gggg':'  $"="  _ /*show solution.*/
          if limit==1 & finds==limit  then leave gggg                   /*leave big loop*/
          end     /*m*/
        end       /*k*/
      end         /*j*/
    end           /*i*/
  end             /*gggg*/
return finds
/*──────────────────────────────────────────────────────────────────────────────────────*/
sortc: procedure;  arg nnnn;           @.=        /*sorts the digits of   NNNN          */
              do i=1  for length(nnnn); _= substr(nnnn, i, 1);   @._= @._||_;   end  /*i*/
       return @.0 || @.1 || @.2 || @.3 || @.4 || @.5 || @.6 || @.7 || @.8 || @.9
/*──────────────────────────────────────────────────────────────────────────────────────*/
validate: parse arg y;               errCode= 0;                       _v= verify(y, digs)
                  select
                  when y==''         then call ger 'no digits were 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*/


# Project : 24 game

load "stdlib.ring"
digits = list(4)
check = list(4)
for choice = 1 to 4
     digits[choice] = random(9)
next

see "enter an equation (using all of, and only, the single digits " + nl
for index = 1 to 4
     see digits[index]
     if index != 4
        see " "
    ok
next
see ")"
see " which evaluates to exactly 24. only multiplication (*), division (/)," + nl
see "addition (+) & subtraction (-) operations and parentheses are allowed:" + nl
see "24 = "
give equation
see "equation = " + equation + nl

while true
        for char = 1 to len(equation)
             digit = substr("0123456789", equation[char]) - 1
             if digit >= 0
                for index = 1 to 4
                     if digit = digits[index]
                        if not check[index]
                           check[index] = 1
                           exit
                        ok
                     ok
                next
                if index > 4
                   see "sorry, you used the illegal digit " + digit + nl
                   exit 2
                ok
            ok
        next
        for index = 1 to 4
             if check[index] = 0
                see "sorry, you failed to use the digit " + digits[index] + nl
                exit 2
             ok
        next
        for pair = 11 to 99
             if substr(equation, string(pair))
                see "sorry, you may not use a pair of digits " + pair + nl
             ok
        next
        eval("result = " + equation)
        if result = 24
           see "congratulations, you succeeded in the task!" + nl
           exit
        else
           see "sorry, your equation evaluated to " + result + " rather than 24!" + nl
        ok
end


class Guess < String
  def self.play
    nums = Array.new(4){rand(1..9)}
    loop do
      result = get(nums).evaluate!
      break if result == 24.0
      puts "Try again! That gives #{result}!"
    end
    puts "You win!"
  end

  def self.get(nums)
    loop do
      print "\nEnter a guess using #{nums}: "
      input = gets.chomp
      return new(input) if validate(input, nums)
    end
  end

  def self.validate(guess, nums)
    name, error =
      {
        invalid_character:  ->(str){ !str.scan(%r{[^\d\s()+*/-]}).empty? },
        wrong_number:       ->(str){ str.scan(/\d/).map(&:to_i).sort != nums.sort },
        multi_digit_number: ->(str){ str.match(/\d\d/) }
      }
        .find {|name, validator| validator[guess] }

    error ? puts("Invalid input of a(n) #{name.to_s.tr('_',' ')}!") : true
  end

  def evaluate!
    as_rat = gsub(/(\d)/, '\1r')        # r : Rational suffix
    eval "(#{as_rat}).to_f"
  rescue SyntaxError
    "[syntax error]"
  end
end

Guess.play


use std::io::{self,BufRead};
extern crate rand;
use rand::Rng;

fn op_type(x: char) -> i32{
    match x {
        '-' | '+' => return 1,
        '/' | '*' => return 2,
        '(' | ')' => return -1,
        _   => return 0,
    }
}

fn to_rpn(input: &mut String){

    let mut rpn_string : String = String::new();
    let mut rpn_stack : String = String::new();
    let mut last_token = '#';
    for token in input.chars(){
        if token.is_digit(10) {
            rpn_string.push(token);
        }
        else if op_type(token) == 0 {
            continue;
        }
        else if op_type(token) > op_type(last_token) || token == '(' {
                rpn_stack.push(token);
                last_token=token;
        }
        else {
            while let Some(top) = rpn_stack.pop() {
                if top=='(' {
                    break;
                }
                rpn_string.push(top);
            }
            if token != ')'{
                rpn_stack.push(token);
            }
        }
    }
    while let Some(top) = rpn_stack.pop() {
        rpn_string.push(top);
    }

    println!("you formula results in {}", rpn_string);

    *input=rpn_string;
}

fn calculate(input: &String, list : &mut [u32;4]) -> f32{
    let mut stack : Vec<f32> = Vec::new();
    let mut accumulator : f32 = 0.0;

    for token in input.chars(){
        if token.is_digit(10) {
            let test = token.to_digit(10).unwrap() as u32;
            match list.iter().position(|&x| x == test){
                Some(idx) => list[idx]=10 ,
                _         => println!(" invalid digit: {} ",test),
            }
            stack.push(accumulator);
            accumulator = test as f32;
        }else{
            let a = stack.pop().unwrap();
            accumulator = match token {
                '-' => a-accumulator,
                '+' => a+accumulator,
                '/' => a/accumulator,
                '*' => a*accumulator,
                _ => {accumulator},//NOP
            };
        }
    }
    println!("you formula results in {}",accumulator);
    accumulator
}

fn main() {

    let mut rng = rand::thread_rng();
    let mut list :[u32;4]=[rng.gen::<u32>()%10,rng.gen::<u32>()%10,rng.gen::<u32>()%10,rng.gen::<u32>()%10];

    println!("form 24 with using + - / * {:?}",list);
    //get user input
    let mut input = String::new();
    io::stdin().read_line(&mut input).unwrap();
    //convert to rpn
    to_rpn(&mut input);
    let result = calculate(&input, &mut list);

    if list.iter().any(|&list| list !=10){
        println!("and you used all numbers");
        match result {
            24.0 => println!("you won"),
            _ => println!("but your formulla doesn't result in 24"),
        }
    }else{
        println!("you didn't use all the numbers");
    }

}


C:\Workset>scala TwentyFourGame
The 24 Game

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

Your four digits: 2, 7, 7, 2.
Expression 1: 2*7+2+7
Sorry, that's 23.0.
Expression 2: 7*7/2-2
Sorry, that's 22.5.
Expression 3: 2*7+(7-2)
Sorry, that's 19.0.
Expression 4: 2*(7+7-2)
That's right!
Thank you and goodbye!


#lang scheme
(require srfi/27 srfi/1) ;; random-integer, every

(define (play)
  (let* ([numbers (build-list 4 (lambda (n)
                                  (add1 (random-integer 9))))]
         [valid?  (curryr valid? numbers)])
    (printf startup-message numbers)
    (let loop ([exp (read)])
      (with-handlers ([exn:fail? (lambda (err)
                                   (printf error-message exp (exn-message err))
                                   (loop (read)))])
       (cond [(eq? exp '!) (play)]

             [(or (eq? exp 'q)
                  (eof-object? exp)) (printf quit-message)]

             [(not (valid? exp))
              (printf bad-exp-message exp)
              (loop (read))]

             [(not (= (eval exp) 24))
              (printf bad-result-message exp (eval exp))
              (loop (read))]

             [else (printf winning-message)])))))

(define (valid? exp numbers)
  ;; must contain each number exactly once and only valid symbols
  (define (valid-symbol? sym)
    ;; only +, -, *, and / are valid
    (case sym
      [(+ - * /) #t]
      [else #f]))

  (let* ([ls (flatten exp)]
         [numbers* (filter number? ls)]
         [symbols  (remove number? ls)])
    (and (equal? (sort numbers <)
                 (sort numbers* <))
         (every valid-symbol? symbols))))

(define startup-message "
Write a lisp expression that evaluates to 24
using only (, ), +, -, *, /
and these four numbers: ~a

or '!' to get a new set of numbers
or 'q' to quit")

(define error-message "
Your expression ~a raised an exception:

  \"~a\"

Please try again")

(define bad-exp-message "Sorry, ~a is a bad expression.")
(define bad-result-message "Sorry, ~a evaluates to ~a, not 24.")
(define quit-message "Thanks for playing...")
(define winning-message "You win!")

(provide play)


const digits  = (1..9 -> pick(4))
const grammar = Regex(
    '^ (?&exp) \z
      (?(DEFINE)
          (?<exp> ( (?&term) (?&op) (?&term) )+ )
          (?<term> \( (?&exp) \) | [' + digits.join + '])
          (?<op> [\-+*/] )
      )', 'x'
)

say "Here are your digits: #{digits.join(' ')}"

loop {
    var input = read("Expression: ", String)

    var expr = input
    expr -= /\s+/g     # remove all whitespace

    if (input == 'q') {
        say "Goodbye.  Sorry you couldn't win."
        break
    }

    var given_digits = digits.map{.to_s}.sort.join
    var entry_digits = input.scan(/\d/).sort.join

    if ((given_digits != entry_digits) || (expr !~ grammar)) {
        say "That's not valid"
        next
    }

    given(var n = eval(input)) {
        when (24) { say "You win!"; break }
        default   { say "Sorry, your expression is #{n}, not 24" }
    }
}


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);
          ! OUTTEXT("T = '");
          ! OUTTEXT(T);
          ! OUTTEXT("'");
          ! OUTTEXT(", T.POS = ");
          ! OUTINT(T.POS, 0);
          ! OUTTEXT(", STACKPOS = ");
          ! OUTINT(STACKPOS, 0);
          ! OUTTEXT(", T.MORE = ");
          ! OUTCHAR(IF T.MORE THEN 'T' ELSE 'F');
          ! OUTTEXT(", CH = ");
          ! OUTCHAR(CH);
          ! OUTIMAGE;
            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;

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

L:  BEGIN
        INTEGER ARRAY DIGITSUSED(0:9);
        INTEGER ARRAY DIGITSTAKEN(0:9);
        CHARACTER C, LASTC;
        TEXT INP;

        LASTC := CHAR(0);
        OUTTEXT("MAKE 24 USING THESE DIGITS: ");
        FOR I := 1 STEP 1 UNTIL 4 DO
        BEGIN
            OUTINT(DIGITS(I), 2);
            DIGITSUSED( DIGITS(I) ) := DIGITSUSED( DIGITS(I) ) + 1;
        END;
        OUTIMAGE;
        INIMAGE;
        INP :- COPY(SYSIN.IMAGE.STRIP);
        OUTIMAGE;
        WHILE INP.MORE DO
        BEGIN
            C := INP.GETCHAR;
            IF (C >= '0') AND (C <= '9') THEN
            BEGIN
                INTEGER D;
                IF (LASTC >= '0') AND (LASTC <= '9') THEN
                BEGIN
                    OUTTEXT("NUMBER HAS TOO MANY DIGITS: ");
                    OUTCHAR(LASTC);
                    OUTCHAR(C);
                    OUTIMAGE;
                    GOTO L;
                END;
                D := RANK(C) - RANK('0');
                DIGITSTAKEN(D) := DIGITSTAKEN(D) + 1;
            END
            ELSE IF NOT ((C = '+') OR (C = '-') OR (C = '/') OR (C = '*') OR
                         (C = ' ') OR (C = '(') OR (C = ')')) THEN
            BEGIN
                OUTTEXT("ILLEGAL INPUT CHARACTER: ");
                OUTCHAR(C);
                OUTIMAGE;
                GOTO L;
            END;
            LASTC := C;
        END;
        FOR I := 0 STEP 1 UNTIL 9 DO
        BEGIN
            IF DIGITSUSED(I) <> DIGITSTAKEN(I) THEN
            BEGIN
                OUTTEXT("NOT THE SAME DIGITS.");
                OUTIMAGE;
                GOTO L;
            END;
        END;
        IF E.EVAL(INP) THEN
        BEGIN
            OUTTEXT("RESULT IS ");
            OUTFIX(E.RESULT, 4, 10);
            OUTIMAGE;
            OUTTEXT(IF ABS(E.RESULT - 24) < 0.001
                    THEN "YOU WIN"
                    ELSE "YOU LOOSE");
            OUTIMAGE;
        END
        ELSE
        BEGIN
            OUTTEXT(E.ERR);
            OUTIMAGE;
        END;
    END;

END.


import Darwin
import Foundation

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

func randomDigits() -> Int[] {
    var result = Int[]();
    for var i = 0; i < 4; i++ {
        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 = Int[]()

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(digit.toInt()!)
        case "+", "-", "*", "/":
            enteredOperations.append(character)
        case "\n":
            println()
        default:
            println("Invalid expression")
    }
}

// check value of expression provided by the operator
var value = Int()

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!")
        }
    }
}

if value != 24 {
    println("The value of the provided expression is \(value) instead of 24!")
} else {
    println("Congratulations, you found a solution!")
}


# Four random non-zero digits
proc choose4 {} {
    set digits {}
    foreach x {1 2 3 4} {lappend digits [expr {int(1+rand()*9)}]}
    return [lsort $digits]
}

# Print out a welcome message
proc welcome digits {
    puts [string trim "
The 24 Game

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.
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.
    "]
    puts "\nYour four digits: $digits"
}

# Check whether we've got a legal answer
proc check {answer digits} {
    if {
	[regexp "\[^-+*/() \t[join $digits {}]\]" $answer]
	|| [regexp {\d\d} $answer]
    } then {
	return false
    }
    set digs [lsort [regexp -inline -all {\d} $answer]]
    if {$digs ne $digits} {
	return false
    }
    expr {![catch {expr $answer}]}
}

# The main game loop
proc main {} {
    fconfigure stdout -buffering none

    set digits [choose4]
    welcome $digits
    set trial 0
    while true {
	puts -nonewline "Expression [incr trial]: "
	gets stdin answer

        # Check for various types of non-answer
	if {[eof stdin] || $answer eq "q" || $answer eq "Q"} {
	    break
	} elseif {$answer eq "!"} {
	    set digits [choose4]
	    puts "New digits: $digits"
	    continue
	} elseif {![check $answer $digits]} {
	    puts "The input '$answer' was wonky!"
            continue
	}

        # Check to see if it is the right answer
	set ans [expr [regsub {\d} $answer {&.0}]]
	puts " = [string trimright $ans .0]"
	if {$ans == 24.0} {
	    puts "That's right!"
            break
	}
    }
    puts "Thank you and goodbye"
}
main


function startTwentyFourGame()
{
	if($numbers !$= "")
	{
		echo("Ending current 24 game...");
		endTwentyFourGame();
	}

	echo("Welcome to the 24 game!");
	echo("Generating 4 numbers...");
	for(%a = 0; %a < 4; %a++)
		$numbers = setWord($numbers, %a, getRandom(0, 9));

	echo("Numbers generated! Here are your numbers:");
	echo($numbers);
	echo("Use try24Equation( equation ); to try and guess the equation.");

	$TwentyFourGame = 1;
}

function endTwentyFourGame()
{
	if(!$TwentyFourGame)
	{
		echo("No 24 game is active!");
		return false;
	}

	echo("Ending the 24 game.");
	$numbers = "";
	$TwentyFourGame = 0;
}

function try24Equation(%equ)
{
	if(!$TwentyFourGame)
	{
		echo("No 24 game is active!");
		return false;
	}
	%numbers = "0123456789";
	%operators = "+-*x/()";
	%tempchars = $numbers;
	%other = strReplace(%tempchars, " ", "");

	//Check it and make sure it has all the stuff
	%equ = strReplace(%equ, " ", "");
	%length = strLen(%equ);

	for(%a = 0; %a < %Length; %a++)
	{
		%Char = getSubStr(%equ, %a, 1);
		if(%a+1 != %Length)
			%Next = getSubStr(%equ, %a+1, 1);
		else
			%Next = " ";

		if(strPos(%numbers @ %operators, %char) < 0)
		{
			echo("The equation you entered is invalid! Try again.");
			return false;
		}
		if(strPos(%tempchars, %char) < 0 && strPos(%operators, %char) < 0)
		{
			echo("The equation you entered uses a number you were not given! Try again.");
			return false;
		}
		else if(strPos(%numbers, %next) >= 0 && strPos(%numbers, %char) >= 0)
		{
			echo("No numbers above 9 please! Try again.");
			echo(%next SPC %char SPC %a);
			return false;
		}
		else if(strPos(%operators, %char) > 0)
			continue;

		%pos = 2*strPos(%other, %char);
		if(%pos < 0)
			return "ERROROMG";

		//Remove it from the allowed numbers
		%tempchars = removeWord(%tempchars, %pos/2);
		%other = getSubStr(%other, 0, %pos) @ getSubStr(%other, %pos+1, strLen(%other));
    }

    %result = doEquation(%equ);

    if(%result != 24)
    {
        echo("Your equation resulted to" SPC %result @ ", not 24! Try again.");
        return false;
    }

    for(%a = 0; %a < 4; %a++)
        $numbers = setWord($numbers, %a, getRandom(0, 9));

    echo("Great job!" SPC %equ SPC "Does result to 24! Here's another set for you:");
    echo($numbers);
}

//Evaluates an equation without using eval.
function doEquation(%equ)
{   //Validate the input
    %equ = strReplace(%equ, " ", "");%equ = strReplace(%equ, "*", "x");
    %equ = strReplace(%equ, "+", " + ");%equ = strReplace(%equ, "x", " x ");
    %equ = strReplace(%equ, "/", " / ");%equ = strReplace(%equ, "-", " - ");

    //Parenthesis'
    while(strPos(%equ, "(") > -1 && strPos(%equ, ")") > 0)
    {
        %start = strPos(%equ, "(");
        %end = %start;
        %level = 1;
        while(%level != 0 && %end != strLen(%equ))
        {
            %end++;
            if(getsubStr(%equ, %end, 1) $= "(") %level++;
            if(getsubStr(%equ, %end, 1) $= ")") %level--;
        }
        if(%level != 0)
            return "ERROR";
        %inbrackets = getsubStr(%equ, %start+1, %end - strLen(getsubStr(%equ, 0, %start + 1)));
        %leftofbrackets = getsubStr(%equ, 0, %start);
        %rightofbrackets = getsubStr(%equ, %end + 1, strLen(%equ) - %end);
        %equ = %leftofbrackets @ doEquation(%inbrackets) @ %rightofbrackets;
    }

    if(strPos(%equ, "ERROR") >= 0)
        return "ERROR";

    //Multiplication/Division loop
    for(%a = 0; %a < getWordCount(%equ); %a++)
    {
        if(getWord(%equ, %a) $= "x" || getWord(%equ, %a) $= "/" && %a != 0)
        {
            %f = getWord(%equ, %a - 1);
            %l = getWord(%equ, %a + 1);
            %o = getWord(%equ, %a);
            switch$(%o)
            {
                case "x": %a--;
                    %equ = removeWord(removeWord(setWord(%equ, %a+1, %f * %l), %a+2), %a);
                case "/": %a--;
                    %equ = removeWord(removeWord(setWord(%equ, %a+1, %f / %l), %a+2), %a);
            }
        }
    }

    //Addition/Subraction loop
    for(%a = 0; %a < getWordCount(%equ); %a++)
    {
        if(getWord(%equ, %a) $= "+" || getWord(%equ, %a) $= "-" && %a != 0)
        {
            %f = getWord(%equ, %a - 1);
            %l = getWord(%equ, %a + 1);
            %o = getWord(%equ, %a);
            switch$(%o)
            {
                case "+": %a--;
                    %equ = removeWord(removeWord(setWord(%equ, %a+1, %f + %l), %a+2), %a);
                case "-": %a--;
                    %equ = removeWord(removeWord(setWord(%equ, %a+1, %f - %l), %a+2), %a);
            }
        }
    }
    return %equ;
}


$$ MODE TUSCRIPT
BUILD X_TABLE blanks = ":': :"

SECTION game
operators="*'/'+'-'(')",numbers=""

LOOP n=1,4
number=RANDOM_NUMBERS (1,9,1)
numbers=APPEND(numbers,number)
ENDLOOP

SET allowed=APPEND (numbers,operators)
SET allowed=MIXED_SORT (allowed)
SET allowed=REDUCE (allowed)
BUILD S_TABLE ALLOWED =*
DATA '{allowed}'

SET checksum=DIGIT_SORT (numbers)

printnumbers=EXCHANGE (numbers,blanks)
printoperat=EXCHANGE (operators,blanks)

PRINT "Your numbers ", printnumbers
PRINT "Use only these operators ", printoperat
PRINT "Enter an expression that equates to 24"
PRINT "Enter 'l' for new numbers"
PRINT "Your 4 digits: ",printnumbers

DO play
ENDSECTION

SECTION check_expr
 SET pos = VERIFY (expr,allowed)
 IF (pos!=0) THEN
  PRINT "wrong entry on position ",pos
  DO play
  STOP
 ELSE
  SET yourdigits   = STRINGS (expr,":>/:")
  SET yourchecksum = DIGIT_SORT (yourdigits)
   IF (checksum!=yourchecksum) THEN
    PRINT/ERROR "wrong digits"
    DO play
    STOP
   ELSE
    CONTINUE
   ENDIF
 ENDIF
ENDSECTION

SECTION play
LOOP n=1,3
ASK   "Expression {n}": expr=""
IF (expr=="l") THEN
RELEASE S_TABLE allowed
PRINT "Your new numbers"
DO game
ELSEIF (expr!="") THEN
DO check_expr
sum={expr}
 IF (sum!=24) THEN
  PRINT/ERROR expr," not equates 24 but ",sum
  CYCLE
 ELSE
  PRINT "BINGO ", expr," equates ", sum
  STOP
 ENDIF
ELSE
 CYCLE
ENDIF
ENDLOOP
ENDSECTION
DO game


gen_digits() {
    awk 'BEGIN { srand()
                 for(i = 1; i <= 4; i++) print 1 + int(9 * rand())
         }' | sort
}

same_digits() {
    [ "$(tr -dc 0-9 | sed 's/./&\n/g' | grep . | sort)" = "$*" ]
}

guessed() {
    [ "$(echo "$1" | tr -dc '\n0-9()*/+-' | bc 2>/dev/null)" = 24 ]
}

while :
do
    digits=$(gen_digits)
    echo
    echo Digits: $digits
    read -r expr

    echo " $expr" | same_digits "$digits" || \
        { echo digits should be: $digits; continue; }

    guessed "$expr" && message=correct \
                    || message=wrong

    echo $message
done


Sub Rosetta_24game()

Dim Digit(4) As Integer, i As Integer, iDigitCount As Integer
Dim stUserExpression As String
Dim stFailMessage As String, stFailDigits As String
Dim bValidExpression As Boolean, bValidDigits As Boolean, bValidChars As Boolean
Dim vResult As Variant, vTryAgain As Variant, vSameDigits As Variant

' Generate 4 random digits
GenerateNewDigits:
    For i = 1 To 4
        Digit(i) = [randbetween(1,9)]
    Next i

' Get user expression
GetUserExpression:
    bValidExpression = True
    stFailMessage = ""
    stFailDigits = ""
    stUserExpression = InputBox("Enter a mathematical expression which results in 24, using the following digits: " & _
        Digit(1) & ", " & Digit(2) & ", " & Digit(3) & " and " & Digit(4), "Rosetta Code | 24 Game")

' Check each digit is included in user expression
    bValidDigits = True
    stFailDigits = ""
    For i = 1 To 4
        If InStr(stUserExpression, Digit(i)) = 0 Then
            bValidDigits = False
            stFailDigits = stFailDigits & " " & Digit(i)
        End If
    Next i
    If bValidDigits = False Then
        bValidExpression = False
        stFailMessage = "Your expression excluded the following required digits: " & stFailDigits & vbCr & vbCr
    End If

' Check each character of user expression is a valid character type
    bValidDigits = True
    stFailDigits = ""
    For i = 1 To Len(stUserExpression)
        If InStr("0123456789+-*/()", Mid(stUserExpression, i, 1)) = 0 Then
            bValidDigits = False
            stFailDigits = stFailDigits & " " & Mid(stUserExpression, i, 1)
        End If
    Next i
    If bValidDigits = False Then
        bValidExpression = False
        stFailMessage = stFailMessage & "Your expression contained invalid characters:" & stFailDigits & vbCr & vbCr
    End If

' Check no disallowed integers entered
    bValidDigits = True
    stFailDigits = ""
    iDigitCount = 0
    For i = 1 To Len(stUserExpression)
        If Not InStr("0123456789", Mid(stUserExpression, i, 1)) = 0 Then
            iDigitCount = iDigitCount + 1
            If IsError(Application.Match(--(Mid(stUserExpression, i, 1)), Digit, False)) Then
                bValidDigits = False
                stFailDigits = stFailDigits & " " & Mid(stUserExpression, i, 1)
            End If
        End If
    Next i
    If iDigitCount > 4 Then
        bValidExpression = False
        stFailMessage = stFailMessage & "Your expression contained more than 4 digits" & vbCr & vbCr
    End If
        If iDigitCount < 4 Then
        bValidExpression = False
        stFailMessage = stFailMessage & "Your expression contained less than 4 digits" & vbCr & vbCr
    End If
    If bValidDigits = False Then
        bValidExpression = False
        stFailMessage = stFailMessage & "Your expression contained invalid digits:" & stFailDigits & vbCr & vbCr
    End If

' Check no double digit numbers entered
    bValidDigits = True
    stFailDigits = ""
    For i = 11 To 99
        If Not InStr(stUserExpression, i) = 0 Then
            bValidDigits = False
            stFailDigits = stFailDigits & " " & i
        End If
    Next i
    If bValidDigits = False Then
        bValidExpression = False
        stFailMessage = stFailMessage & "Your expression contained invalid numbers:" & stFailDigits & vbCr & vbCr
    End If

' Check result of user expression
    On Error GoTo EvalFail
    vResult = Evaluate(stUserExpression)
    If Not vResult = 24 Then
        bValidExpression = False
        stFailMessage = stFailMessage & "Your expression did not result in 24. It returned: " & vResult
    End If

' Return results
    If bValidExpression = False Then
        vTryAgain = MsgBox(stFailMessage & vbCr & vbCr & "Would you like to try again?", vbCritical + vbRetryCancel, "Rosetta Code | 24 Game | FAILED")
            If vTryAgain = vbRetry Then
                vSameDigits = MsgBox("Do you want to use the same numbers?", vbQuestion + vbYesNo, "Rosetta Code | 24 Game | RETRY")
                If vSameDigits = vbYes Then
                    GoTo GetUserExpression
                Else
                    GoTo GenerateNewDigits
                End If
            End If
    Else
        vTryAgain = MsgBox("You entered: " & stUserExpression & vbCr & vbCr & "which resulted in: " & vResult, _
            vbInformation + vbRetryCancel, "Rosetta Code | 24 Game | SUCCESS")
        If vTryAgain = vbRetry Then
            GoTo GenerateNewDigits
        End If
    End If
    Exit Sub
EvalFail:
    bValidExpression = False
    vResult = Err.Description
    Resume
End Sub


import os
import rand
import rand.seed
import math

fn main() {
    rand.seed(seed.time_seed_array(2))
    mut n := []int{len: 4}
    for i in 0.. n.len {
        n[i] = rand.intn(9) or {0}
    }
    println("Your numbers: $n")
    expr := os.input("Enter RPN: ")
    if expr.len != 7 {
        println("invalid. expression length must be 7." +
            " (4 numbers, 3 operators, no spaces)")
        return
    }
    mut stack := []f64{len: 0, cap:4}
    for r in expr.split('') {
        if r >= '0' && r <= '9' {
            if n.len == 0 {
                println("too many numbers.")
                return
            }
            mut i := 0
            for n[i] != r.int() {
                i++
                if i == n.len {
                    println("wrong numbers.")
                    return
                }
            }
            n.delete(n.index(r.int()))
            stack << f64(r[0]-'0'[0])
            continue
        }
        if stack.len < 2 {
            println("invalid expression syntax.")
            return
        }
        match r {
            '+' {
                stack[stack.len-2] += stack[stack.len-1]
            }
            '-' {
                stack[stack.len-2] -= stack[stack.len-1]
            }
            '*' {
                stack[stack.len-2] *= stack[stack.len-1]
            }
            '/' {
                stack[stack.len-2] /= stack[stack.len-1]
            }
            else {
                println("$r invalid.")
                return
            }
        }
        stack = stack[..stack.len-1]
    }
    if math.abs(stack[0]-24) > 1e-6 {
        println("incorrect. ${stack[0]} != 24")
    } else {
        println("correct.")
    }
}


import "random" for Random
import "/ioutil" for Input
import "/seq" for Stack

var R = Random.new()

class Game24 {
    static run() {
        var digits = List.filled(4, 0)
        for (i in 0..3) digits[i] = R.int(1, 10)
        System.print("Make 24 using these digits: %(digits)")
        var cin = Input.text("> ")
        var s = Stack.new()
        var total = 0
        for (c in cin) {
            var d = c.bytes[0]
            if (d >= 48 && d <= 57) {
                d = d - 48
                total = total + (1 << (d*5))
                s.push(d)
            } else if ("+-*/".indexOf(c) != -1) s.push(applyOperator_(s.pop(), s.pop(), c))
        }
        if (tallyDigits_(digits) != total) {
            System.write("Not the same digits.")
        } else if ((24 - s.peek()).abs < 0.001) {
            System.print("Correct!")
        } else {
            System.write("Not correct.")
        }
    }

    static applyOperator_(a, b, c) {
        if (c == "+") return a + b
        if (c == "-") return b - a
        if (c == "*") return a * b
        if (c == "/") return b / a
        return 0/0
    }

    static tallyDigits_(a) {
        var total = 0
        for (i in 0...a.count) total = total + (1 << (a[i]*5))
        return total
    }
}

Game24.run()


operadores$ = "*/+-"
espacios$ = "                                                                                "

clear screen
print "24 Game"
print "============\n"
print "The player is provided with 4 numbers with which to perform operations"
print "of addition (+), subtraction (-), multiplication (*) or division (/) to attempt"
print "to get 24 as result."
print "Use reverse Polish notation (first the operands and then the operators)."
print "For example: instead of 2 + 4, type 2 4 +\n\n"

repeat
	print at(0,9) espacios$, espacios$, espacios$, espacios$, espacios$, espacios$
	print at(0,9);
	serie$ = ordenaCadena$(genSerie$())
	validos$ = serie$+operadores$
	line input "Enter your formula in reverse Polish notation: " entrada$
	entrada$ = quitaEspacios$(entrada$)
	entradaOrd$ = ordenaCadena$(entrada$)
	if (right$(entradaOrd$,4) <> serie$) or (len(entradaOrd$)<>7) then
		print "Error in the entered series"
	else
		resultado = evaluaEntrada(entrada$)
		print "The result is = ",resultado," "
		if resultado = 24 then
			print "Correct!"
		else
			print "Error!"
		end if
	end if
	print "Want to try again? (press N to exit, or another key to continue)"
until(upper$(left$(inkey$(),1)) = "N")

sub genSerie$()
	local i, c$, s$

	print "The numbers to be used are: ";
	i = ran()
	for i = 1 to 4
		c$ = str$(int(ran(9))+1)
		print c$," ";
		s$ = s$ + c$
	next i
	print
	return s$
end sub

sub evaluaEntrada(entr$)
	local d1, d2, c$, n(4), i

	while(entr$<>"")
		c$ = left$(entr$,1)
		entr$ = mid$(entr$,2)
		if instr(serie$,c$) then
			i = i + 1
			n(i) = val(c$)
		elseif instr(operadores$,c$) then
			d2 = n(i)
			n(i) = 0
			i = i - 1
			d1 = n(i)
			n(i) = evaluador(d1, d2, c$)
		else
			print "Invalid sign"
			return
		end if
	wend

	return n(i)

end sub

sub evaluador(d1, d2, op$)
	local t

	switch op$
		case "+": t = d1 + d2 : break
		case "-": t = d1 - d2 : break
		case "*": t = d1 * d2 : break
		case "/": t = d1 / d2 : break
	end switch

	return t
end sub

sub quitaEspacios$(entr$)
	local n, i, s$, t$(1)

	n = token(entr$,t$()," ")

	for i=1 to n
		s$ = s$ + t$(i)
	next i
	return s$
end sub

sub ordenaCadena$(cadena$)
	local testigo, n, fin, c$

	fin = len(cadena$)-1
	repeat
		testigo = false
		for n = 1 to fin
			if mid$(cadena$,n,1) > mid$(cadena$,n+1,1) then
				testigo = true
				c$ = mid$(cadena$,n,1)
				mid$(cadena$,n,1) = mid$(cadena$,n+1,1)
				mid$(cadena$,n+1,1) = c$
			end if
		next n
	until(testigo = false)
	return cadena$
end sub


while(1){
   digits := [1..4].pump(String,(0).random.fpM("11-",1,9));
   exp := ask("Enter an expression using the digits ",digits,
	      " that evals to 24: ") - " \n";
   expf:=exp.apply(fcn(c){if ("1"<=c<="9") "(%s).toFloat()".fmt(c) else c});
   reg r;
   try { Compiler.Compiler.compileText(expf).__constructor(); r=vm.regX }
   catch { println("bad expression"); continue; }
   else{
      extra := (exp - "+-/*()" - digits);
      if (extra) { println("Extra goodies in expression: ",extra); continue; }
      (digits.split("").sort() != (exp - "+-/*()").split("").sort()) :
         if(_) { println("You can only use the digits ",digits," once each"); continue; };
      if (exp.matches("*[1-9][1-9]*"))
	 { println("no repeated digits"); continue; }
      if (r.closeTo(24,0.001)) "nice!".println();
      else println("That evaled to ",r,", not 24");
   }
}


10 LET n$=""
20 RANDOMIZE
30 FOR i=1 TO 4
40 LET n$=n$+STR$ (INT (RND*9)+1)
50 NEXT i
60 LET i$="": LET f$="": LET p$=""
70 CLS
80 PRINT "24 game"
90 PRINT "Allowed characters:"
100 LET i$=n$+"+-*/()"
110 PRINT AT 4,0;
120 FOR i=1 TO 10
130 PRINT i$(i);" ";
140 NEXT i
150 PRINT "(0 to end)"
160 INPUT "Enter the formula";f$
170 IF f$="0" THEN STOP
180 PRINT AT 6,0;f$;" = ";
190 FOR i=1 TO LEN f$
200 LET c$=f$(i)
210 IF c$=" " THEN LET f$(i)="": GO TO 250
220 IF c$="+" OR c$="-" OR c$="*" OR c$="/" THEN LET p$=p$+"o": GO TO 250
230 IF c$="(" OR c$=")" THEN LET p$=p$+c$: GO TO 250
240 LET p$=p$+"n"
250 NEXT i
260 RESTORE
270 FOR i=1 TO 11
280 READ t$
290 IF t$=p$ THEN LET i=11
300 NEXT i
310 IF t$<>p$ THEN PRINT INVERSE 1;"Bad construction!": BEEP 1,.1: PAUSE 0: GO TO 60
320 FOR i=1 TO LEN f$
330 FOR j=1 TO 10
340 IF (f$(i)=i$(j)) AND f$(i)>"0" AND f$(i)<="9" THEN LET i$(j)=" "
350 NEXT j
360 NEXT i
370 IF i$( TO 4)<>"    " THEN PRINT FLASH 1;"Invalid arguments!": BEEP 1,.01: PAUSE 0: GO TO 60
380 LET r=VAL f$
390 PRINT r;" ";
400 IF r<>24 THEN PRINT FLASH 1;"Wrong!": BEEP 1,1: PAUSE 0: GO TO 60
410 PRINT FLASH 1;"Correct!": PAUSE 0: GO TO 10
420 DATA "nononon"
430 DATA "(non)onon"
440 DATA "nono(non)"
450 DATA "no(no(non))"
460 DATA "((non)on)on"
470 DATA "no(non)on"
480 DATA "(non)o(non)"
485 DATA "no((non)on)"
490 DATA "(nonon)on"
495 DATA "(no(non))on"
500 DATA "no(nonon)"


F play_random(n)
   V pardoned = 0
   V in_drawer = Array(0.<100)
   V sampler = Array(0.<100)
   L 0 .< n
      random:shuffle(&in_drawer)
      V found = 0B
      L(prisoner) 100
         found = 0B
         L(reveal) random:sample(sampler, 50)
            V card = in_drawer[reveal]
            I card == prisoner
               found = 1B
               L.break
         I !found
            L.break
      I found
         pardoned++
   R Float(pardoned) / n * 100

F play_optimal(n)
   V pardoned = 0
   V in_drawer = Array(0.<100)
   L 0 .< n
      random:shuffle(&in_drawer)
      V found = 0B
      L(prisoner) 100
         V reveal = prisoner
         found = 0B
         L 50
            V card = in_drawer[reveal]
            I card == prisoner
               found = 1B
               L.break
            reveal = card
         I !found
            L.break
      I found
         pardoned++
   R Float(pardoned) / n * 100

V n = 100'000
print(‘ Simulation count: ’n)
print(‘ Random play wins: #2.1% of simulations’.format(play_random(n)))
print(‘Optimal play wins: #2.1% of simulations’.format(play_optimal(n)))


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program prisonniex64.s   */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"

.equ NBDOORS,   100
.equ NBLOOP, 1000

/*********************************/
/* Initialized data              */
/*********************************/
.data
sMessResult:        .asciz "Random strategie  : @ sur 1000 \n"
sMessResultOPT:     .asciz "Optimal strategie : @ sur 1000 \n"
szCarriageReturn:   .asciz "\n"
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:        .skip 24
tbDoors:          .skip 8 * NBDOORS
tbTest:           .skip 8 * NBDOORS
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                 // entry of program

    ldr x1,qAdrtbDoors
    mov x2,#0
1:                                    // loop init doors table
    add x3,x2,#1
    str x3,[x1,x2,lsl #3]
    add x2,x2,#1
    cmp x2,#NBDOORS
    blt 1b

    mov x9,#0                         // loop counter
    mov x10,#0                        // counter successes random strategie
    mov x11,#0                        // counter successes optimal strategie
2:
    ldr x0,qAdrtbDoors
    mov x1,#NBDOORS
    bl knuthShuffle

    ldr x0,qAdrtbDoors
    bl aleaStrategie
    cmp x0,#NBDOORS
    cinc x10,x10,eq

    ldr x0,qAdrtbDoors
    bl optimaStrategie
    cmp x0,#NBDOORS
    cinc x11,x11,eq

    add x9,x9,#1
    cmp x9,#NBLOOP
    blt 2b

    mov x0,x10                        // result display
    ldr x1,qAdrsZoneConv
    bl conversion10                   // call decimal conversion
    ldr x0,qAdrsMessResult
    ldr x1,qAdrsZoneConv              // insert conversion in message
    bl strInsertAtCharInc
    bl affichageMess

    mov x0,x11                        // result display
    ldr x1,qAdrsZoneConv
    bl conversion10                   // call decimal conversion
    ldr x0,qAdrsMessResultOPT
    ldr x1,qAdrsZoneConv              // insert conversion in message
    bl strInsertAtCharInc
    bl affichageMess

100:                                  // standard end of the program
    mov x0,0                          // return code
    mov x8,EXIT                       // request to exit program
    svc 0                             // perform the system call

qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrsMessResult:          .quad sMessResult
qAdrsMessResultOPT:       .quad sMessResultOPT
qAdrtbDoors:              .quad tbDoors
qAdrtbTest:               .quad tbTest
qAdrsZoneConv:            .quad sZoneConv
/******************************************************************/
/*            random door test strategy                           */
/******************************************************************/
/* x0 contains the address of table */
aleaStrategie:
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    ldr x6,qAdrtbTest            // table doors tests address
    mov x8,x0                    // save table doors address
    mov x4,#0                    // counter number of successes
    mov x2,#0                    // prisonners indice
1:
    bl razTable                  // zero to table doors tests
    mov x5,#0                    // counter of door tests
    add x7,x2,#1
2:
    mov x0,#1
    mov x1,#NBDOORS
    bl extRandom                 // random test
    ldr x3,[x6,x0,lsl #3]        // doors also tested ?
    cmp x3,#0
    bne 2b                       // yes
    ldr x3,[x8,x0,lsl #3]        // load N° door
    cmp x3,x7                    // compar N° door N° prisonner
    cinc x4,x4,eq
    beq 3f
    mov x3,#1                    // top test table item
    str x3,[x6,x0,lsl #3]
    add x5,x5,#1
    cmp x5,#NBDOORS / 2          // number tests maxi ?
    blt 2b                       // no -> loop
3:
    add x2,x2,#1                 // other prisonner
    cmp x2,#NBDOORS
    blt 1b

    mov x0,x4                    // return number of successes
100:
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*     raz test table                                             */
/******************************************************************/
razTable:
    stp x0,lr,[sp,-16]!        // save  registres
    stp x1,x2,[sp,-16]!        // save  registres
    ldr x0,qAdrtbTest
    mov x1,#0                  // item indice
    mov x2,#0
1:
    str x2,[x0,x1,lsl #3]      // store zero à item
    add x1,x1,#1
    cmp x1,#NBDOORS
    blt 1b
100:
    ldp x1,x2,[sp],16          // restaur des  2 registres
    ldp x0,lr,[sp],16          // restaur des  2 registres
    ret
/******************************************************************/
/*            random door test strategy                           */
/******************************************************************/
/* x0 contains the address of table */
optimaStrategie:
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    mov x4,#0                    // counter number of successes
    mov x2,#0                    // counter prisonner
1:
    mov x5,#0                    // counter test
    mov x1,x2                    // first test = N° prisonner
2:
    ldr x3,[x0,x1,lsl #3]        // load N° door
    cmp x3,x2
    cinc x4,x4,eq                // equal -> succes
    beq 3f
    mov x1,x3                    // new test with N° door
    add x5,x5,#1
    cmp x5,#NBDOORS / 2          // test number maxi ?
    blt 2b
3:
    add x2,x2,#1                 // other prisonner
    cmp x2,#NBDOORS
    blt 1b

    mov x0,x4
100:
    ldp x4,x5,[sp],16          // restaur des  2 registres
    ldp x2,x3,[sp],16          // restaur des  2 registres
    ldp x1,lr,[sp],16          // restaur des  2 registres
    ret
/******************************************************************/
/*     knuth Shuffle                                  */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the number of elements */
knuthShuffle:
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!         // save  registers
    mov x5,x0                   // save table address
    mov x6,x1                   // save number of elements
    mov x2,0                    // start index
1:
    mov x0,0
    mov x1,x2                   // generate aleas
    bl extRandom
    ldr x3,[x5,x2,lsl #3]        // swap number on the table
    ldr x4,[x5,x0,lsl #3]
    str x4,[x5,x2,lsl #3]
    str x3,[x5,x0,lsl #3]
    add x2,x2,#1                 // next number
    cmp x2,x6                    // end ?
    blt 1b                       // no -> loop
100:
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret

/******************************************************************/
/*     random number                                          */
/******************************************************************/
/*  x0 contains inferior value */
/*  x1 contains maxi value */
/*  x0 return random number */
extRandom:
    stp x1,lr,[sp,-16]!        // save  registers
    stp x2,x8,[sp,-16]!        // save  registers
    stp x3,x4,[sp,-16]!        // save  registers
    stp x19,x20,[sp,-16]!      // save  registers
    sub sp,sp,16               // reserve 16 octets on stack
    mov x19,x0
    add x20,x1,1
    mov x0,sp                  // store result on stack
    mov x1,8                   // length 8 bytes
    mov x2,0
    mov x8,278                 //  call system Linux 64 bits Urandom
    svc 0
    mov x0,sp                  // load résult on stack
    ldr x0,[x0]
    sub x2,x20,x19             // calculation of the range of values
    udiv x1,x0,x2              // calculation range modulo
    msub x0,x1,x2,x0
    add  x0,x0,x19             // and add inferior value
100:
    add sp,sp,16               // alignement stack
    ldp x19,x20,[sp],16        // restaur  2 registers
    ldp x3,x4,[sp],16          // restaur  2 registers
    ldp x2,x8,[sp],16          // restaur  2 registers
    ldp x1,lr,[sp],16          // restaur  2 registers
    ret                        // return to address lr x30
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


package Prisoners is

   type Win_Percentage is digits 2 range 0.0 .. 100.0;
   type Drawers is array (1 .. 100) of Positive;

   function Play_Game
     (Repetitions : in Positive;
      Strategy    :    not null access function
        (Cupboard     : in Drawers; Max_Prisoners : Integer;
         Max_Attempts :    Integer; Prisoner_Number : Integer) return Boolean)
      return Win_Percentage;
   -- Play the game with a specified number of repetitions, the chosen strategy
   -- is passed to this function

   function Optimal_Strategy
     (Cupboard : in Drawers; Max_Prisoners : Integer; Max_Attempts : Integer;
      Prisoner_Number :    Integer) return Boolean;

   function Random_Strategy
     (Cupboard : in Drawers; Max_Prisoners : Integer; Max_Attempts : Integer;
      Prisoner_Number :    Integer) return Boolean;

end Prisoners;


∇ R ← random Nnc; N; n; c
  (N n c) ← Nnc
  R ← ∧/{∨/⍵=c[n?N]}¨⍳N
∇

∇ R ← follow Nnc; N; n; c; b
  (N n c) ← Nnc
  b ← n N⍴⍳N
  R ← ∧/∨⌿b={⍺⊢c[⍵]}⍀n N⍴c
∇

∇ R ← M timesSimPrisoners Nn; N; n; m; c; r; s
  (N n) ← Nn
  R ← 0 0
  m ← M
  LOOP: c←N?N
  r ← random N n c
  s ← follow N n c
  R ← R + r,s
  →((m←m-1)>0)/LOOP
  R ← R ÷ M
∇

5000 timesSimPrisoners 100 50


0 GOTO 9

1 FOR X = 0 TO N:J(X) = X: NEXT: FOR I = 0 TO N:FOR X = 0 TO N:T = J(X):NP =  INT ( RND (1) * H):J(X) = J(NP):J(NP) = T: NEXT :FOR G = 1 TO W:IF D(J(G)) = I THEN IP = IP + 1: NEXT I: RETURN
2 NEXT G:RETURN

3 FOR I = 0 TO N:NG = I: FOR G = 0 TO W:CD = D(NG):IF CD = I THEN IP = IP + 1: NEXT I: RETURN
4 NG = CD:IF CD = I THEN STOP
5 NEXT G: RETURN

9 H=100:N=H-1:DIM D(99),J(99):FOR I = 0 TO N:D(I) = I: NEXT:W=INT(H/2)-1:M$=CHR$(13):M$(1)="RANDOM GUESSING":M$(2)="CHAINED NUMBER PICKING"

1000 FOR Q = 0 TO 1 STEP 0 : HOME : PRINT "100 PRISONERS"M$: INPUT "HOW MANY TRIALS FOR EACH METHOD? ";  TT
1010     VTAB 2:CALL-958:PRINT M$"RESULTS:"M$
1020     FOR M = 1 TO 2: SU(M) = 0:FA(M) = 0
1030         FOR TN = 1 TO TT
1040             VTAB 4:PRINT M$ "   OUT OF " TT " TRIALS, THE RESULTS ARE"M$"   AS FOLLOWS...";
1050             IP = 0: X =  RND ( - TI): FOR I = 0 TO N:R =  INT ( RND (1) * N):T = D(I):D(I) = D(R):D(R) = T: NEXT
1060             ON M GOSUB 1,3 : SU(M) = SU(M) + (IP = H):FA(M) = FA(M) + (IP < H)
1070             FOR Z = 1 TO 2
1071                 PRINT M$M$Z". "M$(Z)":"M$
1073                 PRINT "   "SU(Z)" SUCCESSES"TAB(21)
1074                 PRINT "   "FA(Z)" FAILURES"M$
1075                 PRINT "   "(SU(Z) / TT) * 100"% SUCCESS RATE.";:CALL-868
1090     NEXT Z,TN,M

1100     PRINT M$M$"AGAIN?"
1110     GET K$
1120     Q = K$ <> "Y" AND K$ <> CHR$(ASC("Y") + 32) : NEXT Q