threeval.perl:


#!/usr/local/bin/perl -T -w
# © Copyright 1998 John Halleck
# All rights reserved.

# Program to parse a users input and tell if the expression
# is constant, contingent, true, or false.

require 5.0; # Perl 4 can't hack this.

=head1 NAME

  John Halleck's Three valued logic evaluator..

=head1 SYNOPSIS

  Check consistancy of three valued logic expressions.

=head1 DESCRIPTION

  The program determines validity of expressions by
  appropriate enumeration.

=head1 DOCUMENTATION


=head1 SOURCES


=cut

use strict; # Let's hold to high standards.

use vars qw (
    $text %input
    $istrue $isfalse $isindeterminant $isconst
    $thischar $thispos @exprtext $remainingline $usedline
    $thistoken $lasterror
    $complaints
    @examples
    @varlist %varhash @boundlist
    $experror
    $pexpression $expression
    $showparse $showvars $showstruct
    $showexamples $shownotation
    $showeval
    $checkcount
    %compute_and %compute_or %compute_not %compute_implies
    %compute_eq
    %compute_Q %compute_E %compute_M %compute_L
);

my $myname = ($0 =~ m;(^|/)([^/]+)$;)[1] ; # Name of this program.
  # To go in forms.

# ~
%compute_not =      (  'T' => 'F',     'I' => 'I',     'F' => 'T');

# <>
%compute_M =        (  'T' => 'T',     'I' => 'T',     'F' => 'F');
# []
%compute_L =        (  'T' => 'T',     'I' => 'F',     'F' => 'F');
# !
%compute_E =        (  'T' => 'T',     'I' => 'F',     'F' => 'T');
# ?
%compute_Q =        (  'T' => 'F',     'I' => 'T',     'F' => 'F');

# or
%compute_or  =      ('T,T' => 'T',   'T,I' => 'T',   'T,F' => 'T',
                     'I,T' => 'T',   'I,I' => 'I',   'I,F' => 'I',
                     'F,T' => 'T',   'F,I' => 'I',   'F,F' => 'F');

# and
%compute_and =      ('T,T' => 'T',   'T,I' => 'I',   'T,F' => 'F',
                     'I,T' => 'I',   'I,I' => 'I',   'I,F' => 'F',
                     'F,T' => 'F',   'F,I' => 'F',   'F,F' => 'F');

# =>
%compute_implies = ( 'T,T' => 'T',   'T,I' => 'I',   'T,F' => 'F',
                     'I,T' => 'T',   'I,I' => 'T',   'I,F' => 'I',
                     'F,T' => 'T',   'F,I' => 'T',   'F,F' => 'T');

# <=>
%compute_eq =       ('T,T' => 'T',   'T,I' => 'F',   'T,F' => 'F',
                     'I,T' => 'F',   'I,I' => 'T',   'I,F' => 'F',
                     'F,T' => 'F',   'F,I' => 'F',   'F,F' => 'T');

# ===========================================================
# Minor canned security.

  $ENV{'PATH'} = '/usr/bin:/usr/sbin:/usr/lib:/usr/ucb';
  my $securityitem;
  foreach $securityitem (keys %ENV) {
     if    ($securityitem =~ m/^LD_/)        {delete $ENV{$securityitem}}
     elsif ($securityitem =~ m/^SHLIB_PATH/) {delete $ENV{$securityitem}}
  }
  delete @ENV{qw(IFS CDPATH ENV BASH_ENV PERLLIB PERL5LIB PAGER SHELL)};
  umask 0077;

# -----------------  Deal with HTML input -------------------
# The user fills out an HTML form to give the expression.
# This code gets that expression back, undoing HTML quoting,
# etc.
# Read in text

# -----------------  Deal with HTML input --------------------------------------

