Result:
found more than 582 distributions - search limited to the first 2001 files matching your query
( run in 0.908 )
Album
view release on metacpan or search on metacpan
script/album view on Meta::CPAN
# Package name.
my $my_package = 'Sciurix';
# Program name and version.
my ($my_name, $my_version) = $RCS_Id =~ /: (.+).pl,v ([\d.]+)/;
# Tack '*' if it is not checked in into RCS.
$my_version .= '*' if length('$Locker: $ ') > 12;
my $creator = "Created with <a href=\"http://search.cpan.org/~jv/Album/\">Album</a> $::VERSION";
################ Command line parameters ################
script/album view on Meta::CPAN
}
elsif ( /^caption\s*(.*)/ ) {
setopt("caption", $1);
}
elsif ( /^icon\s*(.*)/ ) {
setopt("icon", defined($1) && length($1) ? $1 : 1);
}
elsif ( /^locale\s*(.*)/ ) {
setopt("locale", $1);
}
elsif ( /^depth\s+(\d+)/ ) {
script/album view on Meta::CPAN
}
sub prepare_images {
my $ddot = 0;
my $tdot = 0;
my $fmt = "[%" . length($filelist->tally) . "d]\n";
my $msgfile;
my $msg = sub {
return unless $verbose > 1;
if ( $verbose > 2 ) {
script/album view on Meta::CPAN
print STDERR ("\n") if $did;
}
sub process_fmt {
my ($fmt, %map) = @_;
$fmt =~ s/^(.*?)\$(\w+)\b/$1.indent($map{$2}, length($1))/gme;
$fmt;
}
################ Helpers for Image/Index/Journal pages ################
script/album view on Meta::CPAN
$v .= sprintf("mm (%.1fmm equiv.)", $v*4.857);
}
else {
$v .= "mm";
}
$app->("Focal length", $v);
}
$app->("ISO", $v) if $v = $el->ISOSpeedRatings;
$app->("Flash", $v)
if ($v = $el->Flash) && $v ne "Flash did not fire";
$app->("Metering", $v) if $v = $el->MeteringMode;
script/album view on Meta::CPAN
sub update_if_needed($$) {
my ($fname, $new) = @_;
# Do not overwrite unless modified.
if ( -s $fname && -s _ == length($new) ) {
local($/);
my $hh = do { local *F; *F };
my $old;
open($hh, $fname) && ($old = <$hh>) && close($hh);
if ( $old eq $new ) {
script/album view on Meta::CPAN
# Select lines to process.
next if /[a-z]/;
next unless /^X(.*)/s;
$_ = $1;
next unless int((((ord() - 32) & 077) + 2) / 3)
== int(length() / 4);
# Decode.
print $out unpack("u",$_);
next;
}
script/album view on Meta::CPAN
my (@l) = split(/\t/, $line, -1);
# Replace tabs with blanks, retaining layout
$line = shift(@l);
$line .= " " x (8-length($line)%8) . shift(@l) while @l;
$line;
}
################ Copying: plain files ################
Algorithm-AM
view release on metacpan or search on metacpan
lib/Algorithm/AM/BigInt.pm view on Meta::CPAN
#pod argument.
#pod
#pod =cut
sub bigcmp {
my($a,$b) = @_;
return (length($a) <=> length($b)) || ($a cmp $b);
}
1;
__END__
Algorithm-Accounting
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 libs {
my $self = shift;
Algorithm-AdaBoost
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-AhoCorasick-XS
view release on metacpan or search on metacpan
lib/Algorithm/AhoCorasick/XS.pm view on Meta::CPAN
You can simply call C< decode('UTF-8', ...) > on the substrings to get their
Unicode versions. The offsets will be in bytes though; converting them to character
offsets in the Unicode string is a little more tricky:
use Encode qw(decode);
my $unicode_start = length(decode('UTF-8', bytes::substr($string, 0, $start)));
my $unicode_end = $start + length(decode('UTF-8', $word)) - 1;
This will be handled for you in a future version.
=head1 CAVEATS
Algorithm-AhoCorasick
view release on metacpan or search on metacpan
lib/Algorithm/AhoCorasick.pm view on Meta::CPAN
Aho-Corasick is a classic (1975) algorithm for locating elements of a
finite set of strings within an input text. It constructs a finite
state machine from a list of keywords, then uses the machine to locate
all occurrences of the keywords. Construction of the machine takes
time proportional to the sum of the lengths of the keywords and the
machine processes the input string in a single pass - that is, the
algorithm may be considerably more efficient than searching for each
keyword separately.
=head1 PROCEDURAL INTERFACE
lib/Algorithm/AhoCorasick.pm view on Meta::CPAN
=head2 find_all
When no keyword is found in the input text, C<find_all> returns
undef; when some keywords are found, the return value is a hash
reference mapping positions to keywords (in an array reference,
ordered by length) found at those positions.
=head2 find_first
When no keyword is found in the input text, C<find_first> returns
undef in scalar context and an empty array in list context; when a
Algorithm-BIT-XS
view release on metacpan or search on metacpan
lib/Algorithm/BIT/XS.pm view on Meta::CPAN
=over
=item Algorithm::BIT::XS->B<new>(I<$len>)
Create a new binary indexed tree of length I<$len>. As binary indexed
trees are 1-indexed, its indexes are [1..I<$len>]. It is initially
filled with zeroes.
=item $bit->B<clear>()
Algorithm-Backoff-RetryTimeouts
view release on metacpan or search on metacpan
t/00-report-prereqs.t view on Meta::CPAN
}
if ( @reports ) {
push @full_reports, "=== $title ===\n\n";
my $ml = _max( map { length $_->[0] } @reports );
my $wl = _max( map { length $_->[1] } @reports );
my $hl = _max( map { length $_->[2] } @reports );
if ($type eq 'modules') {
splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl];
push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports;
}
Algorithm-BaumWelch
view release on metacpan or search on metacpan
lib/Algorithm/BaumWelch.pm view on Meta::CPAN
croak qq{\nThis method expects 3 arguments.} if @_ != 4;
my ($self, $trans, $emis, $start) = @_;
croak qq{\nThis method expects 3 arguments.} if (ref $trans ne q{ARRAY} || ref $emis ne q{HASH} || ref $start ne q{ARRAY});
my $obs_tipos = $self->[0][1];
my $obs_numero = $self->[0][2];
my $t_length = &_check_trans($trans);
&_check_emis($emis, $obs_tipos, $obs_numero, $t_length);
&_check_start($start, $t_length);
$self->[1][0] = $trans;
$self->[1][1] = $emis;
$self->[1][2] = $start;
my @stop; # 0.1/1 nao faz diferenca e para|comeca (stop|start) sempre iguala = 0
for (0..$#{$trans}) { push @stop, 1 };
$self->[1][3] = [@stop];
return;
}
sub _check_start {
my ($start, $t_length) = @_;
croak qq{\nThere must be an initial probablity for each state in the start ARRAY.} if scalar @{$start} != $t_length;
for (@{$start}) { croak qq{\nThe start ARRAY values must be numeric.} if !(/^[+-]?\ *(\d+(\.\d*)?|\.\d+)([eE][+-]?\d+)?$/) };
my $sum =0;
for (@{$start}) { $sum += $_ }
croak qq{\nThe starting probabilities must sum to 1.} if ($sum <= 0.95 || $sum >= 1.05);
return;
}
sub _check_emis {
my ($emis, $obs_tipos, $obs_numero, $t_length) = @_;
my @emis_keys = (keys %{$emis});
@emis_keys = sort {$a cmp $b} @emis_keys;
croak qq{\nThere must be an entry in the emission matrix for each type of observation in the observation series.} if $obs_numero != scalar @emis_keys;
for (0..$#emis_keys) { croak qq{\nThe observations in the emission matrix do not match those in the observation series.} if $emis_keys[$_] ne $obs_tipos->[$_]; }
for (values %{$emis}) {
croak qq{\nThere must be a probability value for each state in the emission matrix.} if scalar @{$_} != $t_length;
for my $cell (@{$_}) { croak qq{\nThe emission matrix values must be numeric.} if $cell !~ /^[+-]?\ *(\d+(\.\d*)?|\.\d+)([eE][+-]?\d+)?$/; }
}
for my $i (0..$t_length-1) { # só fazendo 2-estado agora
my $sum = 0;
for my $o (@{$obs_tipos}) { $sum += $emis->{$o}[$i] }
croak qq{\nThe emission matrix column must sum to 1.} if ($sum <= 0.95 || $sum >= 1.05);
}
return;
}
sub _check_trans {
my $trans = shift;
my $t_length = scalar @{$trans};
for (@{$trans}) {
croak qq{\nThe transition matrix much be square.} if scalar @{$_} != $t_length;
my $sum = 0;
for my $cell (@{$_}) {
croak qq{\nThe transition matrix values must be numeric.} if $cell !~ /^[+-]?\ *(\d+(\.\d*)?|\.\d+)([eE][+-]?\d+)?$/;
$sum += $cell
}
croak qq{\nThe transition matrix row must sum to 1.} if ($sum <= 0.95 || $sum >= 1.05);
}
return $t_length;
}
sub random_initialise {
my ($self, $states) = @_;
my $obs_names = $self->[0][1];
lib/Algorithm/BaumWelch.pm view on Meta::CPAN
$self->[1][3] = [@stop];
return;
}
sub _gera_init {
my $length = shift;
my $sum = 0;
my $init = [];
srand;
$#{$init} = $length-1; # só fazendo 2-estado agora
for (@{$init}) { $_ = rand; $sum += $_ }
#/ normalise such that sum is equal to 1
for (@{$init}) { $_ /= $sum }
return $init;
}
sub _gera_trans {
my $length = shift;
my $t = [];
$#{$t} = $length-1; # só fazendo 2-estado agora
#/ gera_init normalises
for (@{$t}) { $_ = &_gera_init($length); }
return $t;
}
sub _gera_emis {
my ($length, $obs_names) = @_;
my $e = {};
srand;
for (@{$obs_names}) {
my $init = [];
$#{$init} = $length-1; # só fazendo 2-estado agora
for (@{$init}) { $_ = rand; }
$e->{$_} = $init;
}
# para cada estado a suma deve iguala 1 - normalise such that sum of obs_x|state = 1
for my $i (0..$length-1) { # só fazendo 2-estado agora
my $sum = 0;
for my $o (@{$obs_names}) { $sum += $e->{$o}[$i] }
for my $o (@{$obs_names}) { $e->{$o}[$i] /= $sum }
}
#print qq{\n\nauto-gera emis de numeros aleatorios que sumam 1 para cada estado}; draw($e);
lib/Algorithm/BaumWelch.pm view on Meta::CPAN
my $self = shift;
for (0..10) { $self->_forwardbackward_reestimacao; }
return;
}
sub _baum_welch_length {
my $self = shift;
for (0..$#{$self->[0][0]}) { $self->_forwardbackward_reestimacao; }
return;
}
lib/Algorithm/BaumWelch.pm view on Meta::CPAN
#ARRAY REFERENCE (0)
# |
# |__ARRAY REFERENCE (1) [ '->[0]' ]
# | |
# | |__ARRAY REFERENCE (2) ---LONG_LIST_OF_SCALARS--- [ length = 33 ] e.g. 0..2: obs2, obs3, obs3 [ '->[0][0]' ] # a serie
# | |
# | |__ARRAY REFERENCE (2) ---LONG_LIST_OF_SCALARS--- [ length = 3 ]: obs3, obs1, obs2 [ '->[0][1]' ] # a lista de tipos de observacoes
# | |
# | |__SCALAR = '3' (2) [ '->[0][2]' ] # o numero de tipos de observacoes
# |
# |__ARRAY REFERENCE (1) [ '->[1]' ]
# | |
# | |__ARRAY REFERENCE (2) [ '->[1][0]' ] # transition matrix
# | | |
# | | |__ARRAY REFERENCE (3) ---LONG_LIST_OF_SCALARS--- [ length = 2 ]: 0.933779184947876, 0.0718663090308487 [ '->[1][0][0]' ]
# | | |
# | | |__ARRAY REFERENCE (3) ---LONG_LIST_OF_SCALARS--- [ length = 2 ]: 0.0662208150521236, 0.864944219467616 [ '->[1][0][1]' ]
# | |
# | |__HASH REFERENCE (2) [ '->[1][1]' ] # emission matrix
# | | |
# | | |__'obs3'=>ARRAY REFERENCE (3) ---LONG_LIST_OF_SCALARS--- [ length = 2 ]: 0.211448366743702, 0.465609305295478 [ '->[1][1]{obs3}' ]
# | | |
# | | |__'obs1'=>ARRAY REFERENCE (3) ---LONG_LIST_OF_SCALARS--- [ length = 2 ]: 0.640481492730478, 7.18630557481621e-09 [ '->[1][1]{obs1}' ]
# | | |
# | | |__'obs2'=>ARRAY REFERENCE (3) ---LONG_LIST_OF_SCALARS--- [ length = 2 ]: 0.14807014052582, 0.534390687518216 [ '->[1][1]{obs2}' ]
# | |
# | |__ARRAY REFERENCE (2) ---LONG_LIST_OF_SCALARS--- [ length = 2 ]: 4.52394236439737e-30, 1 [ '->[1][2]' ] # start conditions
# |
# |__ ARRAY REFERENCE (1) [ '->[2]' ] # perp
#
=head1 SEE ALSO
Algorithm-Bertsekas
view release on metacpan or search on metacpan
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
print "]\n\n";
}
if ( $verbose >= 2 ){
my $index_length = length($original_max_size);
if ( $verbose >= 3 ){
printf " modified matrix %d x %d:\n", $#matrix + 1, $#{$matrix[0]} + 1;
for my $i ( 0 .. $#matrix ) {
print " [";
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
$sum_matrix_value += $matrix_value if ( defined $matrix_input[$index_array1] and defined $matrix_input[$index_array1]->[$index_array2] );
my $weight = ( defined $matrix_input[$index_array1] and defined $matrix_input[$index_array1]->[$index_array2] ) ? sprintf( "%${matrix_spaces}.${decimals}f", $matrix_value ) : ' ' x $matrix_spaces ;
printf( " indexes ( %${index_length}d, %${index_length}d ), matrix value = $weight ; sum of values = %${sum_spaces}.${decimals}f \n", $index_array1, $index_array2, $sum_matrix_value );
}}
}
}
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
my $min_matrix_value;
for my $i ( 0 .. $#matrix ) {
for my $j ( 0 .. $#{$matrix[$i]} ) {
my $char_number = length( $matrix[$i]->[$j] ); # count the number of characters
$matrix_spaces = $char_number if ( (not defined $matrix_spaces) || ($char_number > $matrix_spaces) );
$max_matrix_value = $matrix[$i]->[$j] if ( (not defined $max_matrix_value) || ($matrix[$i]->[$j] > $max_matrix_value) );
$min_matrix_value = $matrix[$i]->[$j] if ( (not defined $min_matrix_value) || ($matrix[$i]->[$j] < $min_matrix_value) );
}}
$decimals = length(($max_matrix_value =~ /[,.](\d+)/)[0]); # counting the number of digits after the decimal point
$decimals = 0 unless ( defined $decimals ); # for integers $decimals = 0
my $range = $max_matrix_value - $min_matrix_value; # $range >= 0
$range = 1 if ($range == 0);
Algorithm-BestChoice
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-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;
( run in 0.908 second using v1.01-cache-2.11-cpan-140bd7fdf52 )