view release on metacpan or  search on metacpan

inc/Devel/CheckLib.pm  view on Meta::CPAN

326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
    require Win32;
    @sys_cmd = (
        @$cc,
        $cfile,
        "/Fe$exefile",
        (map { '/I'.Win32::GetShortPathName($_) } @incpaths),
        "/link",
        @$ld,
        split(' ', $Config{libs}),
    );
} elsif($Config{cc} =~ /bcc32(\.exe)?/) {    # Borland
    @sys_cmd = (
        @$cc,
        @$ld,
        (map { "-I$_" } @incpaths),
        "-o$exefile",
        $cfile
    );
} else { # Unix-ish: gcc, Sun, AIX (gcc, cc), ...
    @sys_cmd = (
        @$cc,
        @$ld,
        $cfile,
        (map { "-I$_" } @incpaths),
        "-o", "$exefile"
    );
}
warn "# @sys_cmd\n" if $args{debug};
my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd);

inc/Devel/CheckLib.pm  view on Meta::CPAN

369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
for my $lib ( @libs ) {
    my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe};
    my @sys_cmd;
    if ( $Config{cc} eq 'cl' ) {                 # Microsoft compiler
        require Win32;
        my @libpath = map { 
            q{/libpath:} . Win32::GetShortPathName($_)
        } @libpaths; 
        # this is horribly sensitive to the order of arguments
        @sys_cmd = (
            @$cc,
            $cfile,
            "${lib}.lib",
            "/Fe$exefile", 
            (map { '/I'.Win32::GetShortPathName($_) } @incpaths),
            "/link",
            @$ld,
            split(' ', $Config{libs}),
            (map {'/libpath:'.Win32::GetShortPathName($_)} @libpaths),
        );
    } elsif($Config{cc} eq 'CC/DECC') {          # VMS
    } elsif($Config{cc} =~ /bcc32(\.exe)?/) {    # Borland
        @sys_cmd = (
            @$cc,
            @$ld,
            "-o$exefile",
            (map { "-I$_" } @incpaths),
            (map { "-L$_" } @libpaths),
            "-l$lib",
            $cfile);
    } else {                                     # Unix-ish
                                                 # gcc, Sun, AIX (gcc, cc)
        @sys_cmd = (
            @$cc,
            @$ld,
            $cfile,
            "-o", "$exefile",
            (map { "-I$_" } @incpaths),
            (map { "-L$_" } @libpaths),
            "-l$lib",
        );
    }
    warn "# @sys_cmd\n" if $args{debug};
    local $ENV{LD_RUN_PATH} = join(":", @libpaths).":".$ENV{LD_RUN_PATH} unless $^O eq 'MSWin32';

inc/Devel/CheckLib.pm  view on Meta::CPAN

429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
        }
        _cleanup_exe($exefile);
    } 
    unlink $cfile;
 
    my $miss_string = join( q{, }, map { qq{'$_'} } @missing );
    die("Can't link/include C library $miss_string, aborting.\n") if @missing;
    my $wrong_string = join( q{, }, map { qq{'$_'} } @wrongresult);
    die("wrong result: $wrong_string\n") if @wrongresult;
    my $analysis_string = join(q{, }, map { qq{'$_'} } @wronganalysis );
    die("wrong analysis: $analysis_string") if @wronganalysis;
}
 
sub _cleanup_exe {
    my ($exefile) = @_;

 view release on metacpan or  search on metacpan

lib/AAC/Pvoice.pm  view on Meta::CPAN

3
4
5
6
7
8
9
10
11
12
13
use strict;
use warnings;
 
use Wx qw(:everything);
use Wx::Perl::Carp;
use AAC::Pvoice::Bitmap;
use AAC::Pvoice::Input;
use AAC::Pvoice::Row;
use AAC::Pvoice::EditableRow;
use AAC::Pvoice::Panel;
use AAC::Pvoice::Dialog;

lib/AAC/Pvoice.pm  view on Meta::CPAN

68
69
70
71
72
73
74
75
76
77
78
79
80
81
                                    0,                  
                                    'Comic Sans MS',    # face name
                                    wxFONTENCODING_SYSTEM));
 
    $d->Append($messagectrl,1);
