Result:
found more than 582 distributions - search limited to the first 2001 files matching your query
( run in 2.136 )
Algorithm-IRCSRP2
view release on metacpan or search on metacpan
lib/Algorithm/IRCSRP2.pm view on Meta::CPAN
sub cbc_decrypt {
my ($self, $data) = @_;
my $blocksize = $self->cbc_blocksize();
die('length($data) % $blocksize != 0') unless (length($data) % $blocksize == 0);
my $IV = substr($data, 0, $blocksize);
$data = substr($data, $blocksize);
my $plaintext = '';
foreach (@{[ 0 .. (length($data) / $blocksize) - 1 ]}) {
my $temp = $self->cipher->decrypt(substr($data, 0, $blocksize));
my $temp2 = xorstring($temp, $IV, $blocksize);
$plaintext .= $temp2;
$IV = substr($data, 0, $blocksize);
$data = substr($data, $blocksize);
lib/Algorithm/IRCSRP2.pm view on Meta::CPAN
sub cbc_encrypt {
my ($self, $data) = @_;
my $blocksize = $self->cbc_blocksize();
die('length($data) % $blocksize != 0') unless (length($data) % $blocksize == 0);
my $IV = urandom($blocksize);
die('len(IV) == blocksize') unless (length($IV) == $blocksize);
my $ciphertext = $IV;
foreach (@{[ 0 .. (length($data) / $blocksize) - 1 ]}) {
my $xored = xorstring($data, $IV, $blocksize);
my $enc = $self->cipher->encrypt($xored);
$ciphertext .= $enc;
$IV = $enc;
$data = substr($data, $blocksize);
}
die('len(ciphertext) % blocksize == 0') unless (length($ciphertext) % $blocksize == 0);
return $ciphertext;
}
sub decrypt_message {
lib/Algorithm/IRCSRP2.pm view on Meta::CPAN
if ($msg =~ /^\xffKEY/) {
my $new = substr($msg, 4);
if (length($new) != (32 + 32)) {
die('decrypt_message: length($new) != 32 + 32 ; length is ' . length($new));
}
$self->debug_cb->('decrypt_message: rekeying');
$self->session_key(substr($new, 0, 32));
lib/Algorithm/IRCSRP2.pm view on Meta::CPAN
my ($self, $who, $msg) = @_;
my $times = pack('L>', int(time()));
# info = len(username) || username || timestamp
my $infos = chr(length($who)) . $who . $times;
# ctext = IV || AES-CBC(sessionkey, IV, "M" || info || plaintext)
my $ctext = $self->cbc_encrypt(padto('M' . $infos . $msg, 16));
# cmac = HM(mackey, ctext)
Algorithm-IncludeExclude
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
my $cwd = Cwd::cwd();
$Config = [];
my $maxlen = length(
(
sort { length($b) <=> length($a) }
grep { /^[^\-]/ }
map {
ref($_)
? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
: ''
Algorithm-Interval2Prefix
view release on metacpan or search on metacpan
Interval2Prefix.pm view on Meta::CPAN
my($lo, $hi) = @_;
my @res = _i2a($lo, $hi, 10,
sub {
my($n, $i, $base)= @_;
my $p = $n / _step($i, $base);
my $s = length($n) - length($p);
return $p . ($s ? '\d' . ($s > 1 ? "{$s}" : '') : '');
});
return unless @res;
return '^(?:' . join('|', @res) . ')$';
}
Interval2Prefix.pm view on Meta::CPAN
This type of conversion is particularly useful when working with
telephony switching equipment, which usually determines call routing
based on number prefixes rather than ranges.
Note that the numbers in the interval must be of the same length
for the result to make sense.
The algorithm is much dependent on the number base, which defaults to
10. Other number bases can be specified explicitly.
Interval2Prefix.pm view on Meta::CPAN
=over 4
=item *
With interval2prefix(), the endpoints of the interval must be the
same length (same number of digits in the particular number base)
for the results to make any sense.
=item *
interval2regex() only does base 10.
Algorithm-InversionList
view release on metacpan or search on metacpan
InversionList.pm view on Meta::CPAN
my $string = shift @_;
# we need a valid string
return undef unless defined $string;
# handle trivial case of 0-length string
return [] unless length $string;
# this is suboptimal, we eventually want to do things in multiples of 8 (on byte boundaries)
# $length is length in bits, we avoid b* because it will create a list 8 times larger than C*
my @unpacked = unpack("C*", $string);
my $length = scalar @unpacked * 8;
my $current = vec($string, 0, 1);
my $new;
my @list;
push @list, 0 if $current;
foreach my $offset (0..$length)
{
$new = vec($string, $offset, 1);
if ($new != $current)
{
push @list, $offset;
}
$current = $new;
}
push @list, $length unless exists $list[-1] && $list[-1] == $length;
return \@list;
}
sub data_from_invlist
InversionList.pm view on Meta::CPAN
the numeric position of each switch between a run of 0 and 1 bits.
Thus, the data "111111100" is encoded as the list of numbers 0, 7 in
an inversion list. This module begins the list with the start of the
run of 1's, so if the first 2 bits in the string are 0, the first
entry in the list will be a 2 (where we find the first bit that is 1).
The last number will always be the length of the string, so that we
know where to end it.
Inversion lists are very efficient. Because of the way that Perl
stores scalars and lists and the various architectures to which Perl
has been ported, there is no definitive rule as to what's the exact
proportion of bit runs to bitstring length required to make inversion
lists efficient. Generally, if you see long runs of repeated 0 or 1
bits, an inversion list may be appropriate.
This module stores inversion lists in an offset-based format which has
some nice properties, for instance searching is fast and you can
Algorithm-KNN-XS
view release on metacpan or search on metacpan
mg_copy|||
mg_dup|||
mg_find|||
mg_free|||
mg_get|||
mg_length||5.005000|
mg_localize|||
mg_magical|||
mg_set|||
mg_size||5.005000|
mini_mktime||5.007002|
reg_named_buff_scalar||5.009005|
reg_named_buff|||
reg_namedseq|||
reg_node|||
reg_numbered_buff_fetch|||
reg_numbered_buff_length|||
reg_numbered_buff_store|||
reg_qr_package|||
reg_recode|||
reg_scan_name|||
reg_skipcomment|||
usage|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|
utf8_distance||5.006000|
utf8_hop||5.006000|
utf8_length||5.007001|
utf8_mg_pos_cache_update|||
utf8_to_bytes||5.006001|
utf8_to_uvchr||5.007001|
utf8_to_uvuni||5.007001|
utf8n_to_uvchr|||
if (exists $opt{'list-unsupported'}) {
my $f;
for $f (sort { lc $a cmp lc $b } keys %API) {
next unless $API{$f}{todo};
print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
}
exit 0;
}
# Scan for possible replacement candidates
#ifndef ERRSV
# define ERRSV get_sv("@",FALSE)
#endif
/* Hint: gv_stashpvn
* This function's backport doesn't support the length parameter, but
* rather ignores it. Portability can only be ensured if the length
* parameter is used for speed reasons, but the length can always be
* correctly computed from the string argument.
*/
#ifndef gv_stashpvn
# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
#endif
#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
Size_t
DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
{
Size_t used, length, copy;
used = strlen(dst);
length = strlen(src);
if (size > 0 && used < size - 1) {
copy = (length >= size - used) ? size - used - 1 : length;
memcpy(dst + used, src, copy);
dst[used + copy] = '\0';
}
return used + length;
}
#endif
#endif
#if !defined(my_strlcpy)
#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
Size_t
DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
{
Size_t length, copy;
length = strlen(src);
if (size > 0) {
copy = (length >= size) ? size - 1 : length;
memcpy(dst, src, copy);
dst[copy] = '\0';
}
return length;
}
#endif
#endif
#ifndef PERL_PV_ESCAPE_QUOTE
Algorithm-Kademlia
view release on metacpan or search on metacpan
lib/Algorithm/Kademlia.pm view on Meta::CPAN
field $local_id_bin : param : writer : reader;
field $k : param //= 20;
field @buckets : reader;
#
ADJUST {
my $id_len = length $local_id_bin;
my $num_buckets = $id_len * 8;
@buckets = map { [] } 0 .. $num_buckets - 1
}
method add_peer ( $peer_id_bin, $peer_data ) {
Algorithm-KernelKMeans
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
}
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map {
$_ . '0' x (3 - length $_)
} $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
Algorithm-Kmeanspp
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
}
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map {
$_ . '0' x (3 - length $_)
} $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
Algorithm-LBFGS
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
my $cwd = Cwd::cwd();
$Config = [];
my $maxlen = length(
(
sort { length($b) <=> length($a) }
grep { /^[^\-]/ }
map {
ref($_)
? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
: ''
Algorithm-LCS-XS
view release on metacpan or search on metacpan
Most useful when computing multiple LCSs against a single file.
=item LCS(\@a,\@b)
Finds a Longest Common Subsequence, taking two arrayrefs as method
arguments. In scalar context the return value is the length of the
subsequence. In list context it yields a list of corresponding
indices, which are represented by 2-element array refs. See the
L<Algorithm::Diff> manpage for more details.
=back
Algorithm-LCSS
view release on metacpan or search on metacpan
my $match = CSS(@_);
if ( ref $_[0] eq 'ARRAY' ) {
@$match = map{$_->[0]}sort{$b->[1]<=>$a->[1]}map{[$_,scalar(@$_)]}@$match
}
else {
@$match = map{$_->[0]}sort{$b->[1]<=>$a->[1]}map{[$_,length($_)]}@$match
}
return $match;
}
sub LCSS {
my $is_array = ref $_[0] eq 'ARRAY' ? 1 : 0;
my $css = CSS(@_);
my $index;
my $length = 0;
if ( $is_array ) {
for( my $i = 0; $i < @$css; $i++ ) {
next unless @{$css->[$i]}>$length;
$index = $i;
$length = @{$css->[$i]};
}
}
else {
for( my $i = 0; $i < @$css; $i++ ) {
next unless length($css->[$i])>$length;
$index = $i;
$length = length($css->[$i]);
}
}
return $css->[$index];
}
=head1 METHODS
=head2 LCSS
Returns the longest common sub sequence. If there may be more than one (with
exactly the same length) and it matters use CSS instead.
my $lcss_ary_ref = LCSS( \@SEQ1, \@SEQ2 ); # ref to array
my $lcss_string = LCSS( $STR1, $STR2 ); # string
=head2 CSS
Algorithm-LDA
view release on metacpan or search on metacpan
lib/Algorithm/LDA.pm view on Meta::CPAN
#Also remove words of less than three letters
my $D = @documents;
for my $wd (0..$#words)
{
my $times = $map{$words[$wd]};
my $test = ($times > 0.5*$D || $times<=$threshold || length($words[$wd]) <=3);
if($test)
{
$words[$wd]=0;
}
lib/Algorithm/LDA.pm view on Meta::CPAN
#form a single big regex
$stop_regex.="(".$_.")|";
}
if(length($stop_regex)<=0)
{
print STDERR "No valid Perl Regular Experssion found in Stop file $stop";
exit;
}
Algorithm-LUHN
view release on metacpan or search on metacpan
lib/Algorithm/LUHN.pm view on Meta::CPAN
valid_chars(). If NUM is not valid, $Algorithm::LUHN::ERROR will contain the
reason.
This function is equivalent to
substr $N,length($N)-1 eq check_digit(substr $N,0,length($N)-1)
For example, C<4242 4242 4242 4242> is a valid Visa card number,
that is provided for test purposes. The final digit is '2',
which is the right check digit. If you change it to a '3', it's not
a valid card number. Ie:
lib/Algorithm/LUHN.pm view on Meta::CPAN
=cut
sub is_valid {
my $N = shift;
my $c = check_digit(substr($N, 0,length($N)-1));
if (defined $c) {
if (substr($N,length($N)-1, 1) eq $c) {
return 1;
} else {
$ERROR = "Check digit incorrect. Expected $c";
return '';
}
Algorithm-LUHN_XS
view release on metacpan or search on metacpan
lib/Algorithm/LUHN_XS.pm view on Meta::CPAN
valid_chars(). If NUM is not valid, $Algorithm::LUHN_XS::ERROR will contain the
reason.
This function is equivalent to
substr $N,length($N)-1 eq check_digit(substr $N,0,length($N)-1)
For example, C<4242 4242 4242 4242> is a valid Visa card number,
that is provided for test purposes. The final digit is '2',
which is the right check digit. If you change it to a '3', it's not
a valid card number. Ie:
Algorithm-LibLinear
view release on metacpan or search on metacpan
src/liblinear.xs view on Meta::CPAN
}
HV *feature_hash = (HV *)SvRV(feature);
hv_iterinit(feature_hash);
HE *nonzero_element;
while ((nonzero_element = hv_iternext(feature_hash))) {
I32 index_length;
int index = atoi(hv_iterkey(nonzero_element, &index_length));
if (max_feature_index < index) { max_feature_index = index; }
}
}
return max_feature_index;
}
src/liblinear.xs view on Meta::CPAN
int feature_vector_size =
hv_iterinit(feature_hash) + (has_bias ? 1 : 0) + 1;
struct feature_node *feature_vector;
Newx(feature_vector, feature_vector_size, struct feature_node);
char *index;
I32 index_length;
SV *value;
struct feature_node *curr = feature_vector;
while ((value = hv_iternextsv(feature_hash, &index, &index_length))) {
curr->index = atoi(index);
curr->value = SvNV(value);
++curr;
}
if (has_bias) {
Algorithm-Line-Bresenham
view release on metacpan or search on metacpan
lib/Algorithm/Line/Bresenham.pm view on Meta::CPAN
my $leftFn=sub{
my ($arg,$p,$l)=@_;
# C<$arg> is passed by calling routine,
# C<$p> is point on line
# C<$l> is length of line
return $p % $arg;
};
=cut
lib/Algorithm/Line/Bresenham.pm view on Meta::CPAN
my $y= $y0;
my $x= $x0;
my $threshold = $dx - 2*$dy;
my $E_diag= -2*$dx;
my $E_square= 2*$dy;
my $length = $dx+1;
my $D= sqrt($dx*$dx+$dy*$dy);
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;
lib/Algorithm/Line/Bresenham.pm view on Meta::CPAN
my $y= $y0;
my $x= $x0;
my $threshold = $dy - 2*$dx;
my $E_diag= -2*$dy;
my $E_square= 2*$dx;
my $length = $dy+1;
my $D= sqrt($dx*$dx+$dy*$dy);
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;
Algorithm-Line-Lerp
view release on metacpan or search on metacpan
CopSTASHPV_set|5.017001|5.017001|p
CopSTASH_set|5.006000|5.003007|p
cop_store_label|5.031004|5.031004|x
Copy|5.003007|5.003007|
CopyD|5.009002|5.003007|p
copy_length|||Viu
core_prototype|5.015002||Vi
coresub_op|5.015003||Viu
CowREFCNT|5.017007||Viu
cPADOP|5.006000||Viu
cPADOPo|5.006000||Viu
KEY_kill|5.003007||Viu
KEY_last|5.003007||Viu
KEY_lc|5.003007||Viu
KEY_lcfirst|5.003007||Viu
KEY_le|5.003007||Viu
KEY_length|5.003007||Viu
KEY___LINE|5.003007||Viu
KEY_link|5.003007||Viu
KEY_listen|5.003007||Viu
KEY_local|5.003007||Viu
KEY_localtime|5.003007||Viu
mg_free_type|5.013006|5.013006|
MGf_REFCOUNTED|5.003007||Viu
MGf_REQUIRE_GV|5.021004||Viu
MGf_TAINTEDDIR|5.003007||Viu
mg_get|5.003007|5.003007|
mg_length|5.005000|5.005000|d
mg_localize|5.009003||Vi
mg_magical|5.003007|5.003007|n
MgPV|5.003007||Viu
MgPV_const|5.009003||Viu
MgPV_nolen_const|5.009003||Viu
regnode_guts_debug|||Viu
REGNODE_MAX|5.009004||Viu
REGNODE_SIMPLE|5.013002||Viu
REGNODE_VARIES|5.013002||Viu
reg_numbered_buff_fetch|5.009005||cViu
reg_numbered_buff_length|5.009005||cViu
reg_numbered_buff_store|5.009005||cViu
regpiece|5.005000||Viu
regpnode|5.031010||Viu
regprop|5.003007||Viu
reg_qr_package|5.009005||cViu
UTF8_IS_REPLACEMENT|||
UTF8_IS_START|5.007001||Viu
UTF8_IS_START_base|5.031007||Viu
UTF8_IS_SUPER|5.023002|5.023002|
UTF8_IS_SURROGATE|5.023002|5.023002|
utf8_length|5.007001|5.007001|
UTF8_MAXBYTES|5.009002|5.006000|p
UTF8_MAXBYTES_CASE|5.009002|5.003007|p
UTF8_MAX_FOLD_CHAR_EXPAND|5.013009||Viu
UTF8_MAXLEN|5.006000||Viu
utf8_mg_len_cache_update|5.013003||Viu
next if $API{$f}{beyond_depr};
next if $API{$f}{inaccessible};
next if $API{$f}{experimental};
next unless $API{$f}{todo};
next if int_parse_version($API{$f}{todo}) <= $int_min_perl;
my $repeat = 40 - length($f);
$repeat = 0 if $repeat < 0;
print "$f ", '.'x $repeat, " ", format_version($API{$f}{todo}), "\n";
}
exit 0;
}
my $end_of_hint = 0;
# A line containing a comment end marker closes the hint. Remove that
# marker for processing below.
if (s/\s*$rcce(.*?)\s*$//) {
die "Nothing can follow the end of comment in '$_'\n" if length $1 > 0;
$end_of_hint = 1;
}
# Set $h to the hash of which type.
my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
#ifndef ERRSV
# define ERRSV get_sv("@",FALSE)
#endif
/* Hint: gv_stashpvn
* This function's backport doesn't support the length parameter, but
* rather ignores it. Portability can only be ensured if the length
* parameter is used for speed reasons, but the length can always be
* correctly computed from the string argument.
*/
#ifndef gv_stashpvn
# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
#endif
/* The actual implementation of the backported macros. If too short, croak,
* otherwise call the original that doesn't have an upper limit parameter */
# define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l) \
(((((e) - (s)) <= 0) \
/* We could just do nothing, but modern perls croak */ \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
# define D_PPP_UV_TO_UTF8 uvchr_to_utf8
# else
# define D_PPP_UV_TO_UTF8 uv_to_utf8
# endif
/* Get the utf8 of the case changed value, and store its length; then have
* to re-calculate the changed case value in order to return it */
# define D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(name, c, s, l) \
(*(l) = (D_PPP_UV_TO_UTF8(s, \
UNI_TO_NATIVE(to_uni_ ## name(NATIVE_TO_UNI(c)))) - (s)), \
UNI_TO_NATIVE(to_uni_ ## name(NATIVE_TO_UNI(c))))
# define toFOLD_uvchr(c, s, l) toLOWER_uvchr(c, s, l)
#endif
# define D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(name, s, e, r, l) \
(((((e) - (s)) <= 0) \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
/* Get the changed code point and store its UTF-8 */ \
: D_PPP_UV_TO_UTF8(r, to_utf8_ ## name(s)), \
/* Then store its length, and re-get code point for return */ \
*(l) = UTF8SKIP(r), to_utf8_ ## name(r))
/* Warning: toUPPER_utf8_safe, toLOWER_utf8_safe, toTITLE_utf8_safe,
* toUPPER_uvchr, toLOWER_uvchr, toTITLE_uvchr
The UTF-8 case changing operations had bugs before around 5.12 or 5.14;
#endif
#ifndef HvNAMELEN_get
# define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
#endif
#if (PERL_BCDVERSION >= 0x5009002) && (PERL_BCDVERSION <= 0x5009003) /* 5.9.2 and 5.9.3 ignore the length param */
#undef gv_fetchpvn_flags
#endif
#ifdef GV_NOADD_MASK
# define D_PPP_GV_NOADD_MASK GV_NOADD_MASK
Size_t
DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
{
Size_t used, length, copy;
used = strlen(dst);
length = strlen(src);
if (size > 0 && used < size - 1) {
copy = (length >= size - used) ? size - used - 1 : length;
memcpy(dst + used, src, copy);
dst[used + copy] = '\0';
}
return used + length;
}
#endif
#endif
#if !defined(my_strlcpy)
Size_t
DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
{
Size_t length, copy;
length = strlen(src);
if (size > 0) {
copy = (length >= size) ? size - 1 : length;
memcpy(dst, src, copy);
dst[copy] = '\0';
}
return length;
}
#endif
#endif
DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)
{
# if (PERL_BCDVERSION >= 0x5031004) /* But from above, must be < 5.35.10 */
# if (PERL_BCDVERSION != 0x5035009)
/* Versions less than 5.35.9 could dereference s on zero length, so
* pass it something where no harm comes from that. */
if (send <= s) s = send = (U8 *) "?";
return Perl_utf8_to_uvchr_buf_helper(aTHX_ s, send, retlen);
# else /* Below is 5.35.9, which also works on non-empty input, but
STRLEN curlen;
bool overflows = 0;
const U8 *cur_s = s;
const bool do_warnings = ckWARN_d(WARN_UTF8);
# if (PERL_BCDVERSION < 0x5026000) && ! defined(EBCDIC)
STRLEN overflow_length = 0;
# endif
if (send > s) {
curlen = send - s;
}
/* First, on a 32-bit machine the first byte being at least \xFE
* automatically is overflow, as it indicates something requiring more
* than 31 bits */
if (sizeof(ret) < 8) {
overflows = 1;
overflow_length = (*s == 0xFE) ? 7 : 13;
}
else {
const U8 highest[] = /* 2*63-1 */
"\xFF\x80\x87\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF";
const U8 *cur_h = highest;
/* Here, either we set the bool and broke out of the loop, or got
* to the end and all bytes are the same which indicates it doesn't
* overflow. If it did overflow, it would be this number of bytes
* */
overflow_length = 13;
}
}
if (UNLIKELY(overflows)) {
ret = 0;
if (! do_warnings && retlen) {
*retlen = overflow_length;
}
}
else
# endif /* < 5.26 */
ret = UNICODE_REPLACEMENT;
# if (PERL_BCDVERSION < 0x5016000)
/* Versions earlier than this don't necessarily return the proper
* length. It should not extend past the end of string, nor past
* what the first byte indicates the length is, nor past the
* continuation characters */
if (retlen && (IV) *retlen >= 0) {
unsigned int i = 1;
*retlen = D_PPP_MIN(*retlen, curlen);
Algorithm-Loops
view release on metacpan or search on metacpan
lib/Algorithm/Loops.pm view on Meta::CPAN
etc.:
my @sorted= Filter {
s#\d{2}(\d+)#\1#g
} sort Filter {
s#(\d+)# sprintf "%02d%s", length($1), $1 #g
} @data;
[ Note that at least some versions of Perl have a bug that breaks C<sort>
if you write C<sub {> as part of building the list of items to be sorted
but you don't provide a comparison routine. This bug means we can't
write the previous code as:
my @sorted= Filter {
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
lib/Algorithm/Loops.pm view on Meta::CPAN
to write it like this:
my @sorted= Filter {
s#\d{2}(\d+)#\1#g
} sort &Filter( sub {
s#(\d+)# sprintf "%02d%s", length($1), $1 #g
}, @data );
Which is how I wrote it in ex/NaturalSort.plx. ]
Need to sort names? Then you'll probably want to ignore letter case and
lib/Algorithm/Loops.pm view on Meta::CPAN
=head3 Differences
The different MapCar* functions are only different in how they deal with
being pqssed arrays that are not all of the same size.
If not all of your arrays are the same length, then MapCarU() will pass
in C<undef> for any values corresponding to arrays that didn't have
enough values. The "U" in "MapCarU" stands for "undef".
In contrast, MapCar() will simply leave out values for short arrays (just
like I left the "U" out of its name).
MapCarE() will croak without ever calling your subroutine unless all of
the arrays are the same length. It considers it an Error if your arrays
are not of Equal length and so throws an Exception.
Finally, MapCarMin() only calls your subroutine as many times as there
are elements in the B<shortest> array.
In other words,
lib/Algorithm/Loops.pm view on Meta::CPAN
Transposing a two-dimensional matrix:
my @transposed= MapCarE {[@_]} @matrix;
or, using references to the matrices and allowing for different row
lengths:
my $transposed= MapCarU {[@_]} @$matrix;
Formatting a date-time:
Algorithm-MLCS
view release on metacpan or search on metacpan
lib/Algorithm/MLCS.pm view on Meta::CPAN
@ISA = qw/ Exporter /;
@EXPORT = qw/ lcs /;
$VERSION = '1.02';
# Gets arrayref of sequences (arrayrefs) and return LCS array in list context
# or length of LCS in scalar context
sub lcs {
my ( @seq, @lcs ) = map { _build_seq($_) } _get_dict( $_[0] );
while ( @seq && !( grep { !@$_ } @seq ) ) {
my %dict = ( %{ $seq[0][0] } );
lib/Algorithm/MLCS.pm view on Meta::CPAN
[ qw/a b c x f h j q z/ ],
[ qw/a b c f g j q z/ ],
);
my @lcs = lcs( \@seqs );
my $lcs_length = lcs( \@seqs );
print Dumper( \@lcs );
=head1 ABSTRACT
Finding the longest common subsequence (LCS) for the general case of an arbitrary
lib/Algorithm/MLCS.pm view on Meta::CPAN
=head2 lcs ( \@seqs )
Finds a Longest Common Subsequence of multiple sequences given by @seqs arrayref.
Each element of @seqs is arrayref that represents the one of multiple sequences
(e.g. [ ['a', 'b', 'c'], ['a', 'c', 'd', 'e'], ... ]). In list context it returns
LCS array, in scalar - the length of LCS.
=head1 SEE ALSO
Algorithm::LCS
Algorithm-MarkovChain
view release on metacpan or search on metacpan
lib/Algorithm/MarkovChain.pm view on Meta::CPAN
local $; = $self->{seperator};
my $l = 0;
for (keys %{ $self->{chains} }) {
my @tmp = split $;, $_;
my $length = scalar @tmp;
$l = $length if $length > $l;
}
return $l;
}
lib/Algorithm/MarkovChain.pm view on Meta::CPAN
# learn about things from @symbols
$chain->seed(symbols => \@symbols,
longest => 6);
# attempt to tell me something about the sky
my @newness = $chain->spew(length => 20,
complete => [ qw( the sky is ) ]);
=head1 DESCRIPTION
Algorithm::MarkovChain is an implementation of the Markov Chain
lib/Algorithm/MarkovChain.pm view on Meta::CPAN
=item $obj->spew()
Uses the constructed chains to produce symbol streams
Takes four optional parameters C<complete>, C<length>,
C<longest_subchain>, C<force_length>, C<stop_at_terminal> and
C<strict_start>
C<complete> provides a starting point for the generation of output.
Note: the algorithm will discard elements of this list if it does not
find a starting chain that matches it, this is infinite-loop avoidance.
C<length> specifies the minimum number of symbols desired (default is 30)
C<stop_at_terminal> directs the spew to stop chaining at the first
terminal point reached
C<force_length> ensures you get exactly C<length> symbols returned
(note this overrides the behaviour of C<stop_at_terminal>)
C<strict_start> makes the spew operation always take a known start
state rather than selecting a sequence at random
Algorithm-MasterMind
view release on metacpan or search on metacpan
app/run_experiment_all.pl view on Meta::CPAN
my $method_options = $conf->{'Method_options'};
$io->print( $method, $method_options );
my $engine = variations_with_repetition($method_options->{'alphabet'},
$method_options->{'length'});
my $combination;
my $repeats = $conf->{'repeats'} || 10;
while ( $combination = $engine->next() ) {
my $secret_code = join("",@$combination);
Algorithm-MedianSelect-XS
view release on metacpan or search on metacpan
ck_fun|||
ck_glob|||
ck_grep|||
ck_index|||
ck_join|||
ck_lengthconst|||
ck_lfun|||
ck_listiob|||
ck_match|||
ck_method|||
ck_null|||
mg_copy|||
mg_dup|||
mg_find|||
mg_free|||
mg_get|||
mg_length||5.005000|
mg_localize|||
mg_magical|||
mg_set|||
mg_size||5.005000|
mini_mktime||5.007002|
reg_named_buff_scalar||5.009005|
reg_named_buff|||
reg_namedseq|||
reg_node|||
reg_numbered_buff_fetch|||
reg_numbered_buff_length|||
reg_numbered_buff_store|||
reg_qr_package|||
reg_recode|||
reg_scan_name|||
reg_skipcomment|||
usage|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|
utf8_distance||5.006000|
utf8_hop||5.006000|
utf8_length||5.007001|
utf8_mg_pos_cache_update|||
utf8_to_bytes||5.006001|
utf8_to_uvchr||5.007001|
utf8_to_uvuni||5.007001|
utf8n_to_uvchr|||
if (exists $opt{'list-unsupported'}) {
my $f;
for $f (sort { lc $a cmp lc $b } keys %API) {
next unless $API{$f}{todo};
print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
}
exit 0;
}
# Scan for possible replacement candidates
? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
: newSV(0))
#endif
/* Hint: gv_stashpvn
* This function's backport doesn't support the length parameter, but
* rather ignores it. Portability can only be ensured if the length
* parameter is used for speed reasons, but the length can always be
* correctly computed from the string argument.
*/
#ifndef gv_stashpvn
# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
#endif
#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
Size_t
DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
{
Size_t used, length, copy;
used = strlen(dst);
length = strlen(src);
if (size > 0 && used < size - 1) {
copy = (length >= size - used) ? size - used - 1 : length;
memcpy(dst + used, src, copy);
dst[used + copy] = '\0';
}
return used + length;
}
#endif
#endif
#if !defined(my_strlcpy)
#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
Size_t
DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
{
Size_t length, copy;
length = strlen(src);
if (size > 0) {
copy = (length >= size) ? size - 1 : length;
memcpy(dst, src, copy);
dst[copy] = '\0';
}
return length;
}
#endif
#endif
Algorithm-Merge
view release on metacpan or search on metacpan
my $conflict = $callbacks->{'CONFLICT'} || sub { };
my $b_len = scalar(@{$bdoc});
my $c_len = scalar(@{$cdoc});
my $target_len = $b_len < $c_len ? $b_len : $c_len;
my $bc_different_lengths = $b_len != $c_len;
my(@bdoc_save, @cdoc_save);
# make these into traverse_sequences calls
my($left, $right);
@diffs{(AC_A, AC_C)} = ([], []);
$left = AC_A; $right = AC_C;
Algorithm::Diff::traverse_sequences( $adoc, $cdoc, $ts_callbacks, $keyGen, @_);
if($bc_different_lengths) {
@diffs{(CB_C, CB_B)} = ([], []);
$left = CB_C; $right = CB_B;
Algorithm::Diff::traverse_sequences( $cdoc, $bdoc, $ts_callbacks, $keyGen, @_);
example does not work, send it to <jsmith@cpan.org> or report it on
<http://rt.cpan.org/>, the CPAN bug tracker.
L<Algorithm::Diff|Algorithm::Diff>'s implementation of
C<traverse_sequences> may not be symmetric with respect to the input
sequences if the second and third sequence are of different lengths.
Because of this, C<traverse_sequences3> will calculate the diffs of
the second and third sequences as passed and swapped. If the differences
are not the same, it will issue an `Algorithm::Diff::diff is not symmetric
for second and third sequences...' warning. It will try to handle
this, but there may be some cases where it can't.
Algorithm-MinPerfHashTwoLevel
view release on metacpan or search on metacpan
lib/Algorithm/MinPerfHashTwoLevel.pm view on Meta::CPAN
sub _seed {
my $self= shift;
if (@_) {
my $seed= shift;
Carp::confess(sprintf "Seed should be undef, or a string exactly %d bytes long, not %d bytes",
STADTX_HASH_SEED_BYTES,length($seed))
if defined($seed) and length($seed) != 16;
$self->{seed}= $seed;
delete $self->{state};
}
if ( !defined $self->{seed} ) {
#1234567812345678
Algorithm-Munkres
view release on metacpan or search on metacpan
t/DoubleInvoke.t view on Meta::CPAN
# A script to run tests on the Algorithm::Mukres module.
# The following are among the tests run by this script:
# This test case checks the module with normal input values, i.e. without fractions/negative values/zeros etc.
# 1. Try loading the Algorithm::Munkres i.e. is it added to the @INC variable
# 2. Compare the lengths of the Solution array and the Output array.
# 3. Compare each element of the Solution array and the Output array.
use strict;
use warnings;
t/DoubleInvoke.t view on Meta::CPAN
my @assign_out = ();
my $i = 0;
assign(\@mat,\@assign_out);
#Compare the lengths of the Solution array and the Output array.
is($#soln, $#assign_out, 'Compare the lengths of the Solution array and the Output array.');
#Compare each element of the Solution array and the Output array.
for($i = 0; $i <= $#assign_out; $i++)
{
is($soln[$i], $assign_out[$i], "Compare $i element of the Solution array and the Output array")
t/DoubleInvoke.t view on Meta::CPAN
@assign_out = ();
assign(\@mat,\@assign_out);
#Compare the lengths of the Solution array and the Output array.
is($#soln, $#assign_out, 'Compare the lengths of the Solution array and the Output array.');
#Compare each element of the Solution array and the Output array.
for($i = 0; $i <= $#assign_out; $i++)
{
is($soln[$i], $assign_out[$i], "Compare $i element of the Solution array and the Output array")
Algorithm-NeedlemanWunsch
view release on metacpan or search on metacpan
lib/Algorithm/NeedlemanWunsch.pm view on Meta::CPAN
| |
sequence B: t g a t - -
(and exponentially many other ways, of course). Note that
Needleman-Wunsch considers I<global> alignments, over the entire
length of both sequences; each item is either aligned with an item of
the other sequence, or corresponds to a I<gap> (which is always
aligned with an item - aligning two gaps wouldn't help anything). This
approach is especially suitable for comparing sequences of comparable
length and somewhat similar along their whole lengths - that is,
without long stretches that have nothing to do with each other. If
your sequences don't satisfy these requirements, consider using local
alignment, which, strictly speaking, isn't Needleman-Wunsch, but is
similar enough to be implemented in this module as well - see below
for details.
Algorithm-Networksort
view release on metacpan or search on metacpan
lib/Algorithm/Networksort.pm view on Meta::CPAN
has network => (
isa => 'ArrayRef[ArrayRef[Int]]', is => 'rw', required => 0,
predicate => 'has_network',
);
has ['depth', 'length'] => (
isa => 'Int', is => 'rw', required => 0,
init_arg => 0,
);
has creator => (
lib/Algorithm/Networksort.pm view on Meta::CPAN
# Providing our own-grown network?
#
if ($alg eq 'none')
{
croak "No comparators provided" unless ($self->has_comparators);
$self->length(scalar @{ $self->comparators });
#
# Algorithm::Networksort::Best will set these, so
# only go through with this if this is a user-provided
# sequence of comparators.
lib/Algorithm/Networksort.pm view on Meta::CPAN
@network = oddeventransposition($inputs) if ($alg eq 'oddeventrans');
@network = balanced($inputs) if ($alg eq 'balanced');
@network = oddevenmerge($inputs) if ($alg eq 'oddevenmerge');
$self->title($algname{$alg} . " for N = " . $inputs) unless ($self->has_title);
$self->length(scalar @network);
$self->comparators(\@network); # The 'raw' list of comparators.
#
# Re-order the comparator list using the parallel grouping for
# the graphs. The resulting parallelism means less stalling
lib/Algorithm/Networksort.pm view on Meta::CPAN
my @comparators;
my($bit, $xbit, $ybit);
#
# $t = ceiling(log2($inputs - 1)); but we'll
# find it using the length of the bitstring.
#
my $t = length sprintf("%b", $inputs - 1);
my $lastbit = 1 << $t;
#
# $x and $y are the comparator endpoints.
lib/Algorithm/Networksort.pm view on Meta::CPAN
return bn_split(0, $inputs);
}
#
# @comparators = bn_split($i, $length);
#
# The helper function that divides the range to be sorted.
#
# Note that the work of splitting the ranges is performed with the
# 'length' variables. The $i variable merely acts as a starting
# base, and could easily have been 1 to begin with.
#
sub bn_split
{
my($i, $length) = @_;
my @comparators = ();
#
### bn_split():
#### $i
#### $length
#
if ($length >= 2)
{
my $mid = $length >> 1;
push @comparators, bn_split($i, $mid);
push @comparators, bn_split($i + $mid, $length - $mid);
push @comparators, bn_merge($i, $mid, $i + $mid, $length - $mid);
}
#
### bn_split() returns
##### @comparators
#
return @comparators;
}
#
# @comparators = bn_merge($i, $length_i, $j, $length_j);
#
# The other helper function that adds comparators to the list, for a
# given pair of ranges.
#
# As with bn_split, the different conditions all depend upon the
# lengths of the ranges. The $i and $j variables merely act as
# starting bases.
#
sub bn_merge
{
my($i, $length_i, $j, $length_j) = @_;
my @comparators = ();
#
### bn_merge():
#### $i
#### $length_i
#### $j
#### $length_j
#
if ($length_i == 1 && $length_j == 1)
{
push @comparators, [$i, $j];
}
elsif ($length_i == 1 && $length_j == 2)
{
push @comparators, [$i, $j + 1];
push @comparators, [$i, $j];
}
elsif ($length_i == 2 && $length_j == 1)
{
push @comparators, [$i, $j];
push @comparators, [$i + 1, $j];
}
else
{
my $i_mid = int($length_i/2);
my $j_mid = int(($length_i & 1)? $length_j/2: ($length_j + 1)/2);
push @comparators, bn_merge($i, $i_mid, $j, $j_mid);
push @comparators, bn_merge($i + $i_mid, $length_i - $i_mid, $j + $j_mid, $length_j - $j_mid);
push @comparators, bn_merge($i + $i_mid, $length_i - $i_mid, $j, $j_mid);
}
#
### bn_merge() returns
##### @comparators
lib/Algorithm/Networksort.pm view on Meta::CPAN
my $inputs = shift;
my @network;
#
# $t = ceiling(log2($inputs)); but we'll
# find it using the length of the bitstring.
#
my $t = length sprintf("%b", $inputs);
my $p = 1 << ($t -1);
while ($p > 0)
{
lib/Algorithm/Networksort.pm view on Meta::CPAN
my ($lo, $n, $dir) = @_;
if ($n > 1) {
#
# $t = ceiling(log2($n - 1)); but we'll
# find it using the length of the bitstring.
#
my $t = length sprintf("%b", $n - 1);
my $m = 1 << ($t - 1);
for my $i ($lo .. $lo+$n-$m-1)
{
lib/Algorithm/Networksort.pm view on Meta::CPAN
my $inputs = shift;
my @network;
#
# $t = ceiling(log2($inputs - 1)); but we'll
# find it using the length of the bitstring.
#
my $t = length sprintf("%b", $inputs - 1);
for (1 .. $t)
{
for (my $curr = 1 << $t; $curr > 1; $curr >>= 1)
{
lib/Algorithm/Networksort.pm view on Meta::CPAN
my $inputs = shift;
my @network;
#
# $t = ceiling(log2($inputs - 1)); but we'll
# find it using the length of the bitstring.
#
my $t = length sprintf("%b", $inputs - 1);
my ($add_elem, $sort, $merge);
$add_elem = sub {
my ($i, $j) = @_;
lib/Algorithm/Networksort.pm view on Meta::CPAN
The chances that you will need to use this function are slim, but the
following code snippet may represent an example:
my $nw = Algorithm::Networksort->new(inputs => 8, algorithm => 'batcher');
print "There are ", $nw->length(),
" comparators in this network, grouped into\n",
$nw->depth(), " parallel operations.\n\n";
print $nw, "\n";
lib/Algorithm/Networksort.pm view on Meta::CPAN
{
carp "Color '$color' is not in six or three hexadecimal digit RGB form.";
$color = "000";
}
if (length $color == 3)
{
$color =~ s/(.)(.)(.)/$1$1 $2$2 $3$3/;
}
elsif (length $color == 6)
{
$color =~ s/(..)(..)(..)/$1 $2 $3/;
}
else
{
Algorithm-Odometer-Tiny
view release on metacpan or search on metacpan
t/algorithm_odometer_tiny.t view on Meta::CPAN
{
my @wheels = ( ['foo','bar'], [3..6], ['quz','baz'] );
my $odo = Algorithm::Odometer::Gray->new(@wheels);
# note the following generates two "used only once" warnings on Perls 5.8 thru 5.18, that's ok
my $exp_len = reduce { $a * $b } map {0+@$_} @wheels; # product() was added in List::Util 1.35
is $exp_len, 16, 'expected length calc is correct';
my @c = $odo->();
is_deeply \@c, ['foo','3','quz'], 'basic ::Gray test 1/2';
my @o;
while (<$odo>) { push @o, $_ }
is_deeply \@o, [qw/ bar3quz bar4quz foo4quz foo5quz bar5quz bar6quz foo6quz
Algorithm-PageRank-XS
view release on metacpan or search on metacpan
ck_fun|||
ck_glob|||
ck_grep|||
ck_index|||
ck_join|||
ck_lengthconst|||
ck_lfun|||
ck_listiob|||
ck_match|||
ck_method|||
ck_null|||
mg_copy|||
mg_dup|||
mg_find|||
mg_free|||
mg_get|||
mg_length||5.005000|
mg_localize|||
mg_magical|||
mg_set|||
mg_size||5.005000|
mini_mktime||5.007002|
reg_named_buff_scalar||5.009005|
reg_named_buff|||
reg_namedseq|||
reg_node|||
reg_numbered_buff_fetch|||
reg_numbered_buff_length|||
reg_numbered_buff_store|||
reg_qr_package|||
reg_recode|||
reg_scan_name|||
reg_skipcomment|||
usage|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|
utf8_distance||5.006000|
utf8_hop||5.006000|
utf8_length||5.007001|
utf8_mg_pos_cache_update|||
utf8_to_bytes||5.006001|
utf8_to_uvchr||5.007001|
utf8_to_uvuni||5.007001|
utf8n_to_uvchr|||
if (exists $opt{'list-unsupported'}) {
my $f;
for $f (sort { lc $a cmp lc $b } keys %API) {
next unless $API{$f}{todo};
print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
}
exit 0;
}
# Scan for possible replacement candidates
#ifndef ERRSV
# define ERRSV get_sv("@",FALSE)
#endif
/* Hint: gv_stashpvn
* This function's backport doesn't support the length parameter, but
* rather ignores it. Portability can only be ensured if the length
* parameter is used for speed reasons, but the length can always be
* correctly computed from the string argument.
*/
#ifndef gv_stashpvn
# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
#endif
#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
Size_t
DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
{
Size_t used, length, copy;
used = strlen(dst);
length = strlen(src);
if (size > 0 && used < size - 1) {
copy = (length >= size - used) ? size - used - 1 : length;
memcpy(dst + used, src, copy);
dst[used + copy] = '\0';
}
return used + length;
}
#endif
#endif
#if !defined(my_strlcpy)
#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
Size_t
DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
{
Size_t length, copy;
length = strlen(src);
if (size > 0) {
copy = (length >= size) ? size - 1 : length;
memcpy(dst, src, copy);
dst[copy] = '\0';
}
return length;
}
#endif
#endif
Algorithm-Pair-Best2
view release on metacpan or search on metacpan
lib/Algorithm/Pair/Best2.pm view on Meta::CPAN
### $seen{$idxs[$idx]} = $seen{$idxs[$idx + 1]} = 1;
### push @pairs, join '-', sort $idxs[$idx], $idxs[$idx + 1];
### $idx += 2;
### }
### my $key = join ',', sort @pairs;
### # $key = ' ' x (25 - length $key) . $key;
### return $key;
### }
###
#### you might want to adjust this for your items...
### sub print_items {
( run in 2.136 seconds using v1.01-cache-2.11-cpan-140bd7fdf52 )