Algorithm::QuineMcCluskey::Util - provide utility functions to


Algorithm-QuineMcCluskey documentation Contained in the Algorithm-QuineMcCluskey distribution.

Index


Code Index:

NAME

Top

Algorithm::QuineMcCluskey::Util - provide utility functions to Algorithm::QuineMcCluskey

VERSION

Top

This document describes version 0.01 released 24 June 2006.

DESCRIPTION

Top

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

FUNCTIONS

Top

uniqels

Returns unique elements of an arrayref; usable for deep structures

columns

Rotates 90 degrees a hashtable of the type used for %::primes

bin

Wrap oct() to provide easy conversion of a binary string to a number

tobit

Convert a number to an n-wide string of bits representing it

maskmatch

Returns true if a mask matches a minterm, false otherwise.

maskmatches

Returns the elements that match a mask, selected from an array

remel

Remove a value from an arrayref if it matches a mask

diffpos

Find the location of the first difference between two strings

hdist

Hamming distance

diffposes

Return pairwise the 'un-sameness' of two strings

stl

Splits a string into a list of its chars

TODO

Top

Documentation. Most of the subs are very simple, but they still could use a bit more explanation.

SEE ALSO

Top

Algorithm::QuineMcCluskey

AUTHOR

Top

Darren M. Kulp <darren@kulp.ch>

COPYRIGHT AND LICENSE

Top


Algorithm-QuineMcCluskey documentation Contained in the Algorithm-QuineMcCluskey distribution.
package Algorithm::QuineMcCluskey::Util;

use strict;
use warnings;

use Data::Dumper;
use List::MoreUtils qw(pairwise firstidx);
use List::Util qw(sum min);

use base qw(Exporter);
our @EXPORT = qw(
	bin columns diffpos diffposes hdist maskmatch maskmatches remel stl tobit
	uniqels
);
our @EXPORT_OK = qw(
	bin columns diffpos diffposes hdist maskmatch maskmatches remel stl tobit
	uniqels
);

our $VERSION = 0.01;

################################################################################
# Sub declarations
################################################################################
sub uniqels (@);
sub columns ($@);
sub diffpos ($$);
sub tobit ($$);
sub bin ($);
sub remel ($$);
sub diffposes;
sub stl ($);

sub uniqels (@) {
    my %h;
    map { $h{Dumper($_)}++ == 0 ? $_ : () } @_;
}

sub columns ($@) {
	my ($r, @c) = @_;
	map {
		my $o = $_;
		$o => [ grep {
			sum map {
				$_ eq $o ? 1 : 0
			} @{ $r->{$_} }
		} keys %$r ]
	} @c
}

sub bin ($) { oct "0b" . shift }

sub tobit ($$) { substr(unpack("B32", pack("N", shift)), -shift) }

sub maskmatch {
	my ($mask, $term) = @_;
	(my $mask0 = $mask) =~ s/$::dc/0/g;
	(my $mask1 = $mask) =~ s/$::dc/1/g;
	((bin $mask0 & bin $term) == bin $mask0) &&
		((bin $mask1 & bin $term) == bin $term)
}

sub maskmatches ($@) { my $m = shift; grep { maskmatch($m, $_) } @_ }

sub remel ($$) {
	my ($el, $a) = @_;
	my $pos = firstidx { maskmatch($el, $_) } @$a;
	splice(@$a, $pos, 1) if $pos >= 0;
	$a;
}

sub diffpos ($$) { firstidx { $_ } diffposes @_ }

sub hdist { sum diffposes @_ }

sub diffposes { pairwise { $a ne $b } @{[ stl shift ]}, @{[ stl shift ]} }

sub stl ($) { split //, shift }

1;

__END__