my $ok     = [Wx::NewId,AAC::Pvoice::Bitmap->new('',50,25,'OK',    Wx::Colour->new(255, 230, 230)),sub{$d->SetReturnCode(wxOK);    $d->Close()}];
my $yes    = [Wx::NewId,AAC::Pvoice::Bitmap->new('',50,30,'Yes',   Wx::Colour->new(255, 230, 230)),sub{$d->SetReturnCode(wxYES);   $d->Close()}];
my $no     = [Wx::NewId,AAC::Pvoice::Bitmap->new('',50,25,'No',    Wx::Colour->new(255, 230, 230)),sub{$d->SetReturnCode(wxNO);    $d->Close()}];
my $cancel = [Wx::NewId,AAC::Pvoice::Bitmap->new('',50,60,'Cancel',Wx::Colour->new(255, 230, 230)),sub{$d->SetReturnCode(wxCANCEL);$d->Close()}];
my $items = [];
push @$items, $ok     if $style & wxOK;
push @$items, $yes    if $style & wxYES_NO;
push @$items, $no     if $style & wxYES_NO;
push @$items, $cancel if $style & wxCANCEL;

lib/AAC/Pvoice.pm  view on Meta::CPAN

145
146
147
148
149
150
151
152
153
LICENSE file included with this module.
 
 
=head1 SEE ALSO
 
perl(1), Wx, AAC::Pvoice::Panel, AAC::Pvoice::Bitmap, AAC::Pvoice::Row
AAC::Pvoice::EditableRow, AAC::Pvoice::Input
 
=cut

 view release on metacpan or  search on metacpan

lib/ABNF/Generator.pm  view on Meta::CPAN

365
366
367
368
369
370
371
372
373
374
375
                return $begin;
        }
 
        when ( "Choice" ) {
                return [
                        map { @{_asStrings($_)} } @{$generated->{value}}
                ];
        }
 
        default { die "Unknown class " . $generated->{class} . Dumper $generated }
}

 view release on metacpan or  search on metacpan

eg/filelist.pm  view on Meta::CPAN

