File Coverage

blib/lib/AI/Categorizer/Util.pm
Criterion Covered Total %
statement 34 52 65.3
branch 12 24 50.0
condition n/a
subroutine 7 11 63.6
pod 0 6 0.0
total 53 93 56.9


line stmt bran cond sub pod time code
1             package AI::Categorizer::Util;
2              
3 12     12   7508 use Exporter;
  12         21  
  12         474  
4 12     12   57 use base qw(Exporter);
  12         18  
  12         969  
5             @EXPORT_OK = qw(intersection average max min random_elements binary_search);
6              
7 12     12   65 use strict;
  12         20  
  12         821  
8              
9             # It's possible that this can be a class - something like
10             #
11             # $e = Evaluate->new(); $e->correct([...]); $e->assigned([...]); print $e->precision;
12              
13             # A simple binary search
14             sub binary_search {
15 5     5 0 292 my ($arr, $target) = @_;
16 5         7 my ($low, $high) = (0, scalar @$arr);
17 12     12   9877 use integer;
  12         106  
  12         84  
18 5         12 while ( $low < $high ) {
19 10         12 my $cur = ($low + $high)/2;
20 10 100       13 if ( $arr->[$cur] < $target ) {
21 4         9 $low = $cur + 1;
22             } else {
23 6         11 $high = $cur;
24             }
25             }
26 5         20 return $low;
27             }
28              
29             sub max {
30 4 50   4 0 12 return undef unless @_;
31 4         6 my $max = shift;
32 4         8 foreach (@_) {
33 22 100       45 $max = $_ if $_ > $max;
34             }
35 4         10 return $max;
36             }
37              
38             sub min {
39 0 0   0 0 0 return undef unless @_;
40 0         0 my $min = shift;
41 0         0 foreach (@_) {
42 0 0       0 $min = $_ if $_ > $min;
43             }
44 0         0 return $min;
45             }
46              
47             sub average {
48 0 0   0 0 0 return undef unless @_;
49 0         0 my $total;
50 0         0 $total += $_ foreach @_;
51 0         0 return $total/@_;
52             }
53              
54             sub intersection {
55 0     0 0 0 my ($one, $two) = @_;
56 0         0 $two = _hashify($two);
57              
58 0         0 return UNIVERSAL::isa($one, 'HASH') ? # Accept hash or array for $one
59 0         0 grep {exists $two->{$_}} keys %$one :
60 0 0       0 grep {exists $two->{$_}} @$one;
61             }
62              
63             sub _hashify {
64 0 0   0   0 return $_[0] if UNIVERSAL::isa($_[0], 'HASH');
65 0         0 return {map {$_=>1} @{$_[0]}};
  0         0  
  0         0  
66             }
67              
68             sub random_elements {
69 2     2 0 748 my ($a_ref, $n) = @_;
70 2 50       8 return @$a_ref if $n >= @$a_ref;
71            
72 2 100       8 my ($select, $mode) = ($n < @$a_ref/2) ? ($n, 'include') : (@$a_ref - $n, 'exclude');
73              
74 2         3 my %i;
75 2         78 $i{int rand @$a_ref} = 1 while keys(%i) < $select;
76              
77 2 100       10 return @{$a_ref}[keys %i] if $mode eq 'include';
  1         7  
78 1 100       4 return map {$i{$_} ? () : $a_ref->[$_]} 0..$#$a_ref;
  10         27  
79             }
80              
81             1;