AI-MaxEntropy
view release on metacpan or search on metacpan
AI-MaxEntropy.xs view on Meta::CPAN
struct f_map_t* f_map =
INT2PTR(struct f_map_t*, SvIV(*hvref_fetch(_c, "f_map")));
int** lambda_idx = f_map->lambda_idx;
/* fetch other useful data */
SV* smoother = *hvref_fetch(self, "smoother");
int x_num = SvIV(*hvref_fetch(self, "x_num"));
int y_num = SvIV(*hvref_fetch(self, "y_num"));
int f_num = SvIV(*hvref_fetch(self, "f_num"));
/* intermediate variables */
AV* av_d_log_lh;
char* smoother_type;
int i, j, x, y, lambda_i;
double log_lh, sum_exp_lambda_f, sigma, fxy;
double* lambda_f = (double*)malloc(sizeof(double) * y_num);
double* exp_lambda_f = (double*)malloc(sizeof(double) * y_num);
double* d_log_lh = (double*)malloc(sizeof(double) * f_num);
double* lambda = (double*)malloc(sizeof(double) * f_num);
CODE:
/* initialize */
TRACE("enter");
for (i = 0; i < f_num; i++)
AI-MaxEntropy.xs view on Meta::CPAN
for (j = 0; j < samples->x_len[i]; j++) {
lambda_i = lambda_idx[y][samples->x[i][j]];
if (lambda_i != -1)
d_log_lh[lambda_i] += samples->w[i] *
(fxy - exp_lambda_f[y] / sum_exp_lambda_f);
}
}
}
TRACE("finish log likelihood and gradient");
/* smoothing */
if (SvOK(smoother) && hvref_exists(smoother, "type")) {
smoother_type = SvPV_nolen(*hvref_fetch(smoother, "type"));
if (strcmp(smoother_type, "gaussian") == 0) {
sigma = SvOK(*hvref_fetch(smoother, "sigma")) ?
SvNV(*hvref_fetch(smoother, "sigma")) : 1.0;
for (i = 0; i < f_num; i++) {
log_lh -= (lambda[i] * lambda[i]) / (2 * sigma * sigma);
d_log_lh[i] -= lambda[i] / (sigma * sigma);
}
}
}
TRACE("finish smoothing");
/* negate the value and finish */
---
abstract: Perl extension for learning Maximum Entropy Models
author:
- Laye Suen, <laye@cpan.org>
distribution_type: module
generated_by: Module::Install version 0.68
license: MIT
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.3.html
version: 1.3
name: AI-MaxEntropy
no_index:
directory:
- inc
- t
new
Create a Maximum Entropy learner. Optionally, initial values of
properties can be specified.
my $me1 = AI::MaxEntropy->new;
my $me2 = AI::MaxEntropy->new(
algorithm => { epsilon => 1e-6 });
my $me3 = AI::MaxEntropy->new(
algorithm => { m => 7, epsilon => 1e-4 },
smoother => { type => 'gaussian', sigma => 0.8 }
);
see
Let the Maximum Entropy learner see a sample.
my $me = AI::MaxEntropy->new;
# see a sample with default weight 1.0
$me->see(['red', 'round'] => 'apple');
L-BFGS provides full functionality, while GIS runs faster, but only
applicable on limited scenarios.
To use GIS, the following conditions must be satisified:
1. All samples have same number of active features
2. No feature has been cut
3. No smoother is used (in fact, the property "smoother" is simplly
ignored when the type of algorithm equal to 'gis').
This property "algorithm" is supposed to be a hash ref, like
{
type => ...,
progress_cb => ...,
param_1 => ...,
param_2 => ...,
...,
param_n => ...
}
type
The entry "type => ..." specifies which algorithm is used for the
optimization. Valid values include:
'lbfgs' Limited-memory Broyden-Fletcher-Goldfarb-Shanno (L-BFGS)
'gis' General Iterative Scaling (GIS)
If ommited, 'lbfgs' is used by default.
progress_cb
The entry "progress_cb => ..." specifies the progress callback
subroutine which is used to trace the process of the algorithm. The
specified callback routine will be called at each iteration of the
algorithm.
For L-BFGS, "progress_cb" will be directly passed to "fmin" in
Algorithm::LBFGS. f(x) is the negative log-likelihood of current lambda
vector.
For GIS, the "progress_cb" is supposed to have a prototype like
progress_cb(i, lambda, d_lambda, lambda_norm, d_lambda_norm)
"i" is the number of the iterations, "lambda" is an array ref containing
the current lambda vector, "d_lambda" is an array ref containing the
delta of the lambda vector in current iteration, "lambda_norm" and
"d_lambda_norm" are Euclid norms of "lambda" and "d_lambda"
respectively.
For both L-BFGS and GIS, the client program can also pass a string
For L-BFGS, the parameters will be directly passed to Algorithm::LBFGS
object, please refer to "Parameters" in Algorithm::LBFGS for details.
For GIS, there is only one parameter "epsilon", which controls the
precision of the algorithm (similar to the "epsilon" in
Algorithm::LBFGS). Generally speaking, a smaller "epsilon" produces a
more precise result. The default value of "epsilon" is 1e-3.
smoother
The smoother is a solution to the over-fitting problem. This property
chooses which type of smoother the client program want to apply and sets
the smoothing parameters.
Only one smoother have been implemented in this version of the module,
the Gaussian smoother.
One can apply the Gaussian smoother as following,
my $me = AI::MaxEntropy->new(
smoother => { type => 'gaussian', sigma => 0.6 }
);
The parameter "sigma" indicates the strength of smoothing. Usually,
sigma is a positive number no greater than 1.0. The strength of
smoothing grows as sigma getting close to 0.
SEE ALSO
AI::MaxEntropy::Model, AI::MaxEntropy::Util
Algorithm::LBFGS
inc/Module/AutoInstall.pm view on Meta::CPAN
else {
$DisabledTests{$_} = 1 for map { glob($_) } @tests;
}
}
$UnderCPAN = _check_lock(); # check for $UnderCPAN
if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
require Config;
print
"*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n";
# make an educated guess of whether we'll need root permission.
print " (You may need to do that as the 'root' user.)\n"
if eval '$>';
}
print "*** $class configuration finished.\n";
chdir $cwd;
# import to main::
inc/Module/Install/Metadata.pm view on Meta::CPAN
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
$VERSION = '0.68';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
my @scalar_keys = qw{
name module_name abstract author version license
distribution_type perl_version tests installdirs
};
my @tuple_keys = qw{
build_requires requires recommends bundles
};
sub Meta { shift }
sub Meta_ScalarKeys { @scalar_keys }
sub Meta_TupleKeys { @tuple_keys }
inc/Module/Install/Metadata.pm view on Meta::CPAN
while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
$self->feature( $name, @$mods );
}
return $self->{values}->{features}
? @{ $self->{values}->{features} }
: ();
}
sub no_index {
my $self = shift;
my $type = shift;
push @{ $self->{values}{no_index}{$type} }, @_ if $type;
return $self->{values}{no_index};
}
sub read {
my $self = shift;
$self->include_deps( 'YAML', 0 );
require YAML;
my $data = YAML::LoadFile('META.yml');
inc/Test/Builder.pm view on Meta::CPAN
use Config;
# Load threads::shared when threads are turned on.
# 5.8.0's threads are so busted we no longer support them.
if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'}) {
require threads::shared;
# Hack around YET ANOTHER threads::shared bug. It would
# occassionally forget the contents of the variable when sharing it.
# So we first copy the data, then share, then put our copy back.
*share = sub (\[$@%]) {
my $type = ref $_[0];
my $data;
if( $type eq 'HASH' ) {
%$data = %{$_[0]};
}
elsif( $type eq 'ARRAY' ) {
@$data = @{$_[0]};
}
elsif( $type eq 'SCALAR' ) {
$$data = ${$_[0]};
}
else {
die("Unknown type: ".$type);
}
$_[0] = &threads::shared::share($_[0]);
if( $type eq 'HASH' ) {
%{$_[0]} = %$data;
}
elsif( $type eq 'ARRAY' ) {
@{$_[0]} = @$data;
}
elsif( $type eq 'SCALAR' ) {
${$_[0]} = $$data;
}
else {
die("Unknown type: ".$type);
}
return $_[0];
};
}
# 5.8.0's threads::shared is busted when threads are off
# and earlier Perls just don't have that module at all.
else {
*share = sub { return $_[0] };
*lock = sub { 0 };
inc/Test/Builder.pm view on Meta::CPAN
$out .= " - $name";
$result->{name} = $name;
}
else {
$result->{name} = '';
}
if( $todo ) {
$out .= " # TODO $todo";
$result->{reason} = $todo;
$result->{type} = 'todo';
}
else {
$result->{reason} = '';
$result->{type} = '';
}
$self->{Test_Results}[$self->{Curr_Test}-1] = $result;
$out .= "\n";
$self->_print($out);
unless( $test ) {
my $msg = $todo ? "Failed (TODO)" : "Failed";
$self->_print_diag("\n") if $ENV{HARNESS_ACTIVE};
inc/Test/Builder.pm view on Meta::CPAN
$self->diag(qq[ $msg test at $file line $line.\n]);
}
}
return $test ? 1 : 0;
}
sub _unoverload {
my $self = shift;
my $type = shift;
$self->_try(sub { require overload } ) || return;
foreach my $thing (@_) {
if( $self->_is_object($$thing) ) {
if( my $string_meth = overload::Method($$thing, $type) ) {
$$thing = $$thing->$string_meth();
}
}
}
}
sub _is_object {
my($self, $thing) = @_;
inc/Test/Builder.pm view on Meta::CPAN
$self->ok($test, $name);
$self->_is_diag($got, '==', $expect) unless $test;
return $test;
}
return $self->cmp_ok($got, '==', $expect, $name);
}
sub _is_diag {
my($self, $got, $type, $expect) = @_;
foreach my $val (\$got, \$expect) {
if( defined $$val ) {
if( $type eq 'eq' ) {
# quote and force string context
$$val = "'$$val'"
}
else {
# force numeric context
$self->_unoverload_num($val);
}
}
else {
$$val = 'undef';
inc/Test/Builder.pm view on Meta::CPAN
}
#line 685
my %numeric_cmps = map { ($_, 1) }
("<", "<=", ">", ">=", "==", "!=", "<=>");
sub cmp_ok {
my($self, $got, $type, $expect, $name) = @_;
# Treat overloaded objects as numbers if we're asked to do a
# numeric comparison.
my $unoverload = $numeric_cmps{$type} ? '_unoverload_num'
: '_unoverload_str';
$self->$unoverload(\$got, \$expect);
my $test;
{
local($@,$!,$SIG{__DIE__}); # isolate eval
my $code = $self->_caller_context;
# Yes, it has to look like this or 5.4.5 won't see the #line directive.
# Don't ask me, man, I just work here.
$test = eval "
$code" . "\$got $type \$expect;";
}
local $Level = $Level + 1;
my $ok = $self->ok($test, $name);
unless( $ok ) {
if( $type =~ /^(eq|==)$/ ) {
$self->_is_diag($got, $type, $expect);
}
else {
$self->_cmp_diag($got, $type, $expect);
}
}
return $ok;
}
sub _cmp_diag {
my($self, $got, $type, $expect) = @_;
$got = defined $got ? "'$got'" : 'undef';
$expect = defined $expect ? "'$expect'" : 'undef';
return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
%s
%s
%s
DIAGNOSTIC
}
sub _caller_context {
my $self = shift;
inc/Test/Builder.pm view on Meta::CPAN
$self->_plan_check;
lock($self->{Curr_Test});
$self->{Curr_Test}++;
$self->{Test_Results}[$self->{Curr_Test}-1] = &share({
'ok' => 1,
actual_ok => 1,
name => '',
type => 'skip',
reason => $why,
});
my $out = "ok";
$out .= " $self->{Curr_Test}" if $self->use_numbers;
$out .= " # skip";
$out .= " $why" if length $why;
$out .= "\n";
$self->_print($out);
inc/Test/Builder.pm view on Meta::CPAN
$self->_plan_check;
lock($self->{Curr_Test});
$self->{Curr_Test}++;
$self->{Test_Results}[$self->{Curr_Test}-1] = &share({
'ok' => 1,
actual_ok => 0,
name => '',
type => 'todo_skip',
reason => $why,
});
my $out = "not ok";
$out .= " $self->{Curr_Test}" if $self->use_numbers;
$out .= " # TODO & SKIP $why\n";
$self->_print($out);
return 1;
inc/Test/Builder.pm view on Meta::CPAN
# If the test counter is being pushed forward fill in the details.
my $test_results = $self->{Test_Results};
if( $num > @$test_results ) {
my $start = @$test_results ? @$test_results : 0;
for ($start..$num-1) {
$test_results->[$_] = &share({
'ok' => 1,
actual_ok => undef,
reason => 'incrementing test number',
type => 'unknown',
name => undef
});
}
}
# If backward, wipe history. Its their funeral.
elsif( $num < @$test_results ) {
$#{$test_results} = $num - 1;
}
}
return $self->{Curr_Test};
inc/Test/More.pm view on Meta::CPAN
return $ok;
}
sub _format_stack {
my(@Stack) = @_;
my $var = '$FOO';
my $did_arrow = 0;
foreach my $entry (@Stack) {
my $type = $entry->{type} || '';
my $idx = $entry->{'idx'};
if( $type eq 'HASH' ) {
$var .= "->" unless $did_arrow++;
$var .= "{$idx}";
}
elsif( $type eq 'ARRAY' ) {
$var .= "->" unless $did_arrow++;
$var .= "[$idx]";
}
elsif( $type eq 'REF' ) {
$var = "\${$var}";
}
}
my @vals = @{$Stack[-1]{vals}}[0,1];
my @vars = ();
($vars[0] = $var) =~ s/\$FOO/ \$got/;
($vars[1] = $var) =~ s/\$FOO/\$expected/;
my $out = "Structures begin differing at:\n";
inc/Test/More.pm view on Meta::CPAN
}
$out .= "$vars[0] = $vals[0]\n";
$out .= "$vars[1] = $vals[1]\n";
$out =~ s/^/ /msg;
return $out;
}
sub _type {
my $thing = shift;
return '' if !ref $thing;
for my $type (qw(ARRAY HASH REF SCALAR GLOB CODE Regexp)) {
return $type if UNIVERSAL::isa($thing, $type);
}
return '';
}
#line 925
sub diag {
my $tb = Test::More->builder;
inc/Test/More.pm view on Meta::CPAN
#'#
sub eq_array {
local @Data_Stack;
_deep_check(@_);
}
sub _eq_array {
my($a1, $a2) = @_;
if( grep !_type($_) eq 'ARRAY', $a1, $a2 ) {
warn "eq_array passed a non-array ref";
return 0;
}
return 1 if $a1 eq $a2;
my $ok = 1;
my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
for (0..$max) {
my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, $e2] };
$ok = _deep_check($e1,$e2);
pop @Data_Stack if $ok;
last unless $ok;
}
return $ok;
}
sub _deep_check {
inc/Test/More.pm view on Meta::CPAN
if( defined $e1 xor defined $e2 ) {
$ok = 0;
}
elsif ( _dne($e1) xor _dne($e2) ) {
$ok = 0;
}
elsif ( $same_ref and ($e1 eq $e2) ) {
$ok = 1;
}
elsif ( $not_ref ) {
push @Data_Stack, { type => '', vals => [$e1, $e2] };
$ok = 0;
}
else {
if( $Refs_Seen{$e1} ) {
return $Refs_Seen{$e1} eq $e2;
}
else {
$Refs_Seen{$e1} = "$e2";
}
my $type = _type($e1);
$type = 'DIFFERENT' unless _type($e2) eq $type;
if( $type eq 'DIFFERENT' ) {
push @Data_Stack, { type => $type, vals => [$e1, $e2] };
$ok = 0;
}
elsif( $type eq 'ARRAY' ) {
$ok = _eq_array($e1, $e2);
}
elsif( $type eq 'HASH' ) {
$ok = _eq_hash($e1, $e2);
}
elsif( $type eq 'REF' ) {
push @Data_Stack, { type => $type, vals => [$e1, $e2] };
$ok = _deep_check($$e1, $$e2);
pop @Data_Stack if $ok;
}
elsif( $type eq 'SCALAR' ) {
push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
$ok = _deep_check($$e1, $$e2);
pop @Data_Stack if $ok;
}
elsif( $type ) {
push @Data_Stack, { type => $type, vals => [$e1, $e2] };
$ok = 0;
}
else {
_whoa(1, "No type in _deep_check");
}
}
}
return $ok;
}
sub _whoa {
my($check, $desc) = @_;
inc/Test/More.pm view on Meta::CPAN
#line 1304
sub eq_hash {
local @Data_Stack;
return _deep_check(@_);
}
sub _eq_hash {
my($a1, $a2) = @_;
if( grep !_type($_) eq 'HASH', $a1, $a2 ) {
warn "eq_hash passed a non-hash ref";
return 0;
}
return 1 if $a1 eq $a2;
my $ok = 1;
my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
foreach my $k (keys %$bigger) {
my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $e2] };
$ok = _deep_check($e1, $e2);
pop @Data_Stack if $ok;
last unless $ok;
}
return $ok;
}
#line 1361
lib/AI/MaxEntropy.pm view on Meta::CPAN
}
sub learn {
my $self = shift;
# cut 0 for default
$self->cut(0) if $self->{last_cut} == -1;
# initialize
$self->{lambda} = [map { 0 } (1 .. $self->{f_num})];
$self->_cache;
# optimize
my $type = $self->{algorithm}->{type} || 'lbfgs';
if ($type eq 'lbfgs') {
my $o = Algorithm::LBFGS->new(%{$self->{algorithm}});
$o->fmin(\&_neg_log_likelihood, $self->{lambda},
$self->{algorithm}->{progress_cb}, $self);
}
elsif ($type eq 'gis') {
die 'GIS is not applicable'
if $self->{af_num} == -1 or $self->{last_cut} != 0;
my $progress_cb = $self->{algorithm}->{progress_cb};
$progress_cb = sub {
print "$_[0]: |lambda| = $_[3], |d_lambda| = $_[4]\n"; 0;
} if defined($progress_cb) and $progress_cb eq 'verbose';
my $epsilon = $self->{algorithm}->{epsilon} || 1e-3;
$self->{lambda} = $self->_apply_gis($progress_cb, $epsilon);
}
else { die "$type is not a valid algorithm type" }
# finish
$self->_free_cache;
return $self->_create_model;
}
sub _create_model {
my $self = shift;
my $model = AI::MaxEntropy::Model->new;
$model->{$_} = ref($self->{$_}) eq 'ARRAY' ? [@{$self->{$_}}] :
ref($self->{$_}) eq 'HASH' ? {%{$self->{$_}}} :
lib/AI/MaxEntropy.pm view on Meta::CPAN
=head2 new
Create a Maximum Entropy learner. Optionally, initial values of properties
can be specified.
my $me1 = AI::MaxEntropy->new;
my $me2 = AI::MaxEntropy->new(
algorithm => { epsilon => 1e-6 });
my $me3 = AI::MaxEntropy->new(
algorithm => { m => 7, epsilon => 1e-4 },
smoother => { type => 'gaussian', sigma => 0.8 }
);
=head2 see
Let the Maximum Entropy learner see a sample.
my $me = AI::MaxEntropy->new;
# see a sample with default weight 1.0
$me->see(['red', 'round'] => 'apple');
lib/AI/MaxEntropy.pm view on Meta::CPAN
L-BFGS provides full functionality, while GIS runs faster, but only
applicable on limited scenarios.
To use GIS, the following conditions must be satisified:
1. All samples have same number of active features
2. No feature has been cut
3. No smoother is used (in fact, the property L</smoother> is simplly
ignored when the type of algorithm equal to 'gis').
This property C<algorithm> is supposed to be a hash ref, like
{
type => ...,
progress_cb => ...,
param_1 => ...,
param_2 => ...,
...,
param_n => ...
}
=head3 type
The entry C<type =E<gt> ...> specifies which algorithm is used for the
optimization. Valid values include:
'lbfgs' Limited-memory Broyden-Fletcher-Goldfarb-Shanno (L-BFGS)
'gis' General Iterative Scaling (GIS)
If ommited, C<'lbfgs'> is used by default.
=head3 progress_cb
The entry C<progress_cb =E<gt> ...> specifies the progress callback
subroutine which is used to trace the process of the algorithm.
The specified callback routine will be called at each iteration of the
algorithm.
For L-BFGS, C<progress_cb> will be directly passed to
L<Algorithm::LBFGS/fmin>. C<f(x)> is the negative log-likelihood of current
lambda vector.
For GIS, the C<progress_cb> is supposed to have a prototype like
progress_cb(i, lambda, d_lambda, lambda_norm, d_lambda_norm)
C<i> is the number of the iterations, C<lambda> is an array ref containing
the current lambda vector, C<d_lambda> is an array ref containing the
delta of the lambda vector in current iteration, C<lambda_norm> and
C<d_lambda_norm> are Euclid norms of C<lambda> and C<d_lambda> respectively.
For both L-BFGS and GIS, the client program can also pass a string
C<'verbose'> to C<progress_cb> to use a default progress callback
lib/AI/MaxEntropy.pm view on Meta::CPAN
for details.
For GIS, there is only one parameter C<epsilon>, which controls the
precision of the algorithm (similar to the C<epsilon> in
L<Algorithm::LBFGS>). Generally speaking, a smaller C<epsilon> produces
a more precise result. The default value of C<epsilon> is 1e-3.
=head2 smoother
The smoother is a solution to the over-fitting problem.
This property chooses which type of smoother the client program want to
apply and sets the smoothing parameters.
Only one smoother have been implemented in this version of the module,
the Gaussian smoother.
One can apply the Gaussian smoother as following,
my $me = AI::MaxEntropy->new(
smoother => { type => 'gaussian', sigma => 0.6 }
);
The parameter C<sigma> indicates the strength of smoothing.
Usually, sigma is a positive number no greater than 1.0.
The strength of smoothing grows as sigma getting close to 0.
=head1 SEE ALSO
L<AI::MaxEntropy::Model>, L<AI::MaxEntropy::Util>
av_len|||
av_make|||
av_pop|||
av_push|||
av_reify|||
av_shift|||
av_store|||
av_undef|||
av_unshift|||
ax|||n
bad_type|||
bind_match|||
block_end|||
block_gimme||5.004000|
block_start|||
boolSV|5.004000||p
boot_core_PerlIO|||
boot_core_UNIVERSAL|||
boot_core_xsutils|||
bytes_from_utf8||5.007001|
bytes_to_utf8||5.006001|
newSVrv|||
newSVsv|||
newSVuv|5.006000||p
newSV|||
newUNOP|||
newWHILEOP||5.009003|
newXSproto||5.006000|
newXS||5.006000|
new_collate||5.006000|
new_constant|||
new_ctype||5.006000|
new_he|||
new_logop|||
new_numeric||5.006000|
new_stackinfo||5.005000|
new_version||5.009000|
next_symbol|||
nextargv|||
nextchar|||
ninstr|||
no_bareword_allowed|||
pTHX|5.006000||p
pack_cat||5.007003|
pack_rec|||
package|||
packlist||5.008001|
pad_add_anon|||
pad_add_name|||
pad_alloc|||
pad_block_start|||
pad_check_dup|||
pad_compname_type|||
pad_findlex|||
pad_findmy|||
pad_fixup_inner_anons|||
pad_free|||
pad_leavemy|||
pad_new|||
pad_push|||
pad_reset|||
pad_setsv|||
pad_sv|||
save_svref|||
save_threadsv||5.005000|
save_vptr||5.006000|
savepvn|||
savepv|||
savesharedpv||5.007003|
savestack_grow_cnt||5.008001|
savestack_grow|||
savesvpv||5.009002|
sawparens|||
scalar_mod_type|||
scalarboolean|||
scalarkids|||
scalarseq|||
scalarvoid|||
scalar|||
scan_bin||5.006000|
scan_commit|||
scan_const|||
scan_formline|||
scan_heredoc|||
sv_pvbyte||5.006000|
sv_pvn_force_flags||5.007002|
sv_pvn_force|||p
sv_pvn_nomg|5.007003||p
sv_pvn|5.006000||p
sv_pvutf8n_force||5.006000|
sv_pvutf8n||5.006000|
sv_pvutf8||5.006000|
sv_pv||5.006000|
sv_recode_to_utf8||5.007003|
sv_reftype|||
sv_release_COW|||
sv_release_IVX|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.006000||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_utf8_encode||5.006000|
sv_utf8_upgrade_flags||5.007002|
sv_utf8_upgrade||5.007001|
sv_uv|5.006000||p
sv_vcatpvf_mg|5.006000|5.004000|p
sv_vcatpvfn||5.004000|
sv_vcatpvf|5.006000|5.004000|p
sv_vsetpvf_mg|5.006000|5.004000|p
sv_vsetpvfn||5.004000|
sv_vsetpvf|5.006000|5.004000|p
svtype|||
swallow_bom|||
swash_fetch||5.007002|
swash_init||5.006000|
sys_intern_clear|||
sys_intern_dup|||
sys_intern_init|||
taint_env|||
taint_proper|||
tmps_grow||5.006000|
toLOWER|||
$file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
}
}
$file{needs_inc_ppport} = keys %{$file{uses}};
if ($file{needs_inc_ppport}) {
my $pp = '';
for $func (sort keys %{$file{needs}}) {
my $type = $file{needs}{$func};
next if $type eq 'extern';
my $suffix = $type eq 'global' ? '_GLOBAL' : '';
unless (exists $file{"needed_$type"}{$func}) {
if ($type eq 'global') {
diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
}
else {
diag("File needs $func, adding static request");
}
$pp .= "#define NEED_$func$suffix\n";
}
}
if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
#ifndef dNOOP
# define dNOOP extern int Perl___notused PERL_UNUSED_DECL
#endif
#ifndef NVTYPE
# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
# define NVTYPE long double
# else
# define NVTYPE double
# endif
typedef NVTYPE NV;
#endif
#ifndef INT2PTR
# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
# define PTRV UV
# define INT2PTR(any,d) (any)(d)
# else
# if PTRSIZE == LONGSIZE
# define PTRV unsigned long
#endif
/*
* Boilerplate macros for initializing and accessing interpreter-local
* data from C. All statics in extensions should be reworked to use
* this, if you want to make the extension thread-safe. See ext/re/re.xs
* for an example of the use of these macros.
*
* Code that uses these macros is responsible for the following:
* 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
* 2. Declare a typedef named my_cxt_t that is a structure that contains
* all the data that needs to be interpreter-local.
* 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
* 4. Use the MY_CXT_INIT macro such that it is called exactly once
* (typically put in the BOOT: section).
* 5. Use the members of the my_cxt_t structure everywhere as
* MY_CXT.member.
* 6. Use the dMY_CXT macro (a declaration) in all the functions that
* access MY_CXT.
*/
#define Perl_grok_number DPPP_(my_grok_number)
#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
int
DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
{
const char *s = pv;
const char *send = pv + len;
const UV max_div_10 = UV_MAX / 10;
const char max_mod_10 = UV_MAX % 10;
int numtype = 0;
int sawinf = 0;
int sawnan = 0;
while (s < send && isSPACE(*s))
s++;
if (s == send) {
return 0;
} else if (*s == '-') {
s++;
numtype = IS_NUMBER_NEG;
}
else if (*s == '+')
s++;
if (s == send)
return 0;
/* next must be digit or the radix separator or beginning of infinity */
if (isDIGIT(*s)) {
/* UVs are at least 32 bits, so the first 9 decimal digits cannot
break;
}
if (digit >= 0 && digit <= 9
&& (s < send)) {
/* value overflowed.
skip the remaining digits, don't
worry about setting *valuep. */
do {
s++;
} while (s < send && isDIGIT(*s));
numtype |=
IS_NUMBER_GREATER_THAN_UV_MAX;
goto skip_value;
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
numtype |= IS_NUMBER_IN_UV;
if (valuep)
*valuep = value;
skip_value:
if (GROK_NUMERIC_RADIX(&s, send)) {
numtype |= IS_NUMBER_NOT_INT;
while (s < send && isDIGIT(*s)) /* optional digits after the radix */
s++;
}
}
else if (GROK_NUMERIC_RADIX(&s, send)) {
numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
/* no digits before the radix means we need digits after it */
if (s < send && isDIGIT(*s)) {
do {
s++;
} while (s < send && isDIGIT(*s));
if (valuep) {
/* integer approximation is valid - it's 0. */
*valuep = 0;
}
}
} else if (*s == 'N' || *s == 'n') {
/* XXX TODO: There are signaling NaNs and quiet NaNs. */
s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
s++;
sawnan = 1;
} else
return 0;
if (sawinf) {
numtype &= IS_NUMBER_NEG; /* Keep track of sign */
numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
} else if (sawnan) {
numtype &= IS_NUMBER_NEG; /* Keep track of sign */
numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
} else if (s < send) {
/* we can have an optional exponent part */
if (*s == 'e' || *s == 'E') {
/* The only flag we keep is sign. Blow away any "it's UV" */
numtype &= IS_NUMBER_NEG;
numtype |= IS_NUMBER_NOT_INT;
s++;
if (s < send && (*s == '-' || *s == '+'))
s++;
if (s < send && isDIGIT(*s)) {
do {
s++;
} while (s < send && isDIGIT(*s));
}
else
return 0;
}
}
while (s < send && isSPACE(*s))
s++;
if (s >= send)
return numtype;
if (len == 10 && memEQ(pv, "0 but true", 10)) {
if (valuep)
*valuep = 0;
return IS_NUMBER_IN_UV;
}
return 0;
}
#endif
#endif
t/02-learn_by_lbfgs.t view on Meta::CPAN
(1 - exp(.2) / (exp(.1) + exp(.2))) * 3),
- ((0 - exp(.1) / (2 * exp(.1))) * 2 + 0 * 3),
- (0 * 2 + (1 - exp(.2) / (exp(.1) + exp(.2))) * 3),
- (0 * 2 + (1 - exp(.2) / (exp(.1) + exp(.2))) * 3)
]
],
$__;
###
NAME 'Negative log likelihood calculation (with Gaussian smoother)';
$me->{smoother} = { type => 'gaussian', sigma => .5 };
($f, $g) = AI::MaxEntropy::_neg_log_likelihood(
[0, 0, .1, .1, 0, 0, 0, .1, .1, .1], undef, $me
);
delta_ok
[
$f,
$g
],
[
- (log(exp(.1) / (2 * exp(.1))) * 2 +
t/03-learn_by_gis.t view on Meta::CPAN
###
NAME 'Load the module';
BEGIN { use_ok 'AI::MaxEntropy' }
my ($lambda, $d_lambda, $p1_f, $n);
my $zero = 1e-5;
my $me = AI::MaxEntropy->new();
$me->see(['round', 'smooth', 'red'] => 'apple' => 2);
$me->see(['long', 'smooth', 'yellow'] => 'banana' => 3);
$me->{algorithm}->{type} = 'gis';
###
NAME 'The first iteration';
$me->{algorithm}->{progress_cb} =
sub { ($lambda, $d_lambda) = ($_[1], $_[2]); 1 };
$me->learn;
$p1_f = [
2 * (exp(0) / (exp(0) + exp(0))),
2 * (exp(0) / (exp(0) + exp(0))) + 3 * (exp(0) / (exp(0) + exp(0))),
2 * (exp(0) / (exp(0) + exp(0))),
t/04-model.t view on Meta::CPAN
'banana',
'banana',
'apple',
'banana',
'banana'
],
$__;
###
NAME 'Predict with model - GIS';
$me->{algorithm}->{type} = 'gis';
$model = $me->learn;
is_deeply
[
$model->predict(['round']),
$model->predict(['red']),
$model->predict(['long']),
$model->predict(['yellow']),
$model->predict(['smooth']),
$model->predict(['round', 'smooth']),
$model->predict(['red', 'long']),
( run in 3.529 seconds using v1.01-cache-2.11-cpan-df04353d9ac )