File Coverage

blib/lib/Math/VecStat.pm

Criterion	Covered	Total	%
statement	111	122	90.9
branch	37	58	63.7
condition	4	6	66.6
subroutine	13	15	86.6
pod	13	13	100.0
total	178	214	83.1

require Exporter;
package Math::VecStat;
@Math::VecStat::ISA=qw(Exporter);
@EXPORT_OK=qw(max min maxabs minabs sum average
	vecprod ordered convolute
	sumbyelement diffbyelement
	allequal median);
$Math::VecStat::VERSION = '0.08';

use strict;

sub max {
  my $v=ref($_[0]) ? $_[0] : \@_;
  my $i=$#{$v};
  my $j=$i;
  my $m=$v->[$i];
  while (--$i >= 0) { if ($v->[$i] > $m) { $m=$v->[$i]; $j=$i; }}
  return wantarray ? ($m,$j): $m;
}

sub min {
  my $v=ref($_[0]) ? $_[0] : \@_;
  my $i=$#{$v};
  my $j=$i;
  my $m=$v->[$i];
  while (--$i >= 0) { if ($v->[$i] < $m) { $m=$v->[$i]; $j=$i; }}
  return wantarray ? ($m,$j): $m;
}

sub maxabs {
  my $v=ref($_[0]) ? $_[0] : \@_;
  my $i=$#{$v};
  my $j=$i;
  my $m=abs($v->[$i]);
  while (--$i >= 0) { if (abs($v->[$i]) > $m) { $m=abs($v->[$i]); $j=$i}}
  return (wantarray ? ($m,$j) : $m);
}

sub minabs {
   my $v=ref($_[0]) ? $_[0] : \@_;
   my $i=$#{$v};
   my $j=$i;
   my $m=abs($v->[$i]);
   while (--$i >= 0) { if (abs($v->[$i]) < $m) { $m=abs($v->[$i]); $j=$i}}
   return (wantarray ? ($m,$j) : $m);
}

sub sum {
  my $v=ref($_[0]) ? $_[0] : \@_;
  my $s=0;
  foreach(@{$v}) { $s+=$_; }
  return $s;
}

# [e-mail], handle the empty array case
sub average {
  my $v=ref($_[0]) ? $_[0] : \@_;
  return undef unless $#{$v} >= 0;
  return $#{$v}==-1 ? 0 : sum($v)/(1+$#{$v});
}

sub vecprod {
  my $c = shift;
  my $v=ref($_[0]) ? $_[0] : \@_;
  return undef unless $#{$v} >= 0;
  my @result = map( $_ * $c, @{$v} );
  return \@result;
}

sub ordered
{
	my $v=ref($_[0]) ? $_[0] : \@_;
	if( scalar( @{$v} ) < 2 ){ return 1; }
	for(my $i=0; $i<$#{$v}; $i++ ){
		return 0 if $v->[$i] > $v->[$i+1];
	}
	return 1;
}

sub allequal
{
	my($v,$u) = @_;
	return undef unless (defined($v) and defined($u)); # this is controversial
	return undef unless ($#{$v} == $#{$u});
	my $i= @{$v};
	while (--$i >= 0) { return 0 unless( $v->[$i] == $u->[$i]); }
	return 1;
}

sub sumbyelement
{
	my($v,$u) = @_;

	return undef unless ($#{$v} == $#{$u});
	my @summed;
	my $i= @{$v};
	while (--$i >= 0) { $summed[$i] = $v->[$i] + $u->[$i]; }
	return \@summed;
}

sub diffbyelement
{
	my($v,$u) = @_;

	return undef unless ($#{$v} == $#{$u});
	my @summed;
	my $i= @{$v};
	while (--$i >= 0) { $summed[$i] = $v->[$i] - $u->[$i]; }
	return \@summed;
}

sub convolute
{
	my($v,$u) = @_;

	return undef unless ($#{$v} == $#{$u});
	my @conv;
	my $i= @{$v};
	while (--$i >= 0) { $conv[$i] = $v->[$i]*$u->[$i]; }
	return \@conv;
}

sub _justToAvoidWarnings
{
	my $a = $Math::VecStat::VERSION;
}

sub median
{
	my $v=ref($_[0]) ? $_[0] : \@_;
	my $n = scalar @{$v};

# generate a list of [value,index] pairs
	my @tras =	map( [$v->[$_],$_], 0..$#{$v} );
# sort by ascending value, then by original position
# suggested by [e-mail]
	my @sorted = sort { ($a->[0] <=> $b->[0])
		or ($a->[1] <=> $b->[1]) } @tras;
# find the middle ordinal
	my $med = int( $n / 2 );

# when there are several identical median values
# we arbitrarily (but consistently) choose the first one
# in the original array

	while( ($med >= 1) && ($sorted[$med]->[0] == $sorted[$med-1]->[0]) ){
		$med--;
	}

	return $sorted[$med];
}


1;

__END__