# Read in text
$text = ''; %input = ();
if (!defined $ENV{'REQUEST_METHOD'}) { # For debugging, try the command line
   if    (@ARGV) { $text  =       shift @ARGV }
   while (@ARGV) { $text .= '&' . shift @ARGV }
} elsif ($ENV{'REQUEST_METHOD'} eq "GET" && defined $ENV{'QUERY_STRING'}) {
   $text = $ENV{'QUERY_STRING'};
} elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
   read (STDIN, $text, $ENV{'CONTENT_LENGTH'});
}

# process it.
my ($field,$key,$val);
if (defined $text && $text ne '') {
  $text =~ s/\+/ /g; # http uses "+" to mean space... let us undo that.
  foreach $field (split (/&/, $text)) {
     next if $field eq '';
     ($key, $val) = split(/=/, $field, 2);
     $val = '' if !defined $val;
     # convert %XX from hex numbers to alphanumeric.
     $key =~ s/%(..)/pack("C",hex($1))/ge;
     $key = lc $key; # Is this a bad idea?
     $val =~ s/%(..)/pack("C",hex($1))/ge;
     if (!defined $input{$key}) {$input{$key} = $val}
     else                       {$input{$key} .= ', ' . $val}
  }
}

# ----------------- Routines to print expressions for us. (useful in debugging)

# Raw dump of an expression for debugging.
sub dumpexpressionraw {
  if (@_<1) { print "{}"; return} # Huh?
  my $item = shift; if (!defined $item) { $item = 'UNDEFINED' }
  print $item;
  if (@_ > 0) {
     print "(";
     while (@_ > 0)
           { $item = shift; &dumpexpressionraw(@$item); print "," if @_ > 0 }
     print ")";
  }
}
sub dumpexpr { print shift, ' '; &dumpexpressionraw(@_); print "</BR>\n" }

# Print an expression's structure as ASCII art.
sub printstructraw {
  my ($indentraw, $indent, $op, @list) = @_;
  $op = '[UNDEF]' if !defined $op;
  my $opindent = ''; $opindent = "|--" if $indent ne '';
  print $indentraw, $opindent, "\"", $op, "\"\n";
  my $item; my $thisindent = $indent . '|   ';
  while (@list > 0) {
     print $indent, "|\n";
     $item = shift @list;
     if (@list == 0) { $thisindent = $indent . '    ' }
     &printstructraw ($indent, $thisindent, @$item);
  }
}
sub printstructure {
  print "<PRE>\n"; &printstructraw ('', '', @_); print "</PRE>\n";
}

# ----------------- token scanning subroutines ----------------------
# Get a token from the user.  This could be a variable name, punctuation,
# or a constant.

# --- Character routines.

# character initialization
$thischar = '';
$thispos = '';
@exprtext = '';
$remainingline = '';
$usedline = '';

# Initialization
sub initchar {
  $remainingline = shift;
  $usedline = '';
  $thispos  = 0;
}

# Flush the input
sub flushchar {
  $usedline .= $remainingline;
  $remainingline = '';
}

# --- Token routines

# Initialize
$thistoken = '';
$lasterror = '';
sub inittoken {
  &initchar (shift);
  $lasterror = '';
  &nexttoken();
}

