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);

 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 )

 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;
}

 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";

 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 

 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

 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;
}

 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(%$_) : @{$_} )
                  : ''

 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");
    }

 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;
}

 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);
                }

 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.

 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;

 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;

 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

 view release on metacpan or  search on metacpan

Perl.pm  view on Meta::CPAN

	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

Perl.pm  view on Meta::CPAN

	}

	#
	#  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

Perl.pm  view on Meta::CPAN

	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}) {

Perl.pm  view on Meta::CPAN

	}

	#
	#  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);

Perl.pm  view on Meta::CPAN

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

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

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|

ppport.h  view on Meta::CPAN

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|||

ppport.h  view on Meta::CPAN

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|

ppport.h  view on Meta::CPAN

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

ppport.h  view on Meta::CPAN

#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

ppport.h  view on Meta::CPAN

#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)

ppport.h  view on Meta::CPAN

#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

 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 ):

 view release on metacpan or  search on metacpan

Huffman.pm  view on Meta::CPAN

    }
    
    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;
}

Huffman.pm  view on Meta::CPAN

    $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;
            }

Huffman.pm  view on Meta::CPAN

    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;
            }

Huffman.pm  view on Meta::CPAN

}

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;
            }

Huffman.pm  view on Meta::CPAN

}

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;
            }

 view release on metacpan or  search on metacpan

lib/Algorithm/IRCSRP2.pm  view on Meta::CPAN

sub cbc_decrypt {
    my ($self, $data) = @_;

    my $blocksize = $self->cbc_blocksize();

    die('length($data) % $blocksize != 0') unless (length($data) % $blocksize == 0);

    my $IV = substr($data, 0, $blocksize);
    $data = substr($data, $blocksize);

    my $plaintext = '';

    foreach (@{[ 0 .. (length($data) / $blocksize) - 1 ]}) {
        my $temp = $self->cipher->decrypt(substr($data, 0, $blocksize));
        my $temp2 = xorstring($temp, $IV, $blocksize);
        $plaintext .= $temp2;
        $IV = substr($data, 0, $blocksize);
        $data = substr($data, $blocksize);

lib/Algorithm/IRCSRP2.pm  view on Meta::CPAN

sub cbc_encrypt {
    my ($self, $data) = @_;

    my $blocksize = $self->cbc_blocksize();

    die('length($data) % $blocksize != 0') unless (length($data) % $blocksize == 0);

    my $IV = urandom($blocksize);
    die('len(IV) == blocksize') unless (length($IV) == $blocksize);

    my $ciphertext = $IV;

    foreach (@{[ 0 .. (length($data) / $blocksize) - 1 ]}) {
        my $xored = xorstring($data, $IV, $blocksize);
        my $enc = $self->cipher->encrypt($xored);

        $ciphertext .= $enc;
        $IV = $enc;
        $data = substr($data, $blocksize);
    }

    die('len(ciphertext) % blocksize == 0') unless (length($ciphertext) % $blocksize == 0);

    return $ciphertext;
}

sub decrypt_message {

lib/Algorithm/IRCSRP2.pm  view on Meta::CPAN

    if ($msg =~ /^\xffKEY/) {

        my $new = substr($msg, 4);

        if (length($new) != (32 + 32)) {
            die('decrypt_message: length($new) != 32 + 32 ; length is ' . length($new));
        }

        $self->debug_cb->('decrypt_message: rekeying');

        $self->session_key(substr($new, 0, 32));

lib/Algorithm/IRCSRP2.pm  view on Meta::CPAN

    my ($self, $who, $msg) = @_;

    my $times = pack('L>', int(time()));

    # info = len(username) || username || timestamp
    my $infos = chr(length($who)) . $who . $times;

    # ctext = IV || AES-CBC(sessionkey, IV, "M" || info || plaintext)
    my $ctext = $self->cbc_encrypt(padto('M' . $infos . $msg, 16));

    # cmac = HM(mackey, ctext)

 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(%$_) : @{$_} )
                  : ''

 view release on metacpan or  search on metacpan

Interval2Prefix.pm  view on Meta::CPAN

  my($lo, $hi) = @_;
  my @res = _i2a($lo, $hi, 10,
                 sub {
                   my($n, $i, $base)= @_;
                   my $p = $n / _step($i, $base);
                   my $s = length($n) - length($p);
                   return $p . ($s ? '\d' . ($s > 1 ? "{$s}" : '') : '');
                 });
  return unless @res;
  return '^(?:' . join('|', @res) . ')$';
}

Interval2Prefix.pm  view on Meta::CPAN

This type of conversion is particularly useful when working with
telephony switching equipment, which usually determines call routing
based on number prefixes rather than ranges.

Note that the numbers in the interval must be of the same length
for the result to make sense.

The algorithm is much dependent on the number base, which defaults to
10. Other number bases can be specified explicitly.

Interval2Prefix.pm  view on Meta::CPAN

=over 4

=item *

With interval2prefix(), the endpoints of the interval must be the
same length (same number of digits in the particular number base)
for the results to make any sense.

=item *

interval2regex() only does base 10.

 view release on metacpan or  search on metacpan

InversionList.pm  view on Meta::CPAN

 my $string = shift @_;

 # we need a valid string
 return undef unless defined $string;

 # handle trivial case of 0-length string
 return [] unless length $string;

 # this is suboptimal, we eventually want to do things in multiples of 8 (on byte boundaries)
 # $length is length in bits, we avoid b* because it will create a list 8 times larger than C*
 my @unpacked = unpack("C*", $string);
 my $length = scalar @unpacked * 8;
 my $current = vec($string, 0, 1);
 my $new;
 my @list;

 push @list, 0 if $current;

 foreach my $offset (0..$length)
 {  
  $new = vec($string, $offset, 1);
  if ($new != $current)
  {
   push @list, $offset;
  }
  $current = $new;
 }

 push @list, $length unless exists $list[-1] && $list[-1] == $length;

 return \@list;
}

sub data_from_invlist

InversionList.pm  view on Meta::CPAN

the numeric position of each switch between a run of 0 and 1 bits.
Thus, the data "111111100" is encoded as the list of numbers 0, 7 in
an inversion list.  This module begins the list with the start of the
run of 1's, so if the first 2 bits in the string are 0, the first
entry in the list will be a 2 (where we find the first bit that is 1).
The last number will always be the length of the string, so that we
know where to end it.

Inversion lists are very efficient.  Because of the way that Perl
stores scalars and lists and the various architectures to which Perl
has been ported, there is no definitive rule as to what's the exact
proportion of bit runs to bitstring length required to make inversion
lists efficient.  Generally, if you see long runs of repeated 0 or 1
bits, an inversion list may be appropriate.

This module stores inversion lists in an offset-based format which has
some nice properties, for instance searching is fast and you can

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

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|

ppport.h  view on Meta::CPAN

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|||

ppport.h  view on Meta::CPAN

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|||

ppport.h  view on Meta::CPAN

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

ppport.h  view on Meta::CPAN

#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

ppport.h  view on Meta::CPAN

#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)

ppport.h  view on Meta::CPAN

#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

 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;
}

 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;
}

 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(%$_) : @{$_} )
                  : ''

 view release on metacpan or  search on metacpan

