# ========================================================================
# FatXML - parse XML that stores weight and body fat measurements
# Andrew Ho (andrew@tellme.com)
#
# This program contains embedded documentation in Perl POD (Plain Old
# Documentation) format. Search for the string "=head1" in this document
# to find documentation snippets, or use "perldoc" to read it; utilities
# like "pod2man" and "pod2html" can reformat as well.
# ========================================================================

=head1 NAME

FatXML - parse XML that stores weight and body fat measurements

=head1 SYNOPSIS

    use FatXML;

    $parser   = FatXML::Parser->new;
    $measures = $parser->parse($xml);

    @dates   = $measures->dates;
    $measure = $measures->date($dates[0]);
    $weight  = $measure->weight;
    $fat     = $measure->fat;

=head1 DESCRIPTION

This Perl module parses an XML format that stores weight and body fat
measurements by date, returning a Perl object which exposes the relevant
data in a simple way. The XML format itself is best described by example:

    <?xml version="1.0" encoding="UTF-8"?>
    <measures>
      <measure date="2001-10-02">
        <weight>142.5</weight>
        <fat>18.0</fat>
      </measure>
    </measures>

This "FatXML" document is rooted at a C<measures> element, which contains
multiple C<measure> elements. Each C<measure> element has a single
attribute, C<date>, which is an ISO 8601 like date format (four-digit
year, two-digit month, and two-digit day, separated by hyphens) signifying
the date of the measurement.

Each C<measure> element has two children, a C<weight> element and a C<fat>
element, which are the weight in pounds and the body fat percentage,
respectively. Both values are expected to be numbers that can be of
arbitrary precision.

A document following this XML format can be parsed by instantiating a
FatXML::Parser object. The C<parse()>, C<parsestring()>, and
C<parsefile()> methods of this object will return a FatXML::Measures
object, which is a container for multiple FatXML::Measure objects,
each of which represent a single day's weight and body fat measurements.

=cut


# ------------------------------------------------------------------------
# Default package interface

package FatXML;
require 5.005;
use strict;

use vars qw($VERSION);
$VERSION = 0.1;


# ========================================================================
# FatXML::Parser - parse weight and body fat measurements in XML format

package FatXML::Parser;
require 5.005;
use strict;

use XML::Parser ();


# ------------------------------------------------------------------------
# Constructor

=head2 FatXML::Parser Methods

=over 4

=item $p = FatXML::Parser-E<gt>new

The FatXML::Parser constructor takes no arguments, and returns a
FatXML::Parser object. Under the hood, the FatXML::Parser object
holds a single XML::Parser object to do its parsing.

=cut

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $self = {};
    bless $self, $class;

    # Create closures to support object-oriented handlers
    my $Init    = sub { $self->_Init(@_); };
    my $Start   = sub { $self->_Start(@_); };
    my $End     = sub { $self->_End(@_); };
    my $Default = sub { $self->_Default(@_); };
    my $Final   = sub { $self->_Final(@_); };

    $self->{_Parser} =
        new XML::Parser(
            Handlers => {
                Init    => $Init,
                Start   => $Start,
                End     => $End,
                Char    => $Default,
                Default => $Default,
                Final   => $Final,
            },
        );
    undef $self unless defined $self->{_Parser};

    return $self;
}


# ------------------------------------------------------------------------
# Public methods

=item $p-E<gt>parse(), $p-E<gt>parsestring, $p-E<gt>parsefile()

These methods correspond to the C<parse()>, C<parsestring()>, and
C<parsefile()> methods for an XML::Parser object. In summary, 
C<parsestring()> takes a string, C<parsefile()> takes a filename or
an opened filehandle, and C<parse()> takes either.

The return value from all of these parsing methods is a
FatXML::Measures object (see L<"FatXML::Measures Methods">).

=cut

sub parse {
    my $self = shift;
    $self->{_Parser}->parse(@_);
}

sub parsestring {
    my $self = shift;
    $self->{_Parser}->parsestring(@_);
}

sub parsefile {
    my $self = shift;
    $self->{_Parser}->parsefile(@_);
}


=back

=cut


# ------------------------------------------------------------------------
# These are the individual handlers which are called during parsing.

sub _Init {
    my $self = shift;
    $self->{accum} = undef;
    $self->{measure} = undef;
    $self->{measures} = FatXML::Measures->new;
    return;
}