# Grab the next token, whatever it might be.
sub nexttoken {
   # Skip over white space.
   if ($remainingline =~ m/^(\s+)(.*)$/) {
     $remainingline = $2; $usedline .= $1;
   }
   $thistoken = '';
   if ($remainingline eq '') { return }

   if ($remainingline =~ m/^(M|\<\>)(.*)$/i) {
      $thistoken = 'M';
   } elsif ($remainingline =~ m/^(L|\[\])(.*)/i) {
      $thistoken = 'L';
   } elsif ($remainingline =~ m/^(\w+)(.*)$/) {
      $thistoken = $1;
      # Synonyms
      $thistoken = lc $thistoken;
      if    ($thistoken eq 'true')  { $thistoken = 'T' }
      elsif ($thistoken eq 'false') { $thistoken = 'F' }
      elsif ($thistoken eq 't')     { $thistoken = 'T' }
      elsif ($thistoken eq 'f')     { $thistoken = 'F' }
      elsif ($thistoken eq '0')     { $thistoken = 'F' }
      elsif ($thistoken eq '1')     { $thistoken = 'T' }
      elsif ($thistoken eq 'i')     { $thistoken = 'I' }

   } elsif ($remainingline =~ m/^(\~\>|\-\>|\=\>|\>)(.*)$/) {
      $thistoken = 'implies';
   } elsif ($remainingline =~ m/^(and|\&|\*|\/\\)(.*)$/i) {
      $thistoken = 'and';
   } elsif ($remainingline =~ m/^(or|\||\+|\\\/)(.*)$/i) {
      $thistoken = 'or';
   } elsif ($remainingline =~ m/^(equals|\=\=|\<\=\>|\=)(.*)$/i) {
      $thistoken = 'equals';
   } elsif ($remainingline =~ m/^(not|\~|\-)(.*)$/i) {
      $thistoken = 'not';
   } elsif ($remainingline =~ m/^(\!)(.*)$/) {
      $thistoken = '!';
   } elsif ($remainingline =~ m/^(\?)(.*)$/) {
      $thistoken = '?';
   } elsif ($remainingline =~ m/^(\(|\)|\{|\}|\,)(.*)$/) {
      $thistoken = $1;

   } else {
      &iserror ("Bad character in line.");
      $remainingline =~ m/^(.)(.*)$/; $thistoken = $1;
   }
   $remainingline = $2; $usedline .= $1;
}

# Flush tokens;
sub flushtokens {
 &flushchar();
 $thistoken = '';
}

# --------------------- Parsing subroutines ----------------------
# Actually parse the input.

# initialize the parse
sub initparse {
  &inittoken(shift);
  if ($thistoken eq '') { &iserror ("No expression given?") }
}

# Flush out the current token.
sub flushparse { &flushtokens() }

# Note an error.
sub iserror {
  my $error = shift;
  if ($lasterror eq '') {
     $lasterror = $error . " (\"$usedline\" *** \"$remainingline\")\n";
     &nexttoken();
  }
  &flushparse();
}

# Grab a specific expected token
sub mustbe {
   my $token = shift;
   if ($thistoken ne $token) {
      &iserror ("Expected $token and found $thistoken");
   }
   &nexttoken();
}

# test a token match
sub wehave {
  if (shift eq $thistoken) { &nexttoken(); return 1 }
  return 0;
}

# -----------------

# Parse a variable.
# a variable is a token that doesn't have punctuation.
sub parsevar {
  my $this = $thistoken;
  if ($this =~ m/^\w/) {
    &nexttoken();
  } else {
    &iserror("Expecting simple, got $thistoken, \"$remainingline\"");
    &flushparse();
  }
  return ($this);
}


# --------------------------------------------------------------------------
# --- True parsing by the method of recursive descent.

# Parse a unit:
#::=  '(' expression ')'
#|  '-' unit
#|  '+' unit
#|  M unit
#|  L unit
#|  var
#
# (In the   var(expression) case, var had better be a predicate)
sub parseunit {
  my @result = ();
  if    (wehave ('('))     { @result = &parseexpr(); mustbe (')') }
  elsif (wehave ('not'))   { @result = ('not', [&parseunit()])    }
  elsif (wehave ('+'))     { @result = &parseunit()               }
  elsif (wehave ('m'))     { @result = ('M', [&parseunit()])      }
  elsif (wehave ('l'))     { @result = ('L', [&parseunit()])      }
  elsif (wehave ('L'))     { @result = ('L', [&parseunit()])      }
  elsif (wehave ('M'))     { @result = ('M', [&parseunit()])      }
  elsif (wehave ('?'))     { @result = ('?', [&parseunit()])      }
  elsif (wehave ('!'))     { @result = ('!', [&parseunit()])      }
  else                     { @result = &parsevar() }
  # print "DEBUG: Parseunit returning @result\n";
  return @result;
}

