File Coverage

blib/lib/Statistics/Robust/Location.pm

Criterion	Covered	Total	%
statement	62	80	77.5
branch	5	14	35.7
condition			n/a
subroutine	10	11	90.9
pod	5	5	100.0
total	82	110	74.5

package Statistics::Robust::Location;

use strict;
use warnings;
use Carp;

use Math::CDF qw(pbeta);
use POSIX qw(floor);

use base 'Statistics::Robust';

our @EXPORT = ();
our @EXPORT_OK = (qw(
median
win
tmean
mean
hd
));
our %EXPORT_TAGS = ( all => \@EXPORT_OK );

# Implement the median to avoid needing Statistics::Basic
# which has silly Number::Format requirements (Version 1.6004)
sub
median
{
 my($x) = @_;

 my @y = sort {$a <=> $b} @$x;
 my $length = scalar @y;

 my $median = undef;
 if ( $length % 2 )
 {
  my $half = int ($length/2);
  $median = $y[$half];
 }
 else
 {
  my $lower_half = int (($length-1)/2);
  my $upper_half = int  ($length/2);

  $median = ($y[$lower_half] + $y[$upper_half])/2;
 }

 return $median;
}


# The gamma Winsorized mean
sub
win
{
 my($x,$gamma) = @_;

 if ( not defined $gamma )
 {
  $gamma = 0.2;
 }

 my @y = sort {$a <=> $b} @$x;
 my $n = scalar @y;
 my $ibot = floor($gamma*$n) + 1;
 my $itop = $n - $ibot + 1;
 my $xbot = $y[$ibot];
 my $xtop = $y[$itop];

 for(my $i=0;$i<@y;$i++)
 {
  if ( $y[$i] <= $xbot )
  {
   $y[$i] = $xbot;
  }
  if ( $y[$i] >= $xtop )
  {
   $y[$i] = $xtop;
  }
 }

 my $win = mean(\@y);
 return $win;
}

# The trimmed mean
sub
tmean
{
 my($x,$tr) = @_;

 if ( not defined $tr )
 {
  $tr = 0.2;
 }

 my @y = sort {$a <=> $b} @$x;
 my $n = scalar @y;
 my $g = floor($tr*$n);

 my $tmean = 0.0;
 for(my $i=$g;$i<($n-$g);$i++)
 {
  $tmean += $y[$i];
 }
 $tmean = $tmean/($n - 2*$g);

 return $tmean;
}

# The Harrel-Davis Estimator for quantiles
sub
hd
{
 my($x,$q) = @_;

 if ( not defined $q )
 {
  $q = 0.5;
 }
 my $n = scalar @$x;
 my $m1 = ($n+1)*$q;
 my $m2 = ($n+1)*(1-$q);
 my @y = sort  {$a <=> $b} @$x;

 my @wy = ();
 for(my $i=1;$i<=$n;$i++)
 {
  my $w = pbeta(($i/$n),$m1,$m2) - pbeta(($i-1)/$n, $m1,$m2);
  $wy[$i-1] = $w*$y[$i-1];
 }

 my $hd = Statistics::Robust::_sum(\@wy);

 return $hd;
}

sub
mean
{
 my($x) = @_;

 my $n = scalar @$x;
 if ( $n == 0 ) { return undef;}
 my $sum = Statistics::Robust::_sum($x);
 my $mean = $sum/$n;

 return $mean;
}

1;

=head1 NAME

Statistics::Robust::Location - Robust Location Estimators

=head1 SYNOPSIS

 my @x = (1,4,5,3,7,2,4);

 my($tmean) = tmean(\@x);

 my($win) = win(\@x);

=head1 FUNCTIONS

=head2 win

 my($win) = win(\@x,$gamma);

 Return the gamma Winsorized mean.  If gamma is not specified, it defaults to 0.2.

=head2 tmean

 my($tmean) = tmean(\@x,$tr);

 Return the trimmed mean.  If $tr is not specified, it defaults to 0.2.

=head2 mean

 my($mean) = mean(\@x);

 Although not a robust measure of location, it is useful for comparison as well as used internally in the computation
 of some robust methods. This returns the mean of the array @x.

=head2 hd

 my($est) = hd(\@x, $q)

 The Harell-Davis Estimator for the quantile $q.

=head2 median

 my($median) = median(\@x);

 Return the median

=head1 AUTHOR

Walter Szeliga C<<  >>

=cut