package Statistics::Basic::LeastSquareFit;
use strict;
use warnings;
use Carp;
use base 'Statistics::Basic::_TwoVectorBase';
use overload
'""' => sub {
my ($alpha,$beta) = map{$Statistics::Basic::fmt->format_number($_, $Statistics::Basic::IPRES)} $_[0]->query;
"LSF( alpha: $alpha, beta: $beta )";
},
'0+' => sub { croak "the result of LSF may not be used as a number" },
fallback => 1; # tries to do what it would have done if this wasn't present.
# new {{{
sub new {
my $this = shift;
my @var1 = (shift || ());
my @var2 = (shift || ());
my $v1 = eval { Statistics::Basic::Vector->new( @var1 ) } or croak $@;
my $v2 = eval { Statistics::Basic::Vector->new( @var2 ) } or croak $@;
$this = bless {}, $this;
my $c = $v1->_get_linked_computer( LSF => $v2 );
return $c if $c;
$this->{_vectors} = [ $v1, $v2 ];
$this->{vrx} = eval { Statistics::Basic::Variance->new($v1) } or croak $@;
$this->{mnx} = eval { Statistics::Basic::Mean->new($v1) } or croak $@;
$this->{mny} = eval { Statistics::Basic::Mean->new($v2) } or croak $@;
$this->{cov} = eval { Statistics::Basic::Covariance->new($v1, $v2) } or croak $@;
$v1->_set_linked_computer( LSF => $this, $v2 );
$v2->_set_linked_computer( LSF => $this, $v1 );
return $this;
}
# }}}
# _recalc {{{
sub _recalc {
my $this = shift;
delete $this->{recalc_needed};
delete $this->{alpha};
delete $this->{beta};
my $vrx = $this->{vrx}->query; return unless defined $vrx; return unless $vrx > 0;
my $mnx = $this->{mnx}->query; return unless defined $mnx;
my $mny = $this->{mny}->query; return unless defined $mny;
my $cov = $this->{cov}->query; return unless defined $cov;
$this->{beta} = ($cov / $vrx);
$this->{alpha} = ($mny - ($this->{beta} * $mnx));
warn "[recalc " . ref($this) . "] (alpha: $this->{alpha}, beta: $this->{beta})\n" if $Statistics::Basic::DEBUG;
return;
}
# }}}
# query {{{
sub query {
my $this = shift;
$this->_recalc if $this->{recalc_needed};
warn "[query " . ref($this) . " ($this->{alpha}, $this->{beta})]\n" if $Statistics::Basic::DEBUG;
return (wantarray ? ($this->{alpha}, $this->{beta}) : [$this->{alpha}, $this->{beta}] );
}
# }}}
# query_vector1 {{{
sub query_vector1 {
my $this = shift;
return $this->{cov}->query_vector1;
}
# }}}
# query_vector2 {{{
sub query_vector2 {
my $this = shift;
return $this->{cov}->query_vector2;
}
# }}}
# query_mean1 {{{
sub query_mean1 {
my $this = shift;
return $this->{mnx};
}
# }}}
# query_variance1 {{{
sub query_variance1 {
my $this = shift;
return $this->{vrx};
}
# }}}
# query_covariance {{{
sub query_covariance {
my $this = shift;
return $this->{cov};
}
# }}}
# y_given_x {{{
sub y_given_x {
my $this = shift;
my ($alpha, $beta) = $this->query;
my $x = shift;
return ($beta*$x + $alpha);
}
# }}}
# x_given_y {{{
sub x_given_y {
my $this = shift;
my ($alpha, $beta) = $this->query;
my $y = shift;
defined( my $x = eval { ( ($y-$alpha)/$beta ) }) or croak $@;
return $x;
}
# }}}
1;