AI-MaxEntropy
view release on metacpan or search on metacpan
AI-MaxEntropy.xs view on Meta::CPAN
/* internal structures */
struct samples_t {
int s_num;
int* x_len;
int** x;
int* y;
double* w;
};
struct f_map_t {
int y_num;
int** lambda_idx;
};
/**************************************************************************
* EXPORTED XSUBS
**************************************************************************/
MODULE = AI::MaxEntropy PACKAGE = AI::MaxEntropy
void
_neg_log_likelihood(lambda_in, step, self, OUTLIST SV* f, OUTLIST SV* g)
AV* lambda_in
SV* step
SV* self
PREINIT:
dTRACE("_neg_log_likelihood");
/* fetch the pre-cached samples and f_map */
SV* _c = *hvref_fetch(self, "_c");
struct samples_t* samples =
INT2PTR(struct samples_t*, SvIV(*hvref_fetch(_c, "samples")));
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;
AI-MaxEntropy.xs view on Meta::CPAN
free(lambda);
SV*
_apply_gis(self, progress_cb, epsilon)
SV* self
SV* progress_cb
double epsilon
PREINIT:
dSP;
dTRACE("_apply_gis");
/* fetch the pre-cached samples and f_map */
SV* _c = *hvref_fetch(self, "_c");
struct samples_t* samples =
INT2PTR(struct samples_t*, SvIV(*hvref_fetch(_c, "samples")));
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 */
AV* f_freq = (AV*)SvRV(*hvref_fetch(self, "f_freq"));
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"));
int af_num = SvIV(*hvref_fetch(self, "af_num"));
/* intermediate variables */
SV *sv_r;
AV *av_lambda, *av_d_lambda;
int i, j, k, y, lambda_i, r;
AI-MaxEntropy.xs view on Meta::CPAN
CODE:
free(ss->x_len);
for (i = 0; i < ss->s_num; i++) free(ss->x[i]);
free(ss->x);
free(ss->y);
free(ss->w);
free(ss);
hvref_delete(_c, "samples");
void
_cache_f_map(self)
SV* self
PREINIT:
SV* _c = *hvref_fetch(self, "_c");
AV* f_map = (AV*)SvRV(*hvref_fetch(self, "f_map"));
AV* f_map_y;
struct f_map_t* fm =
(struct f_map_t*)malloc(sizeof(struct f_map_t));;
int i, j, x_num;
CODE:
fm->y_num = av_len(f_map) + 1;
fm->lambda_idx = (int**)malloc(sizeof(int*) * fm->y_num);
for (j = 0; j < fm->y_num; j++) {
f_map_y = (AV*)SvRV(*av_fetch(f_map, j, 0));
x_num = av_len(f_map_y) + 1;
fm->lambda_idx[j] = (int*)malloc(sizeof(int) * x_num);
for (i = 0; i < x_num; i++)
fm->lambda_idx[j][i] = SvIV(*av_fetch(f_map_y, i, 0));
}
hvref_store(_c, "f_map", newSVuv(PTR2IV(fm)));
void
_free_cache_f_map(self)
SV* self
PREINIT:
SV* _c = *hvref_fetch(self, "_c");
struct f_map_t* fm =
INT2PTR(struct f_map_t*, SvIV(*hvref_fetch(_c, "f_map")));
int i;
CODE:
for (i = 0; i < fm->y_num; i++) free(fm->lambda_idx[i]);
free(fm->lambda_idx);
free(fm);
hvref_delete(_c, "f_map");
inc/Module/AutoInstall.pm view on Meta::CPAN
use strict;
use Cwd ();
use ExtUtils::MakeMaker ();
use vars qw{$VERSION};
BEGIN {
$VERSION = '1.03';
}
# special map on pre-defined feature sets
my %FeatureMap = (
'' => 'Core Features', # XXX: deprecated
'-core' => 'Core Features',
);
# various lexical flags
my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly );
my ( $PostambleActions, $PostambleUsed );
inc/Module/AutoInstall.pm view on Meta::CPAN
print "*** Checking for Perl dependencies...\n";
my $cwd = Cwd::cwd();
$Config = [];
my $maxlen = length(
(
sort { length($b) <=> length($a) }
grep { /^[^\-]/ }
map {
ref($_)
? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
: ''
}
map { +{@args}->{$_} }
grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
)[0]
);
while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
my ( @required, @tests, @skiptests );
my $default = 1;
my $conflict = 0;
if ( $feature =~ m/^-(\w+)$/ ) {
inc/Module/AutoInstall.pm view on Meta::CPAN
unshift @$modules, $arg;
$arg = 0;
}
# XXX: check for conflicts and uninstalls(!) them.
if (
defined( my $cur = _version_check( _load($mod), $arg ||= 0 ) ) )
{
print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
push @Existing, $mod => $arg;
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
push @required, $mod => $arg;
}
}
next unless @required;
my $mandatory = ( $feature eq '-core' or $core_all );
inc/Module/AutoInstall.pm view on Meta::CPAN
qq{==> Auto-install the }
. ( @required / 2 )
. ( $mandatory ? ' mandatory' : ' optional' )
. qq{ module(s) from CPAN?},
$default ? 'y' : 'n',
) =~ /^[Yy]/
)
)
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
elsif ( !$SkipInstall
and $default
and $mandatory
and
_prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
=~ /^[Nn]/ )
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
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";
inc/Module/AutoInstall.pm view on Meta::CPAN
}
close LOCK;
return;
}
sub install {
my $class = shift;
my $i; # used below to strip leading '-' from config keys
my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
my ( @modules, @installed );
while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
# grep out those already installed
if ( defined( _version_check( _load($pkg), $ver ) ) ) {
push @installed, $pkg;
}
else {
push @modules, $pkg, $ver;
inc/Module/AutoInstall.pm view on Meta::CPAN
require ExtUtils::Manifest;
my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
$args{EXE_FILES} =
[ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
}
$args{test}{TESTS} ||= 't/*.t';
$args{test}{TESTS} = join( ' ',
grep { !exists( $DisabledTests{$_} ) }
map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
my $missing = join( ',', @Missing );
my $config =
join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
if $Config;
$PostambleActions = (
$missing
? "\$(PERL) $0 --config=$config --installdeps=$missing"
: "\$(NOECHO) \$(NOOP)"
inc/Module/Install/AutoInstall.pm view on Meta::CPAN
sub write {
my $self = shift;
$self->auto_install(@_);
}
sub auto_install {
my $self = shift;
return if $self->{done}++;
# Flatten array of arrays into a single array
my @core = map @$_, map @$_, grep ref,
$self->build_requires, $self->requires;
my @config = @_;
# We'll need Module::AutoInstall
$self->include('Module::AutoInstall');
require Module::AutoInstall;
Module::AutoInstall->import(
(@config ? (-config => \@config) : ()),
inc/Module/Install/MakeMaker.pm view on Meta::CPAN
$VERSION = '0.68';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
my $makefile;
sub WriteMakefile {
my ($self, %args) = @_;
$makefile = $self->load('Makefile');
# mapping between MakeMaker and META.yml keys
$args{MODULE_NAME} = $args{NAME};
unless ($args{NAME} = $args{DISTNAME} or !$args{MODULE_NAME}) {
$args{NAME} = $args{MODULE_NAME};
$args{NAME} =~ s/::/-/g;
}
foreach my $key (qw(name module_name version version_from abstract author installdirs)) {
my $value = delete($args{uc($key)}) or next;
$self->$key($value);
}
inc/Module/Install/Makefile.pm view on Meta::CPAN
if ( $self->tests ) {
die "tests_recursive will not work if tests are already defined";
}
my $dir = shift || 't';
unless ( -d $dir ) {
die "tests_recursive dir '$dir' does not exist";
}
require File::Find;
%test_dir = ();
File::Find::find( \&_wanted_t, $dir );
$self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
}
sub write {
my $self = shift;
die "&Makefile->write() takes no arguments\n" if @_;
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args);
$args->{VERSION} = $self->version || $self->determine_VERSION($args);
inc/Module/Install/Makefile.pm view on Meta::CPAN
if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
$args->{SIGN} = 1;
}
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
# merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
map { @$_ }
map { @$_ }
grep $_,
($self->build_requires, $self->requires)
);
# merge both kinds of requires into prereq_pm
my $subdirs = ($args->{DIR} ||= []);
if ($self->bundles) {
foreach my $bundle (@{ $self->bundles }) {
my ($file, $dir) = @$bundle;
push @$subdirs, $dir if -d $dir;
inc/Module/Install/Makefile.pm view on Meta::CPAN
}
if ( my $perl_version = $self->perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
}
$args->{INSTALLDIRS} = $self->installdirs;
my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
my $user_preop = delete $args{dist}->{PREOP};
if (my $preop = $self->admin->preop($user_preop)) {
$args{dist} = $preop;
}
my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
$self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
}
inc/Module/Install/Metadata.pm view on Meta::CPAN
# The user used ->feature like ->features by passing in the second
# argument as a reference. Accomodate for that.
$mods = $_[0];
} else {
$mods = \@_;
}
my $count = 0;
push @$features, (
$name => [
map {
ref($_) ? ( ref($_) eq 'HASH' ) ? %$_
: @$_
: $_
} @$mods
]
);
return @$features;
}
inc/Test/Builder.pm view on Meta::CPAN
my($self, $this, $regex, $name) = @_;
local $Level = $Level + 1;
$self->_regex_ok($this, $regex, '!~', $name);
}
#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';
inc/Test/Builder.pm view on Meta::CPAN
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
}
return $self->{Curr_Test};
}
#line 1489
sub summary {
my($self) = shift;
return map { $_->{'ok'} } @{ $self->{Test_Results} };
}
#line 1544
sub details {
my $self = shift;
return @{ $self->{Test_Results} };
}
#line 1569
inc/Test/More.pm view on Meta::CPAN
foreach my $method (@methods) {
$tb->_try(sub { $proto->can($method) }) or push @nok, $method;
}
my $name;
$name = @methods == 1 ? "$class->can('$methods[0]')"
: "$class->can(...)";
my $ok = $tb->ok( !@nok, $name );
$tb->diag(map " $class->can('$_') failed\n", @nok);
return $ok;
}
#line 523
sub isa_ok ($$;$) {
my($object, $class, $obj_name) = @_;
my $tb = Test::More->builder;
lib/AI/MaxEntropy.pm view on Meta::CPAN
samples => [],
x_bucket => {},
y_bucket => {},
x_list => [],
y_list => [],
x_num => 0,
y_num => 0,
f_num => 0,
af_num => 0,
f_freq => [],
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;
$self->{af_num} = -1 if $self->{af_num} != scalar(@$x);
# convert y from string to ID
my $y_id = $self->{y_bucket}->{$y};
# new y
if (!defined($y_id)) {
# update y_list, y_num, y_bucket, f_freq
push @{$self->{y_list}}, $y;
$self->{y_num} = scalar(@{$self->{y_list}});
$y_id = $self->{y_num} - 1;
$self->{y_bucket}->{$y} = $y_id;
push @{$self->{f_freq}}, [map { 0 } (1 .. $self->{x_num})];
# save ID
$y1 = $y_id;
}
# old y
else { $y1 = $y_id }
# convert x from strings to IDs
for (@$x) {
my $x_id = $self->{x_bucket}->{$_};
# new x
if (!defined($x_id)) {
lib/AI/MaxEntropy.pm view on Meta::CPAN
push @{$self->{samples}}, [$x1, $y1, $w];
$self->{last_cut} = -1;
}
sub cut {
my ($self, $t) = @_;
$self->{f_num} = 0;
for my $y (0 .. $self->{y_num} - 1) {
for my $x (0 .. $self->{x_num} - 1) {
if ($self->{f_freq}->[$y]->[$x] >= $t) {
$self->{f_map}->[$y]->[$x] = $self->{f_num};
$self->{f_num}++;
}
else { $self->{f_map}->[$y]->[$x] = -1 }
}
}
$self->{last_cut} = $t;
}
sub forget_all {
my $self = shift;
$self->{samples} = [];
$self->{x_bucket} = {};
$self->{y_bucket} = {};
$self->{x_num} = 0;
$self->{y_num} = 0;
$self->{f_num} = 0;
$self->{x_list} = [];
$self->{y_list} = [];
$self->{af_num} = 0;
$self->{f_freq} = [];
$self->{f_map} = [];
$self->{last_cut} = -1;
$self->{_c} = {};
}
sub _cache {
my $self = shift;
$self->_cache_samples;
$self->_cache_f_map;
}
sub _free_cache {
my $self = shift;
$self->_free_cache_samples;
$self->_free_cache_f_map;
}
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'
lib/AI/MaxEntropy.pm view on Meta::CPAN
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->{$_}}} :
$self->{$_}
for qw/x_list y_list lambda x_num y_num f_num x_bucket y_bucket/;
$model->{f_map}->[$_] = [@{$self->{f_map}->[$_]}]
for (0 .. $self->{y_num} - 1);
return $model;
}
1;
__END__
=head1 NAME
lib/AI/MaxEntropy/Model.pm view on Meta::CPAN
sub new {
my ($class, $model) = @_;
my $self = bless {}, $class;
$self->load($model) if defined($model);
return $self;
}
sub load {
my ($self, $file) = @_;
my $model = LoadFile($file);
($self->{x_list}, $self->{y_list}, $self->{f_map}, $self->{lambda})
= @$model;
$self->{x_num} = scalar(@{$self->{x_list}});
$self->{y_num} = scalar(@{$self->{y_list}});
$self->{f_num} = scalar(@{$self->{lambda}});
$self->{x_bucket}->{$self->{x_list}->[$_]} = $_
for (0 .. $self->{x_num} - 1);
$self->{y_bucket}->{$self->{y_list}->[$_]} = $_
for (0 .. $self->{y_num} - 1);
}
sub save {
my ($self, $file) = @_;
my $data = [
$self->{x_list},
$self->{y_list},
$self->{f_map},
$self->{lambda}
];
DumpFile($file, $data);
}
sub all_x { @{$_[0]->{x_list}} }
sub all_labels { @{$_[0]->{y_list}} }
sub score {
my $self = shift;
my ($x, $y) = @_;
# 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';
# calculate score
my @x1 = map { $self->{x_bucket}->{$_} } @$x;
my $lambda_f = 0;
if (defined(my $y1 = $self->{y_bucket}->{$y})) {
for my $x1 (@x1) {
if (defined($x1)) {
my $lambda_i = $self->{f_map}->[$y1]->[$x1];
$lambda_f += $self->{lambda}->[$lambda_i]
if $lambda_i != -1;
}
}
}
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;
lib/AI/MaxEntropy/Util.pm view on Meta::CPAN
package AI::MaxEntropy::Util;
use Exporter;
our $VERSION = '0.20';
our @ISA = qw/Exporter/;
our @EXPORT_OK =
qw/traverse_partially map_partially train_and_test precision recall/;
our %EXPORT_TAGS =
(all => [@EXPORT_OK]);
sub traverse_partially(&$$;$) {
my ($code, $samples, $pattern, $t) = @_;
$t ||= 'x';
my ($p, $n) = (length($pattern), scalar(@$samples));
for my $i (grep { substr($pattern, $_, 1) eq $t } (0 .. $p - 1)) {
for (int($n * $i / $p) .. int($n * ($i + 1) / $p) - 1) {
$_ = $samples->[$_];
$code->();
}
}
}
sub map_partially(&$$;$) {
my ($code, $samples, $pattern, $t) = @_;
my @r;
traverse_partially { push @r, $code->($_) } $samples, $pattern, $t;
return \@r;
}
sub train_and_test {
my ($me, $samples, $pattern) = @_;
traverse_partially { $me->see(@$_) } $samples, $pattern, 'x';
my $m = $me->learn;
my $r = map_partially { [$_ => $m->predict($_->[0])] }
$samples, $pattern, 'o';
return ($r, $m);
}
sub precision {
my $r = shift;
my ($c, $n) = (0, 0);
for (@$r) {
my $w = defined($_->[0]->[2]) ? $_->[0]->[2] : 1;
$n += $w;
lib/AI/MaxEntropy/Util.pm view on Meta::CPAN
my $samples = [
[['a', 'b'] => 'x'],
[['c', 'd'] => 'y' => 1.5],
...
];
my $me = AI::MaxEntropy->new;
# see the first one third and the last one third samples
traverse_partially { $me->see(@$_) } $samples, 'x-x';
=head2 map_partially
This function is similar to L</traverse_partially>. However, it returns an
array ref in which all elements in the original array is mapped according
to the code snippet's return value.
my $arr = [1, 2, 3, 4, 5];
# increase the last one third of the elements by 1
$arr = map_partially { $_ + 1 } $arr, '--x';
=head2 precision
Calculates the precision based on the result returned by
L</train_and_test>.
...
my ($result, $model) = train_and_test(...);
print precision($result)."\n";
else {
$opt{'compat-version'} = 5;
}
# Never use C comments in this file!!!!!
my $ccs = '/'.'*';
my $cce = '*'.'/';
my $rccs = quotemeta $ccs;
my $rcce = quotemeta $cce;
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
? ( $1 => {
($2 ? ( base => $2 ) : ()),
($3 ? ( todo => $3 ) : ()),
(index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
(index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
(index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
} )
: die "invalid spec: $_" } qw(
AvFILLp|5.004050||p
AvFILL|||
}
}
$hint = $1 if m{^\s*$rccs\sHint:\s+(\w+)\s*$};
$replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
$replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
$replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
$replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2;
}
$need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
}
if (exists $opt{'api-info'}) {
my $f;
my $count = 0;
my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
for $f (sort { lc $a cmp lc $b } keys %API) {
}
exit 0;
}
my @files;
my @srcext = qw( xs c h cc cpp );
my $srcext = join '|', @srcext;
if (@ARGV) {
my %seen;
@files = grep { -f && !exists $seen{$_} } map { glob $_ } @ARGV;
}
else {
eval {
require File::Find;
File::Find::find(sub {
$File::Find::name =~ /\.($srcext)$/i
and push @files, $File::Find::name;
}, '.');
};
if ($@) {
@files = map { glob "*.$_" } @srcext;
}
}
if (!@ARGV || $opt{filter}) {
my(@in, @out);
my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
for (@files) {
my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/\.($srcext)$/i;
push @{ $out ? \@out : \@in }, $_;
}
if (@ARGV && @out) {
warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
}
@files = @in;
}
{
eval "use @_;";
return $@ eq '';
}
sub rec_depend
{
my $func = shift;
my %seen;
return () unless exists $depends{$func};
grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}};
}
sub parse_version
{
my $ver = shift;
if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
return ($1, $2, $3);
}
elsif ($ver !~ /^\d+\.[\d_]+$/) {
t/01-samples.t view on Meta::CPAN
$me->{samples},
$me->{x_bucket},
$me->{y_bucket},
$me->{x_list},
$me->{y_list},
$me->{x_num},
$me->{y_num},
$me->{f_num},
$me->{af_num},
$me->{f_freq},
$me->{f_map},
$me->{last_cut}
],
[
[ [ [ 0, 1 ] => 0 => 1 ] ],
{ round => 0, red => 1 },
{ tomato => 0 },
[ 'round', 'red' ],
[ 'tomato' ],
2,
1,
t/01-samples.t view on Meta::CPAN
-1
],
$__;
###
NAME 'Cut #1';
$me->cut(0);
is_deeply
[
$me->{f_num},
$me->{f_map},
$me->{last_cut}
],
[
2,
[ [0, 1] ],
0
],
$__;
###
t/01-samples.t view on Meta::CPAN
-1
],
$__;
###
NAME 'Cut #2';
$me->cut(1);
is_deeply
[
$me->{f_num},
$me->{f_map},
$me->{last_cut}
],
[
8,
[
[0, 1, -1, -1, -1],
[2, 3, 4, -1, -1],
[-1, -1, 5, 6, 7]
],
1
t/01-samples.t view on Meta::CPAN
$me->{samples},
$me->{x_bucket},
$me->{y_bucket},
$me->{x_list},
$me->{y_list},
$me->{x_num},
$me->{y_num},
$me->{f_num},
$me->{af_num},
$me->{f_freq},
$me->{f_map},
$me->{last_cut}
],
[
[],
{},
{},
[],
[],
0,
0,
t/01-samples.t view on Meta::CPAN
$me->{samples},
$me->{x_bucket},
$me->{y_bucket},
$me->{x_list},
$me->{y_list},
$me->{x_num},
$me->{y_num},
$me->{f_num},
$me->{af_num},
$me->{f_freq},
$me->{f_map},
$me->{last_cut}
],
[
[
[ [ 0, 1, 2 ] => 0 => 1 ],
[ [ 3, 0 ] => 1 => 1 ]
],
{ 'color:red' => 0, 'color:green' => 1,
'shape:round' => 2, 'surface:smooth' => 3 },
{ 'apple' => 0, 'tomato' => 1 },
t/01-samples.t view on Meta::CPAN
NAME 'Yet another test on af_num and f_freq';
$me->forget_all;
$me->see(['a', 'b'] => 'x');
$me->see(['c', 'd'] => 'x');
$me->see(['a', 'c'] => 'y');
$me->see(['a', 'd'] => 'x');
is_deeply
[
$me->{af_num},
$me->{f_freq},
$me->{f_map},
$me->{f_num},
$me->{last_cut}
],
[
2,
[
[2, 1, 1, 2],
[1, 0, 1, 0]
],
[],
t/01-samples.t view on Meta::CPAN
-1
],
$__;
###
NAME 'Cut #3';
$me->cut(2);
is_deeply
[
$me->{f_num},
$me->{f_map},
$me->{last_cut}
],
[
2,
[
[0, -1, -1, 1],
[-1, -1, -1, -1]
],
2
],
t/02-learn_by_lbfgs.t view on Meta::CPAN
my $model = $me->learn;
is_deeply
[
$model->{x_bucket},
$model->{y_bucket},
$model->{x_list},
$model->{y_list},
$model->{x_num},
$model->{y_num},
$model->{f_num},
$model->{f_map}
],
[
{ round => 0, smooth => 1, red => 2, long => 3, yellow => 4 },
{ apple => 0, banana => 1 },
[ 'round', 'smooth', 'red', 'long', 'yellow' ],
[ 'apple', 'banana' ],
5,
2,
10,
[
t/05-util.t view on Meta::CPAN
###
NAME 'traverse_partially o-o-o => o';
$a = [1, 2, 3, 4, 5, 6];
$b = [];
traverse_partially { push @$b, $_ } $a, 'o-o-o' => 'o';
is_deeply $b, [1, 3, 5, 6],
$__;
###
NAME 'map_partially o-o => o';
$a = [1, 2, 3, 4, 5, 6];
$b = map_partially { $_ + 1 } $a, 'o-o' => 'o';
is_deeply $b, [2, 3, 6, 7],
$__;
###
NAME 'train_and_test xxo';
require AI::MaxEntropy;
my ($me, $samples, $result, $model);
$me = AI::MaxEntropy->new;
$samples = [
[['a', 'b', 'c'] => 'x'],
( run in 0.788 second using v1.01-cache-2.11-cpan-49f99fa48dc )