30
31
32
33
34
35
36
37
38
39
40
my @files = grep {
    # does this file match the request?
    ($_->{subsystem}   eq $syst) &&
    ($_->{end_time}    >= $tmin) &&
    ($_->{start_time}  <= $tmax)
} map {
    # get meta-data on this file. data is json encoded
    my $d = $yenta->get($_);
    $d = $d ? decode_json($d) : {};
    # convert space seperated locations to arrayref
    $d->{location} = [ (split /\s+/, $d->{location}) ];

 view release on metacpan or  search on metacpan

lib/AC/Yenta.pm  view on Meta::CPAN

145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
 
=item debug
 
enable debugging for a particular section
 
    debug map
 
=item map
 
configure a map (a collection of key-value data). you do not need
to configure the same set of maps on all servers. maps should be
configured similarly on all servers that they are on.
 
    map users {
        backend     bdb
        dbfile      /home/acdata/users.ydb
        history     4
    }

 view release on metacpan or  search on metacpan

lib/ACH/Generator.pm  view on Meta::CPAN

52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
# File data
my $data = "";
 
# Iterate through the ACH Data
foreach my $item (@{$self->{_achData}}) { # Array of ACH file Sections
  my @achSections = map { defined $_ ? $_ : '' } @{$item};
  my $sectionValue = 0;
   
  for (my $y=0; $y < @achSections; $y++) { # Array of ACH file Section data
    my %hash = map { defined $_ ? $_ : '' } %{$achSections[$y]};
     
    # Use the appropriate file Format size for the appropriate ACH file section
    foreach my $hashItem (keys (%hash)) { # Hash containing the ACH field name and value
      chomp $hash{$hashItem};
      my $dataValue = "";

 view release on metacpan or  search on metacpan

lib/ACH.pm  view on Meta::CPAN

100
101
102
103
104
105
106
107
108
109
110
111
112
 
# Print all data from the ACH object
sub printAllData {
  my $self = shift;
  foreach my $item (@{$self->{_achData}}) { # Array of ACH file Sections
    my @achSections = map { defined $_ ? $_ : '' } @{$item};
    foreach my $section (@achSections) { # Array of ACH file Section data
      my %hash = map { defined $_ ? $_ : '' } %{$section};
      foreach my $hashItem (keys (%hash)) { # Hash containing the ACH field name and value
        print "$hashItem: $hash{$hashItem}\n";
      }
    }
  }

 view release on metacpan or  search on metacpan

examples/postifx-policy-server.pl  view on Meta::CPAN

12
13
14
15
16
17
18
19
20
21
22
# Global config settings
my $TC = 1;
my $debug = 1;
my $port = 12345;
our $pidfile = "/var/run/postfix-policy-server.pid";
our %redirectmap;
 
# Param1: Client socket
# Param2: hash_ref
sub parse_postfix_input( $$ ) {
        my ($socket,$hashref) = @_;

 view release on metacpan or  search on metacpan

t/00-compile.t  view on Meta::CPAN

30
31
32
33
34
35
36
37
38
39
40
for my $lib (@module_files)
{
    # see L<perlfaq8/How can I capture STDERR from an external command?>
    my $stderr = IO::Handle->new;
 
    diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
            $^X, @switches, '-e', "require q[$lib]"))
        if $ENV{PERL_COMPILE_TEST_DEBUG};
 
    my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
    binmode $stderr, ':crlf' if $^O eq 'MSWin32';

 view release on metacpan or  search on metacpan

t/00-report-prereqs.t  view on Meta::CPAN

147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
    }
 
    if ( @reports ) {
        push @full_reports, "=== $title ===\n\n";
 
        my $ml = _max( map { length $_->[0] } @reports );
        my $wl = _max( map { length $_->[1] } @reports );
        my $hl = _max( map { length $_->[2] } @reports );
 
        if ($type eq 'modules') {
            splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl];
            push @full_reports, map { sprintf("    %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports;
        }
        else {
            splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl];
            push @full_reports, map { sprintf("    %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports;
        }
 
        push @full_reports, "\n";
    }
}

 view release on metacpan or  search on metacpan

t/00-report-prereqs.t  view on Meta::CPAN

147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
    }
 
    if ( @reports ) {
        push @full_reports, "=== $title ===\n\n";
 
        my $ml = _max( map { length $_->[0] } @reports );
        my $wl = _max( map { length $_->[1] } @reports );
        my $hl = _max( map { length $_->[2] } @reports );
 
        if ($type eq 'modules') {
            splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl];
            push @full_reports, map { sprintf("    %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports;
        }
        else {
            splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl];
            push @full_reports, map { sprintf("    %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports;
        }
 
        push @full_reports, "\n";
    }
}

 view release on metacpan or  search on metacpan

Translate.pm  view on Meta::CPAN

15
16
17
18
19
20
21
22
23
24
25
    $translator = Lingua::Translate->new( src => 'en', dest => shift );
  }
 
  *die_handler = *warn_handler = sub {
    if ( $translator ) {
      return map $translator->translate( $_ ), @_;
    } else {
      return @_;
    }
  };
}

 view release on metacpan or  search on metacpan

lib/ACME/Error/SHOUT.pm  view on Meta::CPAN

7
8
9
10
11
12
13
14
15
16
17
$VERSION = '0.02';
 
*warn_handler = *die_handler = sub {
  my @error = @_;
  $error[$_] =~ s/.$/!/g for 0 .. $#error;
  return map uc, @error;
};
 
1;
__END__
# Below is stub documentation for your module. You better edit it!

 view release on metacpan or  search on metacpan

lib/ACME/QuoteDB/LoadDB.pm  view on Meta::CPAN

39
40
41
42
43
44
45
46
47
48
49
my ($class, $args) = @_;
 
# TODO encapsulation
my $self = bless {}, $class;
 
# store each record we extract - keys map to database fields
# TODO proper encapsulation
$self->{record} = {};
$self->{record}->{quote}  = q{};
$self->{record}->{rating} = q{};
$self->{record}->{name}   = q{};

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

441
442
443
444
445
446
447
448
449
450
451
                # Normalise multipart versions
                $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
        }
        $s =~ s/^(\d+)\.?//;
        my $l = $1 || 0;
        my @v = map {
                $_ . '0' x (3 - length $_)
        } $s =~ /(\d{1,3})\D?/g;
        $l = $l . '.' . join '', @v if @v;
        return $l + 0;
}

 view release on metacpan or  search on metacpan

examples/port-probe-multi.pl  view on Meta::CPAN

10
11
12
13
14
15
16
17
18
19
20
GetOptions (
        "timeout=s" => \$timeout,
        "help" => \&usage,
) or usage();
 
my @probe = map {
        /^(.*):(\d+)$/ or die "Expecting host:port. See $0 --help\n"; [$1, $2, $_];
} @ARGV;
usage() unless @probe;
 
# Real work

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

439
440
441
442
443
444
445
446
447
448
449
}
else {
  $opt{'compat-version'} = 5;
}
 
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
                ? ( $1 => {
                      ($2                  ? ( base     => $2 ) : ()),
                      ($3                  ? ( todo     => $3 ) : ()),
                      (index($4, 'v') >= 0 ? ( varargs  => 1  ) : ()),
                      (index($4, 'p') >= 0 ? ( provided => 1  ) : ()),

ppport.h  view on Meta::CPAN

1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
_aMY_CXT|5.007003||p
_add_range_to_invlist|||
_append_range_to_invlist|||
_core_swash_init|||
_get_encoding|||
_get_regclass_nonbitmap_data|||
_get_swash_invlist|||
_invlistEQ|||
_invlist_array_init|||n
_invlist_contains_cp|||n
_invlist_dump|||

ppport.h  view on Meta::CPAN

2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
ptr_table_free||5.009005|
ptr_table_new||5.009005|
ptr_table_split||5.009005|
ptr_table_store||5.009005|
push_scope|||
put_charclass_bitmap_innards_common|||
put_charclass_bitmap_innards_invlist|||
put_charclass_bitmap_innards|||
put_code_point|||
put_range|||
pv_display|5.006000||p
pv_escape|5.009004||p
pv_pretty|5.009004||p

ppport.h  view on Meta::CPAN

2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
$replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
$replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
$replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
 
if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
  my @deps = map { s/\s+//g; $_ } split /,/, $3;
  my $d;
  for $d (map { s/\s+//g; $_ } split /,/, $1) {
    push @{$depends{$d}}, @deps;
  }
}
 
$need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};

ppport.h  view on Meta::CPAN

3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
  exit 0;
}
 
my @files;
my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
my $srcext = join '|', map { quotemeta $_ } @srcext;
 
if (@ARGV) {
  my %seen;
  for (@ARGV) {
    if (-e) {

ppport.h  view on Meta::CPAN

3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
      $File::Find::name =~ /($srcext)$/i
          and push @files, $File::Find::name;
    }, '.');
  };
  if ($@) {
    @files = map { glob "*$_" } @srcext;
  }
}
 
