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;
const
  StackSize = 80;
 
type
  TVariable = record
    Name: Char;
    Value: Boolean;
  end;
 
  TStackOfBool = record
    Top: Integer;
    Elements: array [0 .. StackSize - 1] of Boolean;
  end;
 
var
  Expression: string;
  Variables: array [0 .. 23] of TVariable;
  VariablesLength: Integer;
  i: Integer;
  e: Char;
 
// Stack manipulation functions
function IsFull(var s: TStackOfBool): Boolean;
begin
  IsFull := s.Top = StackSize - 1;
end;
 
function IsEmpty(var s: TStackOfBool): Boolean;
begin
  IsEmpty := s.Top = -1;
end;
 
function Peek(var s: TStackOfBool): Boolean;
begin
  if not IsEmpty(s) then
    Peek := s.Elements[s.Top]
  else
  begin
    Writeln('Stack is empty.');
    Halt;
  end;
end;
 
procedure Push(var s: TStackOfBool; val: Boolean);
begin
  if not IsFull(s) then
  begin
    Inc(s.Top);
    s.Elements[s.Top] := val;
  end
  else
  begin
    Writeln('Stack is full.');
    Halt;
  end
end;
 
function Pop(var s: TStackOfBool): Boolean;
begin
  if not IsEmpty(s) then
  begin
    Result := s.Elements[s.Top];
    Dec(s.Top);
  end
  else
  begin
    Writeln;
    Writeln('Stack is empty.');
    Halt;
  end
end;
 
procedure MakeEmpty(var s: TStackOfBool);
begin
  s.Top := -1;
end;
 
function ElementsCount(var s: TStackOfBool): Integer;
begin
  ElementsCount := s.Top + 1;
end;
 
function IsOperator(const c: Char): Boolean;
begin
  IsOperator := (c = '&') or (c = '|') or (c = '!') or (c = '^');
end;
 
function VariableIndex(const c: Char): Integer;
var
  i: Integer;
begin
  for i := 0 to VariablesLength - 1 do
    if Variables[i].Name = c then
    begin
      VariableIndex := i;
      Exit;
    end;
  VariableIndex := -1;
end;
 
function EvaluateExpression: Boolean;
var
  i, vi: Integer;
  e: Char;
  s: TStackOfBool;
begin
  MakeEmpty(s);
  for i := 1 to Length(Expression) do
  begin
    e := Expression[i];
    vi := VariableIndex(e);
    if e = 'T' then
      Push(s, True)
    else if e = 'F' then
      Push(s, False)
    else if vi >= 0 then
      Push(s, Variables[vi].Value)
    else
    begin
      {$B+} 
      case e of
        '&':
          Push(s, Pop(s) and Pop(s));
        '|':
          Push(s, Pop(s) or Pop(s));
        '!':
          Push(s, not Pop(s));
        '^':
          Push(s, Pop(s) xor Pop(s));
      else
        Writeln;
        Writeln('Non-conformant character ', e, ' in expression.');
        Halt;
      end;
      {$B-}
    end;
  end;
  if ElementsCount(s) <> 1 then
  begin
    Writeln;
    Writeln('Stack should contain exactly one element.');
    Halt;
  end;
  EvaluateExpression := Peek(s);
end;
 
procedure SetVariables(pos: Integer);
var
  i: Integer;
begin
  if pos > VariablesLength then
  begin
    Writeln;
    Writeln('Argument to SetVariables cannot be greater than the number of variables.');
    Halt;
  end
  else if pos = VariablesLength then
  begin
    for i := 0 to VariablesLength - 1 do
    begin
      if Variables[i].Value then
        Write('T  ')
      else
        Write('F  ');
    end;
    if EvaluateExpression then
      Writeln('T')
    else
      Writeln('F');
  end
  else
  begin
    Variables[pos].Value := False;
    SetVariables(pos + 1);
    Variables[pos].Value := True;
    SetVariables(pos + 1);
  end
end;
 
// removes space and converts to upper case
procedure ProcessExpression;
var
  i: Integer;
  exprTmp: string;
begin
  exprTmp := '';
  for i := 1 to Length(Expression) do
  begin
    if Expression[i] <> ' ' then
      exprTmp := Concat(exprTmp, UpCase(Expression[i]));
  end;
  Expression := exprTmp
end;
 
begin
  Writeln('Accepts single-character variables (except for ''T'' and ''F'',');
  Writeln('which specify explicit true or false values), postfix, with');
  Writeln('&|!^ for and, or, not, xor, respectively; optionally');
  Writeln('seperated by space. Just enter nothing to quit.');
 
  while (True) do
  begin
    Writeln;
    Write('Boolean expression: ');
    ReadLn(Expression);
    ProcessExpression;
    if Length(Expression) = 0 then
      Break;
    VariablesLength := 0;
    for i := 1 to Length(Expression) do
    begin
      e := Expression[i];
      if (not IsOperator(e)) and (e <> 'T') and (e <> 'F') and
        (VariableIndex(e) = -1) then
      begin
        Variables[VariablesLength].Name := e;
        Variables[VariablesLength].Value := False;
        Inc(VariablesLength);
      end;
    end;
    WriteLn;
    if VariablesLength = 0 then
      Writeln('No variables were entered.')
    else
    begin
      for i := 0 to VariablesLength - 1 do
        Write(Variables[i].Name, '  ');
      Writeln(Expression);
      Writeln(StringOfChar('=', VariablesLength * 3 + Length(Expression)));
      SetVariables(0);
    end;
  end;
end.
 