view release on metacpan or  search on metacpan

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

			return exists $true{ defined $v ? $v : '' } ? 1 : 0;
		};
	}

	return sub { $_[0] ? 1 : 0 };
} ## end sub _build_bool

=head2 length

    { munger => 'length' }

The character length of the stringified input, C<undef> counting as C<0> (an
absent value is a zero-length one -- e.g. an SNI-absent TLS record). This is the
cheap shape feature behind every C<*_length> column (domain, URL, filename, SNI,
hostname, ...): tunneling and generated names run long, so raw length is a
surprisingly strong corroborator next to L</entropy>. Length is counted in
B<characters>, not bytes, so a multi-byte name is measured as a human would read
it; use L</entropy> (which is byte-oriented) when you want per-symbol randomness.

=cut

sub _build_length {
	my ( $spec, $where ) = @_;
	return sub {
		my ($v) = @_;
		return length( defined $v ? "$v" : '' );
	};
}

=head2 entropy

    { munger => 'entropy' }

Shannon entropy of the input string, in B<bits per symbol> -- i.e.
C<-sum(p*log2(p))> over the frequencies of its bytes. This is the single most
common feature in the pipeline (DGA domains, randomized filenames, forged
User-Agents, generated SNIs / hostnames / principal names), because
machine-generated strings spread their characters far more evenly than
human-chosen ones and so score high, while a real word scores low. An empty
string is C<0>; the maximum is C<8> (every byte value equally likely).

Entropy is computed over the string's B<UTF-8 bytes> (matching L</hash>), so the
value is well-defined regardless of the scalar's internal encoding flag. Like
C<hash>, this munger is XS-accelerated -- a per-byte histogram plus a C<log> per
distinct byte -- with a pure-Perl fallback that produces identical values;
C<$Algorithm::ToNumberMunger::HAVE_XS> says which
is in use.

=cut

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 );
	}
	return $h;
} ## end sub _entropy_pp

=head2 ngram

    { munger => 'ngram', counts => { th => 152, he => 128, in => 94, ... } }
    # defaults: smoothing => 1, fold_case => 1; n is inferred from the keys

Mean per-gram surprisal of the input string against a B<precomputed, frozen>
n-gram count table: C<sum(-ln p(gram)) / gram_count>, each gram's probability
smoothed exactly as in L</frozen_freq_map>. This is C<frozen_freq_map>'s sequential cousin
and the strongest single gibberish detector: L</entropy> misses
I<pronounceable> generated names and is unreliable on short strings, while an
n-gram score against (say) hostname bigram statistics catches both -- real
words ride the common bigrams and score low, generated names keep hitting rare
ones and score high. Dividing by the gram count keeps scores comparable across
lengths.

C<counts> maps each n-gram to how often it was observed when the table was
built; all keys must be the same length, and that length B<is> C<n> (bigrams
are the usual choice -- a 26x26 table stays tiny in C<info.json>; past
C<$FROZEN_FREQ_MAP_WARN_KEYS> entries it warns like C<frozen_freq_map>). C<total> defaults
to the sum of counts and may be given larger to prune the tail, exactly as in
C<frozen_freq_map>. A gram absent from the table gets the smoothed unseen-bucket
probability -- an unseen gram is the interesting case -- so C<smoothing> must
be > 0 (default C<1>). With C<fold_case> (default on) the input is lowercased
before scoring, matching the usual lowercased table. A string with no grams
(shorter than C<n>) scores C<0>. Grams are taken over B<characters>, matching
L</length> rather than the byte-oriented C<entropy>.

=cut

