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 )