sub _Start {
    my($self, $expat, $element, @pairs) = @_;
    if($element eq 'measure') {
        my $date = undef;
        while(@pairs) {
            my($key, $value) = (shift(@pairs), shift(@pairs));
            if($key eq 'date') {
                $date = $value;
                last;
            }
        }
        if($date) {
            $self->{measure} = FatXML::Measure->new;
            $self->{measure}->date($date);
        }
    } elsif($element eq 'weight' or $element eq 'fat') {
        $self->{accum} = '';
    } elsif($self->{accum}) {
        $self->{accum} = undef;
    }
    return;
}

sub _End {
    my($self, $expat, $element) = @_;
    if($element eq 'measure') {
        if($self->{measure}) {
            $self->{measures}->add($self->{measure});
            undef $self->{measure};
        }
    } elsif($self->{measure} && $self->{accum}) {
        if($element eq 'weight') {
            $self->{measure}->weight($self->{accum});
        } elsif($element eq 'fat') {
            $self->{measure}->fat($self->{accum});
        }
        $self->{accum} = undef;
    }
    return;
}

sub _Default {
    my($self, $expat, $str) = @_;
    $self->{accum} .= $str if defined $self->{accum};
    return;
}

sub _Final {
    my $self = shift;
    return $self->{measures};
}


# ========================================================================
# FatXML::Measures - a set of FatXML::Measure objects
#
#     $measures = FatXML::Measures->new;
#     $measures->add($measure);
#
#     @measures = $measures->measures;
#     @dates = $measures->dates;
#     $measure = $measures->date($dates[0]);
#
#     $min_weight = $measures->min_weight;
#     $max_weight = $measures->max_weight;
#     $mean_weight = $measures->mean_weight;
#     $stddev_weight = $measures->stddev_fat;
#
#     $min_fat = $measures->min_fat;
#     $max_fat = $measures->max_fat;
#     $mean_fat = $measures->mean_fat;
#     $stddev_fat = $measures->stddev_fat;
#
# Each $measure is a FatXML::Measure object.
# ========================================================================

package FatXML::Measures;
require 5.005;
use strict;


# ------------------------------------------------------------------------
# Constructor

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = { measures => {}, cache => {} };
    bless $self, $class;
    return $self;
}


# ------------------------------------------------------------------------
# Mutator to add FatXML::Measure objects

=head2 FatXML::Measures Methods

=over 4

=item $measures-E<gt>add($measure)

Add a FatXML::Measure object to this set of measures.

=cut

sub add {
    my $self = shift;
    my $measure = shift;
       $measure->_parent($self);
    $self->{measures}->{$measure->date} = $measure;
    delete $self->{cache}->{$_} foreach keys %{$self->{cache}};
    return;
}


# ------------------------------------------------------------------------
# Accessors

=item @measures = $measures-E<gt>measures

Returns a list or reference to a list of all the FatXML::Measure
objects in $measures.

=cut

sub measures {
    my $self = shift;
    unless(exists $self->{cache}->{measures}) {
        $self->{cache}->{measures} = [
            map { $self->{measures}->{$_} }
                sort keys %{$self->{measures}}
        ];
    }
    return wantarray ? @{$self->{cache}->{measures}} :
                         $self->{cache}->{measures}  ;
}


=item @dates = $measures-E<gt>dates

Returns a list or reference to a list of all the dates for which
measurements are stored in $measures.

=cut

sub dates {
    my $self = shift;
    unless(exists $self->{cache}->{dates}) {
        $self->{cache}->{dates} = [ sort keys %{$self->{measures}} ];
    }
    return wantarray ? @{$self->{cache}->{dates}} :
                         $self->{cache}->{dates}  ;
}


=item $measure = $measure-E<gt>date($date)

Returns a single FatXML::Measure object corresponding to the specified
date, or false if no measurement exists for the specified date.

=cut

sub date {
    my $self = shift;
    my $date = shift;
    return unless exists $self->{measures}->{$date};
    return $self->{measures}->{$date};
}


# ------------------------------------------------------------------------
# Aggregate statistics
#
# All statistics are cached locally, with the cache being cleared whenever
# a new FatXML::Measure object is add()ed to this FatXML::Measures object.


=item $measures-E<gt>min_weight, $measures-E<gt>max_weight

These methods return the minimum and maximum weight measurements from
the set of stored measurements, respectively.

=cut

sub min_weight {
    my $self = shift;
    unless(exists $self->{cache}->{min_weight}) {
        my $measures = $self->measures;
        return unless $measures and @$measures;
        my $min = $measures->[0]->weight;
        foreach(@$measures) {
            $min = $_->weight if $min > $_->weight;
        }
        $self->{cache}->{min_weight} = $min;
    }
    return $self->{cache}->{min_weight};
}

