# Copyright (c) 2006  Paul Price, Joshua Hoblitt
#
# $Id: Stats.pm,v 1.13 2007-02-09 03:55:22 price Exp $

package PS::IPP::Metadata::Stats;

use strict;
use warnings FATAL => qw( all );

our $VERSION = '0.02';

use Carp qw( carp );
use Statistics::Descriptive;

use PS::IPP::Config qw(
    $PS_EXIT_SUCCESS
    $PS_EXIT_UNKNOWN_ERROR
    $PS_EXIT_SYS_ERROR
    $PS_EXIT_CONFIG_ERROR
    $PS_EXIT_PROG_ERROR
    $PS_EXIT_DATA_ERROR
    $PS_EXIT_TIMEOUT_ERROR
    );

use base qw( Class::Accessor::Fast );
__PACKAGE__->mk_accessors( qw( bg_mean bg_stdev bg_mean_stdev constants variables bg_data bg_stdev_data ) );

#$::RD_TRACE = 1;
#$::RD_HINT = 1;
use Data::Dumper;

sub new {
    my $class = shift;                # Class name
    my $constants = shift;        # Array of values that should be constant through the FPA
    my $variables = shift;        # Array of values that may be variable through the FPA

    my $self = { bg_mean => undef, # Mean of the mean backgrounds
                 bg_stdev => undef, # Standard deviation of the mean backgrounds
                 bg_mean_stdev => undef, # Mean of the standard deviation of the backgrounds
                 constants => $constants, # Array of values that should be constant through the FPA
                 variables => $variables, # Array of values that may be variable through the FPA
                 bg_data => [], # Array of background values
                 bg_stdev_data => [],# Array of background standard deviations
                 data => {}        # The data
                 };
    
    # Populate object
    foreach my $constant (@$constants) {
        $self->{data}->{$constant} = { type => 'constant', # Type of value (constant/variable)
                                       value => undef # The actual variable
                                       };
    }
    foreach my $variable (@$variables) {
        $self->{data}->{$variable} = { type => 'variable', # Type of value (constant/variable)
                                       data => [], # Array of data values
                                       mean => undef, # Mean of data values
                                       stdev => undef # Standard deviation of data values
                                       };
    }

    # Bless and return object
    bless $self, $class;
    return $self;
}

# Given a parsed metadata from ppStats, assemble summary statistics
sub parse {
    my $self = shift;                # Where we'll put the information
    my $md = shift;                # Parsed metadata, from PS::IPP::Metadata::Config

    # count of parse errors
    my $errors = 0;

#    $self->_parse_megacam($md);
    $self->_parse_braindead($md);

    # Check that we found everything for the constants
    my $constants = $self->constants();        # Array of constants
    if (defined $constants) {
        foreach my $constant (@$constants) {
            if (not defined $self->{data}->{$constant}->{value}) {
                carp "Unable to find value for ", $constant, "\n";
                $errors++;
            }
        }
    }

    # Get mean, stdev for the variables
    my $variables = $self->variables();        # Array of variables
    if (defined $variables) {
        foreach my $variable (@$variables) {
            my $info = $self->{data}->{$variable}; # The information about this particular variable
            my $array = $info->{data}; # The array of values collected
            if (scalar @$array == 0) {
                carp "Unable to find any values for ", $variable, "\n";
                $errors++;
                next;
            }

            # Get statistics on the value
            my $stats = Statistics::Descriptive::Sparse->new(); # Statistics calculator
            $stats->add_data(@$array);
            $info->{mean} = $stats->mean();
            $info->{stdev} = $stats->standard_deviation();
        }
    }
    
    # Get mean, stdev, mean stdev for the background
    if (scalar @{$self->{bg_data}} > 0) {
        my $meanStats = Statistics::Descriptive::Sparse->new(); # Statistics for mean
        $meanStats->add_data(@{$self->{bg_data}});
        $self->bg_mean($meanStats->mean());
        # XXX the stddev of a set of 1, appears to be a statistics undefined
        # value, however that doesn't do us much go so I'm changing undef to 0
        $self->bg_mean_stdev($meanStats->standard_deviation() || 0);
    } else {
        $self->bg_mean(undef);
        $self->bg_mean_stdev(undef);
    }
    if (scalar @{$self->{bg_stdev_data}} > 0) {
        my $stdevStats = Statistics::Descriptive::Sparse->new(); # Statistics for standard deviation
	my @variances;
	foreach my $number (@{$self->{bg_stdev_data}}) {
	    push @variances, $number**2;
	}
        $stdevStats->add_data(@variances);
        $self->bg_stdev( sqrt( $stdevStats->mean() ) );
    } else {
        $self->bg_stdev(undef);
    }

    if ($errors) {
        carp "a total of $errors parse errors occured";
        return;
    }

    return $self;
}

