A truth table is a display of the inputs to, and the output of a Boolean function organized as a table where each row gives one combination of input values and the corresponding value of the function.



Task

 Input a Boolean function from the user as a string then calculate and print a formatted truth table for the given function.
 (One can assume that the user input is correct).
 Print and show output for Boolean functions of two and three input variables, but any program should not be limited to that many variables in the function. 
 Either reverse-polish or infix notation expressions are allowed.


Related tasks

   Boolean values
   Ternary logic


See also

   Wolfram MathWorld entry on truth tables.
   some "truth table" examples from Google.


 
PROGRAM "truthtables"
VERSION "0.001"
 
$$MaxTop = 80
 
TYPE VARIABLE
  STRING*1 .name
  SBYTE .value
END TYPE
 
TYPE STACKOFBOOL
  SSHORT .top
  SBYTE .elements[$$MaxTop]
END TYPE
 
DECLARE FUNCTION Entry()
INTERNAL FUNCTION IsOperator(c$)
INTERNAL FUNCTION VariableIndex(c$)
INTERNAL FUNCTION SetVariables(pos%)
INTERNAL FUNCTION ProcessExpression()
INTERNAL FUNCTION EvaluateExpression()
 
' Stack manipulation functions
INTERNAL FUNCTION IsFull(STACKOFBOOL @s)
INTERNAL FUNCTION IsEmpty(STACKOFBOOL @s)
INTERNAL FUNCTION Peek(STACKOFBOOL @s)
INTERNAL FUNCTION Push(STACKOFBOOL @s, val@)
INTERNAL FUNCTION Pop(STACKOFBOOL @s)
INTERNAL FUNCTION MakeEmpty(STACKOFBOOL @s)
INTERNAL FUNCTION ElementsCount(STACKOFBOOL @s)
 
FUNCTION Entry()
  SHARED VARIABLE variables[]
  SHARED variablesLength%
  SHARED expression$
 
  DIM variables[23]
  PRINT "Accepts single-character variables (except for 'T' and 'F',"
  PRINT "which specify explicit true or false values), postfix, with"
  PRINT "&|!^ for and, or, not, xor, respectively; optionally"
  PRINT "seperated by space. Just enter nothing to quit."
  DO
    PRINT
    expression$ = INLINE$("Boolean expression: ")
    ProcessExpression()
    IF LEN(expression$) = 0 THEN
      EXIT DO
    END IF
    variablesLength% = 0
    FOR i% = 0 TO LEN(expression$) - 1
      e$ = CHR$(expression${i%})
      IF (!IsOperator(e$)) && (e$ <> "T") && (e$ <> "F") && (VariableIndex(e$) = -1) THEN
        variables[variablesLength%].name = LEFT$(e$, 1)
        variables[variablesLength%].value = $$FALSE
        INC variablesLength%
      END IF
    NEXT i%
    PRINT
    IF variablesLength% = 0 THEN
      PRINT "No variables were entered."
    ELSE
      FOR i% = 0 TO variablesLength% - 1
        PRINT variables[i%].name; "  ";
      NEXT i%
      PRINT expression$
      PRINT CHR$(ASC("="), variablesLength% * 3 + LEN(expression$))
      SetVariables(0)
    END IF
  LOOP
END FUNCTION
 
' Removes space and converts to upper case
FUNCTION ProcessExpression()
  SHARED expression$
  '
  exprTmp$ = ""
  FOR i% = 0 TO LEN(expression$) - 1
    IF CHR$(expression${i%}) <> " " THEN
      exprTmp$ = exprTmp$ + UCASE$(CHR$(expression${i%}))
    END IF
  NEXT i%
  expression$ = exprTmp$
END FUNCTION
 
FUNCTION IsOperator(c$)
  RETURN (c$ = "&") || (c$ = "|") || (c$ = "!") || (c$ = "^")
END FUNCTION
 
FUNCTION VariableIndex(c$)
  SHARED VARIABLE variables[]
  SHARED variablesLength%
  '
  FOR i% = 0 TO variablesLength% - 1
    IF variables[i%].name = c$ THEN
      RETURN i%
    END IF
  NEXT i%
  RETURN -1
END FUNCTION
 
FUNCTION SetVariables(pos%)
  SHARED VARIABLE variables[]
  SHARED variablesLength%
  '
  SELECT CASE TRUE
    CASE pos% > variablesLength%:
      PRINT
      PRINT "Argument to SetVariables cannot be greater than the number of variables."
      QUIT(1)
    CASE pos% = variablesLength%:
      FOR i% = 0 TO variablesLength% - 1
        IF variables[i%].value THEN
          PRINT "T  ";
        ELSE
          PRINT "F  ";
        END IF
      NEXT i%
      IF EvaluateExpression() THEN
        PRINT "T"
      ELSE
        PRINT "F"
      END IF
    CASE ELSE:
      variables[pos%].value = $$FALSE
      SetVariables(pos% + 1)
      variables[pos%].value = $$TRUE
      SetVariables(pos% + 1)
  END SELECT
END FUNCTION
 
FUNCTION EvaluateExpression()
  SHARED VARIABLE variables[]
  SHARED expression$
  STACKOFBOOL s
  '
  MakeEmpty(@s)
  FOR i% = 0 TO LEN(expression$) - 1
    e$ = CHR$(expression${i%})
    vi% = VariableIndex(e$)
    SELECT CASE TRUE
      CASE e$ = "T":
        Push(@s, $$TRUE)
      CASE e$ = "F":
        Push(@s, $$FALSE)
      CASE vi% >= 0:
        Push(@s, variables[vi%].value)
      CASE ELSE:
        SELECT CASE e$
          CASE "&":
            Push(@s, Pop(@s) & Pop(@s))
          CASE "|":
            Push(@s, Pop(@s) | Pop(@s))
          CASE "!":
            Push(@s, !Pop(@s))
          CASE "^":
            Push(@s, Pop(@s) ^ Pop(@s))
          CASE ELSE:
            PRINT
            PRINT "Non-conformant character "; e$; " in expression.";
            QUIT(1)
        END SELECT
    END SELECT
  NEXT i%
  IF ElementsCount(@s) <> 1 THEN
    PRINT
    PRINT "Stack should contain exactly one element."
    QUIT(1)
  END IF
  RETURN Peek(@s)
END FUNCTION
 
FUNCTION IsFull(STACKOFBOOL s)
  RETURN s.top = $$MaxTop
END FUNCTION
 
FUNCTION IsEmpty(STACKOFBOOL s)
  RETURN s.top = -1
END FUNCTION
 
FUNCTION Peek(STACKOFBOOL s)
  IF !IsEmpty(@s) THEN
    RETURN s.elements[s.top]
  ELSE
    PRINT "Stack is empty."
    QUIT(1)
  END IF
END FUNCTION
 
FUNCTION Push(STACKOFBOOL s, val@)
  IF !IsFull(@s) THEN
    INC s.top
    s.elements[s.top] = val@
  ELSE
    PRINT "Stack is full."
    QUIT(1)
  END IF
END FUNCTION
 
FUNCTION Pop(STACKOFBOOL s)
  IF !IsEmpty(@s) THEN
    res@ = s.elements[s.top]
    DEC s.top
    RETURN res@
  ELSE
    PRINT
    PRINT "Stack is empty."
    QUIT(1)
  END IF
END FUNCTION
 
FUNCTION MakeEmpty(STACKOFBOOL s)
  s.top = -1
END FUNCTION
 
FUNCTION ElementsCount(STACKOFBOOL s)
  RETURN s.top + 1
END FUNCTION
END PROGRAM
 