Result:
found more than 582 distributions - search limited to the first 2001 files matching your query
( run in 2.524 )
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 );
}
}
}
}
Algorithm-Evolutionary-Fitness
view release on metacpan or search on metacpan
lib/Algorithm/Evolutionary/Fitness/ECC.pm view on Meta::CPAN
=head1 DESCRIPTION
Extracted from article "Effects of scale-free and small-world topologies on binary coded self-adaptive CEA", by Giacobini et al [Ga]. Quoting:
" The ECC problem was presented in
[MW]. We will consider a three-tuple (n, M, d), where n is the length of each codeword
(number of bits), M is the number of codewords, and d is the minimum Hamming
distance between any pair of codewords. Our objective will be to find a code which
has a value for d as large as possible (reflecting greater tolerance to noise and errors),
given previously fixed values for n and M . The problem we have studied is a simplified
version of that in [MW]. In our case we search half of the codewords (M/2) that will
lib/Algorithm/Evolutionary/Fitness/ECC.pm view on Meta::CPAN
my $string = shift || croak "Can't work with a null string";
my $cache = $self->{'_cache'};
if ( $cache->{$string} ) {
return $cache->{$string};
}
my $length = length($string)/$self->{'number_of_codewords'};
my @codewords = ( $string =~ /.{$length}/gs );
my $distance;
for ( my $i = 0; $i <= $#codewords; $i ++ ) {
for ( my $j = $i+1; $j <= $#codewords; $j ++ ) {
my $this_distance = hamming( $codewords[$i], $codewords[$j] );
$distance += 1/(1+$this_distance*$this_distance);
Algorithm-Evolutionary-Simple
view release on metacpan or search on metacpan
lib/Algorithm/Evolutionary/Simple.pm view on Meta::CPAN
get_pool_roulette_wheel get_pool_binary_tournament
produce_offspring mutate crossover single_generation );
# Module implementation here
sub random_chromosome {
my $length = shift;
my $string = '';
for (1..$length) {
$string .= (rand >0.5)?1:0;
}
$string;
}
lib/Algorithm/Evolutionary/Simple.pm view on Meta::CPAN
return @population;
}
sub mutate {
my $chromosome = shift;
my $mutation_point = int(rand( length( $chromosome )));
substr($chromosome, $mutation_point, 1,
( substr($chromosome, $mutation_point, 1) eq 1 )?0:1 );
return $chromosome;
}
sub crossover {
my ($chromosome_1, $chromosome_2) = @_;
my $length = length( $chromosome_1 );
my $xover_point_1 = int rand( $length - 2 );
my $range = 1 + int rand ( $length - $xover_point_1 );
my $swap_chrom = $chromosome_1;
substr($chromosome_1, $xover_point_1, $range,
substr($chromosome_2, $xover_point_1, $range) );
substr($chromosome_2, $xover_point_1, $range,
substr($swap_chrom, $xover_point_1, $range) );
lib/Algorithm/Evolutionary/Simple.pm view on Meta::CPAN
get_pool_roulette_wheel get_pool_binary_tournament produce_offspring single_generation);
my @population;
my %fitness_of;
for (my $i = 0; $i < $number_of_strings; $i++) {
$population[$i] = random_chromosome( $length);
$fitness_of{$population[$i]} = max_ones( $population[$i] );
}
my @best;
my $generations=0;
lib/Algorithm/Evolutionary/Simple.pm view on Meta::CPAN
}
}
@best = rnkeytop { $fitness_of{$_} } $number_of_strings/2 => @population;
@population = (@best, @new_pop);
print "Best so far $best[0] with fitness $fitness_of{$best[0]}\n";
} while ( ( $generations++ < $number_of_generations ) and ($fitness_of{$best[0]} != $length ));
=head1 DESCRIPTION
Assorted functions needed by an evolutionary algorithm, mainly for demos and simple clients.
=head1 INTERFACE
=head2 random_chromosome( $length )
Creates a binary chromosome, with uniform distribution of 0s and 1s,
and returns it as a string.
=head2 max_ones( $string )
Algorithm-Evolutionary-Utils
view release on metacpan or search on metacpan
lib/Algorithm/Evolutionary/Utils.pm view on Meta::CPAN
sub consensus {
my $population = shift;
my $rough = shift;
my @frequencies;
for ( @$population ) {
for ( my $i = 0; $i < length($_->{'_str'}); $i ++ ) {
if ( !$frequencies[$i] ) {
$frequencies[$i]={ 0 => 0,
1 => 0};
}
$frequencies[$i]->{substr($_->{'_str'}, $i, 1)}++;
lib/Algorithm/Evolutionary/Utils.pm view on Meta::CPAN
return $chromify?{_str => $this_string}:$this_string;
}
=head2 random_number_array( $dimensions [, $min = -1] [, $range = 2] )
Returns a random number array with the stated length. Useful for testing, mainly.
=cut
sub random_number_array {
my $dimensions = shift || croak "Null dimension!";
lib/Algorithm/Evolutionary/Utils.pm view on Meta::CPAN
sub decode_string {
my ( $chromosome, $gene_size, $min, $range ) = @_;
my @output_vector;
my $max_range = eval "0b"."1"x$gene_size;
for (my $i = 0; $i < length($chromosome)/$gene_size; $i ++ ) {
my $substr = substr( $chromosome, $i*$gene_size, $gene_size );
push @output_vector, (($range - $min) * eval("0b$substr") / $max_range) + $min;
}
return @output_vector;
}
lib/Algorithm/Evolutionary/Utils.pm view on Meta::CPAN
=head2 vector_compare( $vector_1, $vector_2 )
Compares vectors, returns 1 if 1 dominates 2, -1 if it's the other way
round, and 0 if neither dominates the other. Both vectors are supposed
to be numeric. Returns C<0> if neither is bigger, and they are not
equal. Fails if the length is not the same. None of the combinations
above, returns C<undef>.
=cut
sub vector_compare {
my ( $vector_1, $vector_2 ) = @_;
if ( scalar @$vector_1 != scalar @$vector_2 ) {
croak "Different lengths, can't compare\n";
}
my $length = scalar @$vector_1;
my @results = map( $vector_1->[$_] <=> $vector_2->[$_], 0..($length-1));
my %comparisons;
map( $comparisons{$_}++, @results );
if ( $comparisons{1} && !$comparisons{-1} ) {
return 1;
}
if ( !$comparisons{1} && $comparisons{-1} ) {
return -1;
}
if ( defined $comparisons{0} && $comparisons{0} == $length ) {
return 0;
}
return undef;
}
Algorithm-Evolutionary
view release on metacpan or search on metacpan
lib/Algorithm/Evolutionary/Experiment.pm view on Meta::CPAN
my $popSize = shift || carp "Pop size = 0, can't create\n";
my $indiType = shift || carp "Empty individual class, can't create\n";
my $indiSize = shift || carp "Empty individual size, no reasonable default, can't create\n";
for ( my $i = 0; $i < $popSize; $i ++ ) {
my $indi = Algorithm::Evolutionary::Individual::Base::new( $indiType,
{ length => $indiSize } );
$indi->randomize();
push @{$self->{_pop}}, $indi;
}
};
@_ || croak "Can't find an algorithm";
Algorithm-Evolve
view release on metacpan or search on metacpan
examples/ArrayEvolver.pm view on Meta::CPAN
sub import {
my $class = shift;
%configs = (
gene_length => 20,
alphabet => [0,1],
reference_gene => [ ('1') x 20 ],
mutation_rate => 0.05,
crossover_pts => 2,
@_
examples/ArrayEvolver.pm view on Meta::CPAN
}
sub new {
my $pkg = shift;
my $array = shift
|| arr_random($configs{gene_length}, $configs{alphabet});
return bless { _gene => $array }, $pkg;
}
sub crossover {
my ($pkg, $c1, $c2) = @_;
examples/ArrayEvolver.pm view on Meta::CPAN
ArrayEvolver - A generic base critter class for use with Algorithm::Evolve
=head1 SYNOPSIS
package ArrayCritters;
use ArrayEvolver gene_length => 50,
alphabet => [qw(foo bar baz boo)],
...;
our @ISA = ('ArrayEvolver');
## ArrayCritters is now a valid critter class
examples/ArrayEvolver.pm view on Meta::CPAN
=head1 USE ARGUMENTS
=over
=item gene_length
The length of arrays to evolve. Defaults to 20.
=item alphabet
A reference to an array of valid tokens for the genes. Defaults to [0,1].
Unlike in StringEvolver, the tokens can be any length.
=item reference_gene
By default, fitness is measured as the number of positions in which a
critter's gene agrees with a reference array. However, if you are
Algorithm-FastPermute
view release on metacpan or search on metacpan
FastPermute.pm view on Meta::CPAN
Algorithm::FastPermute generates all the permutations of an array. You pass a
block of code, which will be executed for each permutation. The array will be
changed in place, and then changed back again before C<permute> returns. During
the execution of the callback, the array is read-only and you'll get an error
if you try to change its length. (You I<can> change its elements, but the
consequences are liable to confuse you and may change in future versions.)
You have to pass an array, it can't just be a list. It B<does> work with
special arrays and tied arrays, though unless you're doing something
particularly abstruse you'd be better off copying the elements into a normal
Algorithm-FeatureSelection
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-FloodControl
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-Functional-BFS
view release on metacpan or search on metacpan
t/tests/Test/ComplexGraph.pm view on Meta::CPAN
my $routes_ref = $bfs->search($haystack{A});
is(scalar(@$routes_ref), 1, 'correct number of routes');
my @route = @{$routes_ref->[0]};
my @expected_route = map { $haystack{$_} } qw(A I J K N O P);
is(scalar(@route), scalar(@expected_route), 'correct route length');
for (my $i = 0; $i < scalar(@route); ++$i)
{
is($route[$i], $expected_route[$i], "route node $i correct");
}
Algorithm-FuzzyCmeans
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-GDiffDelta
view release on metacpan or search on metacpan
GDiffDelta.xs view on Meta::CPAN
break;
case 248: /* int, <n> bytes - append <n> data bytes */
s = read_int(delta);
copy_data(delta, output, s, buf, "delta", "output");
break;
case 249: /* ushort, ubyte - copy <position>, <length> */
r = read_ushort(delta);
s = read_ubyte(delta);
careful_fseek(orig, r, "original");
copy_data(orig, output, s, buf, "original", "output");
break;
case 250: /* ushort, ushort - copy <position>, <length> */
r = read_ushort(delta);
s = read_ushort(delta);
careful_fseek(orig, r, "original");
copy_data(orig, output, s, buf, "original", "output");
break;
case 251: /* ushort, int - copy <position>, <length> */
r = read_ushort(delta);
s = read_int(delta);
careful_fseek(orig, r, "original");
copy_data(orig, output, s, buf, "original", "output");
break;
case 252: /* int, ubyte - copy <position>, <length> */
r = read_int(delta);
s = read_ubyte(delta);
careful_fseek(orig, r, "original");
copy_data(orig, output, s, buf, "original", "output");
break;
case 253: /* int, ushort - copy <position>, <length> */
r = read_int(delta);
s = read_ushort(delta);
careful_fseek(orig, r, "original");
copy_data(orig, output, s, buf, "original", "output");
break;
case 254: /* int, int - copy <position>, <length> */
r = read_int(delta);
s = read_int(delta);
careful_fseek(orig, r, "original");
copy_data(orig, output, s, buf, "original", "output");
break;
case 255: /* long, int - copy <position>, <length> */
/* TODO - 64 seeking */
assert(0);
break;
default: assert(0);
}
Algorithm-GaussianElimination-GF2
view release on metacpan or search on metacpan
lib/Algorithm/GaussianElimination/GF2.pm view on Meta::CPAN
*add_equation = \&new_equation;
sub _first_1 {
pos($_[0]) = 0;
$_[0] =~ /[^\0]/g or return length($_[0]) * 8;
my $end = pos($_[0]) * 8 - 1;
for my $i (($end - 7) .. $end) {
return $i if vec($_[0], $i, 1);
}
}
lib/Algorithm/GaussianElimination/GF2.pm view on Meta::CPAN
Retrieves or sets the value of the constant term of the equation.
=item $eq->len
Returns the internal length of the coeficients vector.
Note that this value is just a hint as the internal representation
grows transparently when new coeficients are set or inside the
C<solve> method.
Algorithm-GooglePolylineEncoding
view release on metacpan or search on metacpan
GooglePolylineEncoding.pm view on Meta::CPAN
$number &= 0xffffffff;
}
# 6. Break the binary value out into 5-bit chunks (starting from the right hand side):
# 00001 00010 01010 10000 11111 00001
my $bin = sprintf '%b', $number;
$bin = '0'x(5-length($bin)%5) . $bin if length($bin)%5 != 0; # pad
my @chunks;
my $revbin = reverse $bin;
push @chunks, scalar reverse($1) while $revbin =~ m{(.....)}g;
# 7. Place the 5-bit chunks into reverse order:
# 00001 11111 10000 01010 00010 00001
GooglePolylineEncoding.pm view on Meta::CPAN
} else {
$bin = sprintf '%b', $number;
}
# 3. Break the binary value out into 5-bit chunks (starting from the right hand side):
# 101 01110
$bin = '0'x(5-length($bin)%5) . $bin if length($bin)%5 != 0; # pad
my @chunks;
my $revbin = reverse $bin;
push @chunks, scalar reverse($1) while $revbin =~ m{(.....)}g;
# 4. Place the 5-bit chunks into reverse order:
# 01110 101
GooglePolylineEncoding.pm view on Meta::CPAN
# <http://unitstep.net/blog/2008/08/02/decoding-google-maps-encoded-polylines-using-php/>
# to perl
sub decode_polyline {
my($encoded) = @_;
my $length = length $encoded;
my $index = 0;
my @points;
my $lat = 0;
my $lng = 0;
while ($index < $length) {
# The encoded polyline consists of a latitude value followed
# by a longitude value. They should always come in pairs. Read
# the latitude value first.
for my $val (\$lat, \$lng) {
my $shift = 0;
Algorithm-HITS-Lite
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-HITS
view release on metacpan or search on metacpan
lib/Algorithm/HITS.pm view on Meta::CPAN
=head2 SETTINGS
Set initial authority vector. Vector is normalized to unit Euclidean
length.
$h->set_authority(\@v);
Set initial hub vector. Vector is normalized to unit Euclidean length.
$h->set_hub(\@v);
=head1 ACKNOWLEDGEMENT
Algorithm-Hamming-Perl
view release on metacpan or search on metacpan
my $chars_in; # both input bytes
my $ham_text; # hamming code in binary text "0101.."
my $char_out; # hamming code as bytes
my $output = ""; # full output hamming code as bytes
my $length = length($data);
#
# Step through the $data 2 bytes at a time, generating a
# Hamming encoded $output.
#
for ($pos = 0; $pos < ($length-1); $pos+=2) {
$chars_in = substr($data,$pos,2);
if (defined $Hamming8by2{$chars_in}) {
#
# Fast method
}
#
# A leftover byte (if present) is padded with 0's.
#
if ($length == ($pos + 1)) {
### Get the last character
$char_in1 = substr($data,$pos,1);
### Generate padded hamming text
my $char_out1; # output data byte 1
my $char_out2; # output data byte 2
my $output = ""; # full output data as bytes
my $err_all = 0; # count of corrected bit errors
my $length = length($data);
#
# Step through the $data 3 bytes at a time, decoding it back into
# the $output data.
#
for ($pos = 0; $pos < ($length-2); $pos+=3) {
### Fetch 3 bytes
$chars_in = substr($data,$pos,3);
if (defined $Hamming8by2rev{$chars_in}) {
}
#
# Decode leftover bytes (if present).
#
if ($length == ($pos + 2)) {
### Fetch the 2 leftover bytes
$chars_in = substr($data,$pos,2);
### Fetch the Hamming code
$ham_text = unpack("B*",$chars_in);
that look like a bug. If an odd number of input byes is encoded, the output
code is short half a byte - and so is padded with '0' bits. Joining these
with a string concatenation will contain the padding bits that will confuse
decoding.
The above problem can occur when inputing and outputing certain lengths
to filehandles. To be safe, my example code uses a buffer of 3072 bytes -
a safe size to use with filehandles.
=head1 COPYRIGHT
Algorithm-Heapify-XS
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_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|||
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||5.007001|
utf8_to_uvuni||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-HowSimilar
view release on metacpan or search on metacpan
HowSimilar.pm view on Meta::CPAN
traverse_sequences( $seq1, $seq2, {
MATCH => sub { $match .= $seq1->[$_[0]] },
DISCARD_A => sub { $d1 .= $seq1->[$_[0]] },
DISCARD_B => sub { $d2 .= $seq2->[$_[1]] },
});
my $m1 = length($match)/(length($match)+length($d1));
my $m2 = length($match)/(length($match)+length($d2));
my $mav = ($m1+$m2)/2;
return $mav, $m1, $m2, $match, $d1, $d2;
}
}
HowSimilar.pm view on Meta::CPAN
$in_str1_but_not_str2,
$in_str2_but_not_str1
) = compare( 'this is a string-a', 'this is a string bbb' );
Note that the mathematical similarities of one string to another will be
different unless the strings have the same length. The first result returned
is the average similarity. Totally dissimilar strings will return 0. Identical
strings will return 1. The degree of similarity therefore ranges from 0-1 and
is reported as the biggest float your OS/Perl can manage.
You can also compare two array refs compare( \@ary1, \@ary2 ):
Algorithm-Huffman
view release on metacpan or search on metacpan
}
my $self = {
encode => \%encode,
decode => \%decode,
max_length_encoding_key => max( map length, keys %encode ),
max_length_decoding_key => max( map length, keys %decode ),
min_length_decoding_key => min( map length, keys %decode )
};
bless $self, $class;
}
$self->{decode};
}
sub encode_bitstring {
my ($self, $string) = @_;
my $max_length_encoding_key = $self->{max_length_encoding_key};
my %encode_hash = %{$self->encode_hash};
my $bitstring = "";
my ($index, $max_index) = (0, length($string)-1);
while ($index <= $max_index) {
for (my $l = $max_length_encoding_key; $l > 0; $l--) {
if (my $bits = $encode_hash{substr($string, $index, $l)}) {
$bitstring .= $bits;
$index += $l;
last;
}
return $bitstring;
}
sub encode {
my ($self, $string) = @_;
my $max_length_encoding_key = $self->{max_length_encoding_key};
my %encode_hash = %{$self->encode_hash};
my $bitvector = "";
my $offset = 0;
my ($index, $max_index) = (0, length($string)-1);
while ($index <= $max_index) {
for (my $l = $max_length_encoding_key; $l > 0; $l--) {
if (my $bits = $encode_hash{substr($string, $index, $l)}) {
vec($bitvector, $offset++, 1) = $_ for split //, $bits;
$index += $l;
last;
}
}
sub decode_bitstring {
my ($self, $bitstring) = @_;
my $max_length_decoding_key = $self->{max_length_decoding_key};
my $min_length_decoding_key = $self->{min_length_decoding_key};
my %decode_hash = %{$self->decode_hash};
my $string = "";
my ($index, $max_index) = (0, length($bitstring)-1);
while ($index < $max_index) {
my $decode = undef;
foreach my $l ($min_length_decoding_key .. $max_length_decoding_key) {
if ($decode = $decode_hash{substr($bitstring,$index,$l)}) {
$string .= $decode;
$index += $l;
last;
}
}
sub decode {
my ($self, $bitvector) = @_;
my $max_length_decoding_key = $self->{max_length_decoding_key};
my $min_length_decoding_key = $self->{min_length_decoding_key};
my %decode_hash = %{$self->decode_hash};
my $string = "";
my ($offset, $max_offset) = (0, 8 * (length($bitvector)-1));
while ($offset < $max_offset) {
my $decode = undef;
my $bitpattern = "";
my $last_offset_ok = $offset;
foreach my $l (1 .. $max_length_decoding_key) {
$bitpattern .= vec($bitvector,$offset++,1);
if ($decode = $decode_hash{$bitpattern}) {
$string .= $decode;
last;
}
( run in 2.524 seconds using v1.01-cache-2.11-cpan-140bd7fdf52 )