Result:
found more than 557 distributions - search limited to the first 2001 files matching your query
( run in 0.676 )
Algorithm-HITS-Lite
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) {
die <<"END_DIE";
Please invoke ${\__PACKAGE__} with:
Algorithm-HITS
view release on metacpan or search on metacpan
0.01 Sat, 21 Aug 2004 07:22:53 +0800
- original version
0.02 Sat, 21 Aug 2004 11:52:52 +0800
- corrected my previous moronic computation error
0.03 Sun, 22 Aug 2004 17:29:40 +0800
- update in test
0.04 Sun, 14 Aug 2005 13:10:10 +0800
Algorithm-Hamming-Perl
view release on metacpan or search on metacpan
# with memory and CPU efficiencu in mind (without resorting to C).
#
sub unhamming_err {
my $data = shift; # input data
my $pos; # counter to step through data string
my $err; # corrected bit error
my $chars_in; # input bytes
my $ham_text; # hamming code in binary text "0101..", 2 bytes
my $ham_text1; # hamming code for first byte
my $ham_text2; # hamming code for second byte
my $char_out1; # output data byte 1
my $char_out2; # output data byte 2
my $output = ""; # full output data as bytes
my $err_all = 0; # count of corrected bit errors
my $length = length($data);
#
# Step through the $data 3 bytes at a time, decoding it back into
# occured.
#
sub unhamchar {
my $text = shift;
my $pos = 0; # counter
my $err = 0; # error bit position
my ($bit);
### If okay, return now
if (defined $Hamming8rev{$text}) {
return ($Hamming8rev{$text},0);
}
### Find error bit
my $copy = $text;
while ($copy ne "") {
$pos++;
$bit = chop($copy);
if ($bit eq "1") {
$err = $err ^ $pos;
}
}
### Correct error bit
$copy = $text;
if ($err <= 12) {
$bit = substr($copy,-$err,1);
if ($bit eq "0") { $bit = "1"; }
else { $bit = "0"; }
# Below is stub documentation for your module. You better edit it!
=head1 NAME
Algorithm::Hamming::Perl - Perl implementation of ECC Hamming encoding,
for single bit auto error correction.
=head1 SYNOPSIS
use Algorithm::Hamming::Perl qw(hamming unhamming);
$code = hamming($data); # Encode $data
$data = unhamming($code); # Decode and fix errors
($data,$errors) = unhamming($code); # + return error count
=head1 DESCRIPTION
This is an Error Correction Code module, implementing Hamming encoding
(8 bits data, 4 bits Hamming - ie increases data size by 50%). Data can
be encoded so that single bit errors within a byte are auto-corrected.
This may be useful as a precaution before storing or sending data where
single bit errors are expected.
Hamming encoding was invented by Richard Hamming, Bell Labs, during 1948.
=head1 EXPORT SUBROUTINES
Returns the Hamming code from the provided input data.
=item unhamming (SCALAR)
Returns the original data from the provided Hamming code. Single bit errors
are auto corrected.
=item unhamming_err (SCALAR)
Returns the original data from the provided Hamming code, and a number counting
the number of bytes that were corrected. Single bit errors are auto corrected.
=back
=head1 OTHER SUBROUTINES
$original = unhamming($hamcode);
=head1 LIMITATIONS
This is Perl only and can be slow. The Hamming encoding used can only
repair a single bit error within a byte - ie if two bits are damaged within
the one byte then this encoding cannot auto correct the error.
=head1 BUGS
Try not to join Hamming encoded strings together - this may give results
that look like a bug. If an odd number of input byes is encoded, the output
Algorithm-Heapify-XS
view release on metacpan or search on metacpan
--diff=program use diff program and options
--compat-version=version provide compatibility with Perl version
--cplusplus accept C++ comments
--quiet don't output anything except fatal errors
--nodiag don't show diagnostics
--nohints don't show hints
--nochanges don't suggest changes
--nofilter don't filter input files
Using this option instructs F<ppport.h> to leave C++
comments untouched.
=head2 --quiet
Be quiet. Don't print anything except fatal errors.
=head2 --nodiag
Don't output any diagnostic messages. Only portability
alerts will be printed.
PL_defgv|5.004050||p
PL_diehook|5.004050||p
PL_dirty|5.004050||p
PL_dowarn|||pn
PL_errgv|5.004050||p
PL_error_count|5.014000||p
PL_expect|5.014000||p
PL_hexdigit|5.005000||p
PL_hints|5.005000||p
PL_in_my_stash|5.014000||p
PL_in_my|5.014000||p
PUTBACK|||
PerlIO_clearerr||5.007003|
PerlIO_close||5.007003|
PerlIO_context_layers||5.009004|
PerlIO_eof||5.007003|
PerlIO_error||5.007003|
PerlIO_fileno||5.007003|
PerlIO_fill||5.007003|
PerlIO_flush||5.007003|
PerlIO_get_base||5.007003|
PerlIO_get_bufsiz||5.007003|
put_byte|||
pv_display|5.006000||p
pv_escape|5.009004||p
pv_pretty|5.009004||p
pv_uni_display||5.007003|
qerror|||
qsortsvu|||
re_compile||5.009005|
re_croak2|||
re_dup_guts|||
re_intuit_start||5.009005|
warner_nocontext|||vn
warner|5.006000|5.004000|pv
warn|||v
watch|||
whichsig|||
with_queued_errors|||
write_no_mem|||
write_to_stderr|||
xmldump_all_perl|||
xmldump_all|||
xmldump_attr|||
xmldump_sub_perl|||
xmldump_sub|||
xmldump_vindent|||
xs_apiversion_bootcheck|||
xs_version_bootcheck|||
yyerror|||
yylex|||
yyparse|||
yyunlex|||
yywarn|||
);
if ($file{changes}) {
if (exists $opt{copy}) {
my $newfile = "$filename$opt{copy}";
if (-e $newfile) {
error("'$newfile' already exists, refusing to write copy of '$filename'");
}
else {
local *F;
if (open F, ">$newfile") {
info("Writing copy of '$filename' with changes to '$newfile'");
print F $c;
close F;
}
else {
error("Cannot open '$newfile' for writing: $!");
}
}
}
elsif (exists $opt{patch} || $opt{changes}) {
if (exists $opt{patch}) {
unless ($patch_opened) {
if (open PATCH, ">$opt{patch}") {
$patch_opened = 1;
}
else {
error("Cannot open '$opt{patch}' for writing: $!");
delete $opt{patch};
$opt{changes} = 1;
goto fallback;
}
}
if (!defined $diff) {
$diff = run_diff('diff', $file, $str);
}
if (!defined $diff) {
error("Cannot generate a diff. Please install Text::Diff or use --copy.");
return;
}
print F $diff;
}
}
unlink $tmp;
}
else {
error("Cannot open '$tmp' for writing: $!");
}
return undef;
}
{
$opt{quiet} and return;
print "*** ", @_, "\n";
}
sub error
{
print "*** ERROR: ", @_, "\n";
}
my %given_hints;
/* It is very unlikely that anyone will try to use this with Perl 6
(or greater), but who knows.
*/
#if PERL_REVISION != 5
# error ppport.h only works with Perl version 5
#endif /* PERL_REVISION != 5 */
#ifndef dTHR
# define dTHR dNOOP
#endif
#ifndef dTHX
# define PL_defgv defgv
# define PL_diehook diehook
# define PL_dirty dirty
# define PL_dowarn dowarn
# define PL_errgv errgv
# define PL_error_count error_count
# define PL_expect expect
# define PL_hexdigit hexdigit
# define PL_hints hints
# define PL_in_my in_my
# define PL_laststatval laststatval
# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
# define PL_in_my D_PPP_my_PL_parser_var(in_my)
# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
# define PL_error_count D_PPP_my_PL_parser_var(error_count)
#else
/* ensure that PL_parser != NULL and cannot be dereferenced */
/* Replace perl_eval_pv with eval_pv */
#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 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;
SV* sv = newSVpv(p, 0);
PUSHMARK(sp);
SPAGAIN;
sv = POPs;
PUTBACK;
if (croak_on_error && SvTRUE(GvSV(errgv)))
croak(SvPVx(GvSV(errgv), na));
return sv;
}
Algorithm-Huffman
view release on metacpan or search on metacpan
}
sub __validate_counting_hash {
my $c = shift;
my $error_msg = undef;
defined $c
or croak "Undefined counting hash";
ref($c) eq 'HASH'
or croak "The argument for the counting hash is not a hash reference, as expected";
scalar(keys %$c) >= 2
a => 1
b => 01
c => 00
and wanted to code 'abc'. The right coding is '10100'.
But '1010' (the last 0 is missing) will produce the error message:
C<Unknown bit sequence starting at index 3 in the bitstring>.
=item $huff->decode($bitvector)
Decodes a packed bitvector (encoded with the ->encode method).
Algorithm-HyperLogLog
view release on metacpan or search on metacpan
lib/Algorithm/HyperLogLog.pm view on Meta::CPAN
}
sub new_from_file {
my ( $class, $filename ) = @_;
open my $fh, '<', $filename or die $!;
my $on_error = sub { close $fh; croak "Invalid dump file($filename)"; };
binmode $fh;
my ( @dumpdata, $buf, $readed );
# Read register size data
$readed = read( $fh, $buf, 1 );
$on_error->() if $readed != 1;
my $k = unpack 'C', $buf;
# Read register content data
my $m = 2**$k;
$readed = read $fh, $buf, $m;
$on_error->() if $readed != $m;
close $fh;
@dumpdata = unpack 'C*', $buf;
my $self = $class->_new_from_dump( $k, \@dumpdata );
return $self;
}
Algorithm-IRCSRP2
view release on metacpan or search on metacpan
lib/Algorithm/IRCSRP2.pm view on Meta::CPAN
use Crypt::OpenSSL::AES;
# local
use Algorithm::IRCSRP2::Utils qw(:all);
has 'error' => (
'isa' => 'Str',
'is' => 'rw',
);
has 'nickname' => (
lib/Algorithm/IRCSRP2.pm view on Meta::CPAN
=item * B<cbc_blocksize> (ro, Int) - CBC blocksize. Defaults to '16'.
=item * B<debug_cb> (rw, CodeRef) - Debug callback. Defaults to C<print()>
=item * B<error> (rw, Str) - If set, there was an error.
=item * B<nickname> (rw, Str) - Child class will set this. Defaults to 'unknown'.
=back
lib/Algorithm/IRCSRP2.pm view on Meta::CPAN
=item * B<encrypt_message($msg, $who)> - Returns encrypted message with
plaintext C<$msg> from nickname C<$who>.
=item * B<decrypt_message($msg)> - Returns decrypted text from encrypted
C<$msg>. C<die()>s on errors.
=back
=head1 SEE ALSO
Algorithm-IncludeExclude
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
return
unless system( 'sudo', $^X, $0, "--config=$config",
"--installdeps=$missing" );
print << ".";
*** The 'sudo' command exited with error! Resuming...
.
}
return _prompt(
qq(
Algorithm-KMeans
view release on metacpan or search on metacpan
lib/Algorithm/KMeans.pm view on Meta::CPAN
my @num_strings = split / /, $cluster_strings[$i];
my @cluster_mean = map {/$_num_regex/;$_} split / /, $num_strings[0];
$data_dimension = @cluster_mean;
push @means, \@cluster_mean;
my @covariance_nums = map {/$_num_regex/;$_} split / /, $num_strings[1];
croak "dimensionality error" if @covariance_nums !=
($data_dimension ** 2);
my $cluster_covariance;
foreach my $j (0..$data_dimension-1) {
foreach my $k (0..$data_dimension-1) {
$cluster_covariance->[$j]->[$k] =
lib/Algorithm/KMeans.pm view on Meta::CPAN
=head1 CHANGES
Version 2.05 removes the restriction on the version of Perl that is required. This
is based on Srezic's recommendation. He had no problem building and testing the
previous version with Perl 5.8.9. Version 2.05 also includes a small augmentation of
the code in the method C<read_data_from_file_csv()> for guarding against user errors
in the specification of the mask that tells the module which columns of the data file
are to be used for clustering.
Version 2.04 allows you to use CSV data files for clustering.
lib/Algorithm/KMeans.pm view on Meta::CPAN
Version 2.02 downshifts the version of Perl that is required for this module. The
module should work with versions 5.10 and higher of Perl. The implementation code
for the module remains unchanged.
Version 2.01 removes many errors in the documentation. The changes made to the module
in Version 2.0 were not reflected properly in the documentation page for that
version. The implementation code remains unchanged.
Version 2.0 includes significant additional functionality: (1) You now have the
option to cluster using the Mahalanobis distance metric (the default is the Euclidean
Algorithm-KNN-XS
view release on metacpan or search on metacpan
lib/Algorithm/KNN/XS.pm view on Meta::CPAN
The default value is 0.
=item * epsilon
The relative error bound for approximate nearest neighbor searching. Please
refer the libANN manual for more information.
The default value is 0.
=item * Return value
lib/Algorithm/KNN/XS.pm view on Meta::CPAN
The default value is 0.
=item * epsilon
The relative error bound for approximate nearest neighbor searching. Please
refer the libANN manual for more information.
The default value is 0.
=item * Return value
lib/Algorithm/KNN/XS.pm view on Meta::CPAN
The default value is 0.
=item * epsilon
The relative error bound for approximate nearest neighbor searching. Please
refer the libANN manual for more information.
The default value is 0.
=item * radius
lib/Algorithm/KNN/XS.pm view on Meta::CPAN
A list of points which must be the same dimension as the tree.
=item * epsilon
The relative error bound for approximate nearest neighbor searching. Please
refer the libANN manual for more information.
The default value is 0.
=item * radius
Algorithm-KernelKMeans
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
inc/Module/Install.pm view on Meta::CPAN
# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my $a = $s - time;
if ( $a > 0 and $a < 5 ) { sleep 5 }
# Too far in the future, throw an error.
my $t = time;
if ( $s > $t ) { die <<"END_DIE" }
Your installer $0 has a modification time in the future ($s > $t).
inc/Module/Install.pm view on Meta::CPAN
# I'm still wondering if we should slurp Makefile.PL to
# get some context or not ...
my ($package, $file, $line) = caller;
die <<"EOT";
Unknown function is found at $file line $line.
Execution of $file aborted due to runtime errors.
If you're a contributor to a project, you may need to install
some Module::Install extensions from CPAN (or other repository).
If you're a user of a module, please contact the author.
EOT
Algorithm-Kmeanspp
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
inc/Module/Install.pm view on Meta::CPAN
# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my $a = $s - time;
if ( $a > 0 and $a < 5 ) { sleep 5 }
# Too far in the future, throw an error.
my $t = time;
if ( $s > $t ) { die <<"END_DIE" }
Your installer $0 has a modification time in the future ($s > $t).
Algorithm-Kuhn-Munkres
view release on metacpan or search on metacpan
lib/Algorithm/Kuhn/Munkres.pm view on Meta::CPAN
=back
=head1 DIAGNOSTICS
Ideally, I would list every single error and warning message that the module can
generate (even the ones that will "never happen"), with a full
explanation of each problem, one or more likely causes, and any
suggested remedies. I'm not that good a person right now.
Algorithm-LBFGS
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
return
unless system( 'sudo', $^X, $0, "--config=$config",
"--installdeps=$missing" );
print << ".";
*** The 'sudo' command exited with error! Resuming...
.
}
return _prompt(
qq(
Algorithm-LUHN
view release on metacpan or search on metacpan
lib/Algorithm/LUHN.pm view on Meta::CPAN
use Algorithm::LUHN qw/check_digit is_valid/;
$c = check_digit("43881234567");
print "It works\n" if is_valid("43881234567$c");
$c = check_digit("A2C4E6G8"); # this will cause an error
print "Valid LUHN characters are:\n";
my %vc = Algorithm::LUHN::valid_chars();
for (sort keys %vc) {
print "$_ => $vc{$_}\n";
Algorithm-LUHN_XS
view release on metacpan or search on metacpan
int i, sum, ch, num, twoup, len;
len = strlen(input);
if (len < 1) {
char err[MAX_ERROR_LEN];
snprintf(err,MAX_ERROR_LEN,"check_digit_fast: No input string.");
SV *error;
error=get_sv("Algorithm::LUHN_XS::ERROR",GV_ADD);
sv_setpv(error,err);
return -1;
}
sum = 0;
twoup = 1;
for (i = len - 1; i >= 0; --i) {
num=_al_vc[input[i]];
if (num == -1) {
/* Don't change the error text, perl tests depend on the exact words */
unsigned char err[MAX_ERROR_LEN];
snprintf(err,MAX_ERROR_LEN,"Invalid character '%c', in check_digit calculation string [%s]",input[i],input);
SV *error;
error=get_sv("Algorithm::LUHN_XS::ERROR",GV_ADD);
sv_setpv(error,err);
return -1;
}
if (!(twoup = !twoup)) {
num *= 2;
}
int len=strlen(input);
if (len < 2) {
unsigned char err[MAX_ERROR_LEN];
snprintf(err,MAX_ERROR_LEN,
"is_valid: you must supply input of at least 2 characters");
SV *error;
error=get_sv("Algorithm::LUHN_XS::ERROR",GV_ADD);
sv_setpv(error,err);
SV* rv=newSVpv(NULL,1);
return rv;
}
unsigned char *leftmost=_al_substr(input,0,len-1);
unsigned char cd=input[len-1];
return(newSViv(1));
} else {
unsigned char err[MAX_ERROR_LEN];
snprintf(err,MAX_ERROR_LEN,
"Check digit incorrect. Expected %c",c);
SV *error;
error=get_sv("Algorithm::LUHN_XS::ERROR",GV_ADD);
sv_setpv(error,err);
SV* rv=newSVpv(NULL,1);
return rv;
}
}
}
return 1;
} else {
unsigned char err[MAX_ERROR_LEN];
snprintf(err,MAX_ERROR_LEN,
"Check digit incorrect. Expected %c",c);
SV *error;
error=get_sv("Algorithm::LUHN_XS::ERROR",GV_ADD);
sv_setpv(error,err);
return 0;
}
}
}
Algorithm-LibLinear
view release on metacpan or search on metacpan
lib/Algorithm/LibLinear.pm view on Meta::CPAN
$data_set->as_problem(bias => $self->bias),
$num_folds,
);
my @labels = map { $_->{label} } @{ $data_set->as_arrayref };
if ($self->is_regression_solver) {
my $total_square_error = sum map {
($targets->[$_] - $labels[$_]) ** 2;
} (0 .. $data_set->size - 1);
# Returns mean squared error.
# TODO: Squared correlation coefficient (see train.c in LIBLINEAR.)
return $total_square_error / $data_set->size;
} else {
my $num_corrects =
grep { $targets->[$_] == $labels[$_] } (0 .. $data_set->size - 1);
return $num_corrects / $data_set->size;
}
Algorithm-Line-Bresenham
view release on metacpan or search on metacpan
lib/Algorithm/Line/Bresenham.pm view on Meta::CPAN
my $dx = abs ($x1 - $x0);
my $sx = $x0 < $x1 ? 1 : -1;
my $dy = -abs ($y1 - $y0);
my $sy = $y0 < $y1 ? 1 : -1;
my $err = $dx + $dy;
my $e2; #/* error value e_xy */
my @points;
while(1){ #/* loop */
if ($callback){
$callback->($x0,$y0,$cbArgs);
lib/Algorithm/Line/Bresenham.pm view on Meta::CPAN
my ($x0, $y0, $x1, $y1)=@_;
my $a = abs ($x1 - $x0);
my $b = abs ($y1 - $y0);
my $b1 = $b & 1; #/* values of diameter */
my $dx = 4 * (1 - $a) * $b * $b;
my $dy = 4 * ($b1 + 1) * $a * $a; #/* error increment */
my $err = $dx + $dy + $b1 * $a * $a;
my $e2; #/* error of 1.step */
if ($x0 > $x1) { $x0 = $x1; $x1 += $a; } #/* if called with swapped points */
$y0 = $y1 if ($y0 >$y1);# /* .. exchange them */
$y0 += ($b + 1) / 2;
$y1 = $y0-$b1; #/* starting pixel */
lib/Algorithm/Line/Bresenham.pm view on Meta::CPAN
my $sy = $y0 < $y2 ? 1 : -1; #/* step direction */
my $cur = $sx * $sy *(($x0 - $x1) * ($y2 - $y1) - ($x2 - $x1) * ($y0 - $y1)); #/* curvature */
my $x = $x0 - 2 * $x1 + $x2;
my $y = $y0 - 2 * $y1 +$y2;
my $xy = 2 * $x * $y * $sx * $sy;
# /* compute error increments of P0 */
my $dx = (1 - 2 * abs ($x0 - $x1)) * $y * $y + abs ($y0 - $y1) * $xy - 2 * $cur * abs ($y0 - $y2);
my $dy = (1 - 2 * abs ($y0 - $y1)) * $x * $x + abs ($x0 - $x1) * $xy + 2 * $cur * abs ($x0 - $x2);
#/* compute error increments of P2 */
my $ex = (1 - 2 * abs ($x2 - $x1)) * $y * $y + abs ($y2 - $y1) * $xy + 2 * $cur * abs ($y0 - $y2);
my $ey = (1 - 2 * abs ($y2 - $y1)) * $x * $x + abs ($x2 - $x1) * $xy - 2 * $cur * abs ($x0 - $x2);
# /* sign of gradient must not change */
warn "gradient change detected" unless (($x0 - $x1) * ($x2 - $x1) <= 0 && ($y0 - $y1) * ($y2 - $y1) <= 0);
if ($cur == 0)
lib/Algorithm/Line/Bresenham.pm view on Meta::CPAN
$xy = -$xy;
$y = -$y;
$dy = -$dy;
$ey = -$ey;
}
#/* algorithm fails for almost straight line, check error values */
if ($dx >= -$y || $dy <= -$x || $ex <= -$y || $ey >= -$x)
{
return (line ($x0, $y0, $x1, $y1), line ($x1, $y1, $x2, $y2)); #/* simple approximation */
}
$dx -= $xy;
$ex = $dx + $dy;
$dy -= $xy; #/* error of 1.step */
my @points;
while(1)
{ #/* plot curve */
push @points,[$x0, $y0];
$ey = 2 * $ex - $dy; #/* save value for test of y step */
lib/Algorithm/Line/Bresenham.pm view on Meta::CPAN
my $E_square= 2*$dy;
my $p=my $q=0;
my $y= $y0;
my $x= $x0;
my $error= $einit;
my $tk= $dx+$dy-$winit;
while($tk<=$w_left)
{
push (@pts,[$x,$y]);
if ($error>=$threshold)
{
$x= $x + $xstep;
$error = $error + $E_diag;
$tk= $tk + 2*$dy;
}
$error = $error + $E_square;
$y= $y + $ystep;
$tk= $tk + 2*$dx;
$q++;
}
$y= $y0;
$x= $x0;
$error= -$einit;
$tk= $dx+$dy+$winit;
while($tk<=$w_right)
{
push (@pts,[$x,$y]) if ($p);
if ($error>$threshold)
{
$x= $x - $xstep;
$error = $error + $E_diag;
$tk= $tk + 2*$dy;
}
$error = $error + $E_square;
$y= $y - $ystep;
$tk= $tk + 2*$dx;
$p++;
}
lib/Algorithm/Line/Bresenham.pm view on Meta::CPAN
$right,$argR, #right thickness function
$pxstep,$pystep)=@_;
my @xPoints;
my $p_error= 0;
my $error= 0;
my $y= $y0;
my $x= $x0;
my $threshold = $dx - 2*$dy;
my $E_diag= -2*$dx;
my $E_square= 2*$dy;
lib/Algorithm/Line/Bresenham.pm view on Meta::CPAN
for(my $p=0;$p<$length;$p++)
{
my $w_left= $left->($argL, $p, $length)*2*$D;
my $w_right= $right->($argR,$p, $length)*2*$D;
push @xPoints,x_perpendicular($x,$y, $dx, $dy, $pxstep, $pystep,
$p_error,$w_left,$w_right,$error);
if ($error>=$threshold)
{
$y= $y + $ystep;
$error = $error + $E_diag;
if ($p_error>=$threshold)
{
push @xPoints,x_perpendicular($x,$y, $dx, $dy, $pxstep, $pystep,
($p_error+$E_diag+$E_square),
$w_left,$w_right,$error);
$p_error= $p_error + $E_diag;
}
$p_error= $p_error + $E_square;
}
$error = $error + $E_square;
$x= $x + $xstep;
}
return @xPoints;
}
lib/Algorithm/Line/Bresenham.pm view on Meta::CPAN
my $E_square= 2*$dx;
my $p=my $q=0;
my $y= $y0;
my $x= $x0;
my $error= -$einit;
my $tk= $dx+$dy+$winit;
while($tk<=$w_left)
{
push @pts,[$x,$y];
if ($error>$threshold)
{
$y= $y + $ystep;
$error = $error + $E_diag;
$tk= $tk + 2*$dx;
}
$error = $error + $E_square;
$x= $x + $xstep;
$tk= $tk + 2*$dy;
$q++;
}
$y= $y0;
$x= $x0;
$error= $einit;
$tk= $dx+$dy-$winit;
while($tk<=$w_right)
{
push (@pts,[$x,$y]) if ($p);
if ($error>=$threshold)
{
$y= $y - $ystep;
$error = $error + $E_diag;
$tk= $tk + 2*$dx;
}
$error = $error + $E_square;
$x= $x - $xstep;
$tk= $tk + 2*$dy;
$p++;
}
lib/Algorithm/Line/Bresenham.pm view on Meta::CPAN
$left, $argL, #left thickness function
$right,$argR, #right thickness function
$pxstep,$pystep)=@_;
my @yPoints;
my $p_error= 0;
my $error= 0;
my $y= $y0;
my $x= $x0;
my $threshold = $dy - 2*$dx;
my $E_diag= -2*$dy;
my $E_square= 2*$dx;
lib/Algorithm/Line/Bresenham.pm view on Meta::CPAN
for(my $p=0;$p<$length;$p++)
{
my $w_left= $left->($argL, $p, $length)*2*$D;
my $w_right= $right->($argR,$p, $length)*2*$D;
push @yPoints,y_perpendicular($x,$y, $dx, $dy, $pxstep, $pystep,
$p_error,$w_left,$w_right,$error);
if ($error>=$threshold)
{
$x= $x + $xstep;
$error = $error + $E_diag;
if ($p_error>=$threshold)
{
push @yPoints,y_perpendicular($x,$y, $dx, $dy, $pxstep, $pystep,
($p_error+$E_diag+$E_square),$w_left,$w_right,$error);
$p_error= $p_error + $E_diag;
}
$p_error= $p_error + $E_square;
}
$error = $error + $E_square;
$y= $y + $ystep;
}
return @yPoints;
}
Algorithm-Line-Lerp
view release on metacpan or search on metacpan
--diff=program use diff program and options
--compat-version=version provide compatibility with Perl version
--cplusplus accept C++ comments
--quiet don't output anything except fatal errors
--nodiag don't show diagnostics
--nohints don't show hints
--nochanges don't suggest changes
--nofilter don't filter input files
Using this option instructs F<Algorithm-Line-Lerp/ppport.h> to leave C++
comments untouched.
=head2 --quiet
Be quiet. Don't print anything except fatal errors.
=head2 --nodiag
Don't output any diagnostic messages. Only portability
alerts will be printed.
FEATURE_UNICODE_BIT|5.031006||Viu
FEATURE_UNICODE_IS_ENABLED|5.015007||Viu
FEATURE_UNIEVAL_BIT|5.031006||Viu
FEATURE_UNIEVAL_IS_ENABLED|5.015007||Viu
feof|5.003007||Viu
ferror|5.003007||Viu
FETCHFEATUREBITSHH|5.031006||Viu
F_exp_amg|5.004000||Viu
FF_0DECIMAL|5.007001||Viu
FF_BLANK|5.003007||Viu
FF_CHECKCHOP|5.003007||Viu
my_snprintf|5.009004||pvVn
my_socketpair|5.007003|5.007003|nu
my_sprintf|5.009003|5.003007|pdn
my_stat|5.013003||Viu
my_stat_flags|5.013003||cViu
my_strerror|5.021001||Viu
my_strftime|5.007002||V
my_strlcat|5.009004|5.003007|pn
my_strlcpy|5.009004|5.003007|pn
my_strnlen|5.027006|5.003007|pn
my_strtod|5.029010|5.029010|n
PerlEnv_os_id|5.006000||Viu
PerlEnv_putenv|5.005000||Viu
PerlEnv_sitelib_path|5.005000||Viu
PerlEnv_uname|5.005004||Viu
PerlEnv_vendorlib_path|5.006000||Viu
Perl_error_log|5.006000||Viu
Perl_eval_pv||5.003007|onu
Perl_eval_sv||5.003007|onu
PERL_EXIT_ABORT|5.019003|5.019003|
PERL_EXIT_DESTRUCT_END|5.007003|5.007003|
PERL_EXIT_EXPECTED|5.006000|5.006000|
PerlIO_context_layers|||u
PerlIO_debug|5.007001|5.007001|
PERLIO_DUP_CLONE|5.007003||Viu
PERLIO_DUP_FD|5.007003||Viu
PerlIO_eof|5.007003|5.007003|
PerlIO_error|5.007003|5.007003|
PerlIO_exportFILE|5.003007|5.003007|n
PERLIO_F_APPEND|5.007001|5.007001|
PerlIO_fast_gets|5.003007|5.003007|n
PERLIO_F_CANREAD|5.007001|5.007001|
PERLIO_F_CANWRITE|5.007001|5.007001|
PerlSIO_fast_gets|5.007001||Viu
PerlSIO_fclose|5.007001||Viu
PerlSIO_fdopen|5.007001||Viu
PerlSIO_fdupopen|5.007001||Viu
PerlSIO_feof|5.007001||Viu
PerlSIO_ferror|5.007001||Viu
PerlSIO_fflush|5.007001||Viu
PerlSIO_fgetc|5.007001||Viu
PerlSIO_fgetpos|5.007001||Viu
PerlSIO_fgets|5.007001||Viu
PerlSIO_fileno|5.007001||Viu
PL_encoding|5.007003||Viu
PL_endav|5.005000||Viu
PL_Env|5.006000||Viu
PL_envgv|5.005000||Viu
PL_errgv|5.004005|5.003007|p
PL_error_count||5.003007|ponu
PL_errors|5.006000||Viu
PL_e_script|5.005000||Viu
PL_eval_root|5.005000||Viu
PL_evalseq|5.005000||Viu
PL_eval_start|5.005000||Viu
PL_exit_flags|5.006000|5.006000|
pWARN_ALL|5.006000||Viu
pWARN_NONE|5.006000||Viu
pWARN_STD|5.006000||Viu
PWGECOS|5.004005|5.004005|Vn
PWPASSWD|5.005000|5.005000|Vn
qerror|5.006000||cViu
QR_PAT_MODS|5.009005||Viu
QUAD_IS_INT|5.006000|5.006000|Vn
QUAD_IS___INT64|5.015003|5.015003|Vn
QUAD_IS_INT64_T|5.006000|5.006000|Vn
QUAD_IS_LONG|5.006000|5.006000|Vn
STORE_LC_NUMERIC_SET_TO_NEEDED|5.021010|5.021010|
STORE_LC_NUMERIC_SET_TO_NEEDED_IN|5.031003|5.031003|
STORE_NUMERIC_SET_STANDARD|||piu
strBEGINs|5.027006||Viu
strEQ|5.003007|5.003007|
Strerror|5.003007||Viu
strerror|5.009000||Viu
STRERROR_R_PROTO|5.008000|5.008000|Vn
strGE|5.003007|5.003007|
strGT|5.003007|5.003007|
STRING|5.006000||Viu
STRINGIFY|5.003007|5.003007|Vn
UTF8_MAX_FOLD_CHAR_EXPAND|5.013009||Viu
UTF8_MAXLEN|5.006000||Viu
utf8_mg_len_cache_update|5.013003||Viu
utf8_mg_pos_cache_update|5.009004||Viu
utf8n_to_uvchr|5.007001|5.007001|n
utf8n_to_uvchr_error|5.025006|5.025006|n
utf8n_to_uvchr_msgs|5.027009|5.027009|n
_utf8n_to_uvchr_msgs_helper|5.029001||cVnu
utf8n_to_uvuni|5.007001||dcV
UTF8_SAFE_SKIP|5.029009|5.006000|p
UTF8SKIP|5.006000|5.006000|
win32_setlocale|5.027006||Viu
withinCOUNT|5.031004||Viu
withinCOUNT_KNOWN_VALID|5.033005||Viu
WITH_LC_NUMERIC_SET_TO_NEEDED|5.031003|5.031003|
WITH_LC_NUMERIC_SET_TO_NEEDED_IN|5.031003|5.031003|
with_queued_errors|5.013001||Viu
with_tp_UTF8ness|5.033003||Viu
with_t_UTF8ness|5.035004||Viu
wrap_keyword_plugin|5.027006|5.027006|x
wrap_op_checker|5.015008|5.015008|
write|5.005000||Viu
YESEXPR|5.027010||Viu
YESSTR|5.027010||Viu
YIELD|5.005000||Viu
YYDEBUG|5.025006||Viu
YYEMPTY|5.009005||Viu
yyerror|5.003007||Viu
yyerror_pv|5.016000||Viu
yyerror_pvn|5.016000||Viu
yylex|5.003007||cViu
yyparse|5.003007||Viu
yyquit|5.025010||Viu
YYSTYPE_IS_DECLARED|5.009001||Viu
YYSTYPE_IS_TRIVIAL|5.009001||Viu
if ($file{changes}) {
if (exists $opt{copy}) {
my $newfile = "$filename$opt{copy}";
if (-e $newfile) {
error("'$newfile' already exists, refusing to write copy of '$filename'");
}
else {
local *F;
if (open F, ">$newfile") {
info("Writing copy of '$filename' with changes to '$newfile'");
print F $c;
close F;
}
else {
error("Cannot open '$newfile' for writing: $!");
}
}
}
elsif (exists $opt{patch} || $opt{changes}) {
if (exists $opt{patch}) {
unless ($patch_opened) {
if (open PATCH, ">$opt{patch}") {
$patch_opened = 1;
}
else {
error("Cannot open '$opt{patch}' for writing: $!");
delete $opt{patch};
$opt{changes} = 1;
goto fallback;
}
}
if (!defined $diff) {
$diff = run_diff('diff', $file, $str);
}
if (!defined $diff) {
error("Cannot generate a diff. Please install Text::Diff or use --copy.");
return;
}
print F $diff;
}
}
unlink $tmp;
}
else {
error("Cannot open '$tmp' for writing: $!");
}
return undef;
}
{
$opt{quiet} and return;
print "*** ", @_, "\n";
}
sub error
{
print "*** ERROR: ", @_, "\n";
}
my %given_hints;
# define D_PPP_MINOR PERL_VERSION
#elif defined(PATCHLEVEL)
# define D_PPP_MINOR PATCHLEVEL
# define PERL_VERSION PATCHLEVEL /* back-compat */
#else
# error Could not find a source for PERL_VERSION_MINOR
#endif
#ifdef PERL_VERSION_PATCH
# define D_PPP_PATCH PERL_VERSION_PATCH
#elif defined(PERL_SUBVERSION)
# define D_PPP_PATCH PERL_SUBVERSION
#elif defined(SUBVERSION)
# define D_PPP_PATCH SUBVERSION
# define PERL_SUBVERSION SUBVERSION /* back-compat */
#else
# error Could not find a source for PERL_VERSION_PATCH
#endif
#if D_PPP_MAJOR < 5 || D_PPP_MAJOR == 6
# error Devel::PPPort works only on Perl 5, Perl 7, ...
#elif D_PPP_MAJOR != 5
/* Perl 7 and above: the old forms are deprecated, set up so that they
* assume Perl 5, and will make this look like 5.201.201.
*
* 201 is used so will be well above anything that would come from a 5
# define PL_defgv defgv
# define PL_diehook diehook
# define PL_dirty dirty
# define PL_dowarn dowarn
# define PL_errgv errgv
# define PL_error_count error_count
# define PL_expect expect
# define PL_hexdigit hexdigit
# define PL_hints hints
# define PL_in_my in_my
# define PL_laststatval laststatval
# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
# define PL_in_my D_PPP_my_PL_parser_var(in_my)
# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
# define PL_error_count D_PPP_my_PL_parser_var(error_count)
#else
/* ensure that PL_parser != NULL and cannot be dereferenced */
( (sizeof(c) == sizeof(U8)) ? withinCOUNT(((U8) (c)), (l), ((u) - (l))) \
: (sizeof(c) == sizeof(U32)) ? withinCOUNT(((U32) (c)), (l), ((u) - (l))) \
: (withinCOUNT(((WIDEST_UTYPE) (c)), (l), ((u) - (l)))))
#endif
/* The '| 0' part ensures a compiler error if c is not integer (like e.g., a
* pointer) */
#undef FITS_IN_8_BITS /* handy.h version uses a core-only constant */
#ifndef FITS_IN_8_BITS
# define FITS_IN_8_BITS(c) ( (sizeof(c) == 1) \
|| !(((WIDEST_UTYPE)((c) | 0)) & ~0xFF))
: 0 ) \
: 0 )
#endif
# else
# error Unknown character set
# endif
#ifndef isCNTRL_utf8_safe
# define isCNTRL_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, CNTRL)
#endif
: ( ( inRANGE(((const U8*)s)[2], 0x67, 0x68 ) ) && ( inRANGE(((const U8*)s)[3], 0x42, 0x47 ) ) ) ? 4 : 0 ) : 0 )\
: 0 )
#endif
# else
# error Unknown character set
# endif
#ifndef isALPHA_LC_utf8_safe
# define isALPHA_LC_utf8_safe(s,e) D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, ALPHA)
#endif
# define UVuf "u"
# define UVof "o"
# define UVxf "x"
# define UVXf "X"
# else
# error "cannot define IV/UV formats"
# endif
#endif
#ifndef NVef
# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
# else
# define eval_sv(sv, flags) ((PL_na = Perl_eval_sv(aTHX_ sv, ((flags) & ~G_RETHROW))), D_PPP_CROAK_IF_ERROR((flags) & G_RETHROW), (I32)PL_na)
# endif
#endif
/* Older Perl versions have broken croak_on_error=1 */
#if (PERL_BCDVERSION < 0x5031002)
# ifdef eval_pv
# undef eval_pv
# if defined(PERL_USE_GCC_BRACE_GROUPS)
# define eval_pv(p, croak_on_error) ({ SV *_sv = Perl_eval_pv(aTHX_ p, 0); D_PPP_CROAK_IF_ERROR(croak_on_error); _sv; })
# else
# define eval_pv(p, croak_on_error) ((PL_Sv = Perl_eval_pv(aTHX_ p, 0)), D_PPP_CROAK_IF_ERROR(croak_on_error), PL_Sv)
# endif
# endif
#endif
/* This is backport for Perl 5.3.97d and older which do not provide perl_eval_pv */
#ifndef eval_pv
#if defined(NEED_eval_pv)
static SV * DPPP_(my_eval_pv)(const char * p, I32 croak_on_error);
static
#else
extern SV * DPPP_(my_eval_pv)(const char * p, I32 croak_on_error);
#endif
#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
#ifdef eval_pv
#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
#define Perl_eval_pv DPPP_(my_eval_pv)
SV*
DPPP_(my_eval_pv)(const char *p, I32 croak_on_error)
{
dSP;
SV* sv = newSVpv(p, 0);
PUSHMARK(sp);
SPAGAIN;
sv = POPs;
PUTBACK;
D_PPP_CROAK_IF_ERROR(croak_on_error);
return sv;
}
#endif
#ifndef REPLACEMENT_CHARACTER_UTF8
# define REPLACEMENT_CHARACTER_UTF8 "\xDD\x72\x72\x70"
#endif
#else
# error Unknown character set
#endif
#if (PERL_BCDVERSION < 0x5035010)
/* Versions prior to 5.31.4 accepted things that are now considered
* malformations, and didn't return -1 on error with warnings enabled.
* Versions before 5.35.10 dereferenced empty input without checking */
# undef utf8_to_uvchr_buf
#endif
/* This implementation brings modern, generally more restricted standards to
# define D_PPP_utf8_to_uvchr_buf_callee utf8n_to_uvchr
# elif /* Must be at least 5.6.1 from #if above; \
If have both regular and _simple, regular has all args */ \
defined(utf8_to_uv) && defined(utf8_to_uv_simple)
# define D_PPP_utf8_to_uvchr_buf_callee utf8_to_uv
# elif defined(utf8_to_uvchr) /* The below won't work well on error input */
# define D_PPP_utf8_to_uvchr_buf_callee(s, curlen, retlen, flags) \
utf8_to_uvchr((U8 *)(s), (retlen))
# else
# define D_PPP_utf8_to_uvchr_buf_callee(s, curlen, retlen, flags) \
utf8_to_uv((U8 *)(s), (retlen))
}
return UNICODE_REPLACEMENT;
}
else {
/* We use the error message in use from 5.8-5.26 */
Perl_warner(aTHX_ packWARN(WARN_UTF8),
"Malformed UTF-8 character (overflow at 0x%" UVxf
", byte 0x%02x, after start byte 0x%02x)",
ret, *cur_s, *s);
if (retlen) {
Algorithm-LineSegments
view release on metacpan or search on metacpan
lib/Algorithm/LineSegments.pm view on Meta::CPAN
=head1 DESCRIPTION
This module takes discrete data points like time series data and
computes a piecewise linear function, line segments, approximating
them. It does this by merging groups of adjacent points into lines,
always picking the pair that produces the smallest error, until it
is told to stop.
=head2 FUNCTIONS
=over
lib/Algorithm/LineSegments.pm view on Meta::CPAN
=item C<cost>
A callback function that is called with two list references of
points and it should return a number indicating how costly it
is, how much of an error it introduces, if all points are made
into a single line segment. The default projects all data points
to the unit range 0 .. 1 based on the maximum and minimum value
and computes the euclidean distance between the points and the
corresponding points on a line that would cover them all.
Algorithm-LinearManifoldDataClusterer
view release on metacpan or search on metacpan
examples/example1.pl view on Meta::CPAN
## Highlights:
##
## --- The data file contains 498 samples in three small clusters
## on the surface of a sphere
##
## --- Note the use of 0.001 for delta_reconstruction_error
use strict;
use Algorithm::LinearManifoldDataClusterer;
examples/example1.pl view on Meta::CPAN
mask => $mask,
K => 3, # number of clusters
P => 2, # manifold dimensionality
max_iterations => 15,
cluster_search_multiplier => 2,
delta_reconstruction_error => 0.001,
terminal_output => 1,
visualize_each_iteration => 1,
show_hidden_in_3D_plots => 1,
make_png_for_each_iteration => 1,
);
$clusterer->get_data_from_csv();
my $clusters = $clusterer->linear_manifold_clusterer();
$clusterer->display_reconstruction_errors_as_a_function_of_iterations();
$clusterer->write_clusters_to_files($clusters);
$clusterer->visualize_clusters_on_sphere("final clustering", $clusters);
Algorithm-Loops
view release on metacpan or search on metacpan
lib/Algorithm/Loops.pm view on Meta::CPAN
Note that in at least some versions of Perl, support for the "Filter
BLOCK ..." syntax is somewhat fragile. For example:
... Filter( {y/aeiou/UAEIO/} @list );
may give you this error:
Array found where operator expected
which can be fixed by dropping the parentheses:
lib/Algorithm/Loops.pm view on Meta::CPAN
s#\d{2}(\d+)#\1#g
} sort Filter sub {
s#(\d+)# sprintf "%02d%s", length($1), $1 #g
}, @data;
because it will produce the following error:
Undefined subroutine in sort
in some versions of Perl. Some versions of Perl may even require you
to write it like this:
lib/Algorithm/Loops.pm view on Meta::CPAN
The "..."s above show that, when the final code reference is provided,
NestedLoops can return a few different types of information.
In a void context, NestedLoops simply iterates and calls the provided
code, discarding any values it returns. (Calling NestedLoops in a void
context without passing a final code reference is a fatal error.)
In a list context, NestedLoops C<push>es the values returned by each call
to \&Code onto an array and then returns (copies of the values from) that
array.
Algorithm-LossyCount
view release on metacpan or search on metacpan
lib/Algorithm/LossyCount.pm view on Meta::CPAN
our $VERSION = 0.03;
sub new {
my ($class, %params) = @_;
my $max_error_ratio = delete $params{max_error_ratio}
// Carp::croak('Missing mandatory parameter: "max_error_ratio"');
if (%params) {
Carp::croak(
'Unknown parameter(s): ',
join ', ', map { qq/"$_"/ } sort keys %params,
)
}
Carp::croak('max_error_ratio must be positive.') if $max_error_ratio <= 0;
my $self = bless +{
bucket_size => POSIX::ceil(1 / $max_error_ratio),
current_bucket => 1,
entries => +{},
max_error_ratio => $max_error_ratio,
num_samples => 0,
num_samples_in_current_bucket => 0,
} => $class;
return $self;
lib/Algorithm/LossyCount.pm view on Meta::CPAN
Carp::croak('add_sample() requires 1 parameter.') unless defined $sample;
if (defined (my $entry = $self->entries->{$sample})) {
$entry->increment_frequency;
$entry->num_allowed_errors($self->current_bucket - 1);
} else {
$self->entries->{$sample} = Algorithm::LossyCount::Entry->new(
num_allowed_errors => $self->current_bucket - 1,
);
}
++$self->{num_samples};
++$self->{num_samples_in_current_bucket};
lib/Algorithm/LossyCount.pm view on Meta::CPAN
'Unknown parameter(s): ',
join ', ', map { qq/"$_"/ } sort keys %params,
)
}
my $threshold = ($support - $self->max_error_ratio) * $self->num_samples;
my %frequencies = map {
my $frequency = $self->entries->{$_}->frequency;
$frequency < $threshold ? () : ($_ => $frequency);
} keys %{ $self->entries };
return \%frequencies;
}
sub max_error_ratio { $_[0]->{max_error_ratio} }
sub num_samples { $_[0]->{num_samples} }
sub num_samples_in_current_bucket { $_[0]->{num_samples_in_current_bucket} }
lib/Algorithm/LossyCount.pm view on Meta::CPAN
use warnings;
use Algorithm::LossyCount;
my @samples = qw/a b a c d f a a d b b c a a .../;
my $counter = Algorithm::LossyCount->new(max_error_ratio => 0.005);
$counter->add_sample($_) for @samples;
my $frequencies = $counter->frequencies;
say $frequencies->{a}; # Approximate freq. of 'a'.
say $frequencies->{b}; # Approximate freq. of 'b'.
lib/Algorithm/LossyCount.pm view on Meta::CPAN
The main advantage of the algorithm is memory efficiency. You can get approximate count of appearance of items with very low memory footprint, compared with total inspection.
Furthermore, Lossy-Counting is an online algorithm. It is applicable to data set such that the size is unknown, and you can take intermediate result anytime.
=head1 METHODS
=head2 new(max_error_ratio => $num)
Construcotr. C<max_error_ratio> is the only mandatory parameter, that specifies acceptable error ratio. It is an error that give zero or a negative number as the value.
=head2 add_sample($sample)
Add given C<$sample> to count.
=head2 frequencies([support => $num])
Returns current result as HashRef. Its keys and values are samples and corresponding counts respectively.
If optional named parameter C<support> is specified, returned HashRef will contain only samples having frequency greater than C<($support - $max_error_ratio) * $num_samples>.
=head2 max_error_ratio
Returns C<max_error_ratio> you've given to the constructor.
=head2 num_samples
Returns the total number of samples you've added.
Algorithm-MasterMind
view release on metacpan or search on metacpan
lib/Algorithm/MasterMind/Consistent_Set.pm view on Meta::CPAN
Adds another combination checking it against previous combinations
=head2 result_to_string ( $result )
Converts result hash into string in a more or less standard way, to
avoid conversion errors
=head2 partitions_for ( $string )
Returns the partition hash for combination $string
Algorithm-MedianSelect-XS
view release on metacpan or search on metacpan
- Allocate space on heap instead of stack for numbers.
- Define croak() wrappers.
- Adjust fatal error messages.
- Use Perl's TRUE/FALSE. [rt #76474 - Slaven Rezić]
- Reword documentation.
Algorithm-Merge
view release on metacpan or search on metacpan
# $no_change = sub {
# if($keyGen->($pivot -> [$_[0]]) ne $keyGen->($doca -> [$_[1]])
# || $keyGen->($pivot -> [$_[0]]) ne $keyGen->($docb -> [$_[2]])
# || $keyGen->($doca -> [$_[1]]) ne $keyGen->($docb -> [$_[2]]))
# {
# croak "No change detected, but elements differ between sequences. Please submit a bug report to jsmith\@cpan.org with a description of the set of sequences which lead to this error.\n";
# }
# push @ret, [ 'u', $pivot -> [$_[0]], $doca -> [$_[1]], $docb -> [$_[2]] ];
# };
# }
# else {
$no_change = sub {
# if($pivot -> [$_[0]] ne $doca -> [$_[1]]
# || $pivot -> [$_[0]] ne $docb -> [$_[2]]
# || $doca -> [$_[1]] ne $docb -> [$_[2]])
# {
# croak "No change detected, but elements differ between sequences. Please submit a bug report to jsmith\@cpan.org with a description of the set of sequences which lead to this error.\n";
# }
push @ret, [ 'u', $pivot -> [$_[0]], $doca -> [$_[1]], $docb -> [$_[2]] ];
};
# }
Algorithm-MinPerfHashTwoLevel
view release on metacpan or search on metacpan
lib/Tie/Hash/MinPerfHashTwoLevel/OnDisk.pm view on Meta::CPAN
sub new {
my ($class, %opts)= @_;
$opts{flags} ||= 0;
$opts{flags} |= MPH_F_VALIDATE if $opts{validate};
my $error;
my $mount= mount_file($opts{file},$error,$opts{flags});
my $error_rsv= delete $opts{error_rsv};
if ($error_rsv) {
$$error_rsv= $error;
}
if (!defined($mount)) {
if ($error_rsv) {
return;
} else {
die "Failed to mount file '$opts{file}': $error";
}
}
$opts{mount}= $mount;
return bless \%opts, $class;
}
lib/Tie/Hash/MinPerfHashTwoLevel/OnDisk.pm view on Meta::CPAN
my $file= $opts{file}
or die "file is a mandatory option to validate_file";
my $verbose= $opts{verbose};
my ($variant,$msg);
my $error_sv;
my $self= $class->new(file => $file, flags => MPH_F_VALIDATE, error_rsv => \$error_sv);
if ($self) {
$msg= sprintf "file '%s' is a valid '%s' file\n"
. " variant: %d\n"
. " keys: %d\n"
. " hash-state: %s\n"
lib/Tie/Hash/MinPerfHashTwoLevel/OnDisk.pm view on Meta::CPAN
$self->get_hdr_str_buf_checksum,
$self->get_comment,
;
$variant = $self->get_hdr_variant;
} else {
$msg= $error_sv;
}
if ($verbose) {
if (defined $variant) {
print $msg;
} else {
lib/Tie/Hash/MinPerfHashTwoLevel/OnDisk.pm view on Meta::CPAN
=item validate_file
Validate the file specified by the 'file' argument. Returns a list of
two values, 'variant' and 'message'. If the file fails validation the 'variant'
will be undef and the 'message' will contain an error message. If the file
passes validation the 'variant' will specify the variant of the file
(currently only 0 is valid), and 'message' will contain some basic information
about the file, such as how many keys it contains, the comment it was
created with, etc.
Algorithm-Munkres
view release on metacpan or search on metacpan
t/Ill_Formed.t view on Meta::CPAN
# A script to run tests on the Algorithm::Mukres module.
# This test cases check for a not well-formed input matrix.
# The following are among the tests run by this script:
# 1. Try loading the Algorithm::Munkres i.e. is it added to the @INC variable
# 2. Check the returned error message.
use strict;
use warnings;
use Test::More tests => 2;
t/Ill_Formed.t view on Meta::CPAN
my $soln_out = "Please check the input matrix.\nThe input matrix is not a well-formed matrix!\nThe input matrix has to be rectangular or square matrix.\n";
eval {assign(\@mat,\@assign_out)};
#Compare the lengths of the Solution array and the Output array.
is($soln_out, $@, 'Compare the returned error message.');
__END__
Algorithm-NaiveBayes
view release on metacpan or search on metacpan
Revision history for Perl extension Algorithm::NaiveBayes.
- Fixed a runtime error in the Gaussian model - the code died looking
for a rescale() function, which I had forgotten to import. [Manju Putcha]
- Added save_state() and restore_state() methods, which will help
consumers (like AI::Categorizer) avoid a pesky "can't find method"
error when using a restored model.
0.03 Mon May 17 22:11:00 CDT 2004
- The double-loop inside the predict() method has been turned
inside-out, so that the outer loop is now over the new attributes,
Algorithm-NeedlemanWunsch
view release on metacpan or search on metacpan
lib/Algorithm/NeedlemanWunsch.pm view on Meta::CPAN
$j = $n;
while (($i > 0) || ($j > 0)) {
my $a = $A->[$i]->[$j];
my @alt;
if ($a & $from_diag) {
die "internal error" unless ($i > 0) && ($j > 0);
push @alt, [ $i - 1, $j - 1 ];
}
if ($a & $from_up) {
die "internal error" unless ($i > 0);
push @alt, [ $i - 1, $j ];
}
if ($a & $from_left) {
die "internal error" unless ($j > 0);
push @alt, [ $i, $j - 1];
}
if (!@alt) {
die "internal error";
}
my $cur = [ $i, $j ];
my $move;
if (@alt == 1) {
lib/Algorithm/NeedlemanWunsch.pm view on Meta::CPAN
} elsif ($move eq 'shift_a') {
--$j;
} elsif ($move eq 'shift_b') {
--$i;
} else {
die "internal error";
}
}
return $D->[$m]->[$n];
}
lib/Algorithm/NeedlemanWunsch.pm view on Meta::CPAN
$i = $m;
$j = $n;
while (($i > 0) || ($j > 0)) {
my @alt;
if ($arrow & $from_diag) {
die "internal error" unless ($i > 0) && ($j > 0);
push @alt, [ $i - 1, $j - 1 ];
}
if ($arrow & $from_up) {
die "internal error" unless ($i > 0);
push @alt, [ $i - 1, $j ];
}
if ($arrow & $from_left) {
die "internal error" unless ($j > 0);
push @alt, [ $i, $j - 1];
}
if (!@alt) {
die "internal error";
}
# my $x = join ', ', map { "[ " . $_->[0] . ", " . $_->[1] . " ]"; } @alt;
# warn "$i, $j: $x\n";
lib/Algorithm/NeedlemanWunsch.pm view on Meta::CPAN
my @base = map { $_->[$i]->[$j] } @D;
$arrow = $self->_retread($score[$from_up_idx], $i, $j,
\@base, \@delta_up);
@score = @base;
} else {
die "internal error";
}
}
return $res;
}
lib/Algorithm/NeedlemanWunsch.pm view on Meta::CPAN
} elsif ($m eq 'shift_a') {
$arg->{shift_a} = $cur->[1] - 1;
} elsif ($m eq 'shift_b') {
$arg->{shift_b} = $cur->[0] - 1;
} else {
die "internal error";
}
}
my $move;
my $cb = $self->{callbacks};
lib/Algorithm/NeedlemanWunsch.pm view on Meta::CPAN
last;
}
}
if (!$move) {
die "internal error";
}
if (exists($cb->{$move})) {
if ($move eq 'align') {
&{$cb->{align}}(@{$arg->{align}});
lib/Algorithm/NeedlemanWunsch.pm view on Meta::CPAN
}
return 'align';
} else {
if ($next->[1] != $cur->[1]) {
die "internal error";
}
if (exists($cb->{shift_b})) {
&{$cb->{shift_b}}($cur->[0] - 1);
}
return 'shift_b';
}
} else {
if ($next->[0] != $cur->[0]) {
die "internal error";
}
if ($next->[1] != $cur->[1] - 1) {
die "internal error";
}
if (exists($cb->{shift_a})) {
&{$cb->{shift_a}}($cur->[1] - 1);
}
( run in 0.676 second using v1.01-cache-2.11-cpan-65fba6d93b7 )