File: _TwoVectorBase.pm

package info (click to toggle)
libstatistics-basic-perl 1.6611-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, sid, trixie
  • size: 392 kB
  • sloc: perl: 947; makefile: 2
file content (115 lines) | stat: -rw-r--r-- 2,933 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
package Statistics::Basic::_TwoVectorBase;

use strict;
use warnings;
use Carp;

use Statistics::Basic; # make sure all the basic classes are loaded

use overload
    '""' => sub { defined( my $v = $_[0]->query ) || return "n/a"; $Statistics::Basic::fmt->format_number("$v", $Statistics::Basic::IPRES) },
    '0+' => sub { $_[0]->query },
    ( defined($Statistics::Basic::TOLER) ? ('==' => sub { abs($_[0]-$_[1])<=$Statistics::Basic::TOLER }) : () ),
    'eq' => sub { "$_[0]" eq "$_[1]" },
    'bool' => sub { 1 },
    fallback => 1; # tries to do what it would have done if this wasn't present.

# query {{{
sub query {
    my $this = shift;

    $this->_recalc if $this->{recalc_needed};

    warn "[query " . ref($this) . " $this->{_value}]\n" if $Statistics::Basic::DEBUG;

    return $this->{_value};
}
# }}}
# query_size {{{
sub query_size {
    my $this = shift;

    my @v = @{$this->{_vectors}};
    return ($v[0]->query_size, $v[1]->query_size); # list rather than map{} so this can be a scalar
}

# maybe deprecate this later
*size = \&query_size unless $ENV{TEST_AUTHOR};

# }}}
# set_size {{{
sub set_size {
    my $this = shift;
    my $size = shift;
    my $nofl = shift;

    eval { $_->set_size($size, $nofl) for @{$this->{_vectors}}; 1 } or croak $@;

    return $this;
}
# }}}
# insert {{{
sub insert {
    my $this = shift;

    warn "[insert " . ref($this) . "]\n" if $Statistics::Basic::DEBUG;

    croak ref($this) . "-insert() takes precisely two arguments.  They can be arrayrefs if you like." unless 2 == int @_;

    my $c = 0;
    $_->insert( $_[$c++] ) for @{$this->{_vectors}};

    return $this;
}
# }}}
# ginsert {{{
sub ginsert {
    my $this = shift;

    warn "[ginsert " . ref($this) . "]\n" if $Statistics::Basic::DEBUG;

    croak "" . ref($this) . "-ginsert() takes precisely two arguments.  They can be arrayrefs if you like." 
        unless 2 == int @_;

    my $c = 0;
    $_->ginsert( $_[$c++] ) for @{$this->{_vectors}};

    my @s = $this->query_size;
    croak "Uneven ginsert detected, the two vectors in a " . ref($this) . " object must remain the same length."
        unless $s[0] == $s[1];

    return $this;
}
*append = \&ginsert;
# }}}
# set_vector {{{
sub set_vector {
    my $this = shift;

    warn "[set_vector " . ref($this) . "]\n" if $Statistics::Basic::DEBUG;

    croak "this set_vector() takes precisely two arguments.  They can be arrayrefs if you like." 
        unless 2 == int @_;

    my $c = 0;
    $_->set_vector( $_[$c++] ) for @{$this->{_vectors}};

    my @s = $this->query_size;
    croak "Uneven set_vector detected, the two vectors in a " . ref($this) . " object must remain the same length."
        unless $s[0] == $s[1];

    return $this;
}
# }}}
# _recalc_needed {{{
sub _recalc_needed {
    my $this = shift;
       $this->{recalc_needed} = 1;

    warn "[recalc_needed " . ref($this) . "]\n" if $Statistics::Basic::DEBUG;

    return;
}
# }}}

1;