=head1 NAME

weco - Perl modul to apply something 
like Western Electric SPC trend rules input data.

=head1 SYNOPSIS

use weco

=head1 DESCRIPTION

The modul follows an object oriented approach. A object contains
the data and different sigmas can be defined for above and below target,
to be used with non symmetric distributions. 

currently existing rules 1-7

$self->check_x_y_z_s cchcks if x out of the last y samples
where more than z sigma away from the target to the same side.

=over 4

=item $self->check_x_y_z_s(1,1,3),

=item $self->check_x_y_z_s(2,3,2),
 
=item $self->check_x_y_z_s(4,5,1),

=item $self->check_x_above_below(9),

=item $self->check_x_up_down(7),

=item $self->check_one_out_x(10),

=item $self->check_all_in_x(15)

=back

=head1 PREREQUISITES

C<Statistics::Descriptive>

=head1 COREQUISITES

none

=head1 TODO

Any other good suggestions that people send me!

=head1 BUGS

Probably, but at moment not known.


=head1 AUTHOR

Gerhard Spitzlsperger
gerhard.spitzlsperger@gs68.de
http://www.gs68.de

=head1 COPYRIGHT AND LICENSE

Copyright (c) 1999 - 2004, Gerhard Spitzlsperger. All Rights Reserved.

This program is free software; you can redistribute it and/or modify it under
the same terms as Perl.

=cut

use strict;
use Statistics::Descriptive;	

package weco;

sub new
{
  my $class = shift;
  my $self = {};  

  $self->{'sigma_up'} = shift;

  $self->{'sigma_down'} = shift;

  $self->{'center'} = shift;

  # necessary points, how many points necessary
  # to check all rules
  $self->{'nec_points'} = 15;
  
  # array to store applicable rules 
  $self->{'rules'} = [];

  # hash to store rule description
  $self->{'rules_des'} = 
  {
    1 => '1 value out of 3 sigma',
    2 => '2 out of 3 values are out of 2 sigma to the same side',
    3 => '4 out of 5 values are out of 1 sigma to the same side',
    4 => '9 successive points are above or below the target line',
    5 => '7 successive points have increasing or decreasing values',
    6 => 'only 1 point out of 10 points is within 1 sigma',
    7 => '15 successive points are within 1 sigma'
   };


  # data for the run
  $self->{'data'} = [];

  bless($self, $class);

  return $self;
}