if (!@ARGV || $opt{filter}) {
  my(@in, @out);
  my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
  for (@files) {
    my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
    push @{ $out ? \@out : \@in }, $_;
  }
  if (@ARGV && @out) {

ppport.h  view on Meta::CPAN

3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
  my($func, $seen) = @_;
  return () unless exists $depends{$func};
  $seen = {%{$seen||{}}};
  return () if $seen->{$func}++;
  my %s;
  grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
}
 
sub parse_version
{
  my $ver = shift;

 view release on metacpan or  search on metacpan

lib/AFS/Command/FS.pm  view on Meta::CPAN

126
127
128
129
130
131
132
133
134
135
my $errors = 0;
 
$errors++ unless $self->_exec_cmds( stderr => 'stdout' );
 
my @paths = ref $args{$pathkey} eq 'ARRAY' ? @{$args{$pathkey}} : ($args{$pathkey});
my %paths = map { $_ => 1 } @paths;
 
my $default = undef; # Used by storebehind
 
while ( defined($_ = $self->{handle}->getline()) ) {

lib/AFS/Command/FS.pm  view on Meta::CPAN

742
743
744
745
746
747
748
749
750
751
752
my $errors = 0;
 
$errors++ unless $self->_exec_cmds( stderr => 'stdout' );
 
my @dirs = ref $args{dir} eq 'ARRAY' ? @{$args{dir}} : ($args{dir});
my %dirs = map { $_ => 1 } @dirs;
 
while ( defined($_ = $self->{handle}->getline()) ) {
 
    my $current = shift @dirs;
    delete $dirs{$current};

 view release on metacpan or  search on metacpan

MANIFEST  view on Meta::CPAN

31
32
33
34
35
36
src/Makefile.PL
src/ppport.h
src/t/Monitor.t
src/afsmon-labels.h
src/Monitor.pm
src/typemap

 view release on metacpan or  search on metacpan

t/style/coverage.t  view on Meta::CPAN

46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
# Load prerequisite modules.
use_prereq('Devel::Cover');
use_prereq('Test::Strict');
 
# Build a list of test directories to use for coverage.
my %ignore = map { $_ => 1 } qw(data docs style), @COVERAGE_SKIP_TESTS;
opendir(my $testdir, 't') or BAIL_OUT("cannot open t: $!");
my @t_dirs = readdir($testdir) or BAIL_OUT("cannot read t: $!");
closedir($testdir) or BAIL_OUT("cannot close t: $!");
 
# Filter out ignored and system directories.
@t_dirs = grep { !$ignore{$_} } File::Spec->no_upwards(@t_dirs);
 
# Prepend the t directory name to the directories.
@t_dirs = map { File::Spec->catfile('t', $_) } @t_dirs;
 
# Disable POD coverage; that's handled separately and is confused by
# autoloading.
$Test::Strict::DEVEL_COVER_OPTIONS
  = '-coverage,statement,branch,condition,subroutine';

 view release on metacpan or  search on metacpan

src/inc/Test/Builder.pm  view on Meta::CPAN

676
677
678
679
680
681
682
683
684
685
686
 
 
sub summary {
    my($self) = shift;
 
    return map { $_->{'ok'} } @Test_Results;
}
 
 
sub details {
    return @Test_Results;

 view release on metacpan or  search on metacpan

lib/AHA.pm  view on Meta::CPAN

130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
    if (ref($arg1) ne "HASH") {
        $self->{host} = $arg1;
        $self->{password} = shift;
        $self->{user} = shift;
    } else {
        map { $self->{$_} = $arg1->{$_} } qw(host password user port);
    }
    die "No host given" unless $self->{host};
    die "No password given" unless $self->{password};
 
    my $base = $self->{port} ? $self->{host} . ":" . $self->{port} : $self->{host};
 
    $self->{ua} = LWP::UserAgent->new;        
    $self->{login_url} = "http://" . $base . "/login_sid.lua";
    $self->{ws_url} = "http://" . $base . "/webservices/homeautoswitch.lua";
    $self->{ain_map} = {};
    return bless $self,$class;
}
 
=item $switches = $aha->list()

lib/AHA.pm  view on Meta::CPAN

154
155
156
157
158
159
160
161
162
163
164
 
=cut
 
sub list {
    my $self = shift;
    return [ map { new AHA::Switch($self,$_) }  (split /\s*,\s*/,$self->_execute_cmd("getswitchlist")) ];
}
 
=item $aha->is_on($ain)
 
Check, whether the switch C<$ain> is in state "on", in which case this methods

lib/AHA.pm  view on Meta::CPAN

255
256
257
258
259
260
261
262
263
264
265
266
267
268
=cut
 
sub ain_by_name {
    my $self = shift;
    my $name = shift;
    my $map = $self->{ain_map};
    return $map->{$name} if $map->{$name};
    $self->_init_ain_map();
    my $ain = $self->{ain_map}->{$name};
    die "No AIN for '$name' found" unless $ain;
    return $ain;
}
 
=item $aha->logout()

lib/AHA.pm  view on Meta::CPAN

354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
    $self->{sid} = ($content =~ /<SID>(.*?)<\/SID>/ && $1);
    print "-- Login, received SID ",$self->{sid} if $DEBUG;
    return $self->{sid};
}
 
# Initialize the reverse name -> AIN map
sub _init_ain_map {
    my $self = shift;
    my $devs = $self->list();
    $self->{ain_map} = {};
    for my $dev (@$devs) {
        $self->{ain_map}->{$self->name($dev->ain())} = $dev->ain();
    }    
}
 
# Convert "inval" to undef
sub _inval_check {

 view release on metacpan or  search on metacpan

lib/AI/ANN.pm  view on Meta::CPAN

132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
                }
        }
 
        # Ok, hopefully all the neurons have happy values by now.
        # Get the output values for neurons corresponding to outputneurons
        my @output = map {$neurons[$_]} @{$self->{'outputneurons'}};
        return \@output;
}
 
 
sub get_state {
        my $self = shift;
        my $net = $self->{'network'}; # For less typing
        my @neurons = map {$net->[$_]->{'state'}} 0..$#{$self->{'network'}};
        my @output = map {$net->[$_]->{'state'}} @{$self->{'outputneurons'}};
 
        return $self->{'inputs'}, \@neurons, \@output;
}

lib/AI/ANN.pm  view on Meta::CPAN

178
179
180
181
182
183
184
185
186
187
188
                        $retval .= "\tInput from input $k, weight is $v\n";
                }
                while (my ($k, $v) = each %{$self->{'network'}->[$i]->{'object'}->neurons()}) {
                        $retval .= "\tInput from neuron $k, weight is $v\n";
                }
                if (map {$_ == $i} $self->{'outputneurons'}) {
                        $retval .= "\tThis neuron is a network output\n";
                }
        }
        return $retval;
}

 view release on metacpan or  search on metacpan