# parse a term:
#::= unit [ 'and' unit ] *
#
sub parseterm {
  my @result = &parseunit();
  while (wehave('and')) { @result = ('and', [@result], [&parseunit()]) }
  return @result;
}

# parse a sum:
#::= term [ 'or' term ]
#
sub parsesum {
  my @result = &parseterm();
  while (wehave('or')) { @result = ('or', [@result], [&parseterm()]) }
  return @result;
}

# Parse an implication:
#::= sum [ 'implies' sum ]*
#
sub parseimp {
  my @result = &parsesum();
  if ($thistoken eq 'implies') {
     @result = ('implies', [@result]);
     while (wehave('implies')) { push @result, [&parsesum()] }
  }
  @result;
}

# Parse a conditional:
#::= implication [ 'equals' implication ]*
#
sub parsecond {
  my @result = &parseimp();
  if ($thistoken eq 'equals') {
     @result = ('equals', [@result]);
     while (wehave('equals')) { push @result, [&parseimp()] }
  }
  return @result;
}

# Parse a full blown expression:
#::= conditional
#
sub parseexpr {
  my @result = &parsecond();
  # print "DEBUG: parseexpr returning @result\n";
  return @result;
}

# -----------------------------------------------------------------------
# set up to parse at run time.

# Parse a given expression
sub parseit {
  my @result = &parseexpr();
  if ($thistoken ne '') {
    &iserror ("No operator, token: $thistoken, \"$remainingline\"");
  }
  return @result;
}

# ----------------- Environment subroutines -----------------
# These subroutines set up the environment we will evaluate in.

@varlist=();
%varhash=();
@boundlist=();

sub initenv {
  @varlist   = ();
  %varhash   = ();
  @boundlist = ();
}

# Find the variables in the expression.
sub findvars {
  my @exp = @_;
  if (@exp == 0) {return}
  my $this = shift @exp;
  my $bound = 0;
  my $thevar = '';
  my ($first, $item);
  # print "DEBUG: in findvars, looking at $this, with boundlist @boundlist\n";
  if (@exp == 0) {                             # this could be a variable.
     if ($this eq '0' || $this eq '1') { return }    # if it is not a constant,
     if ($this eq 'TRUE' || $this eq 'FALSE') { return } # of either flavor.
     if ($this eq 'T' || $this eq 'F' || $this eq 'I') { return }
     foreach $thevar (@boundlist) { return if $this eq $thevar }
        # (we may already know it is  bound.)

     # Otherwise it is free and we need to note
     if (!defined $varhash{$this}) {
        $varhash{$this} = 'F';
        push @varlist, $this;
        # print "DEBUG: adding variable $this\n";
     }
  } else {

    push @boundlist, $thevar if $bound;
    # (And find variables in sub expressions)
    foreach $item (@exp) { &findvars (@$item) }
    # And remember it is not bound as one walks back up the tree;
    pop @boundlist if $bound;
  }
  # print "DEBUG: findvars returning with @varlist\n";
}

# ------ Evaluation subroutines.

# Initialize
$experror = '';
sub initeval { &initenv(); $experror = '' }

