view release on metacpan or  search on metacpan

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

    $self->[0][2] = scalar @obs;
    return;
}

sub feed_values {
    croak qq{\nThis method expects 3 arguments.} if @_ != 4;
    my ($self, $trans, $emis, $start) = @_;
    croak qq{\nThis method expects 3 arguments.} if (ref $trans ne q{ARRAY} || ref $emis ne q{HASH} || ref $start ne q{ARRAY});
    my $obs_tipos = $self->[0][1];
    my $obs_numero = $self->[0][2];
    my $t_length = &_check_trans($trans);
    &_check_emis($emis, $obs_tipos, $obs_numero, $t_length);
    &_check_start($start, $t_length);
    $self->[1][0] = $trans;
    $self->[1][1] = $emis;
    $self->[1][2] = $start;
    my @stop; # 0.1/1 nao faz diferenca e para|comeca (stop|start) sempre iguala = 0
    for (0..$#{$trans}) { push @stop, 1 };
    $self->[1][3] = [@stop];
    return;
}

sub _check_start {
    my ($start, $t_length) = @_;
    croak qq{\nThere must be an initial probablity for each state in the start ARRAY.} if scalar @{$start} != $t_length;
    for (@{$start}) { croak qq{\nThe start ARRAY values must be numeric.} if !(/^[+-]?\ *(\d+(\.\d*)?|\.\d+)([eE][+-]?\d+)?$/) };
    my $sum =0;
    for (@{$start}) { $sum += $_ }
    croak qq{\nThe starting probabilities must sum to 1.} if ($sum <= 0.95 || $sum >= 1.05);
    return;
}

sub _check_emis {
    my ($emis, $obs_tipos, $obs_numero, $t_length) = @_;
    my @emis_keys = (keys %{$emis});
    @emis_keys = sort {$a cmp $b} @emis_keys;
    croak qq{\nThere must be an entry in the emission matrix for each type of observation in the observation series.} if $obs_numero != scalar @emis_keys;
    for (0..$#emis_keys) { croak qq{\nThe observations in the emission matrix do not match those in the observation series.} if $emis_keys[$_] ne $obs_tipos->[$_]; }
    for (values %{$emis}) { 
        croak qq{\nThere must be a probability value for each state in the emission matrix.} if scalar @{$_} != $t_length;
        for my $cell (@{$_}) { croak qq{\nThe emission matrix values must be numeric.} if $cell !~ /^[+-]?\ *(\d+(\.\d*)?|\.\d+)([eE][+-]?\d+)?$/; }
    }
    for my $i (0..$t_length-1) { # só fazendo 2-estado agora
        my $sum = 0;
        for my $o (@{$obs_tipos}) { $sum += $emis->{$o}[$i] }
        croak qq{\nThe emission matrix column must sum to 1.} if ($sum <= 0.95 || $sum >= 1.05);
    }
    return;
}

sub _check_trans {
    my $trans = shift;
    my $t_length = scalar @{$trans};
    for (@{$trans}) { 
        croak qq{\nThe transition matrix much be square.} if scalar @{$_} != $t_length;
        my $sum = 0;
        for my $cell (@{$_}) { 
            croak qq{\nThe transition matrix values must be numeric.} if $cell !~ /^[+-]?\ *(\d+(\.\d*)?|\.\d+)([eE][+-]?\d+)?$/;
            $sum += $cell
        }
        croak qq{\nThe transition matrix row must sum to 1.} if ($sum <= 0.95 || $sum >= 1.05);
    }
    return $t_length;
}

sub random_initialise {
    my ($self, $states) = @_;
    my $obs_names = $self->[0][1];
    my $trans = &_gera_trans($states);
    my $emis = &_gera_emis($states, $obs_names);
    my $start = &_gera_init($states);
    $self->[1][0] = $trans;
    $self->[1][1] = $emis;
    $self->[1][2] = $start;
    my @stop; # 0.1/1 nao faz diferenca e para|comeca (stop|start) sempre iguala = 0
    for (0..$states-1) { push @stop, 1 };
    $self->[1][3] = [@stop];
    return;
}

sub _gera_init {
    my $length = shift;
    my $sum = 0;
    my $init = [];
    srand;
    $#{$init} = $length-1; # só fazendo 2-estado agora
    for (@{$init}) { $_ = rand; $sum += $_ }
    #/ normalise such that sum is equal to 1
    for (@{$init}) { $_ /= $sum }
    return $init;
}

sub _gera_trans {
    my $length = shift;
    my $t = [];
    $#{$t} = $length-1; # só fazendo 2-estado agora
    #/ gera_init normalises
    for (@{$t}) { $_ = &_gera_init($length); }
    return $t;
}

sub _gera_emis {
    my ($length, $obs_names) = @_;
    my $e = {};
    srand;
    for (@{$obs_names}) { 
        my $init = [];
        $#{$init} = $length-1; # só fazendo 2-estado agora
        for (@{$init}) { $_ = rand;  }
        $e->{$_} = $init;
    }
    # para cada estado a suma deve iguala 1 - normalise such that sum of obs_x|state = 1
    for my $i (0..$length-1) { # só fazendo 2-estado agora
        my $sum = 0;
        for my $o (@{$obs_names}) { $sum += $e->{$o}[$i] }
        for my $o (@{$obs_names}) { $e->{$o}[$i] /= $sum }
    }
    #print qq{\n\nauto-gera emis de numeros aleatorios que sumam 1 para cada estado}; draw($e);
    return $e;
}

sub _forwardbackward_reestimacao {
    my $self = shift;

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

    }
    return;
}

sub _baum_welch_10 {
    my $self = shift;
    for (0..10) { $self->_forwardbackward_reestimacao; }
    return;
}

sub _baum_welch_length {
    my $self = shift;
    for (0..$#{$self->[0][0]}) { $self->_forwardbackward_reestimacao; }
    return;
}

sub results {
    my $self = shift;
    my $trans = $self->[1][0];
    my $emis = $self->[1][1];
    my $start = $self->[1][2];

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

}

1; # Magic true value required at end of module

__END__

#ARRAY REFERENCE (0)
#  |  
#  |__ARRAY REFERENCE (1) [ '->[0]' ]
#  |    |  
#  |    |__ARRAY REFERENCE (2) ---LONG_LIST_OF_SCALARS--- [ length = 33 ] e.g. 0..2:  obs2, obs3, obs3 [ '->[0][0]' ] # a serie
#  |    |  
#  |    |__ARRAY REFERENCE (2) ---LONG_LIST_OF_SCALARS--- [ length = 3 ]: obs3, obs1, obs2 [ '->[0][1]' ] # a lista de tipos de observacoes
#  |    |  
#  |    |__SCALAR = '3' (2)  [ '->[0][2]' ] # o numero de tipos de observacoes 
#  |  
#  |__ARRAY REFERENCE (1) [ '->[1]' ]
#  |    |  
#  |    |__ARRAY REFERENCE (2) [ '->[1][0]' ] # transition matrix
#  |    |    |  
#  |    |    |__ARRAY REFERENCE (3) ---LONG_LIST_OF_SCALARS--- [ length = 2 ]: 0.933779184947876, 0.0718663090308487 [ '->[1][0][0]' ]
#  |    |    |  
#  |    |    |__ARRAY REFERENCE (3) ---LONG_LIST_OF_SCALARS--- [ length = 2 ]: 0.0662208150521236, 0.864944219467616 [ '->[1][0][1]' ]
#  |    |  
#  |    |__HASH REFERENCE (2) [ '->[1][1]' ] # emission matrix
#  |    |    |  
#  |    |    |__'obs3'=>ARRAY REFERENCE (3) ---LONG_LIST_OF_SCALARS--- [ length = 2 ]: 0.211448366743702, 0.465609305295478 [ '->[1][1]{obs3}' ]
#  |    |    |  
#  |    |    |__'obs1'=>ARRAY REFERENCE (3) ---LONG_LIST_OF_SCALARS--- [ length = 2 ]: 0.640481492730478, 7.18630557481621e-09 [ '->[1][1]{obs1}' ]
#  |    |    |  
#  |    |    |__'obs2'=>ARRAY REFERENCE (3) ---LONG_LIST_OF_SCALARS--- [ length = 2 ]: 0.14807014052582, 0.534390687518216 [ '->[1][1]{obs2}' ]
#  |    |  
#  |    |__ARRAY REFERENCE (2) ---LONG_LIST_OF_SCALARS--- [ length = 2 ]: 4.52394236439737e-30, 1 [ '->[1][2]' ] # start conditions
#  |
#  |__ ARRAY REFERENCE (1)  [ '->[2]' ] # perp
#

=head1 SEE ALSO

Algorithm::Viterbi

=cut