Beefy Boxes and Bandwidth Generously Provided by pair Networks Cowboy Neal with Hat
Perl Monk, Perl Meditation
 
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 (Parson) 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 (Priest) 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 (Parson) 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 rifling through the Monastery: (14)
As of 2014-04-17 14:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (449 votes), past polls