# evaluate a tree.
sub evaltree {
   # dumpexpr("DEBUG: in evaltree, Expression is ", @_);
   my $op = shift; $op='NO-OP' if !defined $op;
   my @exp = @_;
   my $item;
   my $result = ' [UNINITIALIZED] '; my @resultlist = ();
   my ($first, $second);
   my $saved = '';
   my $var = '';

   # print "DEBUG:   Op is $op\n";
   # print "DEBUG:   varlist is @varlist\n";

   if ($experror ne '')       {  # IF we've had errors, punt.
      # print "DEBUG: Already had error: $experror\n";
      $result = '?';

   } elsif (@exp == 0) {  # If this is a variable of some sort.
      if    ($op eq '0')      { $result = 'F' }
      elsif ($op eq '1')      { $result = 'T' }
      elsif ($op eq 'TRUE')   { $result = 'T' }
      elsif ($op eq 'FALSE')  { $result = 'F' }
      elsif ($op eq 'UNKNOWN'){ $result = 'I' }
      elsif ($op eq 'I')      { $result = 'I' }
      elsif ($op eq 'T')      { $result = 'T' }
      elsif ($op eq 'F')      { $result = 'F' }
      elsif (defined $varhash{$op}) {
          # print "DEBUG: Result to be $varhash{$op}\n";
          $result = $varhash{$op};
          }
      else { $experror = "Unevaluatable variable $op" }

   } elsif ($op eq 'and') {
      $item = shift @exp; $result = &evaltree (@$item);
      foreach $item (@exp) {
         $result = $compute_and { $result . ',' . &evaltree (@$item) }
      }

   } elsif ($op eq 'or') {
      $item = shift @exp; $result = &evaltree (@$item);
      foreach $item (@exp) {
         $result = $compute_or { $result . ',' . &evaltree (@$item) }
      }

   } elsif ($op eq 'not') {
      $item = shift @exp; $result = $compute_not {&evaltree(@$item)};

   } elsif ($op eq 'equals') {
     $item = shift @exp; $result = &evaltree (@$item);
      foreach $item (@exp) {
         $result = $compute_eq { $result . ',' . &evaltree (@$item) }
      }

   } elsif ($op eq 'implies') {
     $item = shift @exp; $result = &evaltree(@$item); my $second;
     foreach $item (@exp)
        { my $second = &evaltree(@$item);
          $result = $compute_implies {$result . ',' . $second};
        }

   } elsif ($op eq 'M') {
      $item = shift @exp; $result = $compute_M {&evaltree(@$item)};

   } elsif ($op eq 'L') {
      $item = shift @exp; $result = $compute_L {&evaltree(@$item)};

   } elsif ($op eq '?') {
      $item = shift @exp; $result = $compute_Q {&evaltree(@$item)};

   } elsif ($op eq '!') {
      $item = shift @exp; $result = $compute_E {&evaltree(@$item)};

   } else {
     $experror = "Unknown operator in evaluation, $op";
     $result = 'ERROR UNKNOWN OP';
   }

   # &dumpexpr ("DEBUG, evaltree returns $result for", ($op, @_));
   if ($experror ne '') {
     print "<P> Error walkback, evaluating $op</P>\n";
   }
   return $result;
}

# -----------------------------------------
# Subroutines to deal with trying all values.

# Initialize
$istrue = '';
$isfalse = '';
$isindeterminant = '';
$isconst = '';
sub initfulleval {
  &initeval();
  $istrue=''; $isfalse=''; $isconst = ''; $isindeterminant = '';
}

# Increment our current set of values.
sub incvals {
   my $result = 0;
   my $item;
   while (scalar(@_)>0) {
      $item = shift;
      if ($varhash{$item} eq 'F') {
          $varhash{$item} = 'I';
          return 0;
      } elsif ($varhash{$item} eq 'I') {
          $varhash{$item} = 'T';
          return 0;
      } elsif ($varhash{$item} eq 'T') {
          $varhash{$item} = 'F';
      } else {
          &reportstate();
          die "Bad value $varhash{$item} in variable enumeration.\n";
      }
   }
   return 1;
}


# Report the current state of our set of values.
sub reportstate {
   my $result = '';
   my $item;
   if (scalar(@varlist)>0) {
      foreach $item (@varlist) {
         $result .= "$item=$varhash{$item}";
         if (@varlist) { $result .= ' ' }
      }
      $result =~ s/0/F/g; $result =~ s/1/T/g;
      $result = " ($result)";
   }
   return $result;
}


