| Algorithm-QuineMcCluskey documentation | Contained in the Algorithm-QuineMcCluskey distribution. |
Algorithm::QuineMcCluskey::Util - provide utility functions to Algorithm::QuineMcCluskey
This document describes version 0.01 released 24 June 2006.
This module provides various utilities designed for (but not limited to) use in Algorithm::QuineMcCluskey.
Returns unique elements of an arrayref; usable for deep structures
Rotates 90 degrees a hashtable of the type used for %::primes
Wrap oct() to provide easy conversion of a binary string to a number
Convert a number to an n-wide string of bits representing it
Returns true if a mask matches a minterm, false otherwise.
Returns the elements that match a mask, selected from an array
Remove a value from an arrayref if it matches a mask
Find the location of the first difference between two strings
Hamming distance
Return pairwise the 'un-sameness' of two strings
Splits a string into a list of its chars
Documentation. Most of the subs are very simple, but they still could use a bit more explanation.
Darren M. Kulp <darren@kulp.ch>
Copyright (C) 2006 by Darren Kulp
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.7 or, at your option, any later version of Perl 5 you may have available.
| 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__