Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Optimize a generic boolean expression

by tsk1979 (Scribe)
on Dec 12, 2013 at 09:44 UTC ( #1066792=perlquestion: print w/ replies, xml ) Need Help??
tsk1979 has asked for the wisdom of the Perl Monks concerning the following question:

I was looking at boolean expression modules, which work using Q_M algo. However, the problem needs to be given in term of minterms I am looking at some kind of code which can optmize a generic expression

For example

RESULT = Fred&Teddy&(Fred|Teddy)|(Fred)&(John) RESULT now should contain RESULT = (Fred&John)|(Teddy&Fred&John)
does such a thing exists. I am at a loss how to code it.

Comment on Optimize a generic boolean expression
Download Code
Re: Optimize a generic boolean expression (truth tables)
by Anonymous Monk on Dec 12, 2013 at 09:59 UTC
    I might use Data::BitMask to keep track of whats on or off, but only because I can't find the existing complete solution I know must exists ( Parse::BooleanLogic?? )
Re: Optimize a generic boolean expression
by tobyink (Abbot) on Dec 12, 2013 at 10:13 UTC

    I suppose I'd parse the expression into some kind of tree structure of objects along the lines of:

    role Node; class Conjunction with Node { has left => (is => 'ro', does => 'Node'); has right => (is => 'ro', does => 'Node'); } class Disjunction with Node { has left => (is => 'ro', does => 'Node'); has right => (is => 'ro', does => 'Node'); } class Negation with Node { has negated_term => (is => 'ro', does => 'Node'); } class Primative with Node { has label => (is => 'ro', isa => Str); } my $fred = Primative->new(label => "Fred"); my $john = Primative->new(label => "John"); my $fred_and_john = Conjunction->new(left => $fred, right => $john); ...;

    Then I'd write a few "visitor" rules that can take a tree and tweak it, for example, finding a candidate for rewriting under De Morgan's laws...

    my $demorgans_laws = sub { my $tree = $_[0]; if ($tree->isa('Conjunction') and $tree->left->isa('Negation') and $tree->right->isa('Negation')) { return Negation->new( node => Disjunction->new( left => $tree->left->negated_term, right => $tree->right->negated_term, ), ); } if ($tree->isa('Disjunction') and $tree->left->isa('Negation') and $tree->right->isa('Negation')) { return Negation->new( node => Conjunction->new( left => $tree->left->negated_term, right => $tree->right->negated_term, ), ); } return $tree; };

    Then use some kind of hill-climbing algorithm to apply the tweaking rules to the tree, creating new trees; discarding trees that become more complex than the original, and retaining trees that become simpler, or at least as simple.

    The problem with hill-climbing is that you can find local maxima. If you're climbing a mountain, sometimes you find a small peak, and you need to climb downwards a bit before you can reach the true summit. This is a hard problem to solve without ending up with a completely undirected search. But luckily, it's a problem that many smart people have thought about, so there's a wealth of ideas on how to solve it if you delve into AI literature.

    use Moops; class Cow :rw { has name => (default => 'Ermintrude') }; say Cow->new->name
Re: Optimize a generic boolean expression
by hdb (Prior) on Dec 12, 2013 at 10:39 UTC

    In order to come up with the minterms, you would need a value table. Here is some code to find the variables and the value table:

    use strict; use warnings; $"="\t"; my $bool = 'Fred&Teddy&(Fred|Teddy)|(Fred)&(John)'; my @vars = keys %{{ map { $_ => 1 } $bool =~ /\b(\w+)\b/g }}; $bool =~ s/($_)/\$b\{${1}\}/g for @vars; my $n = @vars; my %b; print "@vars\tValue\n"; for (0..2**$n-1) { @b{@vars} = split //, sprintf "%0${n}b", $_; print "@b{@vars}\t"; print eval $bool; print "\n"; }
Re: Optimize a generic boolean expression
by BrowserUk (Pope) on Dec 12, 2013 at 10:54 UTC

    Do a search for "Karnaugh maps".


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
Re: Optimize a generic boolean expression
by Laurent_R (Prior) on Dec 12, 2013 at 11:00 UTC
    RESULT = Fred&Teddy&(Fred|Teddy)|(Fred)&(John) RESULT now should contain RESULT = (Fred&John)|(Teddy&Fred&John)
    This does not seem right to me, or am I wrong? What kind of precedence rules are you using between your boolean operators?
Re: Optimize a generic boolean expression
by hdb (Prior) on Dec 12, 2013 at 16:28 UTC

    Here is a complete solution which uses Algorithm::QuineMcCluskey (this module throws a number of warnings but seems to work). I only tested it on your one expression, so if you are using it, let me know whether it works well or not.

    use strict; use warnings; use List::Util 'sum'; use Algorithm::QuineMcCluskey; my $bool = 'Fred&Teddy&(Fred|Teddy)|(Fred)&(John)'; my @vars = keys %{{ map { $_ => 1 } $bool =~ /\b(\w+)\b/g }}; $bool =~ s/($_)/\$b\{${1}\}/g for @vars; my $n = @vars; my @table; my %b; for (0..2**$n-1) { @b{@vars} = split //, sprintf "%0${n}b", $_; push @table, $_ if eval $bool; } my $q = new Algorithm::QuineMcCluskey( width => $n, minterms => \@tabl +e ); my( $result )= $q->solve(); $result =~ s/\+/|/g; $result =~ s/([A-Z])'/!$1/g; $result =~ s#([A-Z]+)# join( "&", map { $vars[ord($_)-ord("A")] } spli +t //, $1 ) #ge; print "$result\n";

    Update: I could not help playing a little with this code. If one uses the vec function instead of a hash for the variables, one can shorten the code to:

    use strict; use warnings; use Algorithm::QuineMcCluskey; my $bool = 'Fred&Teddy&(Fred|Teddy)|(Fred)&(John)'; my @vars = keys %{{ map { $_ => 1 } $bool =~ /\b(\w+)\b/g }}; $bool =~ s/$vars[-$_]/vec(\$_,$_-1,1)/g for 1..@vars; my($result) = Algorithm::QuineMcCluskey->new( width => scalar @vars, minterms => [ grep { eval + $bool } 0..2**@vars-1 ] )->solve(); $result =~ s/\+/|/g; $result =~ s/([A-Z])'/!$1/g; $result =~ s#([A-Z]+)# join( "&", map { $vars[ord($_)-ord("A")] } spli +t //, $1 ) #ge; print "$result\n";

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1066792]
Approved by lidden
Front-paged by toolic
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (17)
As of 2015-07-02 17:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (44 votes), past polls