Index: /trunk/PS-IPP-Config/lib/PS/IPP/Metadata/Stats.pm =================================================================== --- /trunk/PS-IPP-Config/lib/PS/IPP/Metadata/Stats.pm (revision 14012) +++ /trunk/PS-IPP-Config/lib/PS/IPP/Metadata/Stats.pm (revision 14013) @@ -1,5 +1,5 @@ # Copyright (c) 2006 Paul Price, Joshua Hoblitt # -# $Id: Stats.pm,v 1.17 2007-06-26 01:39:16 eugene Exp $ +# $Id: Stats.pm,v 1.18 2007-07-04 23:57:12 eugene Exp $ package PS::IPP::Metadata::Stats; @@ -24,15 +24,6 @@ use base qw( Class::Accessor::Fast ); -__PACKAGE__->mk_accessors( qw( bg_mean - bg_stdev - bg_mean_stdev - fringe_mean - fringe_mean_stdev - fringe_err - dfringe_mean - dfringe_mean_stdev - dfringe_err - constants - variables +__PACKAGE__->mk_accessors( qw( + results ) ); @@ -42,40 +33,15 @@ 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 - fringe_mean => [], # Fringe amplitudes - fringe_err => [], # Fringe amplitude errors - fringe_mean_stdev => [], # Fringe amplitude stdev - dfringe_mean => [], # Fringe residual amplitudes - dfringe_err => [], # Fringe residual amplitude errors - dfringe_mean_stdev => [], # Fringe residual amplitude stdev - 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 - fringe_data => [], # Fringe amplitudes each component - fringe_err_data => [], # Fringe errors for each component - dfringe_data => [], # Fringe residual amplitudes each component - dfringe_err_data => [], # Fringe residual errors for each component - data => {} # The data - }; + my $class = shift; # Class name + my $entries = shift; # Array of values to extract + + my $self = { + entries => $entries, # Array of values that should be constant through the FPA + 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 - }; + # add a hash for storage + foreach my $entry (@$entries) { + $entry->{data} = []; } @@ -90,185 +56,77 @@ 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++; - } - } + $self->_parse_metadata_stats($md); + + # apply the needed calculation to the data based on the type + + my $entries = $self->{entries}; + + foreach my $entry (@$entries) { + my $type = $entry->{type}; + my $data = $entry->{data}; + + if ($type eq "constant") { + if (not defined $entry->{value}) { + $entry->{value} = 'NAN'; + } + next; + } + + if ($type eq "mean") { + if (scalar @$data > 0) { + # Get statistics on the value + my $stats = Statistics::Descriptive::Sparse->new(); # Statistics calculator + $stats->add_data(@$data); + $entry->{value} = $stats->mean(); + } else { + $entry->{value} = 'NAN'; + } + next; + } + + if ($type eq "stdev") { + if (scalar @$data > 1) { + # Get statistics on the value + my $stats = Statistics::Descriptive::Sparse->new(); # Statistics calculator + $stats->add_data(@$data); + $entry->{value} = $stats->stdev(); + next; + } + if (scalar @$data == 1) { + $entry->{value} = 0.0; + next; + } + $entry->{value} = 'NAN'; + next; + } + + if ($type eq "rms") { + if (scalar @$data > 0) { + # Get statistics on the value + # for rmsStats, we pushed the value^2 on the data array + my $stats = Statistics::Descriptive::Sparse->new(); # Statistics calculator + $stats->add_data(@$data); + $entry->{value} = sqrt($stats->mean()); + } else { + $entry->{value} = 'NAN'; + } + } + + if ($type eq "sum") { + if (scalar @$data > 0) { + # Get statistics on the value + my $stats = Statistics::Descriptive::Sparse->new(); # Statistics calculator + $stats->add_data(@$data); + $entry->{value} = $stats->sum(); + } else { + $entry->{value} = 'NAN'; + } + } } - # 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 $stats = Statistics::Descriptive::Sparse->new(); # Statistics for mean - $stats->add_data(@{$self->{bg_data}}); - $self->bg_mean($stats->mean()); - $self->bg_mean_stdev($stats->standard_deviation() || 0); - print STDERR "mean_stdev: " . $self->bg_mean_stdev() . "\n"; - # the stdev of a set of 1 is undefined. that doesn't do - # us much good so I'm changing undef to 0 - } else { - # if we have no data to measure the value, return NAN - $self->bg_mean('NAN'); - $self->bg_mean_stdev('NAN'); - } - if (scalar @{$self->{bg_stdev_data}} > 0) { - my $stats = Statistics::Descriptive::Sparse->new(); # Statistics for standard deviation - my @variances; - foreach my $number (@{$self->{bg_stdev_data}}) { - push @variances, $number**2; - } - $stats->add_data(@variances); - $self->bg_stdev( sqrt( $stats->mean() ) ); - } else { - $self->bg_stdev('NAN'); - } - - # Get fringe measurements - if (scalar @{$self->{fringe_data}} > 0) { - foreach my $array (@{$self->{fringe_data}}) { - my $stats = Statistics::Descriptive::Sparse->new(); # Statistics calculator - $stats->add_data(@$array); - push @{$self->{fringe_mean}}, $stats->mean(); - push @{$self->{fringe_mean_stdev}}, ($stats->standard_deviation() || 0); - # the stdev of a set of 1 is undefined. that doesn't do - # us much good so I'm changing undef to 0 - } - } else { - # create a single NAN entry - push @{$self->{fringe_mean}}, 'NAN'; - push @{$self->{fringe_mean_stdev}}, 'NAN'; - } - if (scalar @{$self->{fringe_err_data}} > 0) { - foreach my $array (@{$self->{fringe_err_data}}) { - my @variances; - foreach my $value (@$array) { - push @variances, $value**2; - } - my $stats = Statistics::Descriptive::Sparse->new(); # Statistics calculator - $stats->add_data(@variances); - push @{$self->{fringe_err}}, sqrt($stats->mean()); - } - } else { - push @{$self->{fringe_err}}, 'NAN'; - } - - # Get fringe residual measurements - if (scalar @{$self->{dfringe_data}} > 0) { - foreach my $array (@{$self->{dfringe_data}}) { - my $stats = Statistics::Descriptive::Sparse->new(); # Statistics calculator - $stats->add_data(@$array); - push @{$self->{dfringe_mean}}, $stats->mean(); - push @{$self->{dfringe_mean_stdev}}, ($stats->standard_deviation() || 0); - # the stdev of a set of 1 is undefined. that doesn't do - # us much good so I'm changing undef to 0 - } - } else { - # create a single NAN entry - push @{$self->{dfringe_mean}}, 'NAN'; - push @{$self->{dfringe_mean_stdev}}, 'NAN'; - } - if (scalar @{$self->{dfringe_err_data}} > 0) { - foreach my $array (@{$self->{dfringe_err_data}}) { - my @variances; - foreach my $value (@$array) { - push @variances, $value**2; - } - my $stats = Statistics::Descriptive::Sparse->new(); # Statistics calculator - $stats->add_data(@variances); - push @{$self->{dfringe_err}}, sqrt($stats->mean()); - } - } else { - push @{$self->{dfringe_err}}, 'NAN'; - } - - 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 +sub _parse_metadata_stats { my ($self, $md) = @_; @@ -278,60 +136,9 @@ # recurse on nested metadata if ($entry->{class} eq 'metadata') { - $self->_parse_braindead($entry->{value}); + $self->_parse_metadata_stats($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}; - } - next; - } - if ($entry->{name} =~ /^FRINGE_RESID/) { - my ($num) = $entry->{name} =~ /_(\d+)$/; # Component number - if ($entry->{name} =~ /_ERR_/) { - my $arrayRef = ${$self->{dfringe_err_data}}[$num]; - unless (defined $arrayRef) { - my @array; - $arrayRef = \@array; - ${$self->{dfringe_err_data}}[$num] = $arrayRef; - } - push @$arrayRef, $entry->{value}; - } else { - my $arrayRef = ${$self->{dfringe_data}}[$num]; - unless (defined $arrayRef) { - my @array; - $arrayRef = \@array; - ${$self->{dfringe_data}}[$num] = $arrayRef; - } - push @$arrayRef, $entry->{value}; - } - next; - } - if ($entry->{name} =~ /^FRINGE/) { - my ($num) = $entry->{name} =~ /_(\d+)$/; # Component number - if ($entry->{name} =~ /_ERR_/) { - my $arrayRef = ${$self->{fringe_err_data}}[$num]; - unless (defined $arrayRef) { - my @array; - $arrayRef = \@array; - ${$self->{fringe_err_data}}[$num] = $arrayRef; - } - push @$arrayRef, $entry->{value}; - } else { - my $arrayRef = ${$self->{fringe_data}}[$num]; - unless (defined $arrayRef) { - my @array; - $arrayRef = \@array; - ${$self->{fringe_data}}[$num] = $arrayRef; - } - push @$arrayRef, $entry->{value}; - } - next; - } + print STDERR "found $entry->{name} : $entry->{value}\n"; $self->_check_values($entry); - } + } return $self; @@ -346,26 +153,46 @@ 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; + my $entries = $self->{entries}; # The data + + # we may request the value more than once (different stats on the same value) + foreach my $entry (@$entries) { + if ($entry->{name} eq $name) { + + my $type = $entry->{type}; # Type of the item: constant or variable + my $data = $entry->{data}; # Array containing all the values + + if ($type eq 'constant') { + if (defined $entry->{value} && ($entry->{value} ne $value)) { + carp "Warning: different value for ", $name, " found: ", $entry->{value}, " (old) vs ", $value, " (new). Ignoring new value.\n"; + next; + } + $entry->{value} = $value; + next; + } + + if ($type eq 'mean') { + push @$data, $value; + next; + } + + if ($type eq 'stdev') { + push @$data, $value; + next; + } + + if ($type eq 'rms') { + push @$data, ($value**2); + next; + } + + if ($type eq 'sum') { + push @$data, $value; + next; + } + carp "Unrecognised type (", $type, ") for value of ", $name, "\n"; + exit($PS_EXIT_PROG_ERROR); + } } - 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; }