Result:
found more than 559 distributions - search limited to the first 2001 files matching your query
( run in 1.460 )
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);
}
Algorithm-Networksort-Chooser
view release on metacpan or search on metacpan
0.110 2016-02-16
* Update docs
* Properly reference binary in Makefile (oops)
* Support --help/-h
* Better error messages when invalid algorithms are specified
* Support optimisation by average swaps
0.100 2013-02-19
* Initial release
Algorithm-Networksort
view release on metacpan or search on metacpan
lib/Algorithm/Networksort.pm view on Meta::CPAN
my @network;
my @grouped;
#
# Catch errors
#
croak "Input size must be 2 or greater" if ($inputs < 2);
#
# Providing our own-grown network?
lib/Algorithm/Networksort.pm view on Meta::CPAN
L<Doug Hoyte|https://github.com/hoytech> provided the code for the bitonic,
odd-even merge, odd-even transposition, balanced, and bubble sort algorithms,
and the idea for what became the L<statistics()> method.
L<Morwenn|https://github.com/Morwenn> found documentation errors and networks
that went into L<Algorithm::Networksort::Best>.
=head1 SEE ALSO
=head2 Bose and Nelson's algorithm.
Algorithm-Numerical-Shuffle
view release on metacpan or search on metacpan
t/000_tests.t view on Meta::CPAN
else {
print "ok ", $test_num ++, "\n";
}
};
if ($@) {print "... error: $@\n";}
eval {
my $a = [];
shuffle $a;
t/000_tests.t view on Meta::CPAN
else {
print "ok ", $test_num ++, "\n";
}
};
if ($@) {print "... error: $@\n";}
eval {
my @a = (0 .. 9);
my @b = shuffle @a;
my @c = sort {$a <=> $b} @b;
t/000_tests.t view on Meta::CPAN
else {
print "ok ", $test_num ++, "\n";
}
};
if ($@) {print "... error: $@\n";}
eval {
my $A = [0 .. 9];
my $B = [0 .. 9];
shuffle $B;
t/000_tests.t view on Meta::CPAN
else {
print "ok ", $test_num ++, "\n";
}
};
if ($@) {print "... error: $@\n";}
Algorithm-Odometer-Tiny
view release on metacpan or search on metacpan
t/algorithm_odometer_tiny.t view on Meta::CPAN
is_deeply [<$odo1>], ["foo3", "foo4", "foo5", "bar3", "bar4", "bar5"], 'list context <> ::Tiny';
my $odo2 = Algorithm::Odometer::Gray->new( ['a','b','c'],[1,2] );
is_deeply [<$odo2>], ["a1", "b1", "c1", "c2", "b2", "a2"], 'list context <> ::Gray';
}
subtest 'errors' => sub { plan tests=>4;
like exception { Algorithm::Odometer::Tiny->new() }, qr/\bno wheels specified\b/i, 'no wheels specified';
like exception { Algorithm::Odometer::Gray->new() }, qr/\bno wheels specified\b/i, 'no wheels specified ::Gray';
like exception { Algorithm::Odometer::Gray->new(['x','y'],['z']) }, qr/\bat least two positions\b/i, 'Gray at least two positions 1/2';
like exception { Algorithm::Odometer::Gray->new(['x','y'],[]) }, qr/\bat least two positions\b/i, 'Gray at least two positions 2/2';
};
Algorithm-PageRank-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.
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|
pv_escape||5.009004|
pv_pretty||5.009004|
pv_uni_display||5.007003|
qerror|||
qsortsvu|||
re_compile||5.009005|
re_croak2|||
re_dup_guts|||
re_intuit_start||5.009005|
xmldump_form|||
xmldump_indent|||v
xmldump_packsubs|||
xmldump_sub|||
xmldump_vindent|||
yyerror|||
yylex|||
yyparse|||
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 */
#ifdef I_LIMITS
# include <limits.h>
#endif
/* 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-Pair-Swiss
view release on metacpan or search on metacpan
- input checks on ->parties method and relevant tests
0.14 2006-07-04
- added pod and pod coverage tests
- added input tests
- fixed some documentation errors
Algorithm-Partition
view release on metacpan or search on metacpan
lib/Algorithm/Partition.pm view on Meta::CPAN
use Algorithm::Partition qw(partition);
my ($one, $two) = partition(2, 4, 1, 5, 8, 16);
unless (defined($one)) {
print "Error: $two"; # now $two is an error
} else {
print "Set 1: @$one\n";
print "Set 2: @$two\n";
}
lib/Algorithm/Partition.pm view on Meta::CPAN
push @one, $set[$i];
$j -= $set[$i];
} elsif (TOP == $table[$i][$j][1]) {
push @two, $set[$i];
} else {
die "Programmer error. Please report this bug.";
}
}
return (\@one, \@two);
}
Algorithm-Permute
view release on metacpan or search on metacpan
lib/Algorithm/Permute.pm view on Meta::CPAN
=item permute BLOCK ARRAY
A block of code is passed, which will be executed for each permutation. The array will be changed in place,
and then changed back again before C<permute> returns. During the execution of the callback,
the array is read-only and you'll get an error if you try to change its length. (You I<can>
change its elements, but the consequences are liable to confuse you and may change in future
versions.)
You have to pass an array, it can't just be a list. It B<does> work with special arrays
and tied arrays, though unless you're doing something particularly abstruse you'd be
Algorithm-QuadTree-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.
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-QuadTree
view release on metacpan or search on metacpan
t/07-bad-use.t view on Meta::CPAN
$ENV{ALGORITHM_QUADTREE_BACKEND} = 'Backend::NonExistent';
eval {
require Algorithm::QuadTree;
};
like $@, qr{\QCan't locate Backend/NonExistent.pm\E}, 'error ok';
done_testing;
Algorithm-QuineMcCluskey
view release on metacpan or search on metacpan
lib/Algorithm/QuineMcCluskey.pm view on Meta::CPAN
my $w = $self->width;
my $last_idx = (1 << $w) - 1;
my @terms;
#
# Catch errors involving minterms, maxterms, and don't-cares.
#
$self->catch_errors();
#
# We've gotten past the error-checking. Create the object.
#
if ($self->has_columnstring)
{
my($min_ref, $max_ref, $dc_ref) =
$self->list_to_terms(split(//, $self->columnstring));
Algorithm-RandomMatrixGeneration
view release on metacpan or search on metacpan
lib/Algorithm/RandomMatrixGeneration.pm view on Meta::CPAN
my @tmp_cmar = @$ref_cmar;
my $n = $#tmp_rmar;
my $m = $#tmp_cmar;
# error checks
if(!$n)
{
print STDERR "No row marginals provided.\n";
exit 1;
}
Algorithm-RectanglesContainingDot_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.
PUSHu|5.004000||p
PUTBACK|||
PerlIO_clearerr||5.007003|
PerlIO_close||5.007003|
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|
ptr_table_store|||
push_scope|||
put_byte|||
pv_display||5.006000|
pv_uni_display||5.007003|
qerror|||
re_croak2|||
re_dup|||
re_intuit_start||5.006000|
re_intuit_string||5.006000|
realloc||5.007002|n
warn|||v
watch|||
whichsig|||
write_no_mem|||
write_to_stderr|||
yyerror|||
yylex|||
yyparse|||
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 */
#ifdef I_LIMITS
# include <limits.h>
#endif
/* Replace perl_eval_pv with eval_pv */
/* eval_pv depends on eval_sv */
#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-SISort
view release on metacpan or search on metacpan
The package now requires Inline v 0.40 to install
0.11 Mon Feb 19 12:58 GMT 2001
- added time zones to the Changelog
- changed Sort() to only copy the input array once.
- some minimal error checking added on the parameters to
_sort().
- removed the need for a sentinel at the front of the
array.
- corrected some spelling errors in the documentation
0.10 Sun Feb 18 23:31 GMT 2001
- renamed to Algorithm::SISort
- initial packaging and release
Algorithm-SVM
view release on metacpan or search on metacpan
lib/Algorithm/SVM/DataSet.pm view on Meta::CPAN
sub new {
my ($class, %args) = @_;
# Do some quick error checking on the values we've been passed.
croak("No label specified for DataSet") if(! exists($args{Label}));
my $self = _new_dataset($args{Label} + 0);
if(exists($args{Data})) {
croak("Data must be an array ref") if(ref($args{Data}) ne "ARRAY");
( run in 1.460 second using v1.01-cache-2.11-cpan-c966e8aa7e8 )