# Do a full blown evaluation.
sub evalall {
   my @given = @_;
   my $this; my $value;
   $isconst = ''; $istrue = ''; $isconst = ''; $isindeterminant = '';
   if (@varlist == 0) {
      $this = &evaltree(@given);
      $isconst = "CONSTANT ($this)";
      return 'C';
   }
   my $done = 0;
   while (!$done &&
            ($istrue eq '' || $isfalse eq '' || $isindeterminant eq '')) {
      # print "<BR>DEBUG: Testing evaluation of " . &reportstate() . "<BR>\n";
      $this = &evaltree(@given);
      # print "\n\nDEBUG: this = $this<BR>\n";
      if ($this eq 'T' && $istrue eq '') {
         $istrue = &reportstate();
         if ($isfalse ne '') { last }
      } elsif ($this eq 'F' && $isfalse eq '') {
         $isfalse = &reportstate();
         if ($istrue ne '') { last }
      } elsif ($this eq 'I' && $isindeterminant eq '') {
         $isindeterminant =  &reportstate();
      }
      $done = &incvals(@varlist);
   }
   if ($istrue eq '0') { $istrue = 'FALSE' }
   elsif ($istrue eq '1') { $istrue = 'TRUE' }
   elsif ($istrue =~ m/^(0|1)\s(\S.*)$/) { $istrue = $2 }
   if ($isfalse eq '0') { $isfalse = 'FALSE' }
   elsif ($isfalse eq '1') { $isfalse = 'TRUE' }
   elsif ($isfalse =~ m/^(0|1)\s(\S.*)$/) { $isfalse = $2 }

   # print "DEBUG: results are\n";
   # print "DEBUG:   false         = $isfalse\n";
   # print "DEBUG:   indeterminant = $isindeterminant\n";
   # print "DEBUG:   true          = $istrue\n";

   if ($istrue ne '' && $isfalse eq '' && $isindeterminant eq '')
      { return 'T' }
   if ($istrue eq '' && $isfalse ne '' && $isindeterminant eq '')
      { return 'F' }
   if ($istrue eq '' && $isfalse eq '' && $isindeterminant ne '')
      { return 'I' }
   return '?';

}

# -----------------  On with the task at hand ----------------

# --- Put out proper HTML headers.

print <<HEADERS;
Content-type: text/html
Pragma: Nocache

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN"
                      "http://www.w3.org/TR/REC-html40/strict.dtd">
<HTML LANG="en"><HEAD>
   <TITLE>John Halleck's Three Valued Modal Logic Expression Evaluator</TITLE>
   <LINK REV=MADE HREF="mailto:John.Halleck\@utah.edu">
   <META NAME="robots"    CONTENT="NONE">
   <META NAME="copyright" CONTENT="Copyright 2000 by John Halleck">
</HEAD><BODY>
<H1>Three Valued Modal Logic Expression Evaluation</H1>
<P>&copy; Copyright 2000 by John Halleck
<BR>All rights reserved</P>
<P>These use truth tables provided by Thad Coons <a href="mailto:toc586\@charter.net">toc586\@charter.net</a></P>
HEADERS

# ---- Get user's options.

$showexamples     = $input {'showexamples'};
    $showexamples = 0                             if !defined $showexamples;
$shownotation     = $input {'shownotation'};
    $shownotation = 0                             if !defined $shownotation;
$showparse        = $input {'showparse'};
       $showparse = 0                             if !defined $showparse;
$showvars         = $input {'showvars'};
       $showvars  = 0                             if !defined $showvars;
$showstruct       = $input {'showstruct'};
      $showstruct = 0                             if !defined $showstruct;
$showeval         = $input {'showeval'};
      $showeval   = 0                             if !defined $showeval;

if (!defined $input{'expression'}) {
   $shownotation     = 1; # defaults for new user.
   $showeval         = 1;
   $showexamples     = 1;
   $showparse        = 0;
   $showvars         = 0;
   $showstruct       = 1;
}

