File Coverage

blib/lib/Statistics/Basic/_TwoVectorBase.pm
Criterion Covered Total %
statement 66 66 100.0
branch 16 28 57.1
condition n/a
subroutine 17 17 100.0
pod 6 6 100.0
total 105 117 89.7


line stmt bran cond sub pod time code
1             package Statistics::Basic::_TwoVectorBase;
2              
3 33     33   189 use strict;
  33         60  
  33         1085  
4 33     33   149 use warnings;
  33         37  
  33         704  
5 33     33   136 use Carp;
  33         45  
  33         1650  
6              
7 33     33   149 use Statistics::Basic; # make sure all the basic classes are loaded
  33         52  
  33         248  
8              
9             use overload
10 11 50   11   795 '""' => sub { defined( my $v = $_[0]->query ) || return "n/a"; $Statistics::Basic::fmt->format_number("$v", $Statistics::Basic::IPRES) },
  11         89  
11 10     10   45 '0+' => sub { $_[0]->query },
12 11     11   6384 ( defined($Statistics::Basic::TOLER) ? ('==' => sub { abs($_[0]-$_[1])<=$Statistics::Basic::TOLER }) : () ),
13 4     4   161 'eq' => sub { "$_[0]" eq "$_[1]" },
14 52     52   128 'bool' => sub { 1 },
15 33 100   33   191 fallback => 1; # tries to do what it would have done if this wasn't present.
  33         45  
  33         432  
16              
17             # query {{{
18             sub query {
19 48     48 1 69 my $this = shift;
20              
21 48 100       177 $this->_recalc if $this->{recalc_needed};
22              
23 48 50       88 warn "[query " . ref($this) . " $this->{_value}]\n" if $Statistics::Basic::DEBUG;
24              
25 48         170 return $this->{_value};
26             }
27             # }}}
28             # query_size {{{
29             sub query_size {
30 18     18 1 20 my $this = shift;
31              
32 18         15 my @v = @{$this->{_vectors}};
  18         33  
33 18         40 return ($v[0]->query_size, $v[1]->query_size); # list rather than map{} so this can be a scalar
34             }
35              
36             # maybe deprecate this later
37             *size = \&query_size unless $ENV{TEST_AUTHOR};
38              
39             # }}}
40             # set_size {{{
41             sub set_size {
42 1     1 1 2 my $this = shift;
43 1         2 my $size = shift;
44 1         2 my $nofl = shift;
45              
46 1 50       2 eval { $_->set_size($size, $nofl) for @{$this->{_vectors}}; 1 } or croak $@;
  1         2  
  1         7  
  1         3  
47              
48 1         2 return $this;
49             }
50             # }}}
51             # insert {{{
52             sub insert {
53 6     6 1 246 my $this = shift;
54              
55 6 50       17 warn "[insert " . ref($this) . "]\n" if $Statistics::Basic::DEBUG;
56              
57 6 50       20 croak ref($this) . "-insert() takes precisely two arguments. They can be arrayrefs if you like." unless 2 == int @_;
58              
59 6         15 my $c = 0;
60 6         13 $_->insert( $_[$c++] ) for @{$this->{_vectors}};
  6         48  
61              
62 6         9 return $this;
63             }
64             # }}}
65             # ginsert {{{
66             sub ginsert {
67 12     12 1 57 my $this = shift;
68              
69 12 50       21 warn "[ginsert " . ref($this) . "]\n" if $Statistics::Basic::DEBUG;
70              
71 12 50       26 croak "" . ref($this) . "-ginsert() takes precisely two arguments. They can be arrayrefs if you like."
72             unless 2 == int @_;
73              
74 12         12 my $c = 0;
75 12         27 $_->ginsert( $_[$c++] ) for @{$this->{_vectors}};
  12         47  
76              
77 12         22 my @s = $this->query_size;
78 12 50       23 croak "Uneven ginsert detected, the two vectors in a " . ref($this) . " object must remain the same length."
79             unless $s[0] == $s[1];
80              
81 12         22 return $this;
82             }
83             *append = \&ginsert;
84             # }}}
85             # set_vector {{{
86             sub set_vector {
87 6     6 1 20 my $this = shift;
88              
89 6 50       24 warn "[set_vector " . ref($this) . "]\n" if $Statistics::Basic::DEBUG;
90              
91 6 50       16 croak "this set_vector() takes precisely two arguments. They can be arrayrefs if you like."
92             unless 2 == int @_;
93              
94 6         8 my $c = 0;
95 6         14 $_->set_vector( $_[$c++] ) for @{$this->{_vectors}};
  6         31  
96              
97 6         30 my @s = $this->query_size;
98 6 50       22 croak "Uneven set_vector detected, the two vectors in a " . ref($this) . " object must remain the same length."
99             unless $s[0] == $s[1];
100              
101 6         11 return $this;
102             }
103             # }}}
104             # _recalc_needed {{{
105             sub _recalc_needed {
106 156     156   125 my $this = shift;
107 156         162 $this->{recalc_needed} = 1;
108              
109 156 50       232 warn "[recalc_needed " . ref($this) . "]\n" if $Statistics::Basic::DEBUG;
110              
111 156         341 return;
112             }
113             # }}}
114              
115             1;