File Coverage

blib/lib/Food/Ratio.pm

Criterion	Covered	Total	%
statement	117	117	100.0
branch	48	48	100.0
condition	32	32	100.0
subroutine	16	16	100.0
pod	9	9	100.0
total	222	222	100.0

# -*- Perl -*-
#
# Ultima Ratio Coquorum

package Food::Ratio 0.03;
use Object::Pad 0.52;
class Food::Ratio :strict(params);
use Carp 'croak';
use List::UtilsBy 'nsort_by';
use Scalar::Util 'looks_like_number';

use constant {
    MASS   => 0,    # array index for $things, $groups, $total
    NAME   => 1,
    GROUPS => 2,
    ORDER  => 3,
    RATIO  => 4,
};
has $things :reader;        # individual ingredients (aref of aref)
has $groups :reader;        # groups of ingredients (href of aref)
has $total  :reader;        # (aref)

has $key :reader;           # ratio key ingredient, group, or total

has $index_group = 0;       # to keep the output in input addition order

ADJUST {
    $groups = {};
    $things = [];
    $total = [];
}

method add($mass, $name, @rest) {
    croak "mass must be positive"
      unless defined $mass
      and looks_like_number($mass)
      and $mass > 0;
    croak "things must be something" unless defined $name and length $name;
    for my $grname (@rest) {
        croak "groups must be something" unless defined $grname and length $grname;
    }
    # hopefully after here nothing blows up that might leave the object
    # in an inconsistent state
    my @meta;
    @meta[ MASS, NAME, GROUPS, RATIO ] = ( $mass, $name, @rest ? \@rest : [], 0 );
    push @$things, \@meta;
    for my $grname (@rest) {
        my $gmeta = $groups->{$grname} //= [];
        $gmeta->@[ NAME, RATIO ] = ( $grname, 0 );
        $gmeta->[MASS] += $mass;
        $gmeta->[ORDER] = $index_group++ unless defined $gmeta->[ORDER];
    }
    $total->[MASS] += $mass;
    return $self;
}

method details() {
    croak "ratio has not been called" unless defined $key;
    my %details;
    for my $ref (@$things) {
        push $details{ingredients}->@*, {
            groups => [ $ref->[GROUPS]->@* ],
            mass => $ref->[MASS],
            name => $ref->[NAME],
            ratio => $ref->[RATIO],
        }
    }
    for my $ref (nsort_by { $_->[ORDER] } values %$groups) {
        push $details{groups}->@*, {
            mass => $ref->[MASS],
            name => $ref->[NAME],
            order => $ref->[ORDER],
            ratio => $ref->[RATIO],
        }
    }
    $details{total} = {
        mass => $total->[MASS],
        ratio => $total->[RATIO],
    };
    return \%details;
}

# the ratio could be based on the total amount, or for cooking there is
# more likely some key ingredient--flour--or a group of ingredients,
# such as a variety of flours that together form the total for the ratio
method ratio(%param) {
    my $amount;
    if ( exists $param{id} ) {
        croak "id must be something"
          unless defined $param{id} and length $param{id};
        # NOTE only the first match is used if there are duplicates in
        # the ingredients list
        my $okay = 0;
        for my $ref (@$things) {
            if ( $ref->[NAME] eq $param{id} ) {
                ( $key, $amount ) = ( $ref, $ref->[MASS] );
                $okay = 1;
                last;
            }
        }
        croak "no such id '$param{id}'" unless $okay;
    } elsif ( exists $param{group} ) {
        croak "group must be something"
          unless defined $param{group} and length $param{group};
        croak "no such group '$param{group}'" unless exists $groups->{ $param{group} };
        $key    = $groups->{ $param{group} };
        $amount = $key->[MASS];
    } else {
        $key = $total;
        $amount = $total->[MASS];
    }
    for my $ref ( @$things, values %$groups, $total ) {
        $ref->[RATIO] = $ref->[MASS] * 100 / $amount;
    }
    return $self;
}

method string() {
    croak "ratio has not been called" unless defined $key;
    my $s = '';
    for my $ref (@$things) {
        $s .= join( "\t",
            sprintf( "%.4g\t%.4g%%", $ref->@[MASS, RATIO] ),
            $ref->[NAME], $ref->[GROUPS]->@* )
          . "\n";
    }
    if ( keys %$groups ) {
        $s .= "--\n";
        for my $ref ( nsort_by { $_->[ORDER] } values %$groups ) {
            $s .=
              join( "\t", sprintf( "%.4g\t%.4g%%", $ref->@[MASS, RATIO] ), $ref->[NAME] )
              . "\n";
        }
    }
    $s .= "--\n";
    $s .= join "\t", $total->[MASS], sprintf( '%.4g%%', $total->[RATIO] ),
      "*total\n";
    return $s;
}

method weigh($mass, %param) {
    croak "ratio has not been called" unless defined $key;
    croak "mass must be positive"
      unless defined $mass
      and looks_like_number($mass)
      and $mass > 0;
    my $ratio;
    if ( exists $param{id} ) {
        croak "id must be something"
          unless defined $param{id} and length $param{id};
        # NOTE only the first match is used if there are duplicates in
        # the ingredients list
        my $okay = 0;
        for my $ref (@$things) {
            if ( $ref->[NAME] eq $param{id} ) {
                $ratio = $mass / $ref->[MASS];
                $okay = 1;
                last;
            }
        }
        croak "no such id '$param{id}'" unless $okay;
    } elsif ( exists $param{group} ) {
        croak "group must be something"
          unless defined $param{group} and length $param{group};
        croak "no such group '$param{group}'" unless exists $groups->{ $param{group} };
        $ratio = $mass / $groups->{ $param{group} }->[MASS];
    } else {
        $ratio = $mass / $total->[MASS];
    }
    for my $ref ( @$things, values %$groups, $total ) {
        $ref->[MASS] *= $ratio;
    }
    return $self;
}

1;
__END__