Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Generate a truth table from input string

by Anonymous Monk
on May 13, 2008 at 14:47 UTC ( [id://686283]=perlquestion: print w/replies, xml ) Need Help??

Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

i parse a certain file to get the boolean function, i need to evaluate this string and generate the truth table for the same, the string could have max 4 variables, and operators for AND is * OR is + NOT is ! or ' and XOR is ^ eg: a*b*!(c) , a'+b'+c', !(A*B) etc, thanks in adv

Replies are listed 'Best First'.
Re: Generate a truth table from input string
by moritz (Cardinal) on May 13, 2008 at 14:58 UTC

      Parsing is quite possibly not required. Assuming that the variables can be assumed to contain a true value why not just leverage perl.

      $str =~ s/\*/&&/g; $str =~ s/\+/||/g; # $str =~ s/'/!/g; $str =~ s/(\w+)'/!$1/g; $str =~ s/\(([^\)]+)\)'/!($1)/g; $str =~ s/\w+/1/g; my $truth = eval $str;

      If the a/b/A/B vars have associated values all that is required is to substitute them in. Perl does the parsing and calculates the truth.

      Update

      Modified to deal with ' postfix syntax

        $str =~ s/'/!/g;
        is not sufficient to convert a postfix operator to a prefix operator. "a'" produces the invalid code "1!".
      the problem that i am facing is, NOT is represented by both ! and ', variables could be !(A)+!(B)+!(C) or A'+B'+C', both mean the same. how do i do it?

        s/(\w+)'/!\1/g

        Rule One: Do not act incautiously when confronting a little bald wrinkly smiling man.
Re: Generate a truth table from input string
by apl (Monsignor) on May 13, 2008 at 15:33 UTC
    When your teacher gave you this assignment, he presumably discussed how to represent an equation as a red-blue tree, or told you you could use Reverse Polish notation, or in some other fashion limited the grammar of the equation.

    Go ask him to provide these details again.

    Failing that I think moritz summed it up pretty well.

Re: Generate a truth table from input string
by ikegami (Patriarch) on May 13, 2008 at 16:40 UTC

    [ Based on the code in Operator Associativity and Eliminating Left-Recursion in Parse::RecDescent. ]

    First you need a parser. I used the same precedence and associativity as Perl uses.

    make_parse.pl (Run once to create Parser.pm)

    use strict; use warnings; use Parse::RecDescent qw( ); my $grammar = <<'__END_OF_GRAMMAR__'; { use strict; use warnings; } parse : <rulevar: local %vars> parse : expr /^\Z/ { [ $item[1], [ sort keys %vars ] ] } # Just an alias expr : or # vvv lowest precedence # or : or '+' and # | or '^' and # | and or : and or_[ $item[1] ] or_ : '+' <commit> and or_[ [ 'or', $arg[0], $item[3] ] ] | '^' <commit> and or_[ [ 'or', $arg[0], $item[3] ] ] | { $arg[0] } # and : and '*' not1 # | not1 and : not1 and_[ $item[1] ] and_ : '*' <commit> not1 and_[ [ 'and', $arg[0], $item[3] ] ] | { $arg[0] } # not : '!' not # | not "'" # | term not1 : '!' <commit> not1 { [ 'not', $item[3] ] } | not2 not2 : term not2_[ $item[1] ] not2_ : "'" <commit> not2_[ [ 'not', $arg[0] ] ] | { $arg[0] } # ^^^ highest precedence term : '(' <commit> expr ')' { $item[3] } | /\w+/ { $vars{$item[1]} = 0; [ 'var', $item[1] ] } __END_OF_GRAMMAR__ Parse::RecDescent->Precompile($grammar, 'Parser') or die("Bad grammar\n");

    Then you can generate the truth tables from the parse tree.

    table_truth.pl

    use strict; use warnings; use Algorithm::Loops qw( NestedLoops ); use Data::Dumper qw( Dumper ); use Parser qw( ); { our %symtab; my %eval = ( var => sub { $symtab{$_[1]} }, not => sub { ( ~ eval_node($_[1]) ) & 1 }, and => sub { eval_node($_[1]) & eval_node($_[2]) }, or => sub { eval_node($_[1]) | eval_node($_[2]) }, xor => sub { eval_node($_[1]) ^ eval_node($_[2]) }, ); sub eval_node { my ($node) = @_; $eval{$node->[0]}->(@$node) } sub eval_expr { my ($tree, $vars, $vals) = @_; local %symtab; @symtab{ @$vars } = @$vals; eval_node($tree) } } my $parser = Parser->new(); foreach my $expr ( "a*b*!(c)", "a'+b'+c'", "!(A*B)", ) { my $results = $parser->parse($expr) or die("Bad expression $expr\n"); my ($tree, $vars) = @$results; print(join("\t", @$vars), "\t$expr\n"); my $i = NestedLoops([ ([0,1])x@$vars ]); while (my @vals = $i->()) { my $result = eval_expr($tree, $vars, \@vals); print(join("\t", @vals), "\t$result\n"); } print("\n"); }

    Output

    >make_parser.pl >truth_table.pl a b c a*b*!(c) 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 1 0 1 0 1 1 0 1 1 1 1 0 a b c a'+b'+c' 0 0 0 1 0 0 1 1 0 1 0 1 0 1 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 1 1 0 A B !(A*B) 0 0 1 0 1 1 1 0 1 1 1 0

    table_truth.pl could actually produce Perl code which you could eval instead of "executing" the tree itself, but executing the tree is quite simple.

    Update: I had the precedence reversed.

Re: Generate a truth table from input string
by psini (Deacon) on May 13, 2008 at 15:09 UTC

    Quick&dirty solution:

    Use a regualr expression to extract all the variables (assuming a form of \w+), store them in an hash along with an auto-generated variable name (eg $a,$b..).

    Use another regexp to replace all variables with the new names and replace the operators with the corresponding perl operator (eg s/\*/ && /g).

    Perform a series of nested loops, one for each variable, and eval the expression.

    Note that this is probably not what your teacher wants from you!

    Rule One: Do not act incautiously when confronting a little bald wrinkly smiling man.
Re: Generate a truth table from input string
by Anonymous Monk on May 14, 2008 at 11:29 UTC
    thanks guys... i am new to perl, with all ur suggestions and inputs from perlmonks, i finally came up with this small piece of code ---truthtable.pl
    #my $bool_func = "((S0'*B)|((!S0)|A))'"; my $bool_func = "(a'+b'+c')"; #my $bool_func = "((A0)'+A1'+!(a2))'"; # convert the function into equivalent perl expression $bool_func =~ s/\((\w*)\)'/~($1)/g; # to convert the case where variable is represented as (A)' to ~(A) $bool_func =~ s/(\w*)'/~$1/g; # to convert the case where variable is represented as A' to ~A $bool_func =~ s/(^\(.*\))~$/~($1)/g; # to convert the case where expression is (EXPR)' to ~(EXPR) $bool_func =~ s/!/~/g; # to convert the case where not is represented by ! to ~ $bool_func =~ s/\+/|/g; $bool_func =~ s/\*/&/g; (my $perl_expr = $bool_func) =~ s/([a-zA-Z]\w*)/\$val{$1}/g; ## end conversion print "equivalent expression: $bool_func\n"; # get the variables my @vars = do { my %seen; grep !$seen{$_}++, $bool_func =~ /([a-zA-Z]\w*)/g; }; print "$vars[2], $vars[1], $vars[0], out\n"; # evaluate and print the output for my $assignment ( 0 .. (2**@vars)-1 ) { my %val; $val{$vars[$_]} = ( $assignment >> $_ ) & 1 for 0 .. $#vars; my $result = eval $perl_expr & 1; print join(", ", map { "$val{$_}" }keys %val)," =$result\n"; }
    ----end--- output---
    equivalent expression: (~a|~b|~c) c, b, a, out 0, 0, 0 = 1 0, 1, 0 = 1 0, 0, 1 = 1 0, 1, 1 = 1 1, 0, 0 = 1 1, 1, 0 = 1 1, 0, 1 = 1 1, 1, 1 = 0
    thanks again

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://686283]
Approved by moritz
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others learning in the Monastery: (2)
As of 2024-03-19 06:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found