Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Re^7: Generate a truth table from input string

by Anonymous Monk
on Oct 28, 2017 at 07:46 UTC ( #1202228=note: print w/replies, xml ) Need Help??


in reply to Re^6: Generate a truth table from input string
in thread Generate a truth table from input string

I'm a total noob and want to understand this code line by line.Can anyone help?

  • Comment on Re^7: Generate a truth table from input string

Replies are listed 'Best First'.
Re^8: Generate a truth table from input string
by Discipulus (Abbot) on Oct 28, 2017 at 11:47 UTC
    Hello,

    it's not at all a noob level code: it's something like a grammar execution using eval

    Nowadays grammars are better implemented using Marpa::R2 but is not my field.

    Anyway using print YAPE::Regex::Explain and Data::Dumper all will become much clearer (I hope..):

    use Data::Dumper; use YAPE::Regex::Explain; print "regex explanation:\n"; print "\t",YAPE::Regex::Explain->new(qr{s/\*/ && /})->explain; print "\t",YAPE::Regex::Explain->new(qr{s/\+/ || /})->explain; print "\t",YAPE::Regex::Explain->new(qr{s/(\w+)\s*'/!$1/g})->explain; print "\t",YAPE::Regex::Explain->new(qr{\((?:(?>[^()]+)|(??{$re}))*\)} +)->explain; print "processing DATA:\n"; while(<DATA>){ chomp; # added by me print "\n\t-->received [$_]\n"; my ($re, $term, @vars, %vars, $loops); s/\*/ && /g; print "\t-->after first regex [$_]\n"; s/\+/ || /g; print "\t-->after second regex [$_]\n"; s/(\w+)\s*'/!$1/g; print "\t-->after third regex [$_]\n"; $re = qr{\((?:(?>[^()]+)|(??{$re}))*\)}; # :-) s/($re)\s*'/!$1/g; print "\t-->after fourth regex [$_]\n"; $term = $_; print "\t-->\$term is [$term]\n"; @vars = $_ =~ m/(\w+)/g; print "\t\@vars is [@vars]\n"; $vars{$_}++ for @vars; print "\t-->\%vars is :\n"; print "\t\t", Dumper \%vars; @vars = sort keys %vars; print "\t-->\@vars is [@vars]\n"; s/(\w+)/\$$1/g; print "\t-->\$_ is [$_]\n"; printf "\n@vars = $term"; @vars = map {"\$$_"}@vars; print "\n\t-->\@vars is [@vars]\n"; $loops .= "for $_ (0..1) {\n" for @vars; print "\t-->\$loops is [$loops]\n"; $loops .= qq{printf "@vars = %d\n", eval;\n}; print "\t-->\$loops is [$loops]\n"; $loops .= "}" for @vars; print "\t-->\$loops is [$loops]\n\n\n"; do{ no strict 'vars'; eval $loops }; die "Can't process $term$_\n$@\n" if $@; } __DATA__ a*b*!(c) a'+b'+c' !(a*b) b^a (a^b)' (a+(a+b))'*c

    which output:

    L*

    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

      Discipulus:

      I was bored, and you mentioned Marpa::R2, so I decided to whack something together for my own amusement. I thought I'd share it in case someone wanted another example of using Marpa.

      #!env perl # # ex_marpa_bool_expr_truth_table.pl <FName> # # Parse a boolean expression and generate its truth table # use strict; use warnings; use Marpa::R2; ### # Fetch the expression to parse ### my $FName = shift; open my $FH, '<', $FName or die "$!"; my $input = trim(slurp($FH)); print "Expression to parse:\n$input\n\n"; ### # Parse the expression into a syntax tree, and display it as an AoA ### my $grammar_spec = slurp(\*DATA); my $grammar = Marpa::R2::Scanless::G->new( { source=>\$grammar_spec } +); my $value_ref = $grammar->parse( \$input, 'parseTree'); print "Parse tree:\n\n", ast_to_string($value_ref), "\n\n"; my %vars; walk_ast_tree(\%vars, $value_ref, sub { my ($context, $node, $phase) = @_; return if $phase ne 'BEFORE'; if ("ARRAY" eq ref $node and $node->[0] eq "variable") { ++$context->{$node->[1]}; } } ); my @varnames = sort keys %vars; print "Variables: ", join(", ", @varnames), "\n"; ### # Build the evaluator function for the expression. # # Essentially, we construct a function tree that mirrors the AST. ### my $tmp = []; walk_ast_tree($tmp, $value_ref, sub { my ($context, $node, $phase) = @_; # We process on 'AFTER' phase because we want to generate # the leaf functions before building their callers. return if $phase ne 'AFTER' or "ARRAY" ne ref $node; my $type= $node->[0]; if ("variable" eq $type) { push @$context, sub { # Fetch the specified variable return $vars{$node->[1]} } } elsif ("NOT" eq $type) { my $fn = pop @$context; push @$context, sub { # Invert the result. # NOTE: We use "0 +" to ensure that we get a # numeric value (o/w we sometimes get "") my $val = $fn->(); return 0 + !$fn->(); } } else { my $rhfn = pop @$context; my $lhfn = pop @$context; push @$context, sub { # Handle binary operator my $rhs = $rhfn->(); my $lhs = $lhfn->(); return $rhs & $lhs if $type eq "AND"; return $rhs | $lhs if $type eq "OR"; return $rhs ^ $lhs if $type eq "XOR"; die "Unexpected type $type!"; } } } ); my $fn_eval = $tmp->[-1]; ### # Draw truth table ### # We'll use the width of the largest variable name to generate # the format my $max_width = @{[sort map { length $_ } @varnames]}[-1]; my $fmtHdr = "%${max_width}s"; my $fmtVal = "%${max_width}u"; print "\nTRUTH TABLE\n\n"; print join(" ", map { sprintf $fmtHdr, $_ } @varnames), " : OUT\n"; for my $i ( 0 .. 2**(keys %vars)-1 ) { # Set the input variable values (map the bits in $i to variables) my $bit = 1; for my $var (reverse @varnames) { $vars{$var} = $bit & $i ? 1 : 0; $bit *= 2; } # Show the input values print join(" ", map { sprintf $fmtVal, $_ } @vars{@varnames}), " : + "; # Evaluate the function, and display the result print $fn_eval->(),"\n"; } #---------------------------------------------------------- # Utility functions #---------------------------------------------------------- # Walk the AST and invoke the users callback for each node. # $context - An arbitrary value you can provide as a scratchpad # value for your function. # $tree - The current node in the AST # $fn - Your callback function. The function will be # called like: # # foo($context, $tree, $phase) # # Your callback is invoked on each node BEFORE # processing the children as well as AFTER processing # the children. $phase will be set to 'BEFORE' or # 'AFTER' accordingly. # sub walk_ast_tree { my ($context, $tree, $fn) = @_; # Process the current node $fn->($context, $tree, 'BEFORE'); # Process children, as required if ("REF" eq ref $tree) { walk_ast_tree($context, $$tree, $fn); } elsif ("ARRAY" eq ref $tree) { walk_ast_tree($context, $_, $fn) for @$tree; } $fn->($context, $tree, 'AFTER'); } # Trim whitespace from both ends of the string sub trim { my $t = shift; $t =~ s/\s+$//; $t =~ s/^\s+//; return $t; } sub slurp { local $/; my $FH = shift; return <$FH>; } sub ast_to_string { my $r = shift; if ("REF" eq ref $r) { return ast_to_string($$r); } elsif ("ARRAY" eq ref $r) { return "(" . join(" ", map { ast_to_string($_) } @$r) . ")"; } elsif ("" eq ref $r) { return $r; } die "? " . ref($r) . " ?"; } __DATA__ # Default action returns the value of the first thing in the productio +n. :default ::= action => ::first expr ::= OR | XOR | term ; term ::= AND | factor ; factor ::= variable | ('(') expr (')') | NOT ; # For our binary operators, we want the name as well for code generati +on # such as "( OR <arg1> <arg2> )" OR ::= expr ('+') term action => [name, values] ; XOR ::= expr ('^') term action => [name, values] ; AND ::= term ('*') factor action => [name, values] ; # We provde both prefix NOT (!) and suffix NOT (') because I saw it in # the thread. Again, we want the name for code generation. In both # cases, we generate "( NOT <arg> )" NOT ::= ('!') factor action => [name, values] | factor (postfix_NOT) action => [name, values] ; variable ::= ID action => [name, values] ; ID ~ [A-Za-z]+ # I did this as a character class because I couldn't quote it in the B +NF postfix_NOT ~ ['] :discard ~ whitespace whitespace ~ [\s]+

      A couple example runs:

      $ perl ex_marpa_bool_expr_truth_table.pl ex_c Expression to parse: A+!B Parse tree: (OR (variable A) (NOT (variable B))) Variables: A, B TRUTH TABLE A B : OUT 0 0 : 1 0 1 : 0 1 0 : 1 1 1 : 1 Roboticus@Waubli ~/parse_example $ perl ex_marpa_bool_expr_truth_table.pl ex_e Expression to parse: A*B*C + A*!B*!C + !A*!B Parse tree: (OR (OR (AND (AND (variable A) (variable B)) (variable C)) (AND (AND ( +variable A) (NOT (variable B))) (NOT (variable C)))) (AND (NOT (varia +ble A)) (NOT (variable B)))) Variables: A, B, C TRUTH TABLE A B C : OUT 0 0 0 : 1 0 0 1 : 1 0 1 0 : 0 0 1 1 : 0 1 0 0 : 1 1 0 1 : 0 1 1 0 : 0 1 1 1 : 1 Roboticus@Waubli ~/parse_example $ perl ex_marpa_bool_expr_truth_table.pl ex_f Expression to parse: A*B*C+!B+C*A Parse tree: (OR (OR (AND (AND (variable A) (variable B)) (variable C)) (NOT (varia +ble B))) (AND (variable C) (variable A))) Variables: A, B, C TRUTH TABLE A B C : OUT 0 0 0 : 1 0 0 1 : 1 0 1 0 : 0 0 1 1 : 0 1 0 0 : 1 1 0 1 : 1 1 1 0 : 0 1 1 1 : 1

      Update: Added $fn_eval so I could ignore $tmp after building the evaluator function.

      Please message me if anything is unclear, and I'll try to tweak it and/or improve the comments. Enjoy!

      ...roboticus

      When your only tool is a hammer, all problems look like your thumb.

Re^8: Generate a truth table from input string
by roboticus (Chancellor) on Oct 28, 2017 at 19:18 UTC

    Just yesterday I mentioned how you can run your code under the perl debugger to see what's happening on a line by line basis. I encourage you to give it a try: it's faster than instrumenting your code with print statements, and it'll help you learn perl faster.

    ...roboticus

    When your only tool is a hammer, all problems look like your thumb.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (3)
As of 2021-08-03 19:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My primary motivation for participating at PerlMonks is: (Choices in context)








    Results (40 votes). Check out past polls.

    Notices?