lib/AI/CBR/Retrieval.pm  view on Meta::CPAN

115
116
117
118
119
120
121
122
123
124
125
=cut
 
sub n_most_similar_candidates {
        my ($self, $n) = @_;
        my $last_index = min($n - 1, int @{$self->{candidates}});
        return map { $self->{candidates}->[$_] } (0 .. $last_index);
}
 
=head3 first_confirmed_candidate
 
Returns the first candidate that is confirmed by a later candidate.

 view release on metacpan or  search on metacpan

lib/AI/Calibrate.pm  view on Meta::CPAN

18
19
20
21
22
23
24
25
26
27
28
our %EXPORT_TAGS = (
    'all' => [
        qw(
              calibrate
              score_prob
              print_mapping
            )
    ]
);
 
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

lib/AI/Calibrate.pm  view on Meta::CPAN

58
59
60
61
62
63
64
65
66
67
68
This module calibrates classifier scores using a method called the Pool
Adjacent Violators (PAV) algorithm.  After you train a classifier, you take a
(usually separate) set of test instances and run them through the classifier,
collecting the scores assigned to each.  You then supply this set of instances
to the calibrate function defined here, and it will return a set of ranges
mapping from a score range to a probability estimate.
 
For example, assume you have the following set of instance results from your
classifier.  Each result is of the form C<[ASSIGNED_SCORE, TRUE_CLASS]>:
 
 my $points = [

lib/AI/Calibrate.pm  view on Meta::CPAN

92
93
94
95
96
97
98
99
100
101
102
   [.3,  1/2 ],
   [.2,  1/3 ],
   [.02,   0 ]
  ]
 
