Result:
found more than 563 distributions - search limited to the first 2001 files matching your query
( run in 0.505 )
Algorithm-BinarySearch-Vec
view release on metacpan or search on metacpan
## $index = vbsearch($v,$key,$nbits)
## $index = vbsearch($v,$key,$nbits,$ilo,$ihi)
sub _vbsearch {
my ($vr,$key,$nbits,$ilo,$ihi) = (\$_[0],@_[1..$#_]);
$ilo = 0 if (!defined($ilo));
$ihi = 8*length($$vr)/$nbits if (!defined($ihi));
my ($imid);
while ($ilo < $ihi) {
$imid = ($ihi+$ilo) >> 1;
if (vec($$vr,$imid,$nbits) < $key) {
$ilo = $imid + 1;
## $index = vbsearch_lb($v,$key,$nbits)
## $index = vbsearch_lb($v,$key,$nbits,$ilo,$ihi)
sub _vbsearch_lb {
my ($vr,$key,$nbits,$ilo,$ihi) = (\$_[0],@_[1..$#_]);
$ilo = 0 if (!defined($ilo));
$ihi = 8*length($$vr)/$nbits if (!defined($ihi));
my ($imin,$imax,$imid) = ($ilo,$ihi);
while ($ihi-$ilo > 1) {
$imid = ($ihi+$ilo) >> 1;
if (vec($$vr,$imid,$nbits) < $key) {
$ilo = $imid;
## $index = vbsearch_ub($v,$key,$nbits)
## $index = vbsearch_ub($v,$key,$nbits,$ilo,$ihi)
sub _vbsearch_ub {
my ($vr,$key,$nbits,$ilo,$ihi) = (\$_[0],@_[1..$#_]);
$ilo = 0 if (!defined($ilo));
$ihi = 8*length($$vr)/$nbits if (!defined($ihi));
my ($imin,$imax,$imid) = ($ilo,$ihi);
while ($ihi-$ilo > 1) {
$imid = ($ihi+$ilo) >> 1;
if (vec($$vr,$imid,$nbits) > $key) {
$ihi = $imid;
##======================================================================
## API: Search: vec-wise
## \@a = vec2array($vec,$nbits)
sub vec2array {
return [map {vec($_[0],$_,$_[1])} (0..(length($_[0])*8/$_[1]-1))];
}
##--------------------------------------------------------------
## $indices = vvbsearch($v,$keys,$nbits)
## $indices = vvbsearch($v,$keys,$nbits,$ilo,$ihi)
##--------------------------------------------------------------
## $vunion = vunion($av,$bv,$nbits)
sub _vunion {
my ($avr,$bvr,$nbits) = (\$_[0],\$_[1],$_[2]);
die(__PACKAGE__ , "::_vunion(): cannot handle nbits < 8, but you requested $nbits") if ($nbits < 8);
my $na = length($$avr)*8/$nbits;
my $nb = length($$bvr)*8/$nbits;
my $cv = '';
my ($ai,$bi,$ci, $aval,$bval);
for ($ai=0,$bi=0,$ci=0; $ai < $na && $bi < $nb; ++$ci) {
$aval = vec($$avr,$ai,$nbits);
$bval = vec($$bvr,$bi,$nbits);
sub _vintersect {
my ($avr,$bvr,$nbits) = (\$_[0],\$_[1],$_[2]);
die(__PACKAGE__ , "::_vintersect(): cannot handle nbits < 8, but you requested $nbits") if ($nbits < 8);
##-- ensure smaller set is "a"
($$avr,$$bvr) = ($$bvr,$$avr) if (length($$bvr) < length($$avr));
my $na = length($$avr)*8/$nbits;
my $nb = length($$bvr)*8/$nbits;
my $cv = '';
my ($ai,$bi,$ci, $blo,$aval,$bval);
for ($ai=0,$blo=0,$ci=0; $ai < $na; ++$ai) {
$aval = vec($$avr,$ai,$nbits);
$bi = _vbsearch_ub($$bvr,$aval,$nbits,$blo,$nb);
## $vsetdiff = vsetdiff($av,$bv,$nbits)
sub _vsetdiff {
my ($avr,$bvr,$nbits) = (\$_[0],\$_[1],$_[2]);
die(__PACKAGE__ , "::_vintersect(): cannot handle nbits < 8, but you requested $nbits") if ($nbits < 8);
my $na = length($$avr)*8/$nbits;
my $nb = length($$bvr)*8/$nbits;
my $cv = '';
my ($ai,$bi,$ci, $blo,$aval,$bval);
for ($ai=0,$blo=0,$ci=0; $ai < $na; ++$ai) {
$aval = vec($$avr,$ai,$nbits);
$bi = _vbsearch_ub($$bvr,$aval,$nbits,$blo,$nb);
=item vbsearch($v,$key,$nbits,?$ilo,?$ihi)
Binary search for $key in the vec()-style vector $v, which contains elements
of $nbits bits each, sorted in ascending order. $ilo and $ihi if specified are
indices to limit the search. $ilo defaults to 0, $ihi defaults to (8*$nbits/bytes::length($v)),
i.e. the entire vector is to be searched.
Returns the index $i of an element in $v matching $key (C<vec($v,$i,$nbits)==$key>,
with ($ilo E<lt>= $i E<lt> $ihi)),
or $KEY_NOT_FOUND if no such element exists.
=item vec2array($vec,$nbits)
Debugging utility, equivalent to
[map {vec($vec,$_,$nbits)} (0..(length($vec)*8/$nbits-1))]
=back
=cut
Algorithm-BitVector
view release on metacpan or search on metacpan
Examples/BitVectorDemo.pl view on Meta::CPAN
my $x = Math::BigInt->new('12345678901234567890123456789012345678901234567890');
$bv = Algorithm::BitVector->new( intVal => $x );
print "\nHere is a bitvector constructed from a very large integer:\n";
print "$bv\n";
printf "The integer value of the above bitvector shown as a string is: %s\n", $bv->int_value();
print "Size of the bitvector: " . $bv->length() . "\n";
# Construct a bitvector of a specified length from a large integer:
$bv =Algorithm::BitVector->new(intVal => Math::BigInt->new("89485765"), size => 32);
print "\nHere is a bitvector of a specified size constructed from a large integer:\n";
my $len= $bv->length();
print "$bv\n";
print "size of bitvec: $len\n";
printf "The integer value of the above bitvector shown as a string is: %s\n", $bv->int_value();
print "Size of the bitvector: " . $bv->length() . "\n";
# Construct a bitvector directly from a bit string:
$bv = Algorithm::BitVector->new( bitstring => '00110011' );
print "\nBitvector constructed directly from a bit string:\n";
print "$bv\n"; # 00110011
Examples/BitVectorDemo.pl view on Meta::CPAN
$bv = Algorithm::BitVector->new(intVal=>1) & Algorithm::BitVector->new(intVal=>13);
print "$bv\n"; # 0001
$bv = Algorithm::BitVector->new(intVal=>1) | Algorithm::BitVector->new(intVal=>13);
print "$bv\n"; # 1101
# Experiments with set_bit() and length():\n";
print "\nExperiments with set_bit() and length():\n";
$bv7->set_bit(7,0);
print "$bv7\n"; # 1111111011111111111
print length($bv7) . "\n"; # 19
my $bv8 = ($bv5 & $bv6) ^ $bv7;
print "$bv8\n"; # 1111111011111111111
# Constructing a bitvector from the contents of a disk file:
print "\nConstruct a bitvector from what is in the file testinput1.txt:\n";
Examples/BitVectorDemo.pl view on Meta::CPAN
open my $FILEOUT, ">test.txt";
$bv1->write_to_file( $FILEOUT );
close $FILEOUT;
$bv2 = Algorithm::BitVector->new( filename => 'test.txt' );
$bv3 = $bv2->read_bits_from_file( 32 );
print "\nDisplay bitvectors written out to file and read back from the file and their respective lengths:\n";
print "$bv1 $bv3\n"; # 00001010 00001010
print length($bv1) . " " . length($bv3) . "\n"; # 8 8
# Experiment with reading a file from beginning to end and constructing 64-bit bit
# vectors as you go along:
print "\nExperiments with reading a file from the beginning to end:\n";
$bv = Algorithm::BitVector->new( filename => 'testinput.txt' );
Examples/BitVectorDemo.pl view on Meta::CPAN
$bv3 = $bv3 << 7;
print "$bv3\n"; # 1001000000110100001110101011011100110011101110010011110010100000
print "\nCircular shift to the right by 7 positions:\n";
$bv3 = $bv3 >> 7;
print "$bv3\n"; # 0100000100100000011010000111010101101110011001110111001001111001
print "Test length on the above bitvector: ";
print length($bv3) . "\n"; # 64
print "\nExperiments with chained invocations of circular shifts:\n";
$bv = Algorithm::BitVector->new( bitlist => [1, 1, 1, 0, 0, 1] );
print "$bv\n"; # 111001
$bv = $bv >> 1;
Algorithm-BloomFilter
view release on metacpan or search on metacpan
bl_serialize(bloom_t *bl, char **out, size_t *out_len)
{
/* Format is pretty simple:
* - varint encoding number of hash functions
* - varint encoding significant_bits
* - X bytes - whatever the length in bytes for the bitmap is */
char *cur;
char *start;
const uint64_t plength = MAX_VARINT_LENGTH /* length of packet, this number */
+ bl->nbytes /* the actual data size */
+ MAX_VARINT_LENGTH /* k */
+ MAX_VARINT_LENGTH; /* significant_bits */
*out_len = (size_t)plength; /* to be revised further down */
start = cur = malloc(*out_len);
if (!cur) {
*out_len = 0;
*out = 0;
return 1;
Algorithm-BreakOverlappingRectangles
view release on metacpan or search on metacpan
lib/Algorithm/BreakOverlappingRectangles.pm view on Meta::CPAN
use constant X1 => 2;
use constant Y1 => 3;
our $verbose = 0;
use constant NVSIZE => length pack F => 1.0;
use constant IDOFFSET => NVSIZE * 4;
sub new {
my $class = shift;
my $self = { rects => [],
Algorithm-CP-IZ
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
my $libname = get_izlib_name;
for my $d (@dirs) {
my $libiz = File::Spec->catfile($d, $libname);
if (length($d) > 0 && -d $d && -f $libiz) {
print "library: $libiz\n";
return $d;
}
}
Makefile.PL view on Meta::CPAN
"$ENV{HOME}/include",
"$ENV{HOME}/izC", "$ENV{HOME}/izC/include");
for my $d (@dirs) {
my $izh = File::Spec->catfile($d, "iz.h");
if (length($d) > 0 && -d $d && -f $izh) {
print "header: $izh\n";
return $d;
}
}
Algorithm-CheckDigits
view release on metacpan or search on metacpan
lib/Algorithm/CheckDigits/M11_004.pm view on Meta::CPAN
return -1 unless ($number =~ /^[-\d.]+$/);
$number =~ s/[-.]//g;
if ('cpf' eq $self->{type}) {
return -1 unless length($number) == 9;
$cd1 = $calc_cd->($number,10);
$cd2 = $calc_cd->($number . $cd1,11);
} elsif ('titulo_eleitor' eq $self->{type}) {
$number = substr("00000000000" . $number, -10);
$cd1 = $calc_cd->(substr($number,0,8),9);
Algorithm-Closest-NetworkAddress
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-Cluster-Thresh
view release on metacpan or search on metacpan
lib/Algorithm/Cluster/Thresh.pm view on Meta::CPAN
my @leafcluster;
# Binary tree: number of internal nodes is 1 less than # of leafs
# Last node is the root, walking down the tree
my $icluster = 0;
# Elements in tree
my $length = $tree->length;
# Root node belongs to cluster 0
$nodecluster[$length-1] = $icluster++;
for (my $i = $length-1; $i >= 0; $i--) {
my $node = $tree->get($i);
# print sprintf "%3d %3d %.3f\n", $i,$nodecluster[$i], $node->distance;
my $left = $node->left;
# Nodes are numbered -1,-2,... Leafs are numbered 0,1,2,...
my $leftref = $left < 0 ? \$nodecluster[-$left-1] : \$leafcluster[$left];
Algorithm-Cluster
view release on metacpan or search on metacpan
perl/Cluster.pm view on Meta::CPAN
#
unless(ref $param->{weight} eq 'ARRAY') {
module_warn("Parameter 'weight' does not point to an array, ignoring it.");
$param->{weight} = $default->{weight};
} else {
my $weight_length = scalar @{ $param->{weight} };
if ($param->{transpose} eq 0) {
unless ($param->{ncols} == $weight_length) {
module_warn("Data matrix has $param->{ncols} columns, but weight array has $weight_length items.\nIgnoring the weight array.");
$param->{weight} = $default->{weight}
}
}
else {
unless ($param->{nrows} == $weight_length) {
module_warn("Data matrix has $param->{nrows} rows, but weight array has $weight_length items.\nIgnoring the weight array.");
$param->{weight} = $default->{weight}
}
}
}
return 1;
Algorithm-Combinatorics
view release on metacpan or search on metacpan
Combinatorics.pm view on Meta::CPAN
return __contextualize(__null_iter()) if $k < 0;
return __contextualize(__once_iter()) if $k == 0;
my @indices = (0) x $k;
my @focus_pointers = 0..$k; # yeah, length $k+1
my @directions = (1) x $k;
my $iter = Algorithm::Combinatorics::Iterator->new(sub {
__next_variation_with_repetition_gray_code(
\@indices,
\@focus_pointers,
Combinatorics.pm view on Meta::CPAN
This is an alias for C<derangements>, documented above.
=head2 variations(\@data, $k)
The variations of length C<$k> of C<@data> are all the tuples of length C<$k> consisting of elements of C<@data>. For example, for C<@data = (1, 2, 3)> and C<$k = 2>:
(1, 2)
(1, 3)
(2, 1)
(2, 3)
(3, 1)
(3, 2)
For this to make sense, C<$k> has to be less than or equal to the length of C<@data>.
Note that
permutations(\@data);
Combinatorics.pm view on Meta::CPAN
v(n, k) = n*(n-1)*...*(n-k+1), if 0 < k <= n
=head2 variations_with_repetition(\@data, $k)
The variations with repetition of length C<$k> of C<@data> are all the tuples of length C<$k> consisting of elements of C<@data>, including repetitions. For example, for C<@data = (1, 2, 3)> and C<$k = 2>:
(1, 1)
(1, 2)
(1, 3)
(2, 1)
Combinatorics.pm view on Meta::CPAN
(2, 3)
(3, 1)
(3, 2)
(3, 3)
Note that C<$k> can be greater than the length of C<@data>. For example, for C<@data = (1, 2)> and C<$k = 3>:
(1, 1, 1)
(1, 1, 2)
(1, 2, 1)
(1, 2, 2)
Combinatorics.pm view on Meta::CPAN
This is an alias for C<variations_with_repetition>, documented above.
=head2 combinations(\@data, $k)
The combinations of length C<$k> of C<@data> are all the sets of size C<$k> consisting of elements of C<@data>. For example, for C<@data = (1, 2, 3, 4)> and C<$k = 3>:
(1, 2, 3)
(1, 2, 4)
(1, 3, 4)
(2, 3, 4)
For this to make sense, C<$k> has to be less than or equal to the length of C<@data>.
The number of combinations of C<n> elements taken in groups of C<< 0 <= k <= n >> is:
n choose k = n!/(k!*(n-k)!)
=head2 combinations_with_repetition(\@data, $k);
The combinations of length C<$k> of an array C<@data> are all the bags of size C<$k> consisting of elements of C<@data>, with repetitions. For example, for C<@data = (1, 2, 3)> and C<$k = 2>:
(1, 1)
(1, 2)
(1, 3)
(2, 2)
(2, 3)
(3, 3)
Note that C<$k> can be greater than the length of C<@data>. For example, for C<@data = (1, 2, 3)> and C<$k = 4>:
(1, 1, 1, 1)
(1, 1, 1, 2)
(1, 1, 1, 3)
(1, 1, 2, 2)
Algorithm-ConsistentHash-CHash
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-ConsistentHash-JumpHash
view release on metacpan or search on metacpan
mg_findext||5.013008|
mg_find|||
mg_free_type||5.013006|
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_nextkey||5.009005|
reg_named_buff_scalar||5.009005|
reg_named_buff|||
reg_node|||
reg_numbered_buff_fetch|||
reg_numbered_buff_length|||
reg_numbered_buff_store|||
reg_qr_package|||
reg_recode|||
reg_scan_name|||
reg_skipcomment|||
utf16_textfilter|||
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_len_cache_update|||
utf8_mg_pos_cache_update|||
utf8_to_bytes||5.006001|
utf8_to_uvchr_buf||5.015009|
utf8_to_uvchr||5.007001|
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-ConsistentHash-Ketama
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-ConstructDFA-XS
view release on metacpan or search on metacpan
t/02simple.t view on Meta::CPAN
for my $s (keys %$dfa) {
for my $label (keys %{$dfa->{$s}{NextOver}}) {
my $mid = $s . ':' . $label;
$dfa_g->add_edge($s, $mid);
$dfa_g->add_edge($mid, $dfa->{$s}{NextOver}{$label});
$dfa_g->set_vertex_attribute($mid, 'label', $label) if length $label;
$dfa_g->add_edge($s, $dfa_g_final)
if $dfa->{$s}{Accepts};
$dfa_g->add_edge($dfa->{$s}{NextOver}{$label}, $dfa_g_final)
if $dfa->{$dfa->{$s}{NextOver}{$label}}{Accepts};
}
Algorithm-ConstructDFA
view release on metacpan or search on metacpan
t/02simple.t view on Meta::CPAN
for my $s (keys %$dfa) {
for my $label (keys %{$dfa->{$s}{NextOver}}) {
my $mid = $s . ':' . $label;
$dfa_g->add_edge($s, $mid);
$dfa_g->add_edge($mid, $dfa->{$s}{NextOver}{$label});
$dfa_g->set_vertex_attribute($mid, 'label', $label) if length $label;
$dfa_g->add_edge($s, $dfa_g_final)
if $dfa->{$s}{Accepts};
$dfa_g->add_edge($dfa->{$s}{NextOver}{$label}, $dfa_g_final)
if $dfa->{$dfa->{$s}{NextOver}{$label}}{Accepts};
}
Algorithm-ConstructDFA2
view release on metacpan or search on metacpan
edges => [ $g->edges ],
)
}
sub random_path_between {
my ($g, $start, $final, $max_length) = @_;
my $dbh = $g->{dbh};
return unless grep {
$_ eq $final
} $start, $g->all_successors($start);
$max_length //= 1_000;
my $sth = $dbh->prepare(q{
WITH RECURSIVE random_path(pos, vertex) AS (
SELECT 0 AS pos, ? AS vertex
UNION ALL
});
while (1) {
my @path = map { @$_ } $dbh->selectall_array($sth,
{}, $start, $max_length);
my @endpoints = indexes { $_ eq $final } @path;
my $last_elem = random_element( @endpoints );
next unless defined $last_elem;
return @path;
}
}
sub random_dfa_path {
my ($dfa, $start_id, $max_length, @accepting) = @_;
my $dbh = $dfa->_dbh;
# return unless grep {
# $_ eq $final
# } $start, $g->all_successors($start);
$max_length //= 1_000;
my $sth = $dbh->prepare(q{
WITH RECURSIVE random_dfa_path(pos, state) AS (
SELECT 0 AS pos, ? AS state
UNION ALL
my %accepting = map { $_ => 1 } @accepting;
while (1) {
my @path = map { @$_ } $dbh->selectall_array($sth,
{}, $start_id, $max_length);
my @endpoints = indexes { %accepting{$_} } @path;
my $last_elem = random_element( @endpoints );
next unless defined $last_elem;
Algorithm-CouponCode
view release on metacpan or search on metacpan
html/jquery.couponcode.js view on Meta::CPAN
});
self.inputs[0].on('paste', function() {
setTimeout(function() { set_parts(self.inputs[0].val()); }, 2);
});
if(start_val.length > 0) {
set_parts(start_val);
}
wrapper.append(inner);
if(self.setFocus) {
self.inputs[0].focus();
html/jquery.couponcode.js view on Meta::CPAN
function validate_one_field(input, index) {
var val = input.val();
var focussed = (self.focus === index);
if(val == '') { return; }
var code = clean_up( val );
if(code.length > 4 || BAD_SYMBOL.test(code)) {
return false;
}
if(code.length < 4) {
return focussed ? null : false;
}
if(code.charAt(3) != checkdigit(code, index + 1)) {
return false;
}
Algorithm-CurveFit-Simple
view release on metacpan or search on metacpan
bin/curvefit view on Meta::CPAN
my @DOCS;
my %OPT = (v => 1);
foreach my $arg (@ARGV) {
if ($arg =~ /^\-+(.+?)\=(.*)/) { $OPT{$1} = $2; }
elsif ($arg =~ /^\-+(v+)$/ ) { $OPT{v} = length($1) + 1; }
elsif ($arg =~ /^\-+q$/ ) { $OPT{v} = 0; }
elsif ($arg =~ /^\-+quiet$/ ) { $OPT{v} = 0; }
elsif ($arg =~ /^\-+(.+)/ ) { $OPT{$1} = -1; }
else { push (@DOCS, $arg); }
}
Algorithm-Damm
view release on metacpan or search on metacpan
lib/Algorithm/Damm.pm view on Meta::CPAN
if CHECKSUMMED_NUM contains an invalid character or does not contain
at least two digits (one for the number, and one for the checksum).
This function is equivalent to
substr $N,length($N)-1 eq check_digit(substr $N,0,length($N)-1)
Additionally, due to the way this algorithm works, if you crank the
checksum calculation through the last digit (checkdigit included), you
will end up with a value of 0.
lib/Algorithm/Damm.pm view on Meta::CPAN
sub is_valid {
my $N = shift;
return undef unless defined( $N );
return undef unless length( $N ) >= 2;
return undef unless $N =~ /^\d+$/;
return check_digit( $N ) == 0;
}
lib/Algorithm/Damm.pm view on Meta::CPAN
sub check_digit {
my $N = shift;
return undef unless defined( $N );
return undef unless length( $N );
return undef unless $N =~ /^\d+$/;
my $c = 0;
my @digits = split(//, $N);
$c = $table[$c][$_] for @digits;
Algorithm-DecisionTree
view release on metacpan or search on metacpan
Examples/get_indexes_associated_with_fields.pl view on Meta::CPAN
for (@double_quoted) {
my $item = $_;
$item = substr($item, 1, -1);
$item =~ s/^s+|,|\s+$//g;
$item = join '_', split /\s+/, $item;
substr($line, index($line, $_), length($_)) = $item;
}
my @white_spaced = $line =~ /,(\s*[^,]+)(?=,|$)/g;
for (@white_spaced) {
my $item = $_;
$item =~ s/\s+/_/g;
$item =~ s/^\s*_|_\s*$//g;
substr($line, index($line, $_), length($_)) = $item;
}
$line =~ s/,\s*(?=,|$)/,NA/g;
return $line;
}
Algorithm-Dependency-MapReduce
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-Dependency-Source-DBI
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-Dependency
view release on metacpan or search on metacpan
lib/Algorithm/Dependency/Source/File.pm view on Meta::CPAN
# Parse and build the item list
my @Items = ();
foreach my $line ( @content ) {
# Split the line by non-word characters
my @sections = grep { length $_ } split /\W+/, $line;
return undef unless scalar @sections;
# Create the new item
my $Item = Algorithm::Dependency::Item->new( @sections ) or return undef;
push @Items, $Item;
Algorithm-Diff-Any
view release on metacpan or search on metacpan
lib/Algorithm/Diff/Any.pm view on Meta::CPAN
use Exporter 'import';
our @EXPORT_OK = qw(
prepare
LCS
LCSidx
LCS_length
diff
sdiff
compact_diff
traverse_sequences
traverse_balanced
lib/Algorithm/Diff/Any.pm view on Meta::CPAN
I<A Fast Algorithm for Computing Longest Common Subsequences>, CACM, vol.20,
no.5, pp.350-353, May 1977.
However, it is algorithmically rather complicated to solve the LCS problem;
for arbitrary sequences, it is an NP-hard problem. Simply comparing two
strings together of lengths I<n> and I<m> is B<O(n x m)>. Consequently, this
means the algorithm necessarily has some tight loops, which, for a dynamic
language like Perl, can be slow.
In order to speed up processing, a fast (C/XS-based) implementation of the
algorithm's core loop was implemented. It can confer a noticable performance
lib/Algorithm/Diff/Any.pm view on Meta::CPAN
=item * LCS
=item * LCSidx
=item * LCS_length
=item * diff
=item * sdiff
lib/Algorithm/Diff/Any.pm view on Meta::CPAN
and Thomas G. Szymanski (Princeton University), authors of the often-cited
paper for computing longest common subsequences.
In their abstract, they claim that a running time of B<O(n log n)> can be
expected, with a worst-case time of B<O(n^2 log n)> for two subsequences of
length I<n>.
=back
=head1 SUPPORT
Algorithm-Diff-Apply
view release on metacpan or search on metacpan
lib/Algorithm/Diff/Apply.pod view on Meta::CPAN
=item apply_diff ARRAY,DIFF
Applies the changes described by a diff to a copy of I<ARRAY>, which
is then returned. I<DIFF> is a diff generated by
C<Algorithm::Diff::diff()>, and I<ARRAY> must be an array of an
appropriate length. Both parameters are passed in as references.
Neither argument is modified.
In a scalar context, C<apply_diff()> returns a reference to the
permuted copy that's generated. In an array context, the permuted copy
is returned as an array value.
lib/Algorithm/Diff/Apply.pod view on Meta::CPAN
Applies more than one diff to a copy of an array at once, manages
conflicts, and returns the permuted copy as either a reference or an
array depending on context.
I<ARRAY> must be a reference to an array value of an appropriate
length. The array behind the passed reference is not permuted.
The I<HASH> parameter contains diffs from different sources, as
generated by C<Algorithm::Diff::diff()>. The diffs are keyed by
arbitrary strings which should reflect their source.
See L<DIFF LABELS> for details of what these strings might reflect.
Algorithm-Diff-XS
view release on metacpan or search on metacpan
inc/Module/Install/Makefile.pm view on Meta::CPAN
sub clean_files {
my $self = shift;
my $clean = $self->makemaker_args->{clean} ||= {};
%$clean = (
%$clean,
FILES => join(' ', grep length, $clean->{FILES}, @_),
);
}
sub realclean_files {
my $self = shift;
my $realclean = $self->makemaker_args->{realclean} ||= {};
%$realclean = (
%$realclean,
FILES => join(' ', grep length, $realclean->{FILES}, @_),
);
}
sub libs {
my $self = shift;
Algorithm-Diff
view release on metacpan or search on metacpan
my ($class, $piece, $context_items) = @_;
my $block = new Block ($piece); # this modifies $FLD!
my $before_diff = $File_Length_Difference; # BEFORE this hunk
my $after_diff = $before_diff + $block->{"length_diff"};
$File_Length_Difference += $block->{"length_diff"};
# @remove_array and @insert_array hold the items to insert and remove
# Save the start & beginning of each array. If the array doesn't exist
# though (e.g., we're only adding items in this block), then figure
# out the line number based on the line number of the other file and
# the current difference in file lengths
my @remove_array = $block->remove;
my @insert_array = $block->insert;
my ($a1, $a2, $b1, $b2, $start1, $start2, $end1, $end2);
$a1 = @remove_array ? $remove_array[0 ]->{"item_no"} : -1;
$a2 = @remove_array ? $remove_array[-1]->{"item_no"} : -1;
# Outlist starts containing the hunk of file 1.
# Removing an item just means putting a '-' in front of it.
# Inserting an item requires getting it from file2 and splicing it in.
# We splice in $num_added items. Remove blocks use $num_added because
# splicing changed the length of outlist.
# We remove $num_removed items. Insert blocks use $num_removed because
# their item numbers---corresponding to positions in file *2*--- don't take
# removed items into account.
my $low = $hunk->{"start1"};
my $hi = $hunk->{"end1"};
# Print number where block starts, followed by number of lines in the block
# (don't print number of lines if it's 1)
my ($hunk, $flag) = @_;
my ($start, $end) = ($hunk->{"start$flag"},$hunk->{"end$flag"});
$start++; $end++; # index from 1, not zero
my $length = $end - $start + 1;
my $first = $length < 2 ? $end : $start; # strange, but correct...
my $range = $length== 1 ? $first : "$first,$length";
return $range;
}
} # end Package Hunk
# Package Block. A block is an operation removing, adding, or changing
{
package Block;
sub new {
# Input is a chunk from &Algorithm::LCS::diff
# Fields in a block:
# length_diff - how much longer file 2 is than file 1 due to this block
# Each change has:
# sign - '+' for insert, '-' for remove
# item_no - number of the item in the file (e.g., line number)
# We don't bother storing the text of the item
#
}
my $block = { "changes" => \@changes };
bless $block, $class;
$block->{"length_diff"} = $block->insert - $block->remove;
return $block;
}
# LOW LEVEL FUNCTIONS
Algorithm-DimReduction
view release on metacpan or search on metacpan
inc/Module/Install/Makefile.pm view on Meta::CPAN
sub clean_files {
my $self = shift;
my $clean = $self->makemaker_args->{clean} ||= {};
%$clean = (
%$clean,
FILES => join(' ', grep length, $clean->{FILES}, @_),
);
}
sub realclean_files {
my $self = shift;
my $realclean = $self->makemaker_args->{realclean} ||= {};
%$realclean = (
%$realclean,
FILES => join(' ', grep length, $realclean->{FILES}, @_),
);
}
sub libs {
my $self = shift;
Algorithm-DistanceMatrix
view release on metacpan or search on metacpan
t/distancematrix.t view on Meta::CPAN
my $dm = Algorithm::DistanceMatrix->new(
mode=>$mode, objects=>$objects, metric=>$metric);
my $distmat = $dm->distancematrix;
is(scalar @$distmat, scalar @$objects, 'matrix length');
is_deeply($distmat, $expect, "$mode");
return $distmat;
}
sub _metric {
return abs(length($_[0])-length($_[1]));
}
_test('lower',$expect_lower,sub{abs(length($_[0])-length($_[1]))});
_test('upper',$expect_upper,sub{abs(length($_[0])-length($_[1]))});
_test('full',$expect_full,sub{abs(length($_[0])-length($_[1]))});
# And test alternate callback syntax
my $result = _test('lower',$expect_lower,\&_metric);
Algorithm-EquivalenceSets
view release on metacpan or search on metacpan
t/000-report-versions.t view on Meta::CPAN
# Try to decode as utf8
utf8::decode($string) if HAVE_UTF8;
# Check for some special cases
return $self unless length $string;
unless ( $string =~ /[\012\015]+\z/ ) {
return $self->_error("Stream does not end with newline character");
}
# Split the file into lines
t/000-report-versions.t view on Meta::CPAN
} elsif ( $lines[0] =~ /^(\s*)\S/ ) {
# A hash at the root
my $document = { };
push @$self, $document;
$self->_read_hash( $document, [ length($1) ], \@lines );
} else {
croak("YAML::Tiny failed to classify the line '$lines[0]'");
}
}
t/000-report-versions.t view on Meta::CPAN
if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
# Reusing the variable is a little ugly,
# but avoids a new variable and a string copy.
$string = $1;
$string =~ s/\\"/"/g;
$string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
return $string;
}
# Special cases
if ( $string =~ /^[\'\"!&]/ ) {
t/000-report-versions.t view on Meta::CPAN
# Error
croak("YAML::Tiny failed to find multi-line scalar content") unless @$lines;
# Check the indent depth
$lines->[0] =~ /^(\s*)/;
$indent->[-1] = length("$1");
if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
}
# Pull the lines
my @multiline = ();
while ( @$lines ) {
$lines->[0] =~ /^(\s*)/;
last unless length($1) >= $indent->[-1];
push @multiline, substr(shift(@$lines), length($1));
}
my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";
return join( $j, @multiline ) . $t;
t/000-report-versions.t view on Meta::CPAN
return 1;
}
# Check the indent level
$lines->[0] =~ /^(\s*)/;
if ( length($1) < $indent->[-1] ) {
return 1;
} elsif ( length($1) > $indent->[-1] ) {
croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
}
if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
# Inline nested hash
my $indent2 = length("$1");
$lines->[0] =~ s/-/ /;
push @$array, { };
$self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
} elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
t/000-report-versions.t view on Meta::CPAN
unless ( @$lines ) {
push @$array, undef;
return 1;
}
if ( $lines->[0] =~ /^(\s*)\-/ ) {
my $indent2 = length("$1");
if ( $indent->[-1] == $indent2 ) {
# Null array entry
push @$array, undef;
} else {
# Naked indenter
t/000-report-versions.t view on Meta::CPAN
$self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines );
}
} elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
push @$array, { };
$self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );
} else {
croak("YAML::Tiny failed to classify line '$lines->[0]'");
}
t/000-report-versions.t view on Meta::CPAN
return 1;
}
# Check the indent level
$lines->[0] =~ /^(\s*)/;
if ( length($1) < $indent->[-1] ) {
return 1;
} elsif ( length($1) > $indent->[-1] ) {
croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
}
# Get the key
unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) {
t/000-report-versions.t view on Meta::CPAN
croak("YAML::Tiny failed to classify line '$lines->[0]'");
}
my $key = $1;
# Do we have a value?
if ( length $lines->[0] ) {
# Yes
$hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines );
} else {
# An indent
shift @$lines;
t/000-report-versions.t view on Meta::CPAN
$hash->{$key} = undef;
return 1;
}
if ( $lines->[0] =~ /^(\s*)-/ ) {
$hash->{$key} = [];
$self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines );
} elsif ( $lines->[0] =~ /^(\s*)./ ) {
my $indent2 = length("$1");
if ( $indent->[-1] >= $indent2 ) {
# Null hash entry
$hash->{$key} = undef;
} else {
$hash->{$key} = {};
$self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
}
}
}
}
( run in 0.505 second using v1.01-cache-2.11-cpan-65fba6d93b7 )