sub analyze
{
    my $self = shift;

    my $result = {};
    my @data = ();

    my $count = @{$self->{'data'}};
    if ($count > 100)
    {
	print "Check number of data: $#{$self->{'data'}}\n";
	
	my $i;
	for ($i = 0; $i < 100; $i++)
	{
	    push (@data, $self->{'data'}->[$i]);
	}

	print "\n\nCheck dataset: @data \n";
    }
    else
    {
	my $i;
	foreach $i (@{$self->{'data'}})
	{
	    push (@data, $i);
	}
    }


    ### Array of data for calculating statistical values
    my $data = Statistics::Descriptive::Full->new();	
    $data->add_data(@data);

    #$data->add_data(@{$self->{'data'}});

    print "\n\n starting analysis ... \n";

    ### Calculating mean and assigning it to hash %result
    my $mean =  $data->mean();
    print "mean: $mean\n";
    $result->{'mean'} = $mean;

    ### Calculating median and assigning it to hash %result
    my $median =  $data->median();
    print "median: $median\n";
    $result->{'median'} = $median;

    ### Calculating max and assigning it to hash %result
    my $max =  $data->max();
    print "max: $max\n";
    $result->{'max'} = $max;

    ### Calculating min and assigning it to hash %result
    my $min =  $data->min();
    print "min: $min\n";
    $result->{'min'} = $min;

    ### Calculating of range and assigning it to hash %result
    my $range =  $data->sample_range();
    print "range: $range\n";    
    $result->{'range'} = $range;

    ### Calculating of standard deviation and assigning it to hash %result
    my $sigma =  $data->standard_deviation();
    print "sigma: $sigma\n";
    $result->{'sigma'} = $sigma;

    print "now separating data ... \n";

    my $udata = Statistics::Descriptive::Full->new();	    
    my $ldata = Statistics::Descriptive::Full->new();	

    ### for all elements in array with reference $self->{'data'}:
    ### assigning it to different lists corresponding to its position to median line
    ### calculating reflected point relating to the median line
    #for(my $i = 0; $i <= $#{$self->{'data'}}; $i++)
    for(my $i = 0; $i <= $#data; $i++)
    {
	# if( $self->{'data'}->[$i] >= $median)
	if( $data[$i] >= $median)
	{
	    #$udata->add_data($self->{'data'}->[$i]);
	    $udata->add_data($data[$i]);

	    ### add also the corresponding lower entry
	    #my $d = $self->{'data'}->[$i] - $median;
	    my $d = $data[$i] - $median;

	    $udata->add_data($median - $d);
	}	
	
	#if( $self->{'data'}->[$i] <= $median)
	if( $data[$i] <= $median)
	{
	    #$ldata->add_data($self->{'data'}->[$i]);
	    $ldata->add_data($data[$i]);

	    ### add also the corresponding lower entry
	    #my $d = $median - $self->{'data'}->[$i];
	    my $d = $median - $data[$i];

	    $ldata->add_data($median + $d);
	}
    }

    ### calculating an 'upper standard deviation' and assigning it to hash %result 
    my $usigma =  $udata->standard_deviation();
    $result->{'sigma_u'} = $usigma;

    ### calculating a 'lower standard deviation' and assigning it to hash %result
    my $lsigma =  $ldata->standard_deviation();
    $result->{'sigma_l'} = $lsigma;

    return $result;
}



sub add_data
{
  my $self = shift;
  my $d = shift; 

  ### Inserting value $d at the beginning of array with reference $self->{'data'}
  unshift(@{$self->{'data'}}, $d);
}



sub add_rule
{
  my $self = shift;
  my $d = shift;

  ### Returns error message if rule definition (number) is invalid
  return ("invalid rule number\n")
    if( $d < 1 || $d > 7 );

  ###  Inserting  rulenumber at beginning of  array with reference $self->{'rules'}
  unshift(@{$self->{'rules'}}, $d);
}



sub check
{
  my $self = shift;
  my %result = (); 
  my $key;
   
   ### Error message if not enough points are in dataset to check rules
  return ("not enough points in history to check all rules\n")
    if( $#{$self->{'data'}} <=  $self->{'nec_points'} );

  
   ### Call of subroutines for rule check corresponding to the selection of rules 
   ### (in array with ref $self->{'rules'})
   ### Assigning results for all rules to hash %result
  foreach $key (@{$self->{'rules'}})
  {
      if( $key == 1 )
      {
	  $result{$key} = $self->check_x_y_z_s(1,1,3);
      }
      elsif( $key == 2 )
      {
	  $result{$key} = $self->check_x_y_z_s(2,3,2);
      }
      elsif( $key == 3 )
      {
	  $result{$key} =  $self->check_x_y_z_s(4,5,1);
      }
      elsif( $key == 4 )
      {
	  $result{$key} = $self->check_x_above_below(9);
      }
      elsif( $key == 5 )
      {
	  $result{$key} = $self->check_x_up_down(7);
      }
      elsif( $key == 6 )
      {
	  $result{$key} = $self->check_one_out_x(10);
      }
      elsif( $key == 7 )
      {
	  $result{$key} = $self->check_all_in_x(15);
      }
  }
  ### Returns result of rulecheck 
  return %result;
}



#
# print the object
#
sub print
{
    my $self = shift;
  
    #print "target: $self->{'center'}\n";
    #print "sigma up: $self->{'sigma_up'}\n";
    #print "sigma down: $self->{'sigma_down'}\n";
    #print "valid rules: @{$self->{'rules'}}\n";
    #print "current data: @{$self->{'data'}}\n";
}



#
# x out of y points are outside z sigma
#
sub check_x_y_z_s
{
    my $self   = shift;
    my $points = shift;
    my $total  = shift;
    my $times  = shift; 

    ### calculating upper/lower limit
    my $limit_up = $times*$self->{'sigma_up'};
    my $limit_down = $times*$self->{'sigma_down'};

    my $count  = 0;
    
    ### distance of last datapoint from center 
    my $d0 = ${$self->{'data'}}[0] - $self->{'center'};
    
    ### recognize if latest point is out  (upper limit)
    if( $d0 > $limit_up )
    { 
	$count += 1; 			### one point is out of $times * Sigma --> counter = 1 
        
	my $j;
        	for( $j = 1; $j < $total; $j++)              ### for second last point to $total last point
		{
	    	  my $d = ${$self->{'data'}}[$j] - $self->{'center'};		### distance from center
	    	  $count += 1 						### increasing counter for values if
               			if( $d > $limit_up && $d * $d0 > 0.0 );		### 	      point is out of 	$times * Sigma
		}							### 	and on same side from center like last point
    }
    ### recognize if latest point is out  (lower limit)
    ### minus is important as $d0 is negative and we compare it to a 
    ### positive value    
    elsif( -1.0 * $d0 > $limit_down )
    {
	$count += 1; 			### one point is out of $times * Sigma --> counter = 1 
        
        my $j;
        for( $j = 1; $j < $total; $j++)		 ### for second last point to $total last point
	{
	    my $d = ${$self->{'data'}}[$j] - $self->{'center'};			### distance from center
	    $count += 1 							### increasing counter for values if
               if( -1.0 * $d > $limit_down && $d * $d0 > 0.0 );			### 	      point is out of 	$times * Sigma
	}								### 	and on same side from center like last point
    }

    ### first point is not counted		???
    return ($count >= $points) ? 1 : 0;			### 1 if rule violated, 0 otherwise
}



#
# x successive points are above or below center
#
sub check_x_above_below
{
    my $self   = shift;
    my $points = shift;
 
    my $count  = 1;
    my $d0 = ${$self->{'data'}}[0] - $self->{'center'};		### distance of last point from center
    
    my $j;
    for( $j = 1; $j < $points; $j++)				### for second point to $points point		
    {
	my $d = ${$self->{'data'}}[$j] - $self->{'center'};	### distance from center
	$count += 1 if( $d * $d0 > 0.0 );			### increasing counter if point is on same side from center like last point
    }

    return ($count == $points) ? 1 : 0;			### 1 if rule violated, 0 otherwise
}



#
# x successive points have increasing or decreasing values
#
sub check_x_up_down
{
    my $self   = shift;
    my $points = shift;
 
    my $result = 0;
    my $count = 1;

    my $d0 = ${$self->{'data'}}[0] - ${$self->{'data'}}[1];		### distance between last two points
    ###
    ### if last two values are same no tendency        
    return 0 if( $d0 == 0.0 );

    my $j;
    for( $j = 1; $j < $points; $j++)				### for second point to $points point					
    {
        my $d = ${$self->{'data'}}[$j] - ${$self->{'data'}}[$j+1];	### distance between two succeeding points

	$count += 1 if( $d * $d0 > 0.0 );			### increasing counter if distance has same sign like 
    }							###  	distance between last two points 

    return ($count == $points) ? 1 : 0;			### 1 if rule violated, 0 otherwise
}



#
# only one out of x points is inside +/- sigma
#
sub check_one_out_x
{
    my $self   = shift;
    my $total = shift;
 
    my $count = 1;

    my $d0 = ${$self->{'data'}}[0] - $self->{'center'};		### distance of last point from center
    
    ### recognize if latest point is out
    if( $d0 > $self->{'sigma_up'} || -1.0 * $d0 > $self->{'sigma_down'})
    {
        my $j=1;
        while( $j < $total )						### from second last to $total last point
	{
	    my $d = ${$self->{'data'}}[$j++] - $self->{'center'};		### distance from center	
	    $count++ if( $d > $self->{'sigma_up'} || 			### increasing counter if point is outside
                         -1.0 * $d > $self->{'sigma_down'} );			### 	center +/- sigma
	}
    }

    return ($count >= ($total - 1)) ?  1 : 0;			### 1 if rule violated, 0 otherwise
}




#
# x successive points are inside +/- sigma
# x must be bigger than 1
#
sub check_all_in_x
{
    my $self  = shift;
    my $total = shift;
 
    my $count = 0;
    my $d0 = ${$self->{'data'}}[0] - $self->{'center'};		### distance of last point from center		
    
    ### recognize if latest point is in 
    if( ($d0 <= $self->{'sigma_up'} && $d0 >= 0.0) || 
        ((-1.0 * $d0) <= $self->{'sigma_down'} && $d0 <= 0.0) )		
    {
        my $j=1;

       	$count++;					### increasing counter to 1

        while( $j < $total )					### for second last to $total last point 
	{
	    my $d = ${$self->{'data'}}[$j++] - $self->{'center'};			### distance of point from center	
	    $count++ 							### increasing counter
               if( ($d <= $self->{'sigma_up'} && $d >= 0.0) || 				### if point is inside +/- sigma
		   ( (-1.0 * $d) <= $self->{'sigma_down'} && $d <= 0.0) );
	}
    }

    return ($count == $total) ?  1 : 0;				### 1 if rule violated, 0 otherwise
}

1;



=head1 AUTHOR

Gerhard Spitzlsperger

=head1 SEE ALSO

L<draw_graph/DESCRIPTION>

=cut