This means that, given a SCORE produced by the classifier, you can map the
SCORE onto a probability like this:
 
               SCORE >= .9        prob = 1
         .9  > SCORE >= .7        prob = 3/4
         .7  > SCORE >= .45       prob = 2/3

lib/AI/Calibrate.pm  view on Meta::CPAN

148
149
150
151
152
153
154
155
156
157
158
        print "($score, $prob)\n";
    }
}
 
#  Copy the data over so PAV can clobber the PROB field
my $new_data = [ map([@$_], @$data) ];
 
#   If not already sorted, sort data decreasing by score
if (!$sorted) {
    $new_data = [ sort { $b->[SCORE] <=> $a->[SCORE] } @$new_data ];
}

lib/AI/Calibrate.pm  view on Meta::CPAN

274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
    #  If we drop off the end, probability estimate is zero
    return 0;
}
 
 
=item B<print_mapping>
 
This is a simple utility function that takes the structure returned by
B<calibrate> and prints out a simple list of lines describing the mapping
created.
 
Example calling form:
 
  print_mapping($calibrated);
 
Sample output:
 
  1.00 > SCORE >= 1.00     prob = 1.000
  1.00 > SCORE >= 0.71     prob = 0.667

lib/AI/Calibrate.pm  view on Meta::CPAN

297
298
299
300
301
302
303
304
305
306
307
shows.
 
=back
 
