#!/usr/local/bin/perl -w
# ========================================================================
# fat2graph - generate a PNG chart of weight and body fat measurements
# Andrew Ho (andrew@tellme.com)
#
# This program generates a graph of fat measurement data from an XML file
# provided as an argument filename, or piped to stdin. It uses
# FatXML::Parser to do the parsing; see the documentation for FatXML.pm
# for the details to the XML format accepted. The graph is generated
# using gnuplot, and postprocessed with GD to fix colors. A bidirectional
# pipe eliminates the need for temporary files.
# ========================================================================

require 5.005;
use strict;

use FatXML ();
use GD ();
use Symbol qw(gensym);
use IPC::Open2 qw(open2);
use File::Basename qw(basename);
use Date::Calc qw(Add_Delta_Days);

use vars qw($ME $GNUPLOT);
$ME = basename $0;
$GNUPLOT = '/usr/local/bin/gnuplot';


# ------------------------------------------------------------------------
# Initialization

# Parse the XML input to get a FatXML::Measures object.

my $parser = FatXML::Parser->new;
my $measures = undef;

$@ = '';
eval {
    $measures = @ARGV ? $parser->parsefile(shift)
                      : $parser->parse(\*STDIN);
};

if($@ || !defined $measures) {
    if($@) {
        $@ =~ s/^\s+//gsm;
        $@ =~ s/\s+$//gsm;
        print STDERR $ME, ': parse error: ', $@, "\n";
        exit 2;
    } else {
        print STDERR $ME, ": general parse error\n";
        exit 2;
    }
}


# Pull out interesting bits of information.

my $min_weight = $measures->min_weight;
my $max_weight = $measures->max_weight;
my $min_fat = $measures->min_fat;
my $max_fat = $measures->max_fat;


# ------------------------------------------------------------------------
# Open a bidirectional pipe to gnuplot and generate the plot

