Algorithm-QuineMcCluskey
view release on metacpan or search on metacpan
lib/Algorithm/QuineMcCluskey.pm view on Meta::CPAN
# minterms (or maxterms). The resulting hash of arrays is our
# set of prime implicants.
#
my %p;
my @bit_terms = $self->minmax_bit_terms();
for my $unmarked (grep { !$implicant{$_} } keys %implicant)
{
my @matched = maskedmatch($unmarked, @bit_terms);
$p{$unmarked} = [@matched] if (@matched);
}
#
### generate_primes() -- prime implicants: hasharray(\%p)
#
return \%p;
}
sub generate_covers
{
my $self = shift;
return [ $self->recurse_solve($self->get_primes, 0) ];
}
sub generate_essentials
{
my $self = shift;
return [sort find_essentials($self->get_primes) ];
}
sub solve
{
my $self = shift;
my $c = $self->get_covers();
### solve -- get_covers() returned: arrayarray($c)
return $self->to_boolean($c->[0]);
}
sub all_solutions
{
my $self = shift;
my $c = $self->get_covers();
### all_solutions -- get_covers() returned: arrayarray($c)
return map {$self->to_boolean($_)} @$c;
}
#
# recurse_solve
#
# Recursive divide-and-conquer solver
#
# "To reduce the complexity of the prime implicant chart:
#
# 1. Select all the essential prime impliciants. If these PIs cover all
# minterms, stop; otherwise go the second step.
#
# 2. Apply Rules 1 and 2 to eliminate redundant rows and columns from
# the PI chart of non-essential PIs. When the chart is thus reduced,
# some PIs will become essential (i.e., some columns will have a single
# 'x'. Go back to step 1."
#
# Introduction To Logic Design, by Sajjan G. Shiva, page 129.
#
sub recurse_solve
{
my $self = shift;
my %primes = %{ $_[0] };
my $level = $_[1];
my @prefix;
my @covers;
my @essentials;
#
##### recurse_solve() level: $level
##### recurse_solve() called with
##### primes: "\n" . chart(\%primes, $self->width)
#
my @essentials_next = find_essentials(\%primes);
#
##### Begin prefix/essentials loop.
#
do
{
#
##### recurse_solve() do loop, essentials: @essentials
#
# Remove the essential prime implicants from
# the prime implicants table.
#
@essentials = @essentials_next;
#
##### Purging prime hash of: "[" . join(", ", sort @essentials) . "]"
#
purge_elements(\%primes, @essentials);
push @prefix, @essentials;
##### recurse_solve() @prefix now: "[" . join(", ", sort @prefix) . "]"
#
# Now eliminate dominated rows and columns.
#
# Rule 1: A row dominated by another row can be eliminated.
# Rule 2: A column that dominated another column can be eliminated.
#
#### Looking for rows dominated by other rows
#### primes table: "\n" . chart(\%primes, $self->width)
my @rows = row_dominance(\%primes, 1);
delete $primes{$_} for (@rows);
#### row_dominance returns rows for removal: "[" . join(", ", @rows) . "]"
#### primes now: "\n" . chart(\%primes, $self->width)
my %cols = transpose(\%primes);
my @cols = row_dominance(\%cols, 0);
remels(\%primes, @cols);
#### row_dominance returns cols for removal: "[" . join(", ", @cols) . "]"
#### primes now: "\n" . chart(\%primes, $self->width)
@essentials_next = find_essentials(\%primes);
##### recurse_solve() essentials after purge/dom: @essentials
} until (is_LequivalentR([
[ @essentials] => [ @essentials_next ]
]));
return [ reverse sort @prefix ] unless (keys %primes);
#
# Find a term (there may be more than one) that has the least
# number of prime implicants covering it, and a list of those
# prime implicants. Use that list to figure out the best set
# to cover the rest of the terms.
#
##### recurse_solve() Primes after loop
##### primes: "\n" . chart(\%primes, $self->width)
#
my($term, @ta) = covered_least(\%primes);
#
##### Least Covered term: $term
##### Covered by: @ta
#
# Make a copy of the section of the prime implicants
# table that don't cover that term.
#
my %r = map {
$_ => [ grep { $_ ne $term } @{ $primes{$_} } ]
} keys %primes;
#
# For each such cover, recursively solve the table with that column
# removed and add the result(s) to the covers table after adding
# back the removed term.
#
for my $ta (@ta)
{
my (@c, @results);
my %reduced = %r;
#
# Use this prime implicant -- delete its row and columns
#
##### Purging reduced hash of: $ta
#
purge_elements(\%reduced, $ta);
if (keys %reduced and scalar(@c = $self->recurse_solve(\%reduced, $level + 1)))
{
#
##### recurse_solve() at level: $level
##### returned (in loop): arrayarray(\@c)
#
@results = map { [ reverse sort (@prefix, $ta, @$_) ] } @c;
}
else
{
@results = [ reverse sort (@prefix, $ta) ]
}
push @covers, @results;
#
##### Covers now at: arrayarray(\@covers)
#
}
#
##### Weed out the duplicated and expensive solutions.
#
@covers = uniqels @covers;
if ($self->minonly and scalar @covers > 1)
{
my @weededcovers = shift @covers;
my $mincost = matchcount(join('', @{$weededcovers[0]}), "[01]");
for my $c (@covers)
{
my $cost = matchcount(join('', @$c), "[01]");
#
##### Cover: join(',', @$c)
##### Cost: $cost
( run in 1.114 second using v1.01-cache-2.11-cpan-39bf76dae61 )