Result:
found more than 905 distributions - search limited to the first 2001 files matching your query
( run in 0.453 )
Algorithm-CheckDigits
view release on metacpan or search on metacpan
lib/Algorithm/CheckDigits/M23_002.pm view on Meta::CPAN
=over 4
=item 1
In reverse order, each digit is multiplied by a weight started at 2.
(i.e. the number left from the check digit is multiplied with 2,
the next with 3 and so on).
=item 2
Algorithm-ChooseSubsets
view release on metacpan or search on metacpan
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..2\n"; }
Algorithm-Closest-NetworkAddress
view release on metacpan or search on metacpan
inc/Module/AutoInstall.pm view on Meta::CPAN
my $makeflags = $CPAN::Config->{make_install_arg} || '';
$CPAN::Config->{make_install_arg} =
join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
# don't show start-up info
$CPAN::Config->{inhibit_startup_message} = 1;
# set additional options
while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
( $args{$opt} = $arg, next )
if $opt =~ /^force$/; # pseudo-option
Algorithm-Cluster-Thresh
view release on metacpan or search on metacpan
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
Algorithm-Cluster
view release on metacpan or search on metacpan
perl/Record.pm view on Meta::CPAN
while ($line = <$handle>) {
my $count = ($line =~ tr/\t//);
@words = split(/\t/, $line);
chomp @words;
scalar @words == $n or die "Line with " . scalar @words . " columns found (expected $n): $!";
my $start = 0;
for my $key (keys %cols) {
if ($key > $start) {
$start = $key;
}
}
if ($words[0] eq 'EWEIGHT') {
@{$self->{eweight}} = @words[$start+1..$n-1];
}
elsif ($words[0] eq 'EORDER') {
@{$self->{eorder}} = @words[$start+1..$n-1];
}
else {
my @rowdata = ();
my @rowmask = ();
for ($i = 0; $i < $n; $i++) {
Algorithm-Combinatorics
view release on metacpan or search on metacpan
Combinatorics.xs view on Meta::CPAN
/**
* The only algorithms I have found by now are either recursive, or a
* naive wrapper around permutations() that loops over all of them and
* discards the ones with fixed-points.
*
* We take here a mixed-approach, which consists on starting with the
* algorithm in __next_permutation() and tweak a couple of places that
* allow us to skip a significant number of permutations sometimes.
*
* Benchmarking shows this subroutine makes derangements() more than
* two and a half times faster than permutations() for n = 8.
Combinatorics.xs view on Meta::CPAN
return (AV*) sv_2mortal((SV*) subset);
}
/** -------------------------------------------------------------------
*
* XS stuff starts here.
*
*/
MODULE = Algorithm::Combinatorics PACKAGE = Algorithm::Combinatorics
PROTOTYPES: DISABLE
Algorithm-ConsistentHash-CHash
view release on metacpan or search on metacpan
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
Algorithm-ConsistentHash-JumpHash
view release on metacpan or search on metacpan
_invlist_subtract|||
_invlist_union_maybe_complement_2nd|||
_invlist_union|||
_is_uni_FOO||5.017008|
_is_uni_perl_idcont||5.017008|
_is_uni_perl_idstart||5.017007|
_is_utf8_FOO||5.017008|
_is_utf8_mark||5.017008|
_is_utf8_perl_idcont||5.017008|
_is_utf8_perl_idstart||5.017007|
_new_invlist_C_array|||
_new_invlist|||
_pMY_CXT|5.007003||p
_swash_inversion_hash|||
_swash_to_invlist|||
bad_type_gv|||
bad_type_pv|||
bind_match|||
block_end|||
block_gimme||5.004000|
block_start|||
blockhook_register||5.013003|
boolSV|5.004000||p
boot_core_PerlIO|||
boot_core_UNIVERSAL|||
boot_core_mro|||
debop||5.005000|
debprofdump||5.005000|
debprof|||
debstackptrs||5.007003|
debstack||5.007003|
debug_start_match|||
deb||5.007003|v
defelem_target|||
del_sv|||
delete_eval_scope|||
delimcpy||5.004000|n
lex_next_chunk||5.011002|
lex_peek_unichar||5.011002|
lex_read_space||5.011002|
lex_read_to||5.011002|
lex_read_unichar||5.011002|
lex_start||5.009005|
lex_stuff_pvn||5.011002|
lex_stuff_pvs||5.013005|
lex_stuff_pv||5.013006|
lex_stuff_sv||5.011002|
lex_unstuff||5.011002|
pad_add_name_pvs||5.015001|
pad_add_name_pv||5.015001|
pad_add_name_sv||5.015001|
pad_alloc_name|||
pad_alloc|||
pad_block_start|||
pad_check_dup|||
pad_compname_type||5.009003|
pad_findlex|||
pad_findmy_pvn||5.015001|
pad_findmy_pvs||5.015001|
qerror|||
qsortsvu|||
re_compile||5.009005|
re_croak2|||
re_dup_guts|||
re_intuit_start||5.019001|
re_intuit_string||5.006000|
re_op_compile|||
readpipe_override|||
realloc||5.007002|n
reentrant_free||5.019003|
sortsv_flags||5.009003|
sortsv||5.007003|
space_join_names_mortal|||
ss_dup|||
stack_grow|||
start_force|||
start_glob|||
start_subparse||5.004000|
stdize_locale|||
strEQ|||
strGE|||
strGT|||
strLE|||
strnNE|||
study_chunk|||
sub_crush_depth|||
sublex_done|||
sublex_push|||
sublex_start|||
sv_2bool_flags||5.013006|
sv_2bool|||
sv_2cv|||
sv_2io|||
sv_2iuv_common|||
next unless $f =~ /$match/;
print "\n=== $f ===\n\n";
my $info = 0;
if ($API{$f}{base} || $API{$f}{todo}) {
my $base = format_version($API{$f}{base} || $API{$f}{todo});
print "Supported at least starting from perl-$base.\n";
$info++;
}
if ($API{$f}{provided}) {
my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
print "Support by $ppport provided back to perl-$todo.\n";
const line_t ocopline = PL_copline;
COP * const ocurcop = PL_curcop;
const int oexpect = PL_expect;
#if (PERL_BCDVERSION >= 0x5004000)
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
veop, modname, imop);
#else
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
modname, imop);
#endif
PL_expect = oexpect;
PL_copline = ocopline;
PL_curcop = ocurcop;
void
DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
{
va_list args;
va_start(args, ver);
vload_module(flags, name, ver, &args);
va_end(args);
}
#endif
/* Hint: newCONSTSUB
* Returns a CV* as of perl-5.7.1. This return value is not supported
* by Devel::PPPort.
*/
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
#if defined(NEED_newCONSTSUB)
static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
static
#else
PL_curstash = PL_curcop->cop_stash = stash;
newSUB(
#if (PERL_BCDVERSION < 0x5003022)
start_subparse(),
#elif (PERL_BCDVERSION == 0x5003022)
start_subparse(0),
#else /* 5.003_23 onwards */
start_subparse(FALSE, 0),
#endif
newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
void
DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
void
DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
void
DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
void
DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
SV *sv;
va_list args;
PERL_UNUSED_ARG(err);
va_start(args, pat);
sv = vnewSVpvf(pat, &args);
va_end(args);
sv_2mortal(sv);
warn("%s", SvPV_nolen(sv));
}
* which is why the stack variable has been renamed to 'xdigit'.
*/
#ifndef grok_bin
#if defined(NEED_grok_bin)
static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_bin
# undef grok_bin
#endif
#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
#define Perl_grok_bin DPPP_(my_grok_bin)
#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
UV
DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_2 = UV_MAX / 2;
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Binary number > 0b11111111111111111111111111111111 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
#endif
#endif
#ifndef grok_hex
#if defined(NEED_grok_hex)
static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_hex
# undef grok_hex
#endif
#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
#define Perl_grok_hex DPPP_(my_grok_hex)
#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
UV
DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_16 = UV_MAX / 16;
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Hexadecimal number > 0xffffffff non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
#endif
#endif
#ifndef grok_oct
#if defined(NEED_grok_oct)
static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_oct
# undef grok_oct
#endif
#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
#define Perl_grok_oct DPPP_(my_grok_oct)
#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
UV
DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_8 = UV_MAX / 8;
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Octal number > 037777777777 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
{
dTHX;
int retval;
va_list ap;
va_start(ap, format);
#ifdef HAS_VSNPRINTF
retval = vsnprintf(buffer, len, format, ap);
#else
retval = vsprintf(buffer, format, ap);
#endif
int
DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
{
va_list args;
va_start(args, pat);
vsprintf(buffer, pat, args);
va_end(args);
return strlen(buffer);
}
#endif
#endif
#ifndef pv_pretty
#if defined(NEED_pv_pretty)
static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
static
#else
extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
#endif
#ifdef pv_pretty
# undef pv_pretty
#endif
#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
char *
DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
const STRLEN max, char const * const start_color, char const * const end_color,
const U32 flags)
{
const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
STRLEN escaped;
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, "<");
if (start_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
if (end_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
Algorithm-ConsistentHash-Ketama
view release on metacpan or search on metacpan
xs/KetamaMD5.c view on Meta::CPAN
SET(b, c, d, a, 9, 21, T64);
#undef SET
/* Then perform the following additions. (That is increment each
of the four registers by the value it had before this block
was started.) */
pms->abcd[0] += a;
pms->abcd[1] += b;
pms->abcd[2] += c;
pms->abcd[3] += d;
}
Algorithm-ConstructDFA-XS
view release on metacpan or search on metacpan
lib/Algorithm/ConstructDFA/XS.pm view on Meta::CPAN
die unless ref $o{is_nullable};
die unless ref $o{is_accepting} or exists $o{final};
die unless ref $o{successors} or ref $o{edges_from};
die unless ref $o{get_label} or ref $o{edges_from};
die unless exists $o{start} or exists $o{many_start};
die if ref $o{is_accepting} and exists $o{final};
die if ref $o{successors} and exists $o{edges_from};
die if ref $o{get_label} and ref $o{edges_from};
my $class = 'Algorithm::ConstructDFA::XS::Synth';
lib/Algorithm/ConstructDFA/XS.pm view on Meta::CPAN
$o{is_accepting} = sub {
grep { $in_final{$_} } @_
};
}
$o{many_start} //= [$o{start}];
my $dfa = _construct_dfa_xs($o{many_start}, $o{get_label},
$o{is_nullable}, $o{successors}, $o{is_accepting});
if (exists $o{edges_from}) {
for (values %$dfa) {
$_->{Combines} = [ grep {
lib/Algorithm/ConstructDFA/XS.pm view on Meta::CPAN
my @todo = map { @$_ } @$roots;
my %seen;
my @args;
my $sm = Data::AutoBimap->new;
my $rm = Data::AutoBimap->new;
my %is_start;
for (my $ix = 0; $ix < @$roots; ++$ix) {
for my $v (@{ $roots->[$ix] }) {
push @{ $is_start{$v} }, $ix + 1;
}
}
while (@todo) {
my $c = pop @todo;
lib/Algorithm/ConstructDFA/XS.pm view on Meta::CPAN
my $is_nullable = !!$nullablef->($c);
my $label = $labelf->($c);
my $label_x = defined $label ? $rm->s2n($label) : undef;
# [vertex, label, nullable, start, successors...]
my @data = ($sm->s2n($c), $label_x, !!$is_nullable, $is_start{$c} // []);
for ($successorsf->($c)) {
push @data, $sm->s2n($_);
push @todo, $_;
}
Algorithm-ConstructDFA
view release on metacpan or search on metacpan
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
push @todo, $successors->($c) if $nullable->($c);
}
keys %seen;
};
my $start = [
sort { $a cmp $b }
uniq map {
$nullable->($_) ? @{ $all_reachable_and_self->($_) } : $_
}
map { $m->s2n($_) }
@$roots
];
my $start_s = join ' ', @$start;
my @todo = ($start);
my %seen;
my $dfa;
my @accepting_dfa_states;
my %predecessors;
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
push @todo, keys %{ $predecessors{$c} };
}
map { $_ => 1 } keys %seen;
};
my $o = Data::AutoBimap->new(start => 0);
# Ensure that DFA state 0 is the one that corresponds to no
# vertices in the input graph. This is an API convention and
# does not have significance beyond that.
my $r = { $o->s2n('') => {
Combines => [],
Accepts => $accepting->()
} };
# Ensure start state is 1 also as a convention
$o->s2n($start_s);
while (my ($src, $x) = each %$dfa) {
# Merge dead states
$src = '' unless $reachable{$src};
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
die unless ref $o{is_nullable};
die unless ref $o{is_accepting} or exists $o{final};
die unless ref $o{successors};
die unless ref $o{get_label};
die unless exists $o{start};
die if ref $o{is_accepting} and exists $o{final};
if (exists $o{final}) {
my %in_final = map { $_ => 1 } @{ $o{final} };
$o{is_accepting} = sub {
grep { $in_final{$_} } @_
};
}
_get_graph($o{start}, $o{get_label}, $o{is_nullable},
$o{successors}, $o{is_accepting});
}
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
=head1 SYNOPSIS
use Algorithm::ConstructDFA;
my $dfa = construct_dfa(
start => [ $start_vertex ],
is_accepting => sub { grep { $_ eq $final_vertex } @_ },
is_nullable => sub {
$g->has_vertex_attribute($_[0], 'label')
},
successors => sub { $g->successors($_[0]) },
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
Construct a DFA using the given options.
=over
=item start
An array of start states for the initial configuration of the
automaton.
=item final
An array of final accepting states. This can be used instead
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
=back
The function returns the DFA as hash reference with integer keys. The
key C<0> is a non-accepting state with no transitions to other states
(the automaton would go into this state if the match has failed). The
key C<1> is the start state. The value of each entry is another hash
reference. As an example:
'1':
Accepts: 1
Combines:
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
The C<Accepts> key indicates whether this is an accepting state. The
C<Combines> key provides access to the list of states in the input
automaton this DFA state corresponds to. The C<NextOver> field is the
transition table out of this state. This automaton matches any sequence
of zero or more C<b>s. The alphabet also includes the label C<a> but
the automaton moves from the start state over the label C<a> to the
non-accepting sink state C<0> and would never enter an accepting state
after that.
An exception to the rule above is when C<is_accepting> returns a true
value when passed no arguments (i.e., the automaton accepts when it is
Algorithm-ConstructDFA2
view release on metacpan or search on metacpan
lib/Algorithm/ConstructDFA2.pm view on Meta::CPAN
my @accepting = map { @$_ } $self->_dbh->selectall_array(q{
SELECT state FROM accepting
});
# NOTE: this also renames states in transitions involving
# possible start states, but they would then simply have no
# transitions, which should be fine.
$self->_dbh->do(q{
WITH RECURSIVE all_living(state) AS (
SELECT state FROM accepting
lib/Algorithm/ConstructDFA2.pm view on Meta::CPAN
vertex_matches => sub($vertex, $input) { ... },
storage_dsn => 'dbi:SQLite:dbname=...',
);
my $start_id = $dfa->find_or_create_state_id(qw/ 2 /);
while (my $count = $dfa->compute_some_transitions(1_000)) {
...
}
lib/Algorithm/ConstructDFA2.pm view on Meta::CPAN
=item $dfa->find_or_create_state_id(@vertices)
Given a list of vertices, computes a new state, adds it to the
automaton if it does not already exist, and returns an identifier
for the state. This is used to create a start state in the DFA.
=item $dfa->compute_some_transitions($limit)
Computes up to C<$limit> additional transitions and returns the
number of transitions actually computed. A return value of zero
Algorithm-CouponCode
view release on metacpan or search on metacpan
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
Algorithm-CriticalPath
view release on metacpan or search on metacpan
lib/Algorithm/CriticalPath.pm view on Meta::CPAN
{
croak 'Invalid graph type for critical path analysis' ;
} ;
# this is ropey - should use guaranteed unique names
my $start = 'GCP::dummyStart';
my $end = 'GCP::dummyEnd';
# this is ropey, should use a BFS search method to return the depth-ordered rankings of vertices.
my $g = $self->graph()->deep_copy();
lib/Algorithm/CriticalPath.pm view on Meta::CPAN
$g->delete_vertex($s);
}
$i++;
}
# $copy adds in the dummy start and end nodes, so we don't destroy the original.
my $copy = $self->graph()->deep_copy();
$copy->add_weighted_vertex($start,0);
$copy->add_weighted_vertex($end,0);
for my $n ($copy->source_vertices()) {
$copy->add_edge($start, $n);
}
for my $n ($copy->sink_vertices()) {
$copy->add_edge($n,$end);
}
for my $n ($copy->isolated_vertices()) {
$copy->add_edge($start, $n);
$copy->add_edge($n,$end);
}
unshift @rank, [$start];
push @rank, [$end];
my %costToHere = map { $_ => 0 } $copy->vertices();
my %criticalPathToHere;
$criticalPathToHere{$start} = [$start];
for my $row ( @rank ) {
for my $node ( @$row ) {
for my $s ( $copy->successors($node) ) {
if ( $costToHere{$node} + $copy->get_vertex_weight($s) > $costToHere{$s} ) {
lib/Algorithm/CriticalPath.pm view on Meta::CPAN
}
}
}
# we don't want to see the dummy nodes on the returned critical path.
@{$criticalPathToHere{$end}} = grep { $_ ne ${start} && $_ ne ${end} } @{$criticalPathToHere{$end}} ;
$self->vertices(\@{$criticalPathToHere{$end}});
$self->cost($costToHere{$end});
Algorithm-Cron
view release on metacpan or search on metacpan
lib/Algorithm/Cron.pm view on Meta::CPAN
A C<crontab> field containing a single asterisk (C<*>), or a missing named
field, indicates that any value here is included in the scheduled times. To
restrict the schedule, a value or set of values can be provided. This should
consist of one or more comma-separated numbers or ranges, where a range is
given as the start and end points, both inclusive.
hour => "3-6"
hour => "3,4,5,6"
Ranges can also be prefixed by a value to give the increment for values in
lib/Algorithm/Cron.pm view on Meta::CPAN
C<Algorithm::Cron> supports using either UTC or the local timezone when
comparing against the given schedule.
=cut
# mday field starts at 1, others start at 0
my %MIN = (
sec => 0,
min => 0,
hour => 0,
mday => 1,
lib/Algorithm/Cron.pm view on Meta::CPAN
}
return 1;
}
=head2 $time = $cron->next_time( $start_time )
Returns the next scheduled time, as an epoch timestamp, after the given
timestamp. This is a stateless operation; it does not change any state stored
by the C<$cron> object.
lib/Algorithm/Cron.pm view on Meta::CPAN
if( defined $self->{mday} and defined $self->{wday} ) {
# Now it gets tricky because cron allows a match of -either- mday or wday
# rather than requiring both. So we'll work out which of the two is sooner
my $next_time_by_wday;
my @wday_t = @t;
my $wday_restart = 0;
$self->next_time_field( \@wday_t, TM_WDAY ) or $wday_restart = 1;
$next_time_by_wday = $funcs->[BUILD]->( @wday_t );
my $next_time_by_mday;
my @mday_t = @t;
my $mday_restart = 0;
$self->next_time_field( \@mday_t, TM_MDAY ) or $mday_restart = 1;
$next_time_by_mday = $funcs->[BUILD]->( @mday_t );
if( $next_time_by_wday > $next_time_by_mday ) {
@t = @mday_t;
goto RESTART if $mday_restart;
}
else {
@t = @wday_t;
goto RESTART if $wday_restart;
}
}
elsif( defined $self->{mday} ) {
$self->next_time_field( \@t, TM_MDAY ) or goto RESTART;
}
Algorithm-CurveFit-Simple
view release on metacpan or search on metacpan
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
Algorithm-DBSCAN
view release on metacpan or search on metacpan
lib/Algorithm/DBSCAN.pm view on Meta::CPAN
The main method that will run the DBSCAN algorithm on the Dataset.
=cut
sub FindClusters {
my ($self, $starting_point_id) = @_;
my $i = 0;
unshift(@{$self->{id_list}}, $starting_point_id) if (defined $starting_point_id);
foreach my $id (@{$self->{id_list}}) {
my $point = $self->{dataset}->{$id};
say "$i";
$i++;
next if ($point->{visited});
lib/Algorithm/DBSCAN.pm view on Meta::CPAN
}
}
=head2 ExpandCluster
This method will expand the cluster starting by the neighborhood of point $point
=cut
sub ExpandCluster {
my ($self, $point, $neighborPts) = @_;
lib/Algorithm/DBSCAN.pm view on Meta::CPAN
sub _one_more_point_visited {
my ($self) = @_;
$self->{nb_visited_points}++;
$self->{start_time} = time() unless ($self->{start_time});
my $eta = time() + ((time() - $self->{start_time})/$self->{nb_visited_points})*(500000);
my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($eta);
say "ETA:".sprintf("%04d-%02d-%02d %02d:%02d:%02d",$year+1900,$mon+1,$mday,$hour,$min,$sec);
say "nb visited:".$self->{nb_visited_points};
}
Algorithm-DecisionTree
view release on metacpan or search on metacpan
lib/Algorithm/DecisionTree.pm view on Meta::CPAN
of such partitioning of data for classification and regression can be traced to the
work of Terry Therneau in the early 1980's in the statistics community, and to the
work of Ross Quinlan in the mid 1990's in the machine learning community.
For those not familiar with decision tree ideas, the traditional way to classify
multidimensional data is to start with a feature space whose dimensionality is the
same as that of the data. Each feature in this space corresponds to the attribute
that each dimension of the data measures. You then use the training data to carve up
the feature space into different regions, each corresponding to a different class.
Subsequently, when you try to classify a new data sample, you locate it in the
feature space and find the class label of the region to which it belongs. One can
lib/Algorithm/DecisionTree.pm view on Meta::CPAN
Starting with Version 3.20, you can use the class C<BoostedDecisionTree> for
constructing a boosted decision-tree classifier. Boosting results in a cascade of
decision trees in which each decision tree is constructed with samples that are
mostly those that are misclassified by the previous decision tree. To be precise,
you create a probability distribution over the training samples for the selection of
samples for training each decision tree in the cascade. To start out, the
distribution is uniform over all of the samples. Subsequently, this probability
distribution changes according to the misclassifications by each tree in the cascade:
if a sample is misclassified by a given tree in the cascade, the probability of its
being selected for training the next tree is increased significantly. You also
associate a trust factor with each decision tree depending on its power to classify
lib/Algorithm/DecisionTree.pm view on Meta::CPAN
=head1 THE C<ExamplesRegression> DIRECTORY
The C<ExamplesRegression> subdirectory in the main installation directory shows
example scripts that you can use to become familiar with regression trees and how
they can be used for nonlinear regression. If you are new to the concept of
regression trees, start by executing the following scripts without changing them and
see what sort of output is produced by them:
regression4.pl
regression5.pl
Algorithm-Dependency-MapReduce
view release on metacpan or search on metacpan
b) You must cause any work that you distribute or publish, that in whole or in
part contains or is derived from the Program or any part thereof, to be licensed
as a whole at no charge to all third parties under the terms of this License.
c) If the modified program normally reads commands interactively when run, you
must cause it, when started running for such interactive use in the most ordinary
way, to print or display an announcement including an appropriate copyright
notice and a notice that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these conditions,
and telling the user how to view a copy of this License. (Exception: if the
Program itself is interactive but does not normally print such an announcement,
Algorithm-Dependency-Source-DBI
view release on metacpan or search on metacpan
b) You must cause any work that you distribute or publish, that in whole or in
part contains or is derived from the Program or any part thereof, to be licensed
as a whole at no charge to all third parties under the terms of this License.
c) If the modified program normally reads commands interactively when run, you
must cause it, when started running for such interactive use in the most ordinary
way, to print or display an announcement including an appropriate copyright
notice and a notice that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these conditions,
and telling the user how to view a copy of this License. (Exception: if the
Program itself is interactive but does not normally print such an announcement,
Algorithm-Dependency
view release on metacpan or search on metacpan
lib/Algorithm/Dependency/Ordered.pm view on Meta::CPAN
my @items = @_ or return undef;
return undef if grep { ! $source->item($_) } @items;
# The actual items to select will be the same as for the unordered
# version, so we can simplify the algorithm greatly by using the
# normal unordered ->schedule method to get the starting list.
my $rv = $self->SUPER::schedule( @items );
my @queue = $rv ? @$rv : return undef;
# Get a working copy of the selected index
my %selected = %{ $self->{selected} };
Algorithm-DependencySolver
view release on metacpan or search on metacpan
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
Algorithm-Diff-Apply
view release on metacpan or search on metacpan
lib/Algorithm/Diff/Apply.pm view on Meta::CPAN
}
# Converts all the hunks in an Algorithm::Diff-style diff to a
# normalised form in which all hunks are a) still internally
# contiguous, and b) have start indices which refer to items in the
# original array, before any diffs are applied. Normally, hunks
# consisting of only inserts don't meet criterion b).
#
# Allso attaches hash data if the hashing function is defined.
lib/Algorithm/Diff/Apply.pm view on Meta::CPAN
my ($orig_diff, %opt) = @_;
my @hdiff = ();
my $delta = 0; # difference between orig and resultant
foreach my $orig_hunk (@$orig_diff)
{
my ($first_op, $start) = @{$orig_hunk->[0]} [0, 1];
$start -= $delta if $first_op eq '+';
my $hhunk = {
start => $start,
changes => [],
};
foreach my $change (@$orig_hunk)
{
my ($op, $data);
lib/Algorithm/Diff/Apply.pm view on Meta::CPAN
$cflict{$id} = [ $hunk ];
# Seed range with $hunk:
my @ch = @{$hunk->{changes}};
my $span = grep { $_->[0] eq '-' } @ch;
$cflict_min = $hunk->{start};
$cflict_max = $cflict_min + $span;
# Detect conflicting hunks, and add those in too.
my %ignore;
while (my $tmp_id = __next_hunk_id($diffset, %ignore))
{
my $tmp_hunk = $diffset->{$tmp_id}->[0];
@ch = @{$tmp_hunk->{changes}};
my $tmp_span = grep { $_->[0] eq '-' } @ch;
my $tmp_max = $tmp_hunk->{start} + $tmp_span;
if ($tmp_hunk->{start} <= $cflict_max)
{
exists $cflict{$tmp_id} or $cflict{$tmp_id} = [];
shift @{$diffset->{$tmp_id}};
push @{$cflict{$tmp_id}}, $tmp_hunk;
$cflict_max = $tmp_max if $tmp_max > $cflict_max;
lib/Algorithm/Diff/Apply.pm view on Meta::CPAN
return ($cflict_min, $cflict_max, %cflict);
}
# Returns the ID of the hunk in %$diffset whose ->{start} is lowest,
# or undef. %ignore{SOMEID} can be set to a true value to cause a
# given sequence to be skipped over.
sub __next_hunk_id
{
my ($diffset, %ignore) = @_;
my ($lo_id, $lo_start);
foreach my $id (keys %$diffset)
{
next if $ignore{$id};
my $diff = $diffset->{$id};
next if $#$diff < 0;
my $start = $diff->[0]->{start};
if ((! defined($lo_start))
|| $start < $lo_start)
{
$lo_id = $id;
$lo_start = $start;
}
}
return $lo_id;
}
lib/Algorithm/Diff/Apply.pm view on Meta::CPAN
@replacement = @$r;
}
else
{
@replacement = $resolver->(src_range_end => $max,
src_range_start => $min,
src_range => \@orig,
alt_txts => \%alt_txts,
invoc_opts => \%opt);
}
splice(@$ary, $min + $delta, $#orig+1, @replacement);
lib/Algorithm/Diff/Apply.pm view on Meta::CPAN
# by doing so.
sub __apply_hunk
{
my ($ary, $rdelta, $hunk) = @_;
my $pos = $hunk->{start} + $$rdelta;
foreach my $change (@{$hunk->{changes}})
{
if ($change->[0] eq '+')
{
splice(@$ary, $pos, 0, $change->[1]);
lib/Algorithm/Diff/Apply.pm view on Meta::CPAN
sub __hunks_identical
{
my ($h1, $h2) = @_;
$h1->{start} == $h2->{start} or return 0;
$#{$h1->{changes}} == $#{$h2->{changes}} or return 0;
foreach my $i (0 .. $#{$h1->{changes}})
{
my ($op1, $data1, $hash1) = @{ $h1->{changes}->[$i] };
my ($op2, $data2, $hash2) = @{ $h2->{changes}->[$i] };
lib/Algorithm/Diff/Apply.pm view on Meta::CPAN
{
print STDERR "-- begin seq tag=\"$tag\" --\n";
my @diff = @{$dset{$tag}};
for my $diff (@diff)
{
print STDERR "\n\@".$diff->{start}."\n";
for my $e (@{$diff->{changes}})
{
my ($op, $data) = @$e;
$data = quotemeta($data);
$data =~ s{^(.{0,75})(.*)}{
Algorithm-Diff-Callback
view release on metacpan or search on metacpan
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
Algorithm-Diff-HTMLTable
view release on metacpan or search on metacpan
lib/Algorithm/Diff/HTMLTable.pm view on Meta::CPAN
croak $files{$name} . " is not a file" if !-f $files{$name};
croak $files{$name} . " is not a readable file" if !-r $files{$name};
}
my $html = $self->_start_table( %files );
$html .= $self->_build_table( %files );
$html .= $self->_end_table( %files );
return $html;
}
sub _start_table {
my $self = shift;
my %files = @_;
my $old = $self->_file_info( $files{a}, 'old' );
my $new = $self->_file_info( $files{b}, 'new' );
Algorithm-Diff-JSON
view release on metacpan or search on metacpan
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) year name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
Algorithm-Diff-XS
view release on metacpan or search on metacpan
}
if (ctx->thresh.max >= 0) {
struct LK *lk;
if (GIMME_V == G_ARRAY) {
SV **start, **end;
XSprePUSH;
start = SP+1;
for (lk = ctx->links.arr[ctx->thresh.max]; lk; lk = lk->link) {
AV *arr;
/* only count transitions */
if (lk->link && lk->link->i == lk->i)
continue;
av_push(arr, newSViv(lk->j));
XPUSHs(sv_2mortal(newRV_noinc((SV *)arr)));
}
/* reverse the stack */
end = SP;
while (start < end) {
SV *tmp = *start;
*start++ = *end;
*end-- = tmp;
}
}
else {
j = 0;
Algorithm-Diff
view release on metacpan or search on metacpan
#
# This subroutine changes $File_Length_Difference
#
# Fields in a Hunk:
# blocks - a list of Block objects
# start - index in file 1 where first block of the hunk starts
# end - index in file 1 where last block of the hunk ends
#
# Variables:
# before_diff - how much longer file 2 is than file 1 due to all hunks
# until but NOT including this one
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;
$b1 = @insert_array ? $insert_array[0 ]->{"item_no"} : -1;
$b2 = @insert_array ? $insert_array[-1]->{"item_no"} : -1;
$start1 = $a1 == -1 ? $b1 - $before_diff : $a1;
$end1 = $a2 == -1 ? $b2 - $after_diff : $a2;
$start2 = $b1 == -1 ? $a1 + $before_diff : $b1;
$end2 = $b2 == -1 ? $a2 + $after_diff : $b2;
# At first, a hunk will have just one Block in it
my $hunk = {
"start1" => $start1,
"start2" => $start2,
"end1" => $end1,
"end2" => $end2,
"blocks" => [$block],
};
bless $hunk, $class;
$hunk->flag_context($context_items);
return $hunk;
}
# Change the "start" and "end" fields to note that context should be added
# to this hunk
sub flag_context {
my ($hunk, $context_items) = @_;
return unless $context_items; # no context
# add context before
my $start1 = $hunk->{"start1"};
my $num_added = $context_items > $start1 ? $start1 : $context_items;
$hunk->{"start1"} -= $num_added;
$hunk->{"start2"} -= $num_added;
# context after
my $end1 = $hunk->{"end1"};
$num_added = ($end1+$context_items > $#f1) ?
$#f1 - $end1 :
sub does_overlap {
my ($hunk, $oldhunk) = @_;
return "" unless $oldhunk; # first time through, $oldhunk is empty
# Do I actually need to test both?
return ($hunk->{"start1"} - $oldhunk->{"end1"} <= 1 ||
$hunk->{"start2"} - $oldhunk->{"end2"} <= 1);
}
# Prepend hunk arg1 to hunk arg0
# Note that arg1 isn't updated! Only arg0 is.
sub prepend_hunk {
my ($hunk, $oldhunk) = @_;
$hunk->{"start1"} = $oldhunk->{"start1"};
$hunk->{"start2"} = $oldhunk->{"start2"};
unshift (@{$hunk->{"blocks"}}, @{$oldhunk->{"blocks"}});
}
# Calculate item number range.
my $range1 = $hunk->unified_range(1);
my $range2 = $hunk->unified_range(2);
print "@@ -$range1 +$range2 @@\n";
# 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"};
my ($num_added, $num_removed) = (0,0);
my @outlist = @$fileref1[$low..$hi];
map {s/^/ /} @outlist; # assume it's just context
$num_removed++;
}
foreach my $item ($block->insert) {
my $op = $item->{"sign"}; # +
my $i = $item->{"item_no"};
my $offset = $i - $hunk->{"start2"} + $num_removed;
splice(@outlist,$offset,0,"$op$$fileref2[$i]");
$num_added++;
}
}
my $range2 = $hunk->context_range(2);
# Print out file 1 part for each block in context diff format if there are
# any blocks that remove items
print "*** $range1 ****\n";
my $low = $hunk->{"start1"};
my $hi = $hunk->{"end1"};
if (@blocklist = grep {$_->remove} @{$hunk->{"blocks"}}) {
my @outlist = @$fileref1[$low..$hi];
map {s/^/ /} @outlist; # assume it's just context
foreach my $block (@blocklist) {
map {s/$/\n/} @outlist; # add \n's
print @outlist;
}
print "--- $range2 ----\n";
$low = $hunk->{"start2"};
$hi = $hunk->{"end2"};
if (@blocklist = grep {$_->insert} @{$hunk->{"blocks"}}) {
my @outlist = @$fileref2[$low..$hi];
map {s/^/ /} @outlist; # assume it's just context
foreach my $block (@blocklist) {
}
}
sub context_range {
# Generate a range of item numbers to print. Only print 1 number if the range
# has only one item in it. Otherwise, it's 'start,end'
my ($hunk, $flag) = @_;
my ($start, $end) = ($hunk->{"start$flag"},$hunk->{"end$flag"});
$start++; $end++; # index from 1, not zero
my $range = ($start < $end) ? "$start,$end" : $end;
return $range;
}
sub unified_range {
# Generate a range of item numbers to print for unified diff
# 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
Algorithm-DimReduction
view release on metacpan or search on metacpan
inc/Spiffy.pm view on Meta::CPAN
my $used = {};
$bases_map->{$class} = [grep {not $used->{$_}++} @bases];
}
my %code = (
sub_start =>
"sub {\n",
set_default =>
" \$_[0]->{%s} = %s\n unless exists \$_[0]->{%s};\n",
init =>
" return \$_[0]->{%s} = do { my \$self = \$_[0]; %s }\n" .
inc/Spiffy.pm view on Meta::CPAN
? '[]'
: (ref($default) eq 'HASH' and not keys %$default )
? '{}'
: default_as_code($default);
my $code = $code{sub_start};
if ($args->{-init}) {
my $fragment = $args->{-weak} ? $code{weak_init} : $code{init};
$code .= sprintf $fragment, $field, $args->{-init}, ($field) x 4;
}
$code .= sprintf $code{set_default}, $field, $default_string, $field
Algorithm-DistanceMatrix
view release on metacpan or search on metacpan
lib/Algorithm/DistanceMatrix.pm view on Meta::CPAN
my $distances = [];
for (my $i = 0; $i < $n; $i++) {
# This initialization is required to prevent 'undef' at [0,0],
$distances->[$i] ||= [];
# Diagonal or full matrix?
my $start = $self->mode =~ /full/i ? 0 : $i+1;
for (my $j = $start; $j < $n; $j++) {
# Use a pointer, then determine if it's row-major or col-major order
# Swap i and j if lower diagonal (default)
my $ref = $self->mode =~ /lower/i ?
\$distances->[$j][$i] : \$distances->[$i][$j];
# Callback function provides the distance
( run in 0.453 second using v1.01-cache-2.11-cpan-0d8aa00de5b )