view release on metacpan or  search on metacpan

lib/Algorithm/QuineMcCluskey/Util.pm  view on Meta::CPAN

=cut

package Algorithm::QuineMcCluskey::Util;

use strict;
use warnings;
use 5.016001;

use List::Util qw(any);
use List::Compare::Functional qw(is_LequivalentR is_LsubsetR);

use Exporter;
our @ISA = qw(Exporter);

our %EXPORT_TAGS = (
	all => [ qw(
		covered_least
		find_essentials
		hammingd1pos
		maskedmatch
		matchcount
		purge_elements
		remels
		row_dominance
		transpose
		uniqels
	) ],
);

our @EXPORT_OK = (
	@{ $EXPORT_TAGS{all} }
);

our $VERSION = 1.01;

=head1 DESCRIPTION

This module provides various utilities designed for (but not limited to) use in
Algorithm::QuineMcCluskey.

The prime implicant and essentials "tables" are in the form of a hash of
array refs, and are manipulated with the functions find_essentials(),
least_covered(), purge_elements(), remels(), row_dominance(), transpose(),
and uniqels().

=cut

=head2 FUNCTIONS

=head3 matchcount()

Returns the count of a search string Y found in the source string X.

E.g.:

    my $str = "d10d11d1d"; 
    matchcount($str, "d");     # returns 4
    matchcount($str, "d1");    # returns 3

To search for only the string without a regular expression accidentally
interfering, enclose the search string between '\Q' and '\E'. E.g.:

    #
    # We don't know what's in $looking, so de-magic it.
    #
    matchcount($str, '\E' . $looking . '\Q]);

=cut

sub matchcount
{
	my($x, $y) = @_;

	return scalar(() = $x=~ m/$y/g);
}

=head3 maskedmatch()

Returns the terms that match a mask made up of zeros, ones, and don't-care
characters.

    my @rterms = maskedmatch("010-0", @terms);

=cut

sub maskedmatch
{
	my($mask, @terms) = @_;
	my @t;

	#
	# Make two patterns based on the don't-care characters
	# in the mask (assumed to be the character that's not
	# a zero or a one, an assumption enforced in BUILD.)
	#
	(my $m0 = $mask) =~ s/[^01]/0/g;
	(my $m1 = $mask) =~ s/[^01]/1/g;
	$m0 = oct "0b" . $m0;
	$m1 = oct "0b" . $m1;

	for my $x (@terms)
	{
		my $b = oct "0b" . $x;
		push @t, $x if ((($m0 & $b) == $m0) && (($m1 & $b) == $b));
	}

	return @t;
}

=head3 maskedmatchindexes()

Returns the indexes of the terms that match a mask made up of zeros,
ones, and don't-care characters.

    my @pos = maskedmatchindexes("010-0", @terms);

=cut

sub maskedmatchindexes
{