sub max_weight {
    my $self = shift;
    unless(exists $self->{cache}->{max_weight}) {
        my $measures = $self->measures;
        return unless $measures and @$measures;
        my $max = 0;
        foreach(@$measures) {
            $max = $_->weight if $max < $_->weight;
        }
        $self->{cache}->{max_weight} = $max;
    }
    return $self->{cache}->{max_weight};
}


=item $measures-E<gt>min_fat, $measures-E<gt>max_fat

These methods return the minimum and maximum body fat percentage
measurements from the set of stored measurements, respectively.

=cut

sub min_fat {
    my $self = shift;
    unless(exists $self->{cache}->{min_fat}) {
        my $measures = $self->measures;
        return unless $measures and @$measures;
        my $min = $measures->[0]->fat;
        foreach(@$measures) {
            $min = $_->fat if $min > $_->fat;
        }
        $self->{cache}->{min_fat} = $min;
    }
    return $self->{cache}->{min_fat};
}

sub max_fat {
    my $self = shift;
    unless(exists $self->{cache}->{max_fat}) {
        my $measures = $self->measures;
        return unless $measures and @$measures;
        my $max = 0;
        foreach(@$measures) {
            $max = $_->fat if $max < $_->fat;
        }
        $self->{cache}->{max_fat} = $max;
    }
    return $self->{cache}->{max_fat};
}


=item $measures-E<gt>mean_fat, $measures-E<gt>mean_fat

These methods return the mean (average) of the weight and body fat
percentage measurements from the set of stored measurements, respectively.

=cut

sub mean_weight {
    my $self = shift;
    unless(exists $self->{cache}->{mean_weight}) {
        my $measures = $self->measures;
        return unless $measures and @$measures;
        $self->{cache}->{mean_weight} = mean(map { $_->weight } @$measures);
    }
    return $self->{cache}->{mean_weight};
}

sub mean_fat {
    my $self = shift;
    unless(exists $self->{cache}->{mean_fat}) {
        my $measures = $self->measures;
        return unless $measures and @$measures;
        $self->{cache}->{mean_fat} = mean(map { $_->fat } @$measures);
    }
    return $self->{cache}->{mean_fat};
}

# mean(@array) or mean($arrayref) returns the mean (average) of all the
# elements in @array (or $arrayref).

sub mean {
    return unless @_ > 0;
    my $values = @_ == 1 ? shift : [ @_ ];
    my $total = 0;
       $total += $_ foreach @$values;
    return $total / @$values;
}


=item $measures-E<gt>stddev_fat, $measures-E<gt>stddev_fat

These methods return the standard deviation of the weight and body fat
percentage measurements from the set of stored measurements, respectively.

=cut

sub stddev_weight {
    my $self = shift;
    unless(exists $self->{cache}->{stddev_weight}) {
        my $measures = $self->measures;
        return unless $measures and @$measures;
        $self->{cache}->{stddev_weight} = stddev(map { $_->weight } @$measures);
    }
    return $self->{cache}->{stddev_weight};
}

sub stddev_fat {
    my $self = shift;
    unless(exists $self->{cache}->{stddev_fat}) {
        my $measures = $self->measures;
        return unless $measures and @$measures;
        $self->{cache}->{stddev_fat} = stddev(map { $_->fat } @$measures);
    }
    return $self->{cache}->{stddev_fat};
}

# stddev(@array) or stddev($arrayref) returns the standard deviation
# of all the elements in @array (or $arrayref).

sub stddev {
    return unless @_ > 0;
    my $values = @_ == 1 ? shift : [ @_ ];
    my $mean = mean($values);
    my $sum = 0; $sum += ($_ - $mean) ** 2 foreach @$values;
    return $sum / (@$values - 1);
}


# ------------------------------------------------------------------------
# Individually stored statistics

# calculate_ewma() goes through all the measures and calculates the
# exponentially weighted moving averages from the first measure onwards.
# It caches the result in each FatXML::Measure object, then marks
# the calculated_ewma flag in the FatXML::Measures cache.

sub calculate_ewma {
    my $self = shift;
    unless(exists $self->{cache}->{calculated_ewma}) {
        my $measures = $self->measures;
        return unless $measures and @$measures;
        my $ewma_weights = ewma(map { $_->weight } @$measures);
        my $ewma_fats    = ewma(map { $_->fat    } @$measures);
        foreach my $i (0 .. $#$measures) {
            $measures->[$i]->ewma_weight($ewma_weights->[$i]);
            $measures->[$i]->ewma_fat($ewma_fats->[$i]);
        }
        $self->{cache}->{calculated_ewma} = 1;
    }
    return $self->{cache}->{calculated_ewma};
}