sub _build_ngram {
	my ( $spec, $where ) = @_;

	my $counts = $spec->{counts};
	croak "ngram munger$where requires a non-empty 'counts' hashref"
		unless ref $counts eq 'HASH' && %$counts;

	my $n;
	my $sum = 0;
	for my $g ( keys %$counts ) {
		$n = length $g unless defined $n;
		croak "ngram munger$where: all 'counts' keys must be the same length "
			. "(that length is n); got '$g' alongside a $n-gram"
			unless length($g) == $n;
		my $c = $counts->{$g};
		croak "ngram munger$where: count for '$g' ('"
			. ( defined $c ? $c : 'undef' )

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

		unless ref $parts eq 'ARRAY' && @$parts;

	my ( $parse, $getter_for ) = _datetime_engine( $spec->{format}, $where );
	my @get = map { $getter_for->($_) } @$parts;

	my ( $memo_in, @memo_out );
	my $code = sub {
		my ($v) = @_;
		return @memo_out
			if defined $v && defined $memo_in && $v eq $memo_in;
		my $t   = $parse->($v);
		my @out = map { $_->($t) } @get;
		( $memo_in, @memo_out ) = ( $v, @out );
		return @out;
	};
	return ( $code, scalar @$parts );
} ## end sub _build_datetime_multi

=head2 hash

    { munger => 'hash', buckets => 1024 }
    { munger => 'hash', buckets => 1024, seed => 7 }
    { munger => 'hash' }                          # raw 32-bit FNV-1a value

Feature hashing for high-cardinality categoricals you do not want to (or cannot)
enumerate with C<enum>. The input is stringified and run through 32-bit FNV-1a;
with C<buckets> the result is reduced modulo that many buckets (C<[0, buckets)>),
otherwise the full 32-bit hash is returned. An optional C<seed> lets you decorrelate
two hashed columns.

This is the one munger that is XS-accelerated: FNV-1a is a per-byte loop with a
32-bit modular multiply, which is slow in pure Perl and (on a 32-bit perl) fussy
to get exactly right. C<$Algorithm::ToNumberMunger::HAVE_XS>
reports whether the compiled path is in use; a pure-Perl fallback (exact on a
64-bit perl) is used otherwise, and both produce identical values.

=cut

sub _build_hash {
	my ( $spec, $where ) = @_;

	my $buckets = $spec->{buckets};
	croak "hash munger$where: 'buckets' must be a positive integer"
		if defined $buckets && $buckets !~ /\A[1-9][0-9]*\z/;

	my $seed = defined $spec->{seed} ? $spec->{seed} : 0;
	croak "hash munger$where: 'seed' must be a non-negative integer"
		if $seed !~ /\A[0-9]+\z/;

	my $fn = $HAVE_XS ? \&_fnv1a_xs : \&_fnv1a_pp;
	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

    # Shannon entropy of just the TLD: lowercase, keep the last dot-label
    { munger => 'chain',
      steps  => [ { op => 'lc' }, { op => 'split', on => '.', index => -1 } ],
      then   => { munger => 'entropy' } }

    # a hex request id buried in a token like 'req-0x2F'
    { munger => 'chain',
      steps  => [ { op => 'capture', pattern => 'req-(0x[0-9a-fA-F]+)' } ],
      then   => { munger => 'num', base => 16 } }

Run the input through a list of string pre-transforms (C<steps>, applied in
order), then hand the result to a terminal munger (C<then>) for the actual
number. Every string munger above scores the I<whole> value; C<chain> is how a
feature targets a I<piece> of it -- the entropy of the TLD alone, the length
of the first path segment, an enum over a normalized token -- without asking
the writer's caller to pre-slice its input. Each step is a hashref with an
C<op>:

=over 4

=item * C<lc> / C<uc> - case-fold the value.

=item * C<trim> - strip leading and trailing whitespace.

=item * C<split> - split on the literal separator C<on> and keep piece
C<index> (0-based; negative counts from the end, so C<-1> is a hostname's last
label). An index past either end yields the empty string.

=item * C<capture> - match the regex C<pattern> and keep capture group
C<group> (default C<1>). No match, or a group that did not participate, yields
the empty string. A true C<ignore_case> matches case-insensitively; the
L</match> trust note applies here too.

=item * C<replace> - replace every match of the regex C<pattern> with the
literal string C<with> (default: delete the matches). C<ignore_case> as above.

=back

C<then> is a full munger spec and may be any built-in that takes one value --
including another C<chain>. All step parameters and the terminal spec are
validated at build time. An undef input enters the chain as the empty string;
whether an empty result is acceptable is the terminal's call (C<entropy> and
C<length> score it C<0>, C<num> croaks).

The multi-output form works too: put C<into> on the B<chain> and the C<parts>
on the terminal, e.g. C<trim> a sloppy timestamp before a L</datetime>
C<sin>/C<cos> expansion.

=cut