sub _parse_megacam
{
    my ($self, $md) = @_;

    # Descend the FPA hierarchy
    foreach my $fpaItem (@$md) {
        if ($fpaItem->{class} eq "metadata") {
            my $chipName = $fpaItem->{name}; # Name of chip
            my $chipData = $fpaItem->{value}; # Chip-level data
            foreach my $chipItem (@$chipData) {
                if ($chipItem->{class} eq "metadata") {
                    my $cellName = $chipItem->{name}; # Name of cell
                    my $cellData = $chipItem->{value}; # Cell-level data
                    my $bgName; # Name of the value we measured
                    my $bgStdevName; # Name of the stdev we measured
                    foreach my $cellItem (@$cellData) {
                        if ($cellItem->{name} =~ /^(SAMPLE|ROBUST|FITTED|CLIPPED)_/) {
                            # It's a statistic of some sort
                            if ($cellItem->{name} =~ /_STDEV$/) {
                                if (defined $bgStdevName) {
                                    carp "Ignoring duplicate background stdev (", $cellItem->{name}, "). ",
                                    "Original is ", $bgStdevName, "\n";
                                    next;
                                }
                                $bgStdevName = $cellItem->{name};
                                push @{$self->{bg_stdev_data}}, $cellItem->{value};
                            } else {
                                if (defined $bgName) {
                                    carp "Ignoring duplicate background value (", $cellItem->{name}, "). ",
                                    "Original is ", $bgName, "\n";
                                    next;
                                }
                                $bgName = $cellItem->{name};
                                push @{$self->{bg_data}}, $cellItem->{value};
                            }
                        } else {
                            $self->_check_values($cellItem);
                        }
                    }
                } else {
                    $self->_check_values($chipItem);
                }
            }
        } else {
            $self->_check_values($fpaItem);
        }
    }
    
    return $self;
}

sub _parse_braindead
{
    my ($self, $md) = @_;

    # descend through the fpa        
    foreach my $entry (@$md) {
        # recurse on nested metadata
        if ($entry->{class} eq 'metadata') {
            $self->_parse_braindead($entry->{value});
        }

        if ($entry->{name} =~ /^(SAMPLE|ROBUST|FITTED|CLIPPED)_/) {
            # It's a statistic of some sort
            if ($entry->{name} =~ /_STDEV$/) {
                push @{$self->{bg_stdev_data}}, $entry->{value};
            } else {
                push @{$self->{bg_data}}, $entry->{value};
            }
        } else {
            $self->_check_values($entry);
        }
    }

    return $self;
}

# Private function to check a metadata item for things we're interested in
sub _check_values {
    my $self = shift;
    my $mdItem = shift;                # Metadata item to check

    my $name = $mdItem->{name};        # Name of the item
    my $value = $mdItem->{value}; # Value of the item

    my $data = $self->{data};        # The data
    return if not defined $data->{$name}; # Not interested
    my $type = $data->{$name}->{type}; # Type of the item: constant or variable

    if ($type eq 'constant') {
        if (defined $data->{$name}->{value} && ($data->{$name}->{value} ne $value)) {
            carp "Warning: different value for ", $name, " found: ", $data->{$name}->{value}, " (old) vs ", 
            $value, " (new).  Ignoring new value.\n";
            return;
        }
        $data->{$name}->{value} = $value;
        return;
    }

    if ($type eq 'variable') {
        my $array = $data->{$name}->{data}; # Array containing all the values
        push @$array, $value;
        return;
    }

    carp "Unrecognised type (", $type, ") for value of ", $name, "\n";
    exit($PS_EXIT_PROG_ERROR);
    return;
}

# Return the data structure for a particular value, or the entire hash
sub data {
    my $self = shift;
    my $name = shift;                # Name of data to return

    return $self->{data} if (not defined $name);
    return $self->{data}->{$name};
}


1;

__END__;