# ---- Evaluate the expression for the user

$expression = $input{'expression'}; $expression = '' if !defined $expression;
if (!defined $expression) {
  $expression = '';
  $pexpression = '';
} else {
  $expression =~ s/\s+$//; $expression =~ s/^s+//g;
  $pexpression = $expression;
  $pexpression =~ s/\>/\&gt;/g;
}

my $item; my $type;
if ($expression ne '') {
   print "<HR TITLE=\"Echo of Expression\">\n";
   print "<H1>Expression is $pexpression";
   print "</H1>\n";
   &initparse($expression);
   my @result = &parseit();
   if ($lasterror ne '') {
     print "<P>Parse error: $lasterror\n";
   } else {
      &dumpexpr('<H2>Parse is:</H2><P>', @result) if $showparse;
      &initfulleval();
      &findvars(@result);
      if ($showvars && scalar(@varlist) > 0) {
         @varlist = sort @varlist;
         print "<H2>Free variables in the expression:</H2>\n";
         print "<UL>\n";
         foreach $item (@varlist) { print "<LI>$item</LI>\n" }
         print "</UL>\n";
      }
      if ($showstruct) {
         print "<H2>Structure is:</H2>\n";
         &printstructure (@result);
      }
      $type = &evalall  (@result);
      if ($experror ne '') {
         print "<P> Evaluation error: $experror\n";
      } else { # showval
         print "<H2>Actual Evaluation</H2>\n";
         print "<P> We find that it is ";
         if    ($isconst ne '')  { print "  <STRONG>$isconst</STRONG>\n" }
         elsif ($type eq 'T')    { print "  <STRONG>TRUE</STRONG>\n" }
         elsif ($type eq 'F')    { print "  <STRONG>FALSE</STRONG>\n" }
         elsif ($type eq 'I')    { print "  <STRONG>INDETERMINANT</STRONG>\n" }
         else {
            $istrue =~ s/^1 //; $isfalse =~ s/^1 //; # Clean up print form.
            $istrue =~ s/^0 //; $isfalse =~ s/^0 //;
            print "<STRONG>contingent</STRONG>, for example:<UL>\n";
            print "<LI>$istrue gives a true evaluation.</LI>\n"
                  if $istrue ne '';
            print
                "<LI>$isindeterminant gives an indeterminant evaluation</LI>\n"
                  if $isindeterminant ne '';
            print "<LI>$isfalse gives a false evaluation</LI>\n"
                  if $isfalse ne '';
            print "</UL>\n";
         }
      }
   }
}

# -------------- Summarize notation.

if ($shownotation) {
   print <<THEOPS;
<HR TITLE="Notation Summary"><H1>Notation Summary</H1>
<P> We don't have all the logical symbols available on
all machines, so we use the following:</P>
<UL>
<LI>"0", "F", and "false" are used for false</LI>
<LI>"1", "T", and "true"are used for true</LI>
<LI>"I" is used for indeterminant.</LI>
<LI>"&gt;" and "implies" are used for material implication. Warning: P &gt; Q
is <b>not</b> equivalent to  ~P v Q as it is in classical logics</LI>
<LI>"=", and "equals" are used for equivalent to.</LI>
<LI>"-", "~", and "not" are used for NOT.</LI>
<LI>"*", "&", "\/\\", and "and" are used for AND.</LI>
<LI>"+", "|", "\\\/", and "or"  are used for OR.</LI>
<LI>M, and &lt;&gt; are used for possiblity</LI>
<LI>L, and [] are used for necessity (or certainty).</LI>
<LI>? is used for "is equivocal", Neither true nor false or
     both true and false.</LI>
<LI>! is used for "is dichotomous", Definitely either true or
    false.</LI>
THEOPS
   print "</UL>\n";
   print <<THEFORM;
<P> Parentheses are used in the normal manner.</P>
<P> Spaces may be liberally added for readability.</P>
<P> Variables are done computer science style...
    ab+cd is <STRONG>NOT</STRONG>  a*b+c*d, instead it is "ab" + "de".</P>
THEFORM
}

