Algorithm-ToNumberMunger
view release on metacpan or search on metacpan
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
sub _build_entropy {
my ( $spec, $where ) = @_;
my $fn = $HAVE_XS ? \&_entropy_xs : \&_entropy_pp;
return sub {
my ($v) = @_;
return $fn->( defined $v ? "$v" : '' );
};
}
# Pure-Perl Shannon entropy (bits), used only when the XS did not build. Byte
# view via an explicit encode so it matches the XS's SvPVutf8, and so the same
# string scores the same regardless of its internal flag.
sub _entropy_pp {
my ($str) = @_;
utf8::encode($str);
my $n = length $str;
return 0 unless $n;
my %count;
$count{$_}++ for unpack 'C*', $str;
my $ln2 = log(2);
my $h = 0;
for my $c ( values %count ) {
my $p = $c / $n;
$h -= $p * ( log($p) / $ln2 );
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
return sub {
my ($v) = @_;
my $h = $fn->( defined $v ? "$v" : '', $seed );
return defined $buckets ? $h % $buckets : $h;
};
} ## end sub _build_hash
# Pure-Perl 32-bit FNV-1a, used only when the XS did not build. On a 64-bit
# perl the intermediate h*16777619 (< 2**57) stays an exact integer, so the
# masked result matches the C version bit for bit. The string is always
# utf8-encoded first so a value hashes as its UTF-8 bytes no matter the internal
# flag -- the same well-defined bytes SvPVutf8 hands the XS.
sub _fnv1a_pp {
my ( $str, $seed ) = @_;
utf8::encode($str);
my $h = ( 2166136261 ^ ( $seed & 0xFFFFFFFF ) ) & 0xFFFFFFFF;
for my $c ( unpack 'C*', $str ) {
$h ^= $c;
$h = ( $h * 16777619 ) & 0xFFFFFFFF;
}
return $h;
} ## end sub _fnv1a_pp
=head2 chain
lib/Algorithm/ToNumberMunger.xs view on Meta::CPAN
UV seed
PREINIT:
STRLEN len;
const unsigned char *p;
U32 h;
STRLEN i;
CODE:
/* Hash the UTF-8 byte encoding of the string's characters, regardless of
* the scalar's internal flag. This is well-defined for any input (a wide
* character would make SvPVbyte croak) and matches the pure-Perl fallback,
* which utf8-encodes before hashing. */
p = (const unsigned char *) SvPVutf8(str, len);
h = (U32) 2166136261UL ^ (U32) seed;
for (i = 0; i < len; i++) {
h ^= (U32) p[i];
h *= (U32) 16777619UL;
}
RETVAL = (UV) h;
OUTPUT:
RETVAL
NV
lib/Algorithm/ToNumberMunger.xs view on Meta::CPAN
STRLEN len;
const unsigned char *p;
STRLEN i;
UV counts[256];
NV h, n, pr, ln2;
CODE:
/* Shannon entropy (in bits) over the UTF-8 bytes of the string, matching
* the pure-Perl fallback's byte view. A single per-byte count pass plus a
* pass over the (at most 256) seen values -- the loop and the log() per
* distinct byte are what make this worth doing in C. */
p = (const unsigned char *) SvPVutf8(str, len);
if (len == 0) {
RETVAL = 0.0;
}
else {
Zero(counts, 256, UV);
for (i = 0; i < len; i++)
counts[p[i]]++;
n = (NV) len;
ln2 = log((NV) 2.0);
h = 0.0;
( run in 1.922 second using v1.01-cache-2.11-cpan-600a1bdf6e4 )