Re^4: counting instances of one array in another array

[jandrew]

For example

Update: key value look-up was wrong - fixed

use strict;
use warnings;
use Smart::Comments '###';
use Math::Fleximal;

my @observed = ("ab", "ab", "ad", "an", "bd", "bn", "dn");
my $ngramOrder  = 2;
my $firstletter = 'a';
my $lastletter  = 'z';
my $flexref     = [ $firstletter..$lastletter ];
my $count_ref;
my $base        = new Math::Fleximal( 'a', $flexref);
my $position    = new Math::Fleximal( 'zz', $flexref);
my $base_10     = new Math::Fleximal( 0, [ 0..9 ] );
### Fleximal Range is: $position->subtr( $base )->base_10
### Fleximals count from 0!
$| = 1;
### Build the list of hits
for my $item( @observed ){
    if( length( $item ) == $ngramOrder and
        $item =~/^[a-z]*$/                    ){
        #Add other scubbers as needed
        $count_ref->{$item}++;#Auto vivifys new keys
    }
}
### Result: $count_ref

### Access the possibilities
### Print known counts (counts from zero!)
for my $key ( sort keys %$count_ref ) {
    $position = $position->set_value( $key );
    my $int_position = $position->subtr( $base )->base_10;
    print "At position -$int_position- the count is: $count_ref->{$key
+}\n";
    #~ ### $position
}
### lookup a position count
my $number_position = 50;
print "At position -$number_position- the count is: " 
       . count_at_position( $number_position ) . "\n";
$number_position = 1;
print "At position -$number_position- the count is: " 
       . count_at_position( $number_position ) . "\n";

sub count_at_position{
    my ( $integer ) = @_;
    my  $flex_int = $base_10->set_value( $integer );
    my  $key = $flex_int->change_flex( $flexref );
    my  $string = $key->to_str();
    while( length( $string ) != $ngramOrder ) {
        $string = $firstletter . $string;
    }
    ### $string 
    my $count = ( exists $count_ref->{$string} ) ?
        $count_ref->{$string} : 0 ;
    return $count;
}

Gives results

### Fleximal Range is: '675'
### Fleximals count from 0!

### Build the list of hits

### Result: {
###           ab => 2,
###           ad => 1,
###           an => 1,
###           bd => 1,
###           bn => 1,
###           dn => 1
###         }

### Access the possibilities
### Print known counts (counts from zero!)
At position -1- the count is: 2
At position -3- the count is: 1
At position -13- the count is: 1
At position -29- the count is: 1
At position -39- the count is: 1
At position -91- the count is: 1

### lookup a position count

### $string: 'by'
At position -50- the count is: 0

### $string: 'ab'
At position -1- the count is: 2