# -------------- Give examples

if ($showexamples) {
   print "<HR TITLE=\"Examples\">\n";
   print <<EXAMPLES;
<H1>Examples</H1>
<P>These examples can be cut and pasted into the program.
<UL>
<LI>a*b+c*d = d*c+b*a</LI>
<LI>(a = b) implies (a implies b)</LI>
<LI>-a + b</LI>
<LI>-a + a</LI>
<LI>a+b+c = b+c+a = c+a+b</LI>
<LI>(a>b>c) = ( (a>b) & (b>c) )</LI>
<LI>a &gt; b</LI>
<LI>( (a &gt; b) * (b &gt; a) ) = ( a=b )</LI>
<LI>M p</LI>
<LI>L p</LI>
<LI>L p &gt; M p</LI>
<LI>?P = ?~P</LI>
<LI>!P = ~?P</LI>
EXAMPLES
   print "</UL>\n";
}

# --------------------------------------------------------
# Put out the HTML form for the user to fill in.

$checkcount = 0;
sub outcheckmark { # Put out a check box for the user.
   my ($name, $check, $text) = @_;
   $checkcount++;
   print "<BR><INPUT TYPE=\"checkbox\" NAME=\"$name\" VALUE=\"1\" TABINDEX=\"$checkcount\" ID=\"$name\"";
   print " CHECKED" if $check;
   print "><LABEL FOR=\"$name\">$text</LABEL>\n";
}

print <<AFORM;
<HR TITLE="Try Expression"><H1>Try an expression</H1>
<FORM METHOD="POST" ACTION="$myname">
<P>Options:
AFORM
&outcheckmark ('shownotation', $shownotation, 'Give summary of notation');
&outcheckmark ('showexamples', $showexamples, 'Show some examples');

$checkcount++;
print <<BFORM
<P><LABEL FOR="expression">Expression:</LABEL><INPUT TYPE="TEXT" NAME="expression" SIZE="80" MAXLENGTH="200"
VALUE="$pexpression" TABINDEX="$checkcount" ID="expression">
BFORM
;

&outcheckmark ('showeval',   $showeval,   'Evaluate the expression');
&outcheckmark ('showparse',  $showparse,  'Show parse in function form');
&outcheckmark ('showvars',   $showvars,   'Show the free variables in the expression');
&outcheckmark ('showstruct', $showstruct, "Show the expression's structure as ASCII art");

$checkcount++;

# ------------------------------------------------------------

# HTML canned closing stuff.
print <<CANNEDEND;
<HR TITLE="Navigation"><H1>Go to ...</H1><UL>
<LI><A HREF="../../../~nahaj/logic/">Logic page</A></LI>
<LI><A HREF="../../../~nahaj/">John Halleck's home page</A></LI>
</UL>
CANNEDEND
print "<HR TITLE=\"Page Maintenance\">\n";
print "<P>This code is: http://www.cc.utah.edu/cgi-bin/cgiwrap";
print "/<A HREF=\"../../../~nahaj/\">nahaj</A>/<A HREF=\"$myname\">$myname</A>";
print "\n";
print <<CANNEDEND2;
<BR>This is Version 1.00_02
<BR>&copy; Copyright 2000 by John Halleck
<BR>The code for this page was last changed on November 24th, 2003
<BR>Send comments or complaints to
   <A HREF="mailto:John.Halleck\@utah.edu">John.Halleck\@utah.edu</A>
</BODY></HTML>
CANNEDEND2
exit 0;


Go to ...


This page is http://www.cc.utah.edu/~nahaj/logic/threeval/threeval.perl.html
© Copyright 2003 by John Halleck, All Rights Reserved.
This snapshot was last modified on November 25th, 2003