my $read_fh  = gensym;
my $write_fh = gensym;
if(open2($read_fh, $write_fh, $GNUPLOT)) {
    my $fh = select $write_fh;
    local $| = 1;

    my @measures = $measures->measures;
    my $data = join "\n",
        ( map { join "\t", $_->date, $_->weight, $_->fat,
                           $_->ewma_weight, $_->ewma_fat }
              @measures ), "e";

    # Set x minimum and maximum to one day before and after the
    # first and last days measured, respectively.

    my $x_min = sprintf '%04d-%02d-%02d',
        Add_Delta_Days(split('-', $measures[0]->date, 3), -1);
    my $x_max = sprintf '%04d-%02d-%02d',
        Add_Delta_Days(split('-', $measures[$#measures]->date, 3), 1);

    # Get y minima and maxima to the closest integer value. Then
    # spread out weight and body fat measurements into the top and
    # bottom thirds of the plot, respectively, by one third of the
    # existing y range, to make the plots easier to discriminate.

    my $y1_min = int $min_weight; $y1_min-- if $y1_min >= $min_weight;
    my $y1_max = int $max_weight; $y1_max++ if $y1_max <= $max_weight;
    my $y2_min = int $min_fat;    $y2_min-- if $y2_min >= $min_fat;
    my $y2_max = int $max_fat;    $y2_max++ if $y2_max <= $max_fat;

    $y1_min -= 0.5; $y1_max++;    # Allow room for the legend (top)
    $y2_min -= 0.5; $y2_max++;    # and eliminate the bottom y labels

    $y1_min -= int(0.5 + ($y1_max - $y1_min) / 2);
    $y2_max += int(0.5 + ($y2_max - $y2_min) / 2);

    # Assemble the gnuplot plot command with its myriad options.
    # Because plots are overwritten by subsequent ones, we plot first
    # the vertical error bars, followed by the measured weights,
    # and on top of everything the trend lines. Note that later on
    # the colors will be adjusted from the defaults.

    my $plots = join ", ",
        q("-" using 1:2:2:4 notitle with yerrorbars),
        q("-" using 1:3:3:5 axes x1y2 notitle with yerrorbars),
        q("-" using 1:2 notitle with linespoints),
        q("-" using 1:3 axes x1y2 notitle with linespoints),
        q("-" using 1:4 title "Weight Trend (lb)" with lines),
        q("-" using 1:5 axes x1y2 title "Body Fat Trend (%)" with lines);

    # Summary messages to display in the title about the overall
    # deltas for weight and fat based on the weighted averages.

    my $delta_weight = sprintf '%0.1f',
        $measures[$#measures]->ewma_weight - $measures[0]->ewma_weight;
    my $delta_fat = sprintf '%0.1f',
        $measures[$#measures]->ewma_fat - $measures[0]->ewma_fat;

    my $delta_weight_msg =
        $delta_weight < 0 ? sprintf '%0.1f lb lost',   abs $delta_weight :
        $delta_weight > 0 ? sprintf '%0.1f lb gained',     $delta_weight :
                           'weight even' ;
    my $delta_fat_msg =
        $delta_fat < 0 ? sprintf '%0.1f%% down', abs $delta_fat :
        $delta_fat > 0 ? sprintf '%0.1f%% up',       $delta_fat :
                         'body fat even' ;

    # Output the actual gnuplot commands, including the commands
    # generated above; the PNG binary data should come in through
    # the $read_fh when this is done.

    print << "    EndGnuplot";
        set terminal png color
        set size 1.00, 0.75

        set title "Weight and Body Fat ($delta_weight_msg, $delta_fat_msg)"

        set xdata time
        set timefmt "%Y-%m-%d"
        set xrange ["$x_min":"$x_max"]
        set xtics nomirror
        set format x "%b"

        set yrange [$y1_min:$y1_max]
        set ytics nomirror
        set ytics 1
        set format y "%g"

        set y2range [$y2_min:$y2_max]
        set y2tics nomirror
        set y2tics 1
        set format y2 "%g%%"

        plot $plots
    EndGnuplot
    print "$data\n" x 6;
    close $write_fh;

    # Read the PNG data and create a GD object from it.

    select $fh;
    local $/ = undef;
    my $png = <$read_fh>;
    close $read_fh;

    my $image = GD::Image->newFromPngData($png);

    # The default gnuplot PNG colors for the 6 lines in this plot
    # are red, green, blue, cyan, magenta, and yellow. We replace
    # the colors with various shades of red for weight and blue for
    # body fat percentage. The error bars are lightest, the real
    # measurements second lightest, and the trend line is darkest.

    $image->colorReplace( 255,   0,   0, 255, 204, 204 );
    $image->colorReplace(   0, 255,   0, 204, 204, 255 );
    $image->colorReplace(   0,   0, 255, 255, 153, 153 );
    $image->colorReplace(   0, 255, 255, 153, 153, 255 );
    $image->colorReplace( 255,   0, 255, 127,   0,   0 );
    $image->colorReplace( 255, 255,   0,   0,   0, 127 );

    binmode STDOUT;
    print STDOUT $image->png;
}

exit 0;


# ------------------------------------------------------------------------
# Internal subroutines

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

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


# ========================================================================
# Color replacement code

# This code extends the GD::Image object to provide a colorReplace()
# method. $image->colorReplace($r1, $g1, $b1, $r2, $g2, $b2) replaces
# the color closest to the RGB triplet ($r1, $g1, $b1) with the color
# ($r2, $g2, $b2). It does this by figuring out the index of the
# existing color to replace, deallocating it, and reallocating colors
# until we hit that index again. colorReplace() returns the new index
# of the color, or false if the replacement fails.

package GD::Image;

sub colorReplace {
    my $self = shift;
    my($r1, $g1, $b1, $r2, $g2, $b2) = @_;

    # Deallocate the original color to replace
    my $index = $self->colorClosest($r1, $g1, $b1);
    return unless defined $index;
    $self->colorDeallocate($index);

    # Reallocate colors until we hit the index of that original color
    my $start_index = undef;
    my $new_index = undef;
    while($new_index = $self->colorAllocate($r2, $g2, $b2)) {
        $start_index = $new_index unless defined $start_index;
        last if $new_index >= $index;
    }

    # Deallocate any extraneously allocated colors
    if(defined $start_index and $start_index < $new_index) {
        $self->colorDeallocate($_) foreach $start_index .. $new_index - 1;
    }

    return $new_index;
}


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