# eww - it's a Base.pm
package Algorithm::MarkovChain::Base;
use strict;
use warnings;
use Carp;
use fields qw(seperator _symbols _recover_symbols _start_states);
sub new {
my $invocant = shift;
my %args = @_;
my $class = ref $invocant || $invocant;
my Algorithm::MarkovChain::Base $self = fields::new($class);
$self->{seperator} = $;;
$self->{_symbols} = {};
$self->{_recover_symbols} = $args{recover_symbols};
return $self;
}
sub seed {
my Algorithm::MarkovChain::Base $self = shift;
my %args = @_;
local $; = $self->{seperator};
croak 'seed: no symbols' unless $args{symbols};
croak 'seed: bad symbols' unless ref($args{symbols}) eq 'ARRAY';
my $longest = $args{longest} || 4;
our @symbols;
*symbols = $args{symbols};
push @{ $self->{_start_states} }, $symbols[0];
if ($self->{_recover_symbols}) {
$self->{_symbols}{$_} = $_ for @symbols;
}
for my $length (1..$longest) {
for (my $i = 0; ($i + $length) < @symbols; $i++) {
my $link = join($;, @symbols[$i..$i + $length - 1]);
$self->increment_seen($link, $symbols[$i + $length]);
}
}
}
sub spew {
my Algorithm::MarkovChain::Base $self = shift;
my %args = @_;
local $; = $self->{seperator};
my $longest_sequence = $self->longest_sequence()
or croak "don't appear to be seeded";
my $length = $args{length} || 30;
my $subchain = $args{longest_subchain} || $length;
my @fin; # final chain
my @sub; # current sub-chain
if ($args{complete} && ref $args{complete} eq 'ARRAY') {
@sub = @{ $args{complete} };
}
while (@fin < $length) {
if (@sub && (!$self->sequence_known($sub[-1]) || (@sub > $subchain))) { # we've gone terminal
push @fin, @sub;
@sub = ();
next if $args{force_length}; # ignore stop_at_terminal
last if $args{stop_at_terminal};
}
unless (@sub) {
if ($args{strict_start}) {
our @starts;
*starts = $self->{_start_states};
@sub = $starts[rand $#starts];
}
else {
@sub = split $;, $self->random_sequence();
}
}
my $consider = 1;
if (@sub > 1) {
$consider = int rand ($longest_sequence - 1);
}
my $start = join($;, @sub[-$consider..-1]);
next unless $self->sequence_known($start); # loop if we missed
my $cprob;
my $target = rand;
my %options = $self->get_options($start);
for my $word (keys %options) {
$cprob += $options{$word};
if ($cprob >= $target) {
push @sub, $word;
last;
}
}
}
$#fin = $length
if $args{force_length};
@fin = map { $self->{_symbols}{$_} } @fin
if $self->{_recover_symbols};
return @fin;
}
sub increment_seen { croak "virtual method call" }
sub get_options { croak "virtual method call" }
sub longest_sequence { croak "virtual method call" }
sub sequence_known { croak "virtual method call" }
sub random_sequence { croak "virtual method call" }
1;
__END__