Result:
found more than 563 distributions - search limited to the first 2001 files matching your query
( run in 0.446 )
Algorithm-LUHN
view release on metacpan or search on metacpan
lib/Algorithm/LUHN.pm view on Meta::CPAN
valid_chars(). If NUM is not valid, $Algorithm::LUHN::ERROR will contain the
reason.
This function is equivalent to
substr $N,length($N)-1 eq check_digit(substr $N,0,length($N)-1)
For example, C<4242 4242 4242 4242> is a valid Visa card number,
that is provided for test purposes. The final digit is '2',
which is the right check digit. If you change it to a '3', it's not
a valid card number. Ie:
lib/Algorithm/LUHN.pm view on Meta::CPAN
=cut
sub is_valid {
my $N = shift;
my $c = check_digit(substr($N, 0,length($N)-1));
if (defined $c) {
if (substr($N,length($N)-1, 1) eq $c) {
return 1;
} else {
$ERROR = "Check digit incorrect. Expected $c";
return '';
}
Algorithm-LUHN_XS
view release on metacpan or search on metacpan
lib/Algorithm/LUHN_XS.pm view on Meta::CPAN
valid_chars(). If NUM is not valid, $Algorithm::LUHN_XS::ERROR will contain the
reason.
This function is equivalent to
substr $N,length($N)-1 eq check_digit(substr $N,0,length($N)-1)
For example, C<4242 4242 4242 4242> is a valid Visa card number,
that is provided for test purposes. The final digit is '2',
which is the right check digit. If you change it to a '3', it's not
a valid card number. Ie:
Algorithm-LibLinear
view release on metacpan or search on metacpan
src/liblinear.xs view on Meta::CPAN
}
HV *feature_hash = (HV *)SvRV(feature);
hv_iterinit(feature_hash);
HE *nonzero_element;
while ((nonzero_element = hv_iternext(feature_hash))) {
I32 index_length;
int index = atoi(hv_iterkey(nonzero_element, &index_length));
if (max_feature_index < index) { max_feature_index = index; }
}
}
return max_feature_index;
}
src/liblinear.xs view on Meta::CPAN
int feature_vector_size =
hv_iterinit(feature_hash) + (has_bias ? 1 : 0) + 1;
struct feature_node *feature_vector;
Newx(feature_vector, feature_vector_size, struct feature_node);
char *index;
I32 index_length;
SV *value;
struct feature_node *curr = feature_vector;
while ((value = hv_iternextsv(feature_hash, &index, &index_length))) {
curr->index = atoi(index);
curr->value = SvNV(value);
++curr;
}
if (has_bias) {
Algorithm-Line-Bresenham
view release on metacpan or search on metacpan
lib/Algorithm/Line/Bresenham.pm view on Meta::CPAN
my $leftFn=sub{
my ($arg,$p,$l)=@_;
# C<$arg> is passed by calling routine,
# C<$p> is point on line
# C<$l> is length of line
return $p % $arg;
};
=cut
lib/Algorithm/Line/Bresenham.pm view on Meta::CPAN
my $y= $y0;
my $x= $x0;
my $threshold = $dx - 2*$dy;
my $E_diag= -2*$dx;
my $E_square= 2*$dy;
my $length = $dx+1;
my $D= sqrt($dx*$dx+$dy*$dy);
for(my $p=0;$p<$length;$p++)
{
my $w_left= $left->($argL, $p, $length)*2*$D;
my $w_right= $right->($argR,$p, $length)*2*$D;
push @xPoints,x_perpendicular($x,$y, $dx, $dy, $pxstep, $pystep,
$p_error,$w_left,$w_right,$error);
if ($error>=$threshold)
{
$y= $y + $ystep;
lib/Algorithm/Line/Bresenham.pm view on Meta::CPAN
my $y= $y0;
my $x= $x0;
my $threshold = $dy - 2*$dx;
my $E_diag= -2*$dy;
my $E_square= 2*$dx;
my $length = $dy+1;
my $D= sqrt($dx*$dx+$dy*$dy);
for(my $p=0;$p<$length;$p++)
{
my $w_left= $left->($argL, $p, $length)*2*$D;
my $w_right= $right->($argR,$p, $length)*2*$D;
push @yPoints,y_perpendicular($x,$y, $dx, $dy, $pxstep, $pystep,
$p_error,$w_left,$w_right,$error);
if ($error>=$threshold)
{
$x= $x + $xstep;
Algorithm-Line-Lerp
view release on metacpan or search on metacpan
CopSTASHPV_set|5.017001|5.017001|p
CopSTASH_set|5.006000|5.003007|p
cop_store_label|5.031004|5.031004|x
Copy|5.003007|5.003007|
CopyD|5.009002|5.003007|p
copy_length|||Viu
core_prototype|5.015002||Vi
coresub_op|5.015003||Viu
CowREFCNT|5.017007||Viu
cPADOP|5.006000||Viu
cPADOPo|5.006000||Viu
KEY_kill|5.003007||Viu
KEY_last|5.003007||Viu
KEY_lc|5.003007||Viu
KEY_lcfirst|5.003007||Viu
KEY_le|5.003007||Viu
KEY_length|5.003007||Viu
KEY___LINE|5.003007||Viu
KEY_link|5.003007||Viu
KEY_listen|5.003007||Viu
KEY_local|5.003007||Viu
KEY_localtime|5.003007||Viu
mg_free_type|5.013006|5.013006|
MGf_REFCOUNTED|5.003007||Viu
MGf_REQUIRE_GV|5.021004||Viu
MGf_TAINTEDDIR|5.003007||Viu
mg_get|5.003007|5.003007|
mg_length|5.005000|5.005000|d
mg_localize|5.009003||Vi
mg_magical|5.003007|5.003007|n
MgPV|5.003007||Viu
MgPV_const|5.009003||Viu
MgPV_nolen_const|5.009003||Viu
regnode_guts_debug|||Viu
REGNODE_MAX|5.009004||Viu
REGNODE_SIMPLE|5.013002||Viu
REGNODE_VARIES|5.013002||Viu
reg_numbered_buff_fetch|5.009005||cViu
reg_numbered_buff_length|5.009005||cViu
reg_numbered_buff_store|5.009005||cViu
regpiece|5.005000||Viu
regpnode|5.031010||Viu
regprop|5.003007||Viu
reg_qr_package|5.009005||cViu
UTF8_IS_REPLACEMENT|||
UTF8_IS_START|5.007001||Viu
UTF8_IS_START_base|5.031007||Viu
UTF8_IS_SUPER|5.023002|5.023002|
UTF8_IS_SURROGATE|5.023002|5.023002|
utf8_length|5.007001|5.007001|
UTF8_MAXBYTES|5.009002|5.006000|p
UTF8_MAXBYTES_CASE|5.009002|5.003007|p
UTF8_MAX_FOLD_CHAR_EXPAND|5.013009||Viu
UTF8_MAXLEN|5.006000||Viu
utf8_mg_len_cache_update|5.013003||Viu
next if $API{$f}{beyond_depr};
next if $API{$f}{inaccessible};
next if $API{$f}{experimental};
next unless $API{$f}{todo};
next if int_parse_version($API{$f}{todo}) <= $int_min_perl;
my $repeat = 40 - length($f);
$repeat = 0 if $repeat < 0;
print "$f ", '.'x $repeat, " ", format_version($API{$f}{todo}), "\n";
}
exit 0;
}
my $end_of_hint = 0;
# A line containing a comment end marker closes the hint. Remove that
# marker for processing below.
if (s/\s*$rcce(.*?)\s*$//) {
die "Nothing can follow the end of comment in '$_'\n" if length $1 > 0;
$end_of_hint = 1;
}
# Set $h to the hash of which type.
my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
#ifndef ERRSV
# define ERRSV get_sv("@",FALSE)
#endif
/* Hint: gv_stashpvn
* This function's backport doesn't support the length parameter, but
* rather ignores it. Portability can only be ensured if the length
* parameter is used for speed reasons, but the length can always be
* correctly computed from the string argument.
*/
#ifndef gv_stashpvn
# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
#endif
/* The actual implementation of the backported macros. If too short, croak,
* otherwise call the original that doesn't have an upper limit parameter */
# define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l) \
(((((e) - (s)) <= 0) \
/* We could just do nothing, but modern perls croak */ \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
# define D_PPP_UV_TO_UTF8 uvchr_to_utf8
# else
# define D_PPP_UV_TO_UTF8 uv_to_utf8
# endif
/* Get the utf8 of the case changed value, and store its length; then have
* to re-calculate the changed case value in order to return it */
# define D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(name, c, s, l) \
(*(l) = (D_PPP_UV_TO_UTF8(s, \
UNI_TO_NATIVE(to_uni_ ## name(NATIVE_TO_UNI(c)))) - (s)), \
UNI_TO_NATIVE(to_uni_ ## name(NATIVE_TO_UNI(c))))
# define toFOLD_uvchr(c, s, l) toLOWER_uvchr(c, s, l)
#endif
# define D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(name, s, e, r, l) \
(((((e) - (s)) <= 0) \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
/* Get the changed code point and store its UTF-8 */ \
: D_PPP_UV_TO_UTF8(r, to_utf8_ ## name(s)), \
/* Then store its length, and re-get code point for return */ \
*(l) = UTF8SKIP(r), to_utf8_ ## name(r))
/* Warning: toUPPER_utf8_safe, toLOWER_utf8_safe, toTITLE_utf8_safe,
* toUPPER_uvchr, toLOWER_uvchr, toTITLE_uvchr
The UTF-8 case changing operations had bugs before around 5.12 or 5.14;
#endif
#ifndef HvNAMELEN_get
# define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
#endif
#if (PERL_BCDVERSION >= 0x5009002) && (PERL_BCDVERSION <= 0x5009003) /* 5.9.2 and 5.9.3 ignore the length param */
#undef gv_fetchpvn_flags
#endif
#ifdef GV_NOADD_MASK
# define D_PPP_GV_NOADD_MASK GV_NOADD_MASK
Size_t
DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
{
Size_t used, length, copy;
used = strlen(dst);
length = strlen(src);
if (size > 0 && used < size - 1) {
copy = (length >= size - used) ? size - used - 1 : length;
memcpy(dst + used, src, copy);
dst[used + copy] = '\0';
}
return used + length;
}
#endif
#endif
#if !defined(my_strlcpy)
Size_t
DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
{
Size_t length, copy;
length = strlen(src);
if (size > 0) {
copy = (length >= size) ? size - 1 : length;
memcpy(dst, src, copy);
dst[copy] = '\0';
}
return length;
}
#endif
#endif
DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)
{
# if (PERL_BCDVERSION >= 0x5031004) /* But from above, must be < 5.35.10 */
# if (PERL_BCDVERSION != 0x5035009)
/* Versions less than 5.35.9 could dereference s on zero length, so
* pass it something where no harm comes from that. */
if (send <= s) s = send = (U8 *) "?";
return Perl_utf8_to_uvchr_buf_helper(aTHX_ s, send, retlen);
# else /* Below is 5.35.9, which also works on non-empty input, but
STRLEN curlen;
bool overflows = 0;
const U8 *cur_s = s;
const bool do_warnings = ckWARN_d(WARN_UTF8);
# if (PERL_BCDVERSION < 0x5026000) && ! defined(EBCDIC)
STRLEN overflow_length = 0;
# endif
if (send > s) {
curlen = send - s;
}
/* First, on a 32-bit machine the first byte being at least \xFE
* automatically is overflow, as it indicates something requiring more
* than 31 bits */
if (sizeof(ret) < 8) {
overflows = 1;
overflow_length = (*s == 0xFE) ? 7 : 13;
}
else {
const U8 highest[] = /* 2*63-1 */
"\xFF\x80\x87\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF";
const U8 *cur_h = highest;
/* Here, either we set the bool and broke out of the loop, or got
* to the end and all bytes are the same which indicates it doesn't
* overflow. If it did overflow, it would be this number of bytes
* */
overflow_length = 13;
}
}
if (UNLIKELY(overflows)) {
ret = 0;
if (! do_warnings && retlen) {
*retlen = overflow_length;
}
}
else
# endif /* < 5.26 */
ret = UNICODE_REPLACEMENT;
# if (PERL_BCDVERSION < 0x5016000)
/* Versions earlier than this don't necessarily return the proper
* length. It should not extend past the end of string, nor past
* what the first byte indicates the length is, nor past the
* continuation characters */
if (retlen && (IV) *retlen >= 0) {
unsigned int i = 1;
*retlen = D_PPP_MIN(*retlen, curlen);
Algorithm-Loops
view release on metacpan or search on metacpan
lib/Algorithm/Loops.pm view on Meta::CPAN
etc.:
my @sorted= Filter {
s#\d{2}(\d+)#\1#g
} sort Filter {
s#(\d+)# sprintf "%02d%s", length($1), $1 #g
} @data;
[ Note that at least some versions of Perl have a bug that breaks C<sort>
if you write C<sub {> as part of building the list of items to be sorted
but you don't provide a comparison routine. This bug means we can't
write the previous code as:
my @sorted= Filter {
s#\d{2}(\d+)#\1#g
} sort Filter sub {
s#(\d+)# sprintf "%02d%s", length($1), $1 #g
}, @data;
because it will produce the following error:
Undefined subroutine in sort
lib/Algorithm/Loops.pm view on Meta::CPAN
to write it like this:
my @sorted= Filter {
s#\d{2}(\d+)#\1#g
} sort &Filter( sub {
s#(\d+)# sprintf "%02d%s", length($1), $1 #g
}, @data );
Which is how I wrote it in ex/NaturalSort.plx. ]
Need to sort names? Then you'll probably want to ignore letter case and
lib/Algorithm/Loops.pm view on Meta::CPAN
=head3 Differences
The different MapCar* functions are only different in how they deal with
being pqssed arrays that are not all of the same size.
If not all of your arrays are the same length, then MapCarU() will pass
in C<undef> for any values corresponding to arrays that didn't have
enough values. The "U" in "MapCarU" stands for "undef".
In contrast, MapCar() will simply leave out values for short arrays (just
like I left the "U" out of its name).
MapCarE() will croak without ever calling your subroutine unless all of
the arrays are the same length. It considers it an Error if your arrays
are not of Equal length and so throws an Exception.
Finally, MapCarMin() only calls your subroutine as many times as there
are elements in the B<shortest> array.
In other words,
lib/Algorithm/Loops.pm view on Meta::CPAN
Transposing a two-dimensional matrix:
my @transposed= MapCarE {[@_]} @matrix;
or, using references to the matrices and allowing for different row
lengths:
my $transposed= MapCarU {[@_]} @$matrix;
Formatting a date-time:
Algorithm-MLCS
view release on metacpan or search on metacpan
lib/Algorithm/MLCS.pm view on Meta::CPAN
@ISA = qw/ Exporter /;
@EXPORT = qw/ lcs /;
$VERSION = '1.02';
# Gets arrayref of sequences (arrayrefs) and return LCS array in list context
# or length of LCS in scalar context
sub lcs {
my ( @seq, @lcs ) = map { _build_seq($_) } _get_dict( $_[0] );
while ( @seq && !( grep { !@$_ } @seq ) ) {
my %dict = ( %{ $seq[0][0] } );
lib/Algorithm/MLCS.pm view on Meta::CPAN
[ qw/a b c x f h j q z/ ],
[ qw/a b c f g j q z/ ],
);
my @lcs = lcs( \@seqs );
my $lcs_length = lcs( \@seqs );
print Dumper( \@lcs );
=head1 ABSTRACT
Finding the longest common subsequence (LCS) for the general case of an arbitrary
lib/Algorithm/MLCS.pm view on Meta::CPAN
=head2 lcs ( \@seqs )
Finds a Longest Common Subsequence of multiple sequences given by @seqs arrayref.
Each element of @seqs is arrayref that represents the one of multiple sequences
(e.g. [ ['a', 'b', 'c'], ['a', 'c', 'd', 'e'], ... ]). In list context it returns
LCS array, in scalar - the length of LCS.
=head1 SEE ALSO
Algorithm::LCS
Algorithm-MarkovChain
view release on metacpan or search on metacpan
lib/Algorithm/MarkovChain.pm view on Meta::CPAN
local $; = $self->{seperator};
my $l = 0;
for (keys %{ $self->{chains} }) {
my @tmp = split $;, $_;
my $length = scalar @tmp;
$l = $length if $length > $l;
}
return $l;
}
lib/Algorithm/MarkovChain.pm view on Meta::CPAN
# learn about things from @symbols
$chain->seed(symbols => \@symbols,
longest => 6);
# attempt to tell me something about the sky
my @newness = $chain->spew(length => 20,
complete => [ qw( the sky is ) ]);
=head1 DESCRIPTION
Algorithm::MarkovChain is an implementation of the Markov Chain
lib/Algorithm/MarkovChain.pm view on Meta::CPAN
=item $obj->spew()
Uses the constructed chains to produce symbol streams
Takes four optional parameters C<complete>, C<length>,
C<longest_subchain>, C<force_length>, C<stop_at_terminal> and
C<strict_start>
C<complete> provides a starting point for the generation of output.
Note: the algorithm will discard elements of this list if it does not
find a starting chain that matches it, this is infinite-loop avoidance.
C<length> specifies the minimum number of symbols desired (default is 30)
C<stop_at_terminal> directs the spew to stop chaining at the first
terminal point reached
C<force_length> ensures you get exactly C<length> symbols returned
(note this overrides the behaviour of C<stop_at_terminal>)
C<strict_start> makes the spew operation always take a known start
state rather than selecting a sequence at random
Algorithm-MasterMind
view release on metacpan or search on metacpan
app/run_experiment_all.pl view on Meta::CPAN
my $method_options = $conf->{'Method_options'};
$io->print( $method, $method_options );
my $engine = variations_with_repetition($method_options->{'alphabet'},
$method_options->{'length'});
my $combination;
my $repeats = $conf->{'repeats'} || 10;
while ( $combination = $engine->next() ) {
my $secret_code = join("",@$combination);
Algorithm-MedianSelect-XS
view release on metacpan or search on metacpan
ck_fun|||
ck_glob|||
ck_grep|||
ck_index|||
ck_join|||
ck_lengthconst|||
ck_lfun|||
ck_listiob|||
ck_match|||
ck_method|||
ck_null|||
mg_copy|||
mg_dup|||
mg_find|||
mg_free|||
mg_get|||
mg_length||5.005000|
mg_localize|||
mg_magical|||
mg_set|||
mg_size||5.005000|
mini_mktime||5.007002|
reg_named_buff_scalar||5.009005|
reg_named_buff|||
reg_namedseq|||
reg_node|||
reg_numbered_buff_fetch|||
reg_numbered_buff_length|||
reg_numbered_buff_store|||
reg_qr_package|||
reg_recode|||
reg_scan_name|||
reg_skipcomment|||
usage|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|
utf8_distance||5.006000|
utf8_hop||5.006000|
utf8_length||5.007001|
utf8_mg_pos_cache_update|||
utf8_to_bytes||5.006001|
utf8_to_uvchr||5.007001|
utf8_to_uvuni||5.007001|
utf8n_to_uvchr|||
if (exists $opt{'list-unsupported'}) {
my $f;
for $f (sort { lc $a cmp lc $b } keys %API) {
next unless $API{$f}{todo};
print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
}
exit 0;
}
# Scan for possible replacement candidates
? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
: newSV(0))
#endif
/* Hint: gv_stashpvn
* This function's backport doesn't support the length parameter, but
* rather ignores it. Portability can only be ensured if the length
* parameter is used for speed reasons, but the length can always be
* correctly computed from the string argument.
*/
#ifndef gv_stashpvn
# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
#endif
#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
Size_t
DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
{
Size_t used, length, copy;
used = strlen(dst);
length = strlen(src);
if (size > 0 && used < size - 1) {
copy = (length >= size - used) ? size - used - 1 : length;
memcpy(dst + used, src, copy);
dst[used + copy] = '\0';
}
return used + length;
}
#endif
#endif
#if !defined(my_strlcpy)
#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
Size_t
DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
{
Size_t length, copy;
length = strlen(src);
if (size > 0) {
copy = (length >= size) ? size - 1 : length;
memcpy(dst, src, copy);
dst[copy] = '\0';
}
return length;
}
#endif
#endif
Algorithm-Merge
view release on metacpan or search on metacpan
my $conflict = $callbacks->{'CONFLICT'} || sub { };
my $b_len = scalar(@{$bdoc});
my $c_len = scalar(@{$cdoc});
my $target_len = $b_len < $c_len ? $b_len : $c_len;
my $bc_different_lengths = $b_len != $c_len;
my(@bdoc_save, @cdoc_save);
# make these into traverse_sequences calls
my($left, $right);
@diffs{(AC_A, AC_C)} = ([], []);
$left = AC_A; $right = AC_C;
Algorithm::Diff::traverse_sequences( $adoc, $cdoc, $ts_callbacks, $keyGen, @_);
if($bc_different_lengths) {
@diffs{(CB_C, CB_B)} = ([], []);
$left = CB_C; $right = CB_B;
Algorithm::Diff::traverse_sequences( $cdoc, $bdoc, $ts_callbacks, $keyGen, @_);
example does not work, send it to <jsmith@cpan.org> or report it on
<http://rt.cpan.org/>, the CPAN bug tracker.
L<Algorithm::Diff|Algorithm::Diff>'s implementation of
C<traverse_sequences> may not be symmetric with respect to the input
sequences if the second and third sequence are of different lengths.
Because of this, C<traverse_sequences3> will calculate the diffs of
the second and third sequences as passed and swapped. If the differences
are not the same, it will issue an `Algorithm::Diff::diff is not symmetric
for second and third sequences...' warning. It will try to handle
this, but there may be some cases where it can't.
Algorithm-MinPerfHashTwoLevel
view release on metacpan or search on metacpan
lib/Algorithm/MinPerfHashTwoLevel.pm view on Meta::CPAN
sub _seed {
my $self= shift;
if (@_) {
my $seed= shift;
Carp::confess(sprintf "Seed should be undef, or a string exactly %d bytes long, not %d bytes",
STADTX_HASH_SEED_BYTES,length($seed))
if defined($seed) and length($seed) != 16;
$self->{seed}= $seed;
delete $self->{state};
}
if ( !defined $self->{seed} ) {
#1234567812345678
Algorithm-Munkres
view release on metacpan or search on metacpan
t/DoubleInvoke.t view on Meta::CPAN
# A script to run tests on the Algorithm::Mukres module.
# The following are among the tests run by this script:
# This test case checks the module with normal input values, i.e. without fractions/negative values/zeros etc.
# 1. Try loading the Algorithm::Munkres i.e. is it added to the @INC variable
# 2. Compare the lengths of the Solution array and the Output array.
# 3. Compare each element of the Solution array and the Output array.
use strict;
use warnings;
t/DoubleInvoke.t view on Meta::CPAN
my @assign_out = ();
my $i = 0;
assign(\@mat,\@assign_out);
#Compare the lengths of the Solution array and the Output array.
is($#soln, $#assign_out, 'Compare the lengths of the Solution array and the Output array.');
#Compare each element of the Solution array and the Output array.
for($i = 0; $i <= $#assign_out; $i++)
{
is($soln[$i], $assign_out[$i], "Compare $i element of the Solution array and the Output array")
t/DoubleInvoke.t view on Meta::CPAN
@assign_out = ();
assign(\@mat,\@assign_out);
#Compare the lengths of the Solution array and the Output array.
is($#soln, $#assign_out, 'Compare the lengths of the Solution array and the Output array.');
#Compare each element of the Solution array and the Output array.
for($i = 0; $i <= $#assign_out; $i++)
{
is($soln[$i], $assign_out[$i], "Compare $i element of the Solution array and the Output array")
Algorithm-NeedlemanWunsch
view release on metacpan or search on metacpan
lib/Algorithm/NeedlemanWunsch.pm view on Meta::CPAN
| |
sequence B: t g a t - -
(and exponentially many other ways, of course). Note that
Needleman-Wunsch considers I<global> alignments, over the entire
length of both sequences; each item is either aligned with an item of
the other sequence, or corresponds to a I<gap> (which is always
aligned with an item - aligning two gaps wouldn't help anything). This
approach is especially suitable for comparing sequences of comparable
length and somewhat similar along their whole lengths - that is,
without long stretches that have nothing to do with each other. If
your sequences don't satisfy these requirements, consider using local
alignment, which, strictly speaking, isn't Needleman-Wunsch, but is
similar enough to be implemented in this module as well - see below
for details.
Algorithm-Networksort
view release on metacpan or search on metacpan
lib/Algorithm/Networksort.pm view on Meta::CPAN
has network => (
isa => 'ArrayRef[ArrayRef[Int]]', is => 'rw', required => 0,
predicate => 'has_network',
);
has ['depth', 'length'] => (
isa => 'Int', is => 'rw', required => 0,
init_arg => 0,
);
has creator => (
lib/Algorithm/Networksort.pm view on Meta::CPAN
# Providing our own-grown network?
#
if ($alg eq 'none')
{
croak "No comparators provided" unless ($self->has_comparators);
$self->length(scalar @{ $self->comparators });
#
# Algorithm::Networksort::Best will set these, so
# only go through with this if this is a user-provided
# sequence of comparators.
lib/Algorithm/Networksort.pm view on Meta::CPAN
@network = oddeventransposition($inputs) if ($alg eq 'oddeventrans');
@network = balanced($inputs) if ($alg eq 'balanced');
@network = oddevenmerge($inputs) if ($alg eq 'oddevenmerge');
$self->title($algname{$alg} . " for N = " . $inputs) unless ($self->has_title);
$self->length(scalar @network);
$self->comparators(\@network); # The 'raw' list of comparators.
#
# Re-order the comparator list using the parallel grouping for
# the graphs. The resulting parallelism means less stalling
lib/Algorithm/Networksort.pm view on Meta::CPAN
my @comparators;
my($bit, $xbit, $ybit);
#
# $t = ceiling(log2($inputs - 1)); but we'll
# find it using the length of the bitstring.
#
my $t = length sprintf("%b", $inputs - 1);
my $lastbit = 1 << $t;
#
# $x and $y are the comparator endpoints.
lib/Algorithm/Networksort.pm view on Meta::CPAN
return bn_split(0, $inputs);
}
#
# @comparators = bn_split($i, $length);
#
# The helper function that divides the range to be sorted.
#
# Note that the work of splitting the ranges is performed with the
# 'length' variables. The $i variable merely acts as a starting
# base, and could easily have been 1 to begin with.
#
sub bn_split
{
my($i, $length) = @_;
my @comparators = ();
#
### bn_split():
#### $i
#### $length
#
if ($length >= 2)
{
my $mid = $length >> 1;
push @comparators, bn_split($i, $mid);
push @comparators, bn_split($i + $mid, $length - $mid);
push @comparators, bn_merge($i, $mid, $i + $mid, $length - $mid);
}
#
### bn_split() returns
##### @comparators
#
return @comparators;
}
#
# @comparators = bn_merge($i, $length_i, $j, $length_j);
#
# The other helper function that adds comparators to the list, for a
# given pair of ranges.
#
# As with bn_split, the different conditions all depend upon the
# lengths of the ranges. The $i and $j variables merely act as
# starting bases.
#
sub bn_merge
{
my($i, $length_i, $j, $length_j) = @_;
my @comparators = ();
#
### bn_merge():
#### $i
#### $length_i
#### $j
#### $length_j
#
if ($length_i == 1 && $length_j == 1)
{
push @comparators, [$i, $j];
}
elsif ($length_i == 1 && $length_j == 2)
{
push @comparators, [$i, $j + 1];
push @comparators, [$i, $j];
}
elsif ($length_i == 2 && $length_j == 1)
{
push @comparators, [$i, $j];
push @comparators, [$i + 1, $j];
}
else
{
my $i_mid = int($length_i/2);
my $j_mid = int(($length_i & 1)? $length_j/2: ($length_j + 1)/2);
push @comparators, bn_merge($i, $i_mid, $j, $j_mid);
push @comparators, bn_merge($i + $i_mid, $length_i - $i_mid, $j + $j_mid, $length_j - $j_mid);
push @comparators, bn_merge($i + $i_mid, $length_i - $i_mid, $j, $j_mid);
}
#
### bn_merge() returns
##### @comparators
lib/Algorithm/Networksort.pm view on Meta::CPAN
my $inputs = shift;
my @network;
#
# $t = ceiling(log2($inputs)); but we'll
# find it using the length of the bitstring.
#
my $t = length sprintf("%b", $inputs);
my $p = 1 << ($t -1);
while ($p > 0)
{
lib/Algorithm/Networksort.pm view on Meta::CPAN
my ($lo, $n, $dir) = @_;
if ($n > 1) {
#
# $t = ceiling(log2($n - 1)); but we'll
# find it using the length of the bitstring.
#
my $t = length sprintf("%b", $n - 1);
my $m = 1 << ($t - 1);
for my $i ($lo .. $lo+$n-$m-1)
{
lib/Algorithm/Networksort.pm view on Meta::CPAN
my $inputs = shift;
my @network;
#
# $t = ceiling(log2($inputs - 1)); but we'll
# find it using the length of the bitstring.
#
my $t = length sprintf("%b", $inputs - 1);
for (1 .. $t)
{
for (my $curr = 1 << $t; $curr > 1; $curr >>= 1)
{
lib/Algorithm/Networksort.pm view on Meta::CPAN
my $inputs = shift;
my @network;
#
# $t = ceiling(log2($inputs - 1)); but we'll
# find it using the length of the bitstring.
#
my $t = length sprintf("%b", $inputs - 1);
my ($add_elem, $sort, $merge);
$add_elem = sub {
my ($i, $j) = @_;
lib/Algorithm/Networksort.pm view on Meta::CPAN
The chances that you will need to use this function are slim, but the
following code snippet may represent an example:
my $nw = Algorithm::Networksort->new(inputs => 8, algorithm => 'batcher');
print "There are ", $nw->length(),
" comparators in this network, grouped into\n",
$nw->depth(), " parallel operations.\n\n";
print $nw, "\n";
lib/Algorithm/Networksort.pm view on Meta::CPAN
{
carp "Color '$color' is not in six or three hexadecimal digit RGB form.";
$color = "000";
}
if (length $color == 3)
{
$color =~ s/(.)(.)(.)/$1$1 $2$2 $3$3/;
}
elsif (length $color == 6)
{
$color =~ s/(..)(..)(..)/$1 $2 $3/;
}
else
{
Algorithm-Odometer-Tiny
view release on metacpan or search on metacpan
t/algorithm_odometer_tiny.t view on Meta::CPAN
{
my @wheels = ( ['foo','bar'], [3..6], ['quz','baz'] );
my $odo = Algorithm::Odometer::Gray->new(@wheels);
# note the following generates two "used only once" warnings on Perls 5.8 thru 5.18, that's ok
my $exp_len = reduce { $a * $b } map {0+@$_} @wheels; # product() was added in List::Util 1.35
is $exp_len, 16, 'expected length calc is correct';
my @c = $odo->();
is_deeply \@c, ['foo','3','quz'], 'basic ::Gray test 1/2';
my @o;
while (<$odo>) { push @o, $_ }
is_deeply \@o, [qw/ bar3quz bar4quz foo4quz foo5quz bar5quz bar6quz foo6quz
Algorithm-PageRank-XS
view release on metacpan or search on metacpan
ck_fun|||
ck_glob|||
ck_grep|||
ck_index|||
ck_join|||
ck_lengthconst|||
ck_lfun|||
ck_listiob|||
ck_match|||
ck_method|||
ck_null|||
mg_copy|||
mg_dup|||
mg_find|||
mg_free|||
mg_get|||
mg_length||5.005000|
mg_localize|||
mg_magical|||
mg_set|||
mg_size||5.005000|
mini_mktime||5.007002|
reg_named_buff_scalar||5.009005|
reg_named_buff|||
reg_namedseq|||
reg_node|||
reg_numbered_buff_fetch|||
reg_numbered_buff_length|||
reg_numbered_buff_store|||
reg_qr_package|||
reg_recode|||
reg_scan_name|||
reg_skipcomment|||
usage|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|
utf8_distance||5.006000|
utf8_hop||5.006000|
utf8_length||5.007001|
utf8_mg_pos_cache_update|||
utf8_to_bytes||5.006001|
utf8_to_uvchr||5.007001|
utf8_to_uvuni||5.007001|
utf8n_to_uvchr|||
if (exists $opt{'list-unsupported'}) {
my $f;
for $f (sort { lc $a cmp lc $b } keys %API) {
next unless $API{$f}{todo};
print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
}
exit 0;
}
# Scan for possible replacement candidates
#ifndef ERRSV
# define ERRSV get_sv("@",FALSE)
#endif
/* Hint: gv_stashpvn
* This function's backport doesn't support the length parameter, but
* rather ignores it. Portability can only be ensured if the length
* parameter is used for speed reasons, but the length can always be
* correctly computed from the string argument.
*/
#ifndef gv_stashpvn
# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
#endif
#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
Size_t
DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
{
Size_t used, length, copy;
used = strlen(dst);
length = strlen(src);
if (size > 0 && used < size - 1) {
copy = (length >= size - used) ? size - used - 1 : length;
memcpy(dst + used, src, copy);
dst[used + copy] = '\0';
}
return used + length;
}
#endif
#endif
#if !defined(my_strlcpy)
#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
Size_t
DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
{
Size_t length, copy;
length = strlen(src);
if (size > 0) {
copy = (length >= size) ? size - 1 : length;
memcpy(dst, src, copy);
dst[copy] = '\0';
}
return length;
}
#endif
#endif
Algorithm-Pair-Best2
view release on metacpan or search on metacpan
lib/Algorithm/Pair/Best2.pm view on Meta::CPAN
### $seen{$idxs[$idx]} = $seen{$idxs[$idx + 1]} = 1;
### push @pairs, join '-', sort $idxs[$idx], $idxs[$idx + 1];
### $idx += 2;
### }
### my $key = join ',', sort @pairs;
### # $key = ' ' x (25 - length $key) . $key;
### return $key;
### }
###
#### you might want to adjust this for your items...
### sub print_items {
Algorithm-Permute
view release on metacpan or search on metacpan
bench/benchmark.pl view on Meta::CPAN
return $fact[$n] if defined $fact[$n];
$fact[$n] = $n * factorial($n - 1);
}
}
# n2pat($N, $len) : produce the $N-th pattern of length $len
sub n2pat {
my $i = 1;
my $N = shift;
my $len = shift;
my @pat;
Algorithm-Prefixspan
view release on metacpan or search on metacpan
lib/Algorithm/Prefixspan.pm view on Meta::CPAN
options:
# set minimum support (default: 2)
$prefixspan->{'minsup'} = 2
# set minimum pattern length (default: 1)
$prefixspan->{'len'} = 1
=head1 DESCRIPTION
Algorithm-QuadTree-XS
view release on metacpan or search on metacpan
CopSTASHPV_set|5.017001|5.017001|p
CopSTASH_set|5.006000|5.003007|p
cop_store_label|5.031004|5.031004|x
Copy|5.003007|5.003007|
CopyD|5.009002|5.003007|p
copy_length|||Viu
core_prototype|5.015002||Vi
coresub_op|5.015003||Viu
CowREFCNT|5.017007||Viu
cPADOP|5.006000||Viu
cPADOPo|5.006000||Viu
KEY_kill|5.003007||Viu
KEY_last|5.003007||Viu
KEY_lc|5.003007||Viu
KEY_lcfirst|5.003007||Viu
KEY_le|5.003007||Viu
KEY_length|5.003007||Viu
KEY___LINE|5.003007||Viu
KEY_link|5.003007||Viu
KEY_listen|5.003007||Viu
KEY_local|5.003007||Viu
KEY_localtime|5.003007||Viu
mg_free_type|5.013006|5.013006|
MGf_REFCOUNTED|5.003007||Viu
MGf_REQUIRE_GV|5.021004||Viu
MGf_TAINTEDDIR|5.003007||Viu
mg_get|5.003007|5.003007|
mg_length|5.005000|5.005000|d
mg_localize|5.009003||Vi
mg_magical|5.003007|5.003007|n
MgPV|5.003007||Viu
MgPV_const|5.009003||Viu
MgPV_nolen_const|5.009003||Viu
regnode_guts_debug|||Viu
REGNODE_MAX|5.009004||Viu
REGNODE_SIMPLE|5.013002||Viu
REGNODE_VARIES|5.013002||Viu
reg_numbered_buff_fetch|5.009005||cViu
reg_numbered_buff_length|5.009005||cViu
reg_numbered_buff_store|5.009005||cViu
regpiece|5.005000||Viu
regpnode|5.031010||Viu
regprop|5.003007||Viu
reg_qr_package|5.009005||cViu
UTF8_IS_REPLACEMENT|||
UTF8_IS_START|5.007001||Viu
UTF8_IS_START_base|5.031007||Viu
UTF8_IS_SUPER|5.023002|5.023002|
UTF8_IS_SURROGATE|5.023002|5.023002|
utf8_length|5.007001|5.007001|
UTF8_MAXBYTES|5.009002|5.006000|p
UTF8_MAXBYTES_CASE|5.009002|5.003007|p
UTF8_MAX_FOLD_CHAR_EXPAND|5.013009||Viu
UTF8_MAXLEN|5.006000||Viu
utf8_mg_len_cache_update|5.013003||Viu
next if $API{$f}{beyond_depr};
next if $API{$f}{inaccessible};
next if $API{$f}{experimental};
next unless $API{$f}{todo};
next if int_parse_version($API{$f}{todo}) <= $int_min_perl;
my $repeat = 40 - length($f);
$repeat = 0 if $repeat < 0;
print "$f ", '.'x $repeat, " ", format_version($API{$f}{todo}), "\n";
}
exit 0;
}
my $end_of_hint = 0;
# A line containing a comment end marker closes the hint. Remove that
# marker for processing below.
if (s/\s*$rcce(.*?)\s*$//) {
die "Nothing can follow the end of comment in '$_'\n" if length $1 > 0;
$end_of_hint = 1;
}
# Set $h to the hash of which type.
my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
#ifndef ERRSV
# define ERRSV get_sv("@",FALSE)
#endif
/* Hint: gv_stashpvn
* This function's backport doesn't support the length parameter, but
* rather ignores it. Portability can only be ensured if the length
* parameter is used for speed reasons, but the length can always be
* correctly computed from the string argument.
*/
#ifndef gv_stashpvn
# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
#endif
/* The actual implementation of the backported macros. If too short, croak,
* otherwise call the original that doesn't have an upper limit parameter */
# define D_PPP_GENERIC_MULTI_ARG_TO(name, s, e,r,l) \
(((((e) - (s)) <= 0) \
/* We could just do nothing, but modern perls croak */ \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
# define D_PPP_UV_TO_UTF8 uvchr_to_utf8
# else
# define D_PPP_UV_TO_UTF8 uv_to_utf8
# endif
/* Get the utf8 of the case changed value, and store its length; then have
* to re-calculate the changed case value in order to return it */
# define D_PPP_GENERIC_SINGLE_ARG_TO_UVCHR(name, c, s, l) \
(*(l) = (D_PPP_UV_TO_UTF8(s, \
UNI_TO_NATIVE(to_uni_ ## name(NATIVE_TO_UNI(c)))) - (s)), \
UNI_TO_NATIVE(to_uni_ ## name(NATIVE_TO_UNI(c))))
# define toFOLD_uvchr(c, s, l) toLOWER_uvchr(c, s, l)
#endif
# define D_PPP_GENERIC_SINGLE_ARG_TO_UTF8(name, s, e, r, l) \
(((((e) - (s)) <= 0) \
? (croak("Attempting case change on zero length string"), \
0) /* So looks like it returns something, and will compile */ \
: ((e) - (s)) < UTF8SKIP(s)) \
? (croak(D_PPP_TOO_SHORT_MSG, \
s[0], (int) ((e) - (s)), (int) UTF8SKIP(s)), \
0) \
/* Get the changed code point and store its UTF-8 */ \
: D_PPP_UV_TO_UTF8(r, to_utf8_ ## name(s)), \
/* Then store its length, and re-get code point for return */ \
*(l) = UTF8SKIP(r), to_utf8_ ## name(r))
/* Warning: toUPPER_utf8_safe, toLOWER_utf8_safe, toTITLE_utf8_safe,
* toUPPER_uvchr, toLOWER_uvchr, toTITLE_uvchr
The UTF-8 case changing operations had bugs before around 5.12 or 5.14;
#endif
#ifndef HvNAMELEN_get
# define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
#endif
#if (PERL_BCDVERSION >= 0x5009002) && (PERL_BCDVERSION <= 0x5009003) /* 5.9.2 and 5.9.3 ignore the length param */
#undef gv_fetchpvn_flags
#endif
#ifdef GV_NOADD_MASK
# define D_PPP_GV_NOADD_MASK GV_NOADD_MASK
Size_t
DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
{
Size_t used, length, copy;
used = strlen(dst);
length = strlen(src);
if (size > 0 && used < size - 1) {
copy = (length >= size - used) ? size - used - 1 : length;
memcpy(dst + used, src, copy);
dst[used + copy] = '\0';
}
return used + length;
}
#endif
#endif
#if !defined(my_strlcpy)
Size_t
DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
{
Size_t length, copy;
length = strlen(src);
if (size > 0) {
copy = (length >= size) ? size - 1 : length;
memcpy(dst, src, copy);
dst[copy] = '\0';
}
return length;
}
#endif
#endif
DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)
{
# if (PERL_BCDVERSION >= 0x5031004) /* But from above, must be < 5.35.10 */
# if (PERL_BCDVERSION != 0x5035009)
/* Versions less than 5.35.9 could dereference s on zero length, so
* pass it something where no harm comes from that. */
if (send <= s) s = send = (U8 *) "?";
return Perl_utf8_to_uvchr_buf_helper(aTHX_ s, send, retlen);
# else /* Below is 5.35.9, which also works on non-empty input, but
STRLEN curlen;
bool overflows = 0;
const U8 *cur_s = s;
const bool do_warnings = ckWARN_d(WARN_UTF8);
# if (PERL_BCDVERSION < 0x5026000) && ! defined(EBCDIC)
STRLEN overflow_length = 0;
# endif
if (send > s) {
curlen = send - s;
}
/* First, on a 32-bit machine the first byte being at least \xFE
* automatically is overflow, as it indicates something requiring more
* than 31 bits */
if (sizeof(ret) < 8) {
overflows = 1;
overflow_length = (*s == 0xFE) ? 7 : 13;
}
else {
const U8 highest[] = /* 2*63-1 */
"\xFF\x80\x87\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF";
const U8 *cur_h = highest;
/* Here, either we set the bool and broke out of the loop, or got
* to the end and all bytes are the same which indicates it doesn't
* overflow. If it did overflow, it would be this number of bytes
* */
overflow_length = 13;
}
}
if (UNLIKELY(overflows)) {
ret = 0;
if (! do_warnings && retlen) {
*retlen = overflow_length;
}
}
else
# endif /* < 5.26 */
ret = UNICODE_REPLACEMENT;
# if (PERL_BCDVERSION < 0x5016000)
/* Versions earlier than this don't necessarily return the proper
* length. It should not extend past the end of string, nor past
* what the first byte indicates the length is, nor past the
* continuation characters */
if (retlen && (IV) *retlen >= 0) {
unsigned int i = 1;
*retlen = D_PPP_MIN(*retlen, curlen);
Algorithm-QuineMcCluskey
view release on metacpan or search on metacpan
lib/Algorithm/QuineMcCluskey/Format.pm view on Meta::CPAN
=cut
sub arrayarray
{
my ($ar) = @_;
my $fmt = "%" . length(scalar @{$ar}) . "d: [%s]";
my $idx = 0;
my @output;
for my $ref (@{$ar})
{
Algorithm-RabinKarp
view release on metacpan or search on metacpan
lib/Algorithm/RabinKarp.pm view on Meta::CPAN
I am using their second equation:
$H[ $c[2..$k + 1] ] = (( $H[ $c[1..$k] ] - $c[1] ** $k ) + $c[$k+1] ) * $k
The results of this hash encodes information about the next k values in
the stream (hense k-gram.) This means for any given stream of length n
integer values (or characters), you will get back n - k + 1 hash
values.
For best results, you will want to create a code generator that filters
your data to remove all unnecessary information. For example, in a large
Algorithm-RectanglesContainingDot_XS
view release on metacpan or search on metacpan
ck_fun|||
ck_glob|||
ck_grep|||
ck_index|||
ck_join|||
ck_lengthconst|||
ck_lfun|||
ck_listiob|||
ck_match|||
ck_method|||
ck_null|||
mg_copy|||
mg_dup|||
mg_find|||
mg_free|||
mg_get|||
mg_length||5.005000|
mg_localize|||
mg_magical|||
mg_set|||
mg_size||5.005000|
mini_mktime||5.007002|
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_init|||
utf8_mg_pos|||
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
? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
: newSV(0))
#endif
/* Hint: gv_stashpvn
* This function's backport doesn't support the length parameter, but
* rather ignores it. Portability can only be ensured if the length
* parameter is used for speed reasons, but the length can always be
* correctly computed from the string argument.
*/
#ifndef gv_stashpvn
# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
#endif
Algorithm-SVM
view release on metacpan or search on metacpan
return mae;
}
// label: label name, start: begin of each class, count: #data of classes, perm: indices to the original data
// perm, length l, must be allocated before calling this subroutine
void svm_group_classes(const svm_problem *prob, int *nr_class_ret, int **label_ret, int **start_ret, int **count_ret, int *perm)
{
int l = prob->l;
int max_nr_class = 16;
int nr_class = 0;
Algorithm-Scale2x
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-Search
view release on metacpan or search on metacpan
lib/Algorithm/Search.pm view on Meta::CPAN
$as->search({ # Example parameters here are the default parameters
search_this => $object_to_search, #no default
search_type => 'dfs', # dfs, bfs, cost, or rdfs
max_steps => 20000, # number of moves to look at
maximum_depth => 0, # longest allowable path length if > 0
solutions_to_find => 0, # search stops when number reached, 0 finds all
do_not_repeat_values => 0, # only traverse position with value once
cost_cannot_increase => 0, # whether or not moves can increase cost
initial_cost => undef, # for cost based search
return_search_trace => 0, # does $as->search_trace return array ref of moves
Algorithm-Shape-RandomTree
view release on metacpan or search on metacpan
lib/Algorithm/Shape/RandomTree.pm view on Meta::CPAN
our $VERSION = '0.01';
## Attributes ##
has 'stem_length' => ( is => 'ro', isa => 'Int' ); # Length of stem
has 'tree_width' => ( is => 'ro', isa => 'Int' ); # Width of stem
has 'stem_curve' => ( is => 'ro', isa => 'Int' ); # Curvature and complexity of stem
has 'branch_length' => ( is => 'ro', isa => 'Int' ); # Average (non-stem) branch length
has 'branch_stdev' => ( is => 'ro', isa => 'Int' ); # Plus-minus range around the average
has 'complexity' => ( is => 'ro', isa => 'Int' ); # Branching modifier: max number of
# branches sprouting from a node
has 'branch_curve' => ( is => 'ro', isa => 'Num' ); # Average curvature of (non-stem)
# branches
lib/Algorithm/Shape/RandomTree.pm view on Meta::CPAN
count_branches => 'count',
filter_branches => 'grep',
},
);
# These two determine the amount of change in branch length and angle
# between branches, and along the whole shape of the tree
has 'dx_range' => ( is => 'ro', isa => 'Int' );
has 'dy_range' => ( is => 'ro', isa => 'Int' );
has 'verbose' => ( is => 'ro', isa => 'Bool' );
# TODO: Determines whether the tree's shape is more dominated by a single stem with
# shorter and less developed sub-branches, or is highly complex and branching.
# An apically dominant tree will have one dominant stem with many branches
# sprouting out of it, throughout it's length. ** Not yet implemented (I still
# need to think how to do this). **
# The easier model is the non-apically-dominant tree, with modular branches.
has 'apical_dominance' => ( is => 'ro', isa => 'Int' );
# This is the width of the image on which the tree will be rendered, in pixels
lib/Algorithm/Shape/RandomTree.pm view on Meta::CPAN
my $self = shift;
my $verb = $self->verbose;
$verb && print "[create_stem] Starting\n";
my $d = $self->stem_length;
# Set stem slope ( currently it's stragight up - slope = 0 )
my $m = 0;
# To set the slope to a random number between -/+0.5:
# my $m = -0.5 + rand(1);
lib/Algorithm/Shape/RandomTree.pm view on Meta::CPAN
my $x_start = int( $self->image_width / 2 );
# Y position is of 1st point is on the ground.
my $y_start = 0;
# Mathematically speaking:
# Stem length = distance between it's start and end points:
# d = sqrt[ (x2-x1)**2 + (y2-y1)**2 ] = sqrt( dx**2 + dy**2 )
# Slope:
# m = dy / dx = (y2-y1) / (x2-x1)
# After development and a applying the square-root:
lib/Algorithm/Shape/RandomTree.pm view on Meta::CPAN
$self->add_branch( $newbranch );
}
# Calculate New Deltas: uses the parent branch's attributes and random factors
# to modify a new branche's dx and dy values, who determin the angle and length
# of the new branch.
sub calc_new_deltas {
my ( $self, $parent ) = @_;
my $verb = $self->verbose;
lib/Algorithm/Shape/RandomTree.pm view on Meta::CPAN
my $old_dx = $parent->dx;
my $old_dy = $parent->dy;
# Calculate modifiers:
# These slightly change the dx and dy to create variation and randomness
# in branches lengths and angles.
# Modifiers range from -range_value to +range_value
my $dx_modifier = (
int( rand( $self->dx_range ) * -1 ) +
int( rand( $self->dx_range ) )
);
lib/Algorithm/Shape/RandomTree.pm view on Meta::CPAN
my $x1 = $start->x;
my $y1 = $start->y;
my $x2 = $end->x;
my $y2 = $end->y;
my $length = sqrt( $dx ** 2 + $dy ** 2 );
my $phandle = $self->branch_curve * $length;
# X / Y values of control point 1 (curving the start point)
my $c1_x = $x1 - rand($phandle) + rand($phandle);
my $c1_y = $y1 - rand($phandle) + rand($phandle);
Algorithm-SixDegrees
view release on metacpan or search on metacpan
samples/ljc.pl view on Meta::CPAN
A web version of this utility is at
L<http://www.petekrawczyk.com/lj_connect/>. It has extra options,
and will show the users as it progresses. You may not get the same
result on the web version as this sample, but they should both be
equivalent lengths.
=cut
use warnings;
use strict;
Algorithm-SkipList
view release on metacpan or search on metacpan
t/01-basic-pp.t view on Meta::CPAN
}
sub succ {
my $char = shift;
unless (length($char)==1) {
die "only a signle character is acceptable";
}
my $count = shift;
unless (defined $count) {
$count =1;
t/01-basic-pp.t view on Meta::CPAN
return pack "C", (unpack "C", $char)+$count;
}
sub pred {
my $char = shift;
unless (length($char)==1) {
die "only a signle character is acceptable";
}
my $count = shift;
unless (defined $count) {
$count =1;
( run in 0.446 second using v1.01-cache-2.11-cpan-65fba6d93b7 )