AI-MaxEntropy
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
# load a module and return the version it reports
sub _load {
my $mod = pop; # class/instance doesn't matter
my $file = $mod;
$file =~ s|::|/|g;
$file .= '.pm';
local $@;
return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
}
# Load CPAN.pm and it's configuration
sub _load_cpan {
return if $CPAN::VERSION;
require CPAN;
if ( $CPAN::HandleConfig::VERSION ) {
# Newer versions of CPAN have a HandleConfig module
CPAN::HandleConfig->load;
} else {
inc/Module/AutoInstall.pm view on Meta::CPAN
$cur =~ s/\s+$//;
# check for version numbers that are not in decimal format
if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
if ( ( $version::VERSION or defined( _load('version') )) and
version->can('new')
) {
# use version.pm if it is installed.
return (
( version->new($cur) >= version->new($min) ) ? $cur : undef );
}
elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
{
# use Sort::Versions as the sorting algorithm for a.b.c versions
return ( ( Sort::Versions::versioncmp( $cur, $min ) != -1 )
? $cur
: undef );
}
warn "Cannot reliably compare non-decimal formatted versions.\n"
. "Please install version.pm or Sort::Versions.\n";
}
# plain comparison
local $^W = 0; # shuts off 'not numeric' bugs
return ( $cur >= $min ? $cur : undef );
}
# nothing; this usage is deprecated.
sub main::PREREQ_PM { return {}; }
sub _make_args {
my %args = @_;
$args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
if $UnderCPAN or $TestOnly;
inc/Test/Builder.pm view on Meta::CPAN
$self->{Test_Died} = 0;
$self->{Have_Plan} = 0;
$self->{No_Plan} = 0;
$self->{Original_Pid} = $$;
share($self->{Curr_Test});
$self->{Curr_Test} = 0;
$self->{Test_Results} = &share([]);
$self->{Exported_To} = undef;
$self->{Expected_Tests} = 0;
$self->{Skip_All} = 0;
$self->{Use_Nums} = 1;
$self->{No_Header} = 0;
$self->{No_Ending} = 0;
$self->_dup_stdhandles unless $^C;
return undef;
}
#line 221
sub exported_to {
my($self, $pack) = @_;
if( defined $pack ) {
$self->{Exported_To} = $pack;
}
inc/Test/Builder.pm view on Meta::CPAN
}
elsif( $cmd eq 'skip_all' ) {
return $self->skip_all($arg);
}
elsif( $cmd eq 'tests' ) {
if( $arg ) {
local $Level = $Level + 1;
return $self->expected_tests($arg);
}
elsif( !defined $arg ) {
$self->croak("Got an undefined number of tests");
}
elsif( !$arg ) {
$self->croak("You said to run 0 tests");
}
}
else {
my @args = grep { defined } ($cmd, $arg);
$self->croak("plan() doesn't understand @args");
}
inc/Test/Builder.pm view on Meta::CPAN
$self->{Have_Plan} = 1;
}
#line 330
sub has_plan {
my $self = shift;
return($self->{Expected_Tests}) if $self->{Expected_Tests};
return('no_plan') if $self->{No_Plan};
return(undef);
};
#line 348
sub skip_all {
my($self, $reason) = @_;
my $out = "1..0";
$out .= " # Skip $reason" if $reason;
inc/Test/Builder.pm view on Meta::CPAN
#line 530
sub is_eq {
my($self, $got, $expect, $name) = @_;
local $Level = $Level + 1;
$self->_unoverload_str(\$got, \$expect);
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
$self->ok($test, $name);
$self->_is_diag($got, 'eq', $expect) unless $test;
return $test;
}
return $self->cmp_ok($got, 'eq', $expect, $name);
}
sub is_num {
my($self, $got, $expect, $name) = @_;
local $Level = $Level + 1;
$self->_unoverload_num(\$got, \$expect);
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
$self->ok($test, $name);
$self->_is_diag($got, '==', $expect) unless $test;
return $test;
}
return $self->cmp_ok($got, '==', $expect, $name);
}
inc/Test/Builder.pm view on Meta::CPAN
if( $type eq 'eq' ) {
# quote and force string context
$$val = "'$$val'"
}
else {
# force numeric context
$self->_unoverload_num($val);
}
}
else {
$$val = 'undef';
}
}
return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
got: %s
expected: %s
DIAGNOSTIC
}
#line 608
sub isnt_eq {
my($self, $got, $dont_expect, $name) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $dont_expect ) {
# undef only matches undef and nothing else
my $test = defined $got || defined $dont_expect;
$self->ok($test, $name);
$self->_cmp_diag($got, 'ne', $dont_expect) unless $test;
return $test;
}
return $self->cmp_ok($got, 'ne', $dont_expect, $name);
}
sub isnt_num {
my($self, $got, $dont_expect, $name) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $dont_expect ) {
# undef only matches undef and nothing else
my $test = defined $got || defined $dont_expect;
$self->ok($test, $name);
$self->_cmp_diag($got, '!=', $dont_expect) unless $test;
return $test;
}
return $self->cmp_ok($got, '!=', $dont_expect, $name);
}
inc/Test/Builder.pm view on Meta::CPAN
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
return 1;
}
#line 916
sub maybe_regex {
my ($self, $regex) = @_;
my $usable_regex = undef;
return $usable_regex unless defined $regex;
my($re, $opts);
# Check for qr/foo/
if( ref $regex eq 'Regexp' ) {
$usable_regex = $regex;
}
# Check for '/foo/' or 'm,foo,'
elsif( ($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or
(undef, $re, $opts) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx
)
{
$usable_regex = length $opts ? "(?$opts)$re" : $re;
}
return $usable_regex;
};
sub _regex_ok {
my($self, $this, $regex, $cmp, $name) = @_;
inc/Test/Builder.pm view on Meta::CPAN
$test = eval "
$code" . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
$test = !$test if $cmp eq '!~';
local $Level = $Level + 1;
$ok = $self->ok( $test, $name );
}
unless( $ok ) {
$this = defined $this ? "'$this'" : 'undef';
my $match = $cmp eq '=~' ? "doesn't match" : "matches";
$self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
%s
%13s '%s'
DIAGNOSTIC
}
return $ok;
}
inc/Test/Builder.pm view on Meta::CPAN
sub is_fh {
my $self = shift;
my $maybe_fh = shift;
return 0 unless defined $maybe_fh;
return 1 if ref $maybe_fh eq 'GLOB'; # its a glob ref
return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob
return eval { $maybe_fh->isa("IO::Handle") } ||
# 5.5.4's tied() and can() doesn't like getting undef
eval { (tied($maybe_fh) || '')->can('TIEHANDLE') };
}
#line 1067
sub level {
my($self, $level) = @_;
if( defined $level ) {
inc/Test/Builder.pm view on Meta::CPAN
sub diag {
my($self, @msgs) = @_;
return if $self->no_diag;
return unless @msgs;
# Prevent printing headers when compiling (i.e. -c)
return if $^C;
# Smash args together like print does.
# Convert undef to 'undef' so its readable.
my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs;
# Escape each line with a #.
$msg =~ s/^/# /gm;
# Stick a newline on the end if it needs it.
$msg .= "\n" unless $msg =~ /\n\Z/;
local $Level = $Level + 1;
$self->_print_diag($msg);
inc/Test/Builder.pm view on Meta::CPAN
sub _print {
my($self, @msgs) = @_;
# Prevent printing headers when only compiling. Mostly for when
# tests are deparsed with B::Deparse
return if $^C;
my $msg = join '', @msgs;
local($\, $", $,) = (undef, ' ', '');
my $fh = $self->output;
# Escape each line after the first with a # so we don't
# confuse Test::Harness.
$msg =~ s/\n(.)/\n# $1/sg;
# Stick a newline on the end if it needs it.
$msg .= "\n" unless $msg =~ /\n\Z/;
print $fh $msg;
}
#line 1259
sub _print_diag {
my $self = shift;
local($\, $", $,) = (undef, ' ', '');
my $fh = $self->todo ? $self->todo_output : $self->failure_output;
print $fh @_;
}
#line 1296
sub output {
my($self, $fh) = @_;
if( defined $fh ) {
inc/Test/Builder.pm view on Meta::CPAN
$self->{Curr_Test} = $num;
# 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/Builder/Module.pm view on Meta::CPAN
@ISA = qw(Exporter);
$VERSION = '0.72';
use strict;
# 5.004's Exporter doesn't have export_to_level.
my $_export_to_level = sub {
my $pkg = shift;
my $level = shift;
(undef) = shift; # redundant arg
my $callpkg = caller($level);
$pkg->export($callpkg, @_);
};
#line 82
sub import {
my($class) = shift;
inc/Test/More.pm view on Meta::CPAN
}
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";
foreach my $idx (0..$#vals) {
my $val = $vals[$idx];
$vals[$idx] = !defined $val ? 'undef' :
_dne($val) ? "Does not exist" :
ref $val ? "$val" :
"'$val'";
}
$out .= "$vars[0] = $vals[0]\n";
$out .= "$vars[1] = $vals[1]\n";
$out =~ s/^/ /msg;
return $out;
inc/Test/More.pm view on Meta::CPAN
my $tb = Test::More->builder;
my $ok = 0;
# Effectively turn %Refs_Seen into a stack. This avoids picking up
# the same referenced used twice (such as [\$a, \$a]) to be considered
# circular.
local %Refs_Seen = %Refs_Seen;
{
# Quiet uninitialized value warnings when comparing undefs.
local $^W = 0;
$tb->_unoverload_str(\$e1, \$e2);
# Either they're both references or both not.
my $same_ref = !(!ref $e1 xor !ref $e2);
my $not_ref = (!ref $e1 and !ref $e2);
if( defined $e1 xor defined $e2 ) {
$ok = 0;
inc/Test/Number/Delta.pm view on Meta::CPAN
use Test::Builder;
use Exporter;
@ISA = qw( Exporter );
@EXPORT = qw( delta_not_ok delta_ok delta_within delta_not_within );
#line 116
my $Test = Test::Builder->new;
my $Epsilon = 1e-6;
my $Relative = undef;
sub import {
my $self = shift;
my $pack = caller;
my $found = grep /within|relative/, @_;
croak "Can't specify more than one of 'within' or 'relative'"
if $found > 1;
if ($found) {
my ($param,$value) = splice @_, 0, 2;
croak "'$param' parameter must be non-zero"
inc/Test/Number/Delta.pm view on Meta::CPAN
# delta_not_ok()
#--------------------------------------------------------------------------#
#line 292
sub delta_not_within($$$;$) {
my ($p, $q, $epsilon, $name) = @_;
croak "Value of epsilon to delta_not_within must be non-zero"
if $epsilon == 0;
$epsilon = abs($epsilon);
my ($ok, undef, @indices) = _check( $p, $q, $epsilon, $name );
$ok = !$ok;
my ($ep, $dp) = _ep_dp( $epsilon );
my $diag = sprintf("Arguments are equal to within %.${ep}f", $epsilon);
return $Test->ok($ok,$name) || $Test->diag( $diag );
}
#line 315
sub delta_not_ok($$;$) {
my ($p, $q, $name) = @_;
lib/AI/MaxEntropy.pm view on Meta::CPAN
f_map => [],
last_cut => -1,
_c => {}
};
return bless $self, $class;
}
sub see {
my ($self, $x, $y, $w) = @_;
$w = 1 if not defined($w);
my ($x1, $y1) = ([], undef);
# preprocess if $x is hashref
$x = [
map {
my $attr = $_;
ref($x->{$attr}) eq 'ARRAY' ?
map { "$attr:$_" } @{$x->{$attr}} : "$_:$x->{$_}"
} keys %$x
] if ref($x) eq 'HASH';
# update af_num
$self->{af_num} = scalar(@$x) if $self->{af_num} == 0;
lib/AI/MaxEntropy/Model.pm view on Meta::CPAN
}
}
}
return $lambda_f;
}
sub predict {
my $self = shift;
my $x = shift;
my @score = map { $self->score($x => $_) } @{$self->{y_list}};
my ($max_score, $max_y) = (undef, undef);
for my $y (0 .. $self->{y_num} - 1) {
($max_score, $max_y) = ($score[$y], $y) if not defined($max_y);
($max_score, $max_y) = ($score[$y], $y) if $score[$y] > $max_score;
}
return $self->{y_list}->[$max_y];
}
1;
__END__
PL_perldb|5.004050||p
PL_ppaddr|5.006000||p
PL_rsfp_filters|5.004050||p
PL_rsfp|5.004050||p
PL_rs|||n
PL_stack_base|5.004050||p
PL_stack_sp|5.004050||p
PL_stdingv|5.004050||p
PL_sv_arenaroot|5.004050||p
PL_sv_no|5.004050||pn
PL_sv_undef|5.004050||pn
PL_sv_yes|5.004050||pn
PL_tainted|5.004050||p
PL_tainting|5.004050||p
POPi|||n
POPl|||n
POPn|||n
POPpbytex||5.007001|n
POPpx||5.005030|n
POPp|||n
POPs|||n
av_fake|||
av_fetch|||
av_fill|||
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|||
cr_textfilter|||
croak_nocontext|||vn
croak|||v
csighandler||5.007001|n
custom_op_desc||5.007003|
custom_op_name||5.007003|
cv_ckproto|||
cv_clone|||
cv_const_sv||5.004000|
cv_dump|||
cv_undef|||
cx_dump||5.005000|
cx_dup|||
cxinc|||
dAXMARK||5.009003|
dAX|5.007002||p
dITEMS|5.007002||p
dMARK|||
dMY_CXT_SV|5.007003||p
dMY_CXT|5.007003||p
dNOOP|5.006000||p
fbm_instr||5.005000|
fd_on_nosuid_fs|||
filter_add|||
filter_del|||
filter_gets|||
filter_read|||
find_beginning|||
find_byclass|||
find_in_my_stash|||
find_runcv|||
find_rundefsvoffset||5.009002|
find_script|||
find_uninit_var|||
fold_constants|||
forbid_setid|||
force_ident|||
force_list|||
force_next|||
force_version|||
force_word|||
form_nocontext|||vn
hv_notallowed|||
hv_placeholders_get||5.009003|
hv_placeholders_p||5.009003|
hv_placeholders_set||5.009003|
hv_riter_p||5.009003|
hv_riter_set||5.009003|
hv_scalar||5.009001|
hv_store_ent||5.004000|
hv_store_flags||5.008000|
hv_store|||
hv_undef|||
ibcmp_locale||5.004000|
ibcmp_utf8||5.007003|
ibcmp|||
incl_perldb|||
incline|||
incpush|||
ingroup|||
init_argv_symbols|||
init_debugger|||
init_global_struct|||
pad_fixup_inner_anons|||
pad_free|||
pad_leavemy|||
pad_new|||
pad_push|||
pad_reset|||
pad_setsv|||
pad_sv|||
pad_swipe|||
pad_tidy|||
pad_undef|||
parse_body|||
parse_unicode_opts|||
path_is_absolute|||
peep|||
pending_ident|||
perl_alloc_using|||n
perl_alloc|||n
perl_clone_using|||n
perl_clone|||n
perl_construct|||n
unlink $tmp;
return $diff;
}
unlink $tmp;
}
else {
error("Cannot open '$tmp' for writing: $!");
}
return undef;
}
sub can_use
{
eval "use @_;";
return $@ eq '';
}
sub rec_depend
{
# define PL_perl_destruct_level perl_destruct_level
# define PL_perldb perldb
# define PL_ppaddr ppaddr
# define PL_rsfp_filters rsfp_filters
# define PL_rsfp rsfp
# define PL_stack_base stack_base
# define PL_stack_sp stack_sp
# define PL_stdingv stdingv
# define PL_sv_arenaroot sv_arenaroot
# define PL_sv_no sv_no
# define PL_sv_undef sv_undef
# define PL_sv_yes sv_yes
# define PL_tainted tainted
# define PL_tainting tainting
/* Replace: 0 */
#endif
#ifndef PERL_UNUSED_DECL
# ifdef HASATTRIBUTE
# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
# define PERL_UNUSED_DECL
# define PTR2NV(p) NUM2PTR(NV,p)
# if PTRSIZE == LONGSIZE
# define PTR2ul(p) (unsigned long)(p)
# else
# define PTR2ul(p) INT2PTR(unsigned long,p)
# endif
#endif /* !INT2PTR */
#undef START_EXTERN_C
#undef END_EXTERN_C
#undef EXTERN_C
#ifdef __cplusplus
# define START_EXTERN_C extern "C" {
# define END_EXTERN_C }
# define EXTERN_C extern "C"
#else
# define START_EXTERN_C
# define END_EXTERN_C
# define EXTERN_C extern
#endif
#ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
# if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
# endif
#endif
#undef STMT_START
#undef STMT_END
#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
# define STMT_END )
#else
# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
# define STMT_START if (1)
# define STMT_END else (void)0
# else
# define STMT_START do
# define STMT_END while (0)
#ifndef eval_pv
#if defined(NEED_eval_pv)
static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
static
#else
extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
#endif
#ifdef eval_pv
# undef eval_pv
#endif
#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
#define Perl_eval_pv DPPP_(my_eval_pv)
#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
SV*
DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
{
dSP;
#ifndef newRV_noinc
#if defined(NEED_newRV_noinc)
static SV * DPPP_(my_newRV_noinc)(SV *sv);
static
#else
extern SV * DPPP_(my_newRV_noinc)(SV *sv);
#endif
#ifdef newRV_noinc
# undef newRV_noinc
#endif
#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
#define Perl_newRV_noinc DPPP_(my_newRV_noinc)
#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
SV *
DPPP_(my_newRV_noinc)(SV *sv)
{
SV *rv = (SV *)newRV(sv);
SvREFCNT_dec(sv);
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5))
#if defined(NEED_newCONSTSUB)
static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
static
#else
extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
#endif
#ifdef newCONSTSUB
# undef newCONSTSUB
#endif
#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
void
DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
{
U32 oldhints = PL_hints;
#ifndef SvPV_nolen
#if defined(NEED_sv_2pv_nolen)
static char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
static
#else
extern char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
#endif
#ifdef sv_2pv_nolen
# undef sv_2pv_nolen
#endif
#define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a)
#define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen)
#if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL)
char *
DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv)
{
STRLEN n_a;
#if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0)))
#if defined(NEED_sv_2pvbyte)
static char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
static
#else
extern char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
#endif
#ifdef sv_2pvbyte
# undef sv_2pvbyte
#endif
#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
char *
DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
{
sv_utf8_downgrade(sv,0);
return SvPV(sv,*lp);
}
#endif
/* Hint: sv_2pvbyte
* Use the SvPVbyte() macro instead of sv_2pvbyte().
*/
#undef SvPVbyte
/* SvPVbyte depends on sv_2pvbyte */
#define SvPVbyte(sv, lp) \
((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
#endif
#else
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf)
#if defined(NEED_vnewSVpvf)
static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
static
#else
extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
#endif
#ifdef vnewSVpvf
# undef vnewSVpvf
#endif
#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
SV *
DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
{
register SV *sv = newSV(0);
#ifndef grok_numeric_radix
#if defined(NEED_grok_numeric_radix)
static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
static
#else
extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
#endif
#ifdef grok_numeric_radix
# undef grok_numeric_radix
#endif
#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
bool
DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
{
#ifdef USE_LOCALE_NUMERIC
#ifdef PL_numeric_radix_sv
#ifndef grok_number
#if defined(NEED_grok_number)
static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
static
#else
extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
#endif
#ifdef grok_number
# undef grok_number
#endif
#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
#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;
#ifndef grok_bin
#if defined(NEED_grok_bin)
static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
#ifdef grok_bin
# undef grok_bin
#endif
#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
#define Perl_grok_bin DPPP_(my_grok_bin)
#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
UV
DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
#ifndef grok_hex
#if defined(NEED_grok_hex)
static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
#ifdef grok_hex
# undef grok_hex
#endif
#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
#define Perl_grok_hex DPPP_(my_grok_hex)
#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
UV
DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
#ifndef grok_oct
#if defined(NEED_grok_oct)
static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
#ifdef grok_oct
# undef grok_oct
#endif
#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
#define Perl_grok_oct DPPP_(my_grok_oct)
#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
UV
DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
t/02-learn_by_lbfgs.t view on Meta::CPAN
my $me = AI::MaxEntropy->new(smoother => {});
$me->see(['round', 'smooth', 'red'] => 'apple' => 2);
$me->see(['long', 'smooth', 'yellow'] => 'banana' => 3);
$me->cut(0);
$me->_cache;
###
NAME 'Negative log likelihood calculation (lambda = all 0)';
my ($f, $g) = AI::MaxEntropy::_neg_log_likelihood(
[0, 0, 0, 0, 0, 0, 0, 0, 0, 0], undef, $me
);
delta_ok
[
$f,
$g
],
[
- (2 * log(0.5) + 3 * log(0.5)),
[
- ((1 - 0.5) * 2 + 0 * 3),
t/02-learn_by_lbfgs.t view on Meta::CPAN
- ((0 - 0.5) * 2 + 0 * 3),
- (0 * 2 + (1 - 0.5) * 3),
- (0 * 2 + (1 - 0.5) * 3)
]
],
$__;
###
NAME 'Negative log likelihood calculation (lambda = random .1 and 0)';
($f, $g) = AI::MaxEntropy::_neg_log_likelihood(
[.1, .1, 0, 0, 0, .1, .1, 0, 0, .1], undef, $me
);
delta_ok
[
$f,
$g
],
[
- (log(exp(.1) / (2 * exp(.1))) * 2 +
log(exp(.2) / (exp(.1) + exp(.2))) * 3),
[
t/02-learn_by_lbfgs.t view on Meta::CPAN
- (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 +
log(exp(.2) / (exp(.1) + exp(.2))) * 3 -
(5 * .1 ** 2) / (2 * .5 ** 2)),
( run in 5.507 seconds using v1.01-cache-2.11-cpan-d80b1682f3f )