XS.pm  view on Meta::CPAN

Most useful when computing multiple LCSs against a single file.

=item LCS(\@a,\@b)

Finds a Longest Common Subsequence, taking two arrayrefs as method
arguments.  In scalar context the return value is the length of the
subsequence.  In list context it yields a list of corresponding
indices, which are represented by 2-element array refs.  See the
L<Algorithm::Diff> manpage for more details.

=back

 view release on metacpan or  search on metacpan

LCSS.pm  view on Meta::CPAN

    my $match = CSS(@_);
    if ( ref $_[0] eq 'ARRAY' ) {
       @$match = map{$_->[0]}sort{$b->[1]<=>$a->[1]}map{[$_,scalar(@$_)]}@$match
    }
    else {
       @$match = map{$_->[0]}sort{$b->[1]<=>$a->[1]}map{[$_,length($_)]}@$match
    }
  return $match;
}

sub LCSS {
    my $is_array = ref $_[0] eq 'ARRAY' ? 1 : 0;
    my $css = CSS(@_);
    my $index;
    my $length = 0;
    if ( $is_array ) {
        for( my $i = 0; $i < @$css; $i++ ) {
            next unless @{$css->[$i]}>$length;
            $index = $i;
            $length = @{$css->[$i]};
        }
    }
    else {
        for( my $i = 0; $i < @$css; $i++ ) {
            next unless length($css->[$i])>$length;
            $index = $i;
            $length = length($css->[$i]);
        }
    }
  return $css->[$index];
}

LCSS.pm  view on Meta::CPAN

=head1 METHODS

=head2 LCSS

Returns the longest common sub sequence. If there may be more than one (with
exactly the same length) and it matters use CSS instead.

    my $lcss_ary_ref = LCSS( \@SEQ1, \@SEQ2 );  # ref to array
    my $lcss_string  = LCSS( $STR1, $STR2 );    # string

=head2 CSS

 view release on metacpan or  search on metacpan

lib/Algorithm/LDA.pm  view on Meta::CPAN

    #Also remove words of less than three letters
    my $D = @documents;
    for my $wd (0..$#words) 
    {
        my $times = $map{$words[$wd]};
        my $test = ($times > 0.5*$D  || $times<=$threshold || length($words[$wd]) <=3);    
	
        if($test)   
        {   
            $words[$wd]=0;
        }

lib/Algorithm/LDA.pm  view on Meta::CPAN

        
	#form a single big regex
        $stop_regex.="(".$_.")|";
    }

    if(length($stop_regex)<=0) 
    {
	print STDERR "No valid Perl Regular Experssion found in Stop file $stop";
	exit;
    }