# ewma(@array) or ewma($arrayref) returns an array which contains the
# set of exponentially weighted moving averages of all the elements in
# @array (or $arrayref). This is based on the following relation:
#
#     ewma(0) = f(0)
#     ewma(n) = ewma(n-1) - (0.10 * (ewma(n-1) - f(n)))
#
# Where ewma(n) is the expontentially weighted moving average, and f(n)
# is the data set of values to be smoothed.

sub ewma {
    return unless @_ > 0;
    my $values = @_ == 1 ? shift : [ @_ ];
    my $delta = $values->[0];
    my @ewma = ( $delta );
    push @ewma, $delta = $delta - (0.10 * ($delta - $_))
        foreach @$values;
    return wantarray ? @ewma : \@ewma;
}


# ------------------------------------------------------------------------
# Output myself

=item $measures-E<gt>as_string

Returns a string which is the XML representation of this measures object.
You should be able to obtain an identical (in the sense of similar)
FatXML::Measures object by parsing this string.

=cut

sub as_string {
    my $self = shift;
    unless(exists $self->{cache}->{xml}) {
        my $measures = $self->measures;
        $self->{cache}->{xml} = join '',
            '<measures>',
            (map { $_->as_string } @$measures),
            '</measures>';
    }
    return $self->{cache}->{xml};
}


=back

=cut


# ========================================================================
# FatXML::Measure - object oriented interface to one set of measurements
#
#     $measure = FatXML::Measure->new;
#     $measure->date($date);
#     $measure->weight($weight);
#     $measure->fat($fat);
#     $weight = $measure->weight;
#     $fat    = $measure->fat;
#
# Store a set of FatXML::Measure objects in a FatXML::Measures object.
# ========================================================================

package FatXML::Measure;
require 5.005;
use strict;


# ------------------------------------------------------------------------
# Constructor

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {};
    bless $self, $class;
    return $self;
}


# ------------------------------------------------------------------------
# Create accessor/mutator classes

=head2 FatXML::Measure Methods

=over 4

=item $measure-E<gt>date, $measure-E<gt>weight, $measure-E<gt>fat

Get or set the date, weight, or body fat percentage stored in this
measurement.

=cut

foreach my $method qw(_parent date weight fat) {
    eval << "    EndPerl";
        sub $method {
            my \$self = shift;
            \$self->{$method} = shift if \@_;
            return unless exists \$self->{$method};
            return \$self->{$method};
        }
    EndPerl
}


=item $measure-E<gt>ewma_weight, $measure-E<gt>ewma_fat

Get or set the weight or body fat percentage for this date, adjusted
through an exponentially weighted moving filter. This requires that $measure
be part of a FatXML::Measures object (e.g. $measure was C<add()>ed to such
an object earlier). If this is not the case, the regular weight or fat
are returned, respectively.

=cut

sub ewma_weight {
    my $self = shift;
    $self->{ewma_weight} = shift if @_;
    unless(exists $self->{ewma_weight}) {
        $self->_parent->calculate_ewma if $self->_parent;
    }
    return $self->weight unless $self->{ewma_weight};
    return $self->{ewma_weight};
}

sub ewma_fat {
    my $self = shift;
    $self->{ewma_fat} = shift if @_;
    unless(exists $self->{ewma_fat}) {
        $self->_parent->calculate_ewma if $self->_parent;
    }
    return $self->fat unless $self->{ewma_fat};
    return $self->{ewma_fat};
}


# ------------------------------------------------------------------------
# Output myself

=item $measure-E<gt>as_string

Returns a string which is the XML representation of this
FatXML::Measure object.

=cut

sub as_string {
    my $self = shift;
    return join '',
        '<measure date="', $self->date,
        '"><weight>', $self->weight,
        '</weight><fat>', $self->fat,
        '</fat></measure>';
}


=back

=cut


# ========================================================================
# Return true to indicate that this file was succesfully included

1;

=head1 BUGS

This module does not allow multiple measurements per day, nor does it
allow measurements in different units. It parses the XML format fairly
loosely, allowing you to nest C<measure> blocks pretty much anywhere.
This could probably be construed as a feature.

Finally, body fat measurement via store-bought integrated scales is not an
exact science. Your hydration level, what you've eaten today, and the time
of day you take your measurements can all make significant fluctuations in
Bioelectrical Impedance Analysis (BIA) measured body fat percentages.
Consult your physician before starting any diet or exercise program.

=head1 SEE ALSO

L<XML::Parser>

=head1 AUTHOR

Andrew Ho E<lt>andrew@zeuscat.comE<gt>

=cut


# ========================================================================
__END__