Data commit

Task/Truth-table/Pascal/truth-table.pas

@@ -0,0 +1,234 @@
+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.