The 24 Game tests one's mental arithmetic.



Task
Write a program that randomly chooses and displays four digits, each from 1 ──► 9 (inclusive) with repetitions allowed.

The program should prompt for the player to enter an arithmetic expression using just those, and all of those four digits, used exactly once each. The program should check then evaluate the expression.

The goal is for the player to enter an expression that (numerically) evaluates to 24.

 Only the following operators/functions are allowed: multiplication, division, addition, subtraction
 Division should use floating point or rational arithmetic, etc, to preserve remainders.
 Brackets are allowed, if using an infix expression evaluator.
 Forming multiple digit numbers from the supplied digits is disallowed. (So an answer of 12+12 when given 1, 2, 2, and 1 is wrong).
 The order of the digits when given does not have to be preserved.


Notes
 The type of expression evaluator used is not mandated. An RPN evaluator is equally acceptable for example.
 The task is not for the program to generate the expression, or test whether an expression is even possible.


Related tasks
 24 game/Solve


Reference
 The 24 Game on h2g2.


 
' The 24 game en FreeBASIC
 
Const operaciones = "*/+-"
 
Declare Sub Encabezado
Declare Function escoge4() As String
Declare Function quitaEspacios(cadena As String, subcadena1 As String, subcadena2 As String) As String   
Declare Function evaluaEntrada(cadena As String) As Integer
Declare Function evaluador(oper1 As Byte, oper2 As Byte, operacion As String) As Integer
 
Dim Shared As String serie, entrada, cadena
Dim As Integer resultado
 
Sub Encabezado
    Cls: Color 15
    Print "The 24 Game"
    Print "============" + Chr(13) + Chr(10)
    Print "Dados cuatro dígitos en el rango de 1 a 9, que pueden repetirse, "
    Print "usando solo los operadores aritméticos suma (+), resta (-), "
    Print "multiplicación (*) y división (/) intentar obtener un resultado de 24." + Chr(13) + Chr(10)
    Print "Use la notación polaca inversa (primero los operandos y luego los operadores)."
    Print "Por ejemplo: en lugar de 2 + 4, escriba 2 4 +" + Chr(13) + Chr(10)
End Sub 
 
Function escoge4() As String
    Dim As Byte i
    Dim As String a, b
 
    Print "Los dígitos a utilizar son:   ";
    For i = 1 To 4
	a = Str(Int(Rnd*9)+1)
	Print a;"      ";
	b = b + a
    Next i
    escoge4 = b
End Function
 
Function evaluaEntrada(cadena As String) As Integer
    Dim As Byte oper1, oper2, n(4), i
    Dim As String op
    oper1 = 0: oper2 = 0: i = 0
 
    While cadena <> ""
	op = Left(cadena, 1)
	entrada = Mid(cadena, 2)	
	If Instr(serie, op) Then
		i = i + 1
		n(i) = Val(op)
        Elseif Instr(operaciones, op) Then
		oper2 = n(i)
		n(i) = 0
		i = i - 1
		oper1 = n(i)
		n(i) = evaluador(oper1, oper2, op)
        Else
		Print "Signo no v lido"
        End If
    Wend   
    evaluaEntrada = n(i)
End Function
 
Function evaluador(oper1 As Byte, oper2 As Byte, operacion As String) As Integer
    Dim As Integer t
 
    Select Case operacion
    Case "+": t = oper1 + oper2
    Case "-": t = oper1 - oper2
    Case "*": t = oper1 * oper2
    Case "/": t = oper1 / oper2
    End Select
 
    evaluador = t
End Function
 
Function quitaEspacios(cadena As String, subcadena1 As String, subcadena2 As String) As String   
    Dim As Byte len1 = Len(subcadena1), len2 = Len(subcadena2)
    Dim As Byte i
 
    i = Instr(cadena, subcadena1)
    While i
        cadena = Left(cadena, i - 1) & subcadena2 & Mid(cadena, i + len1)
        i = Instr(i + len2, cadena, subcadena1)
    Wend
    quitaEspacios = cadena
End Function
 
'--- Programa Principal ---
Randomize Timer
Do
    Encabezado
    serie = escoge4
    Print: Line Input "Introduzca su fórmula en notación polaca inversa: ", entrada
    entrada = quitaEspacios(entrada, " ", "")
    If (Len(entrada) <> 7) Then
        Print "Error en la serie introducida."
    Else
        resultado = evaluaEntrada(entrada)
        Print "El resultado es = "; resultado
        If resultado = 24 Then
            Print "¡Correcto!"
        Else
            Print "¡Error!"
        End If
    End If
    Print "¿Otra ronda? (Pulsa S para salir, u otra tecla para continuar)"
Loop Until (Ucase(Input(1)) = "S")
End
'--------------------------
 