# ========================================================================
# 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:
142.5
18.0
This "FatXML" document is rooted at a C element, which contains
multiple C elements. Each C element has a single
attribute, C, 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 element has two children, a C element and a C
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, C, and
C 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-Enew
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-Eparse(), $p-Eparsestring, $p-Eparsefile()
These methods correspond to the C, C, and
C methods for an XML::Parser object. In summary,
C takes a string, C takes a filename or
an opened filehandle, and C 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-Eadd($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-Emeasures
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-Edates
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-Edate($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-Emin_weight, $measures-Emax_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-Emin_fat, $measures-Emax_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-Emean_fat, $measures-Emean_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-Estddev_fat, $measures-Estddev_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-Eas_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 '',
'',
(map { $_->as_string } @$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-Edate, $measure-Eweight, $measure-Efat
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-Eewma_weight, $measure-Eewma_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 Ced 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-Eas_string
Returns a string which is the XML representation of this
FatXML::Measure object.
=cut
sub as_string {
my $self = shift;
return join '',
'', $self->weight,
'', $self->fat,
'';
}
=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 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
=head1 AUTHOR
Andrew Ho Eandrew@zeuscat.comE
=cut
# ========================================================================
__END__