=cut
sub print_mapping {
    my($calibrated) = @_;
    my $last_bound = 1.0;
    for my $tuple (@$calibrated) {
        my($bound, $prob) = @$tuple;
        printf("%0.3f > SCORE >= %0.3f     prob = %0.3f\n",

lib/AI/Calibrate.pm  view on Meta::CPAN

324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
locally increase rather than decrease.  When it finds such groups, it pools
them and replaces their probability estimates with the average of the group's
values.  It continues this process of averaging and replacement until the
entire sequence is monotonically decreasing.  The result is a sequence of
instances, each of which has a score and an associated probability estimate,
which can then be used to map scores into probability estimates.
 
For further information on the PAV algorithm, you can read the section in my
paper referenced below.
 
=head1 EXPORT
 
This module exports three functions: calibrate, score_prob and print_mapping.
 
=head1 BUGS
 
None known.  This implementation is straightforward but inefficient (its time
is O(n^2) in the length of the data series).  A linear time algorithm is

 view release on metacpan or  search on metacpan

lib/AI/Categorizer/Collection.pm  view on Meta::CPAN

21
22
23
24
25
26
27
28
29
30
31
sub new {
  my ($class, %args) = @_;
   
  # Optimize so every document doesn't have to convert the stopword list to a hash
  if ($args{stopwords} and UNIVERSAL::isa($args{stopwords}, 'ARRAY')) {
    $args{stopwords} = { map {+$_ => 1} @{ $args{stopwords} } };
  }
   
  my $self = $class->SUPER::new(%args);
 
  if ($self->{category_file}) {

lib/AI/Categorizer/Collection.pm  view on Meta::CPAN

108
109
110
111
112
113
114
115
116
117
118
 
=over 4
 
=item category_hash
 
Indicates a reference to a hash which maps document names to category
names.  The keys of the hash are the document names, each value should
be a reference to an array containing the names of the categories to
which each document belongs.
 
=item category_file

 view release on metacpan or  search on metacpan

t/state.t  view on Meta::CPAN

27
28
29
30
31
32
ok $tp;
isa_ok( $tp, 'AI::Classifier::Text' );
 
 
################################################################
sub _hash { +{ map {$_,1} @_ } }

 view release on metacpan or  search on metacpan

lib/AI/ConfusionMatrix.pm  view on Meta::CPAN

23
24
25
26
27
28
29
30
31
32
33
tie my @output_array, 'Tie::File', $file or carp "$!";
# Empty the file
@output_array = ();
 
my @columns = @{$cmData{columns}};
map {$output_array[0] .= $delem . $_} join $delem, (@columns, 'TOTAL', 'TP', 'FP', 'FN', 'SENS', 'ACC');
my $line = 1;
my @expected = sort keys %{$matrix};
for my $expected (@expected) {
    $output_array[$line] = $expected;
    my $lastIndex = 0;

lib/AI/ConfusionMatrix.pm  view on Meta::CPAN

52
53
54
55
56
57
58
59
60
61
62
                               );
    ++$line;
}
# Print the TOTAL row to the csv file
$output_array[$line] = 'TOTAL' . $delem;
map {$output_array[$line] .= $cmData{totals}{$_} . $delem} (@columns);
$output_array[$line] .= join $delem, (
                            $cmData{totals}{'total'},
                            $cmData{totals}{'tp'},
                            $cmData{totals}{'fp'},
                            $cmData{totals}{'fn'},

 view release on metacpan or  search on metacpan

eg/example.pl  view on Meta::CPAN

56
57
58
59
60
61
62
63
64
65
66
print "Result 2: $result\n";  # yes
 
 
 
# Show the created tree structure as rules
print map "$_\n", $dtree->rule_statements;
 
 
# Will barf on inconsistent data
my $t2 = new AI::DecisionTree;
$t2->add_instance( attributes => { foo => 'bar' },

 view release on metacpan or  search on metacpan

lib/AI/Evolve/Befunge/Blueprint.pm  view on Meta::CPAN

65
66
67
68
69
70
71
72
73
74
75
} else {
    $$self{size} = length($$self{code});
}
croak("code has a non-orthogonal size!")
    unless ($$self{size}**$$self{dims}) == length($$self{code});
$$self{size}      = Language::Befunge::Vector->new(map { $$self{size} } (1..$$self{dims}));
$$self{fitness}   = $args{fitness} // 0;
$$self{id}        = $args{id}          if exists $args{id};
$$self{host}      = $args{host}        if exists $args{host};
$$self{id}        = $self->new_popid() unless defined $$self{id};
$$self{host}      = $ENV{HOST}         unless defined $$self{host};