File Coverage

blib/lib/Food/Ratio.pm
Criterion Covered Total %
statement 123 123 100.0
branch 48 48 100.0
condition 32 32 100.0
subroutine 18 18 100.0
pod 9 9 100.0
total 230 230 100.0


line stmt bran cond sub pod time code
1             # -*- Perl -*-
2             #
3             # Ultima Ratio Coquorum
4              
5             package Food::Ratio 0.04;
6 2     2   240816 use strict;
  2         17  
  2         57  
7 2     2   10 use warnings;
  2         4  
  2         56  
8 2     2   1298 use Object::Pad 0.802;
  2         23087  
  2         160  
9              
10             class Food::Ratio :strict(params);
11 2     2   720 use Carp 'croak';
  2         7  
  2         103  
12 2     2   1033 use List::UtilsBy 'nsort_by';
  2         4543  
  2         191  
13 2     2   15 use Scalar::Util 'looks_like_number';
  2         5  
  2         139  
14              
15             use constant {
16 2         6729 MASS => 0, # array index for $things, $groups, $total
17             NAME => 1,
18             GROUPS => 2,
19             ORDER => 3,
20             RATIO => 4,
21 2     2   13 };
  2         6  
22 1     1 1 4 field $things :reader; # individual ingredients (aref of aref)
  1         7  
23 1     1 1 4 field $groups :reader; # groups of ingredients (href of aref)
  1         8  
24 1     1 1 2 field $total :reader; # (aref)
  1         5  
25              
26 1     1 1 4791 field $key :reader; # ratio key ingredient, group, or total
  1         8  
27              
28             field $index_group = 0; # to keep the output in input addition order
29              
30             ADJUST {
31             $groups = {};
32             $things = [];
33             $total = [];
34             }
35              
36 21     21 1 10198 method add ( $mass, $name, @rest ) {
  21         26  
  21         34  
  21         22  
  21         35  
  21         22  
37 21 100 100     487 croak "mass must be positive"
      100        
38             unless defined $mass
39             and looks_like_number($mass)
40             and $mass > 0;
41 18 100 100     218 croak "things must be something"
42             unless defined $name and length $name;
43 16         24 for my $grname (@rest) {
44 16 100 100     206 croak "groups must be something"
45             unless defined $grname and length $grname;
46             }
47             # hopefully after here nothing blows up that might leave the object
48             # in an inconsistent state
49 14         24 my @meta;
50 14 100       50 @meta[ MASS, NAME, GROUPS, RATIO ] =
51             ( $mass, $name, @rest ? \@rest : [], 0 );
52 14         28 push @$things, \@meta;
53 14         21 for my $grname (@rest) {
54 14   100     39 my $gmeta = $groups->{$grname} //= [];
55 14         26 $gmeta->@[ NAME, RATIO ] = ( $grname, 0 );
56 14         21 $gmeta->[MASS] += $mass;
57 14 100       32 $gmeta->[ORDER] = $index_group++ unless defined $gmeta->[ORDER];
58             }
59 14         32 $total->[MASS] += $mass;
60 14         32 return $self;
61             }
62              
63 2     2 1 27 method details() {
  2         3  
  2         2  
64 2 100       135 croak "ratio has not been called" unless defined $key;
65 1         1 my %details;
66 1         3 for my $ref (@$things) {
67             push $details{ingredients}->@*,
68 2         11 { groups => [ $ref->[GROUPS]->@* ],
69             mass => $ref->[MASS],
70             name => $ref->[NAME],
71             ratio => $ref->[RATIO],
72             };
73             }
74 1     2   6 for my $ref ( nsort_by { $_->[ORDER] } values %$groups ) {
  2         14  
75             push $details{groups}->@*,
76 2         17 { mass => $ref->[MASS],
77             name => $ref->[NAME],
78             order => $ref->[ORDER],
79             ratio => $ref->[RATIO],
80             };
81             }
82             $details{total} = {
83 1         5 mass => $total->[MASS],
84             ratio => $total->[RATIO],
85             };
86 1         3 return \%details;
87             }
88              
89             # the ratio could be based on the total amount, or for cooking there is
90             # more likely some key ingredient--flour--or a group of ingredients,
91             # such as a variety of flours that together form the total for the ratio
92 10     10 1 3664 method ratio (%param) {
  10         17  
  10         20  
  10         13  
93 10         12 my $amount;
94 10 100       25 if ( exists $param{id} ) {
    100          
95             croak "id must be something"
96 4 100 100     197 unless defined $param{id} and length $param{id};
97             # NOTE only the first match is used if there are duplicates in
98             # the ingredients list
99 2         3 my $okay = 0;
100 2         6 for my $ref (@$things) {
101 9 100       20 if ( $ref->[NAME] eq $param{id} ) {
102 1         4 ( $key, $amount ) = ( $ref, $ref->[MASS] );
103 1         2 $okay = 1;
104 1         1 last;
105             }
106             }
107 2 100       88 croak "no such id '$param{id}'" unless $okay;
108             } elsif ( exists $param{group} ) {
109             croak "group must be something"
110 4 100 100     178 unless defined $param{group} and length $param{group};
111             croak "no such group '$param{group}'"
112 2 100       100 unless exists $groups->{ $param{group} };
113 1         2 $key = $groups->{ $param{group} };
114 1         2 $amount = $key->[MASS];
115             } else {
116 2         20 $key = $total;
117 2         3 $amount = $total->[MASS];
118             }
119 4         12 for my $ref ( @$things, values %$groups, $total ) {
120 28         50 $ref->[RATIO] = $ref->[MASS] * 100 / $amount;
121             }
122 4         14 return $self;
123             }
124              
125 5     5 1 494 method string() {
  5         6  
  5         7  
126 5 100       94 croak "ratio has not been called" unless defined $key;
127 4         8 my $s = '';
128 4         8 for my $ref (@$things) {
129 20         137 $s .= join( "\t",
130             sprintf( "%.4g\t%.4g%%", $ref->@[ MASS, RATIO ] ),
131             $ref->[NAME], $ref->[GROUPS]->@* )
132             . "\n";
133             }
134 4 100       11 if ( keys %$groups ) {
135 1         2 $s .= "--\n";
136 1     4   10 for my $ref ( nsort_by { $_->[ORDER] } values %$groups ) {
  4         29  
137 4         44 $s .= join( "\t",
138             sprintf( "%.4g\t%.4g%%", $ref->@[ MASS, RATIO ] ),
139             $ref->[NAME] )
140             . "\n";
141             }
142             }
143 4         11 $s .= "--\n";
144 4         24 $s .= join "\t", $total->[MASS], sprintf( '%.4g%%', $total->[RATIO] ),
145             "*total\n";
146 4         18 return $s;
147             }
148              
149 13     13 1 5147 method weigh ( $mass, %param ) {
  13         65  
  13         21  
  13         29  
  13         18  
150 13 100       107 croak "ratio has not been called" unless defined $key;
151 12 100 100     340 croak "mass must be positive"
      100        
152             unless defined $mass
153             and looks_like_number($mass)
154             and $mass > 0;
155 9         15 my $ratio;
156 9 100       42 if ( exists $param{id} ) {
    100          
157             croak "id must be something"
158 4 100 100     186 unless defined $param{id} and length $param{id};
159             # NOTE only the first match is used if there are duplicates in
160             # the ingredients list
161 2         3 my $okay = 0;
162 2         7 for my $ref (@$things) {
163 8 100       20 if ( $ref->[NAME] eq $param{id} ) {
164 1         13 $ratio = $mass / $ref->[MASS];
165 1         3 $okay = 1;
166 1         2 last;
167             }
168             }
169 2 100       90 croak "no such id '$param{id}'" unless $okay;
170             } elsif ( exists $param{group} ) {
171             croak "group must be something"
172 4 100 100     182 unless defined $param{group} and length $param{group};
173             croak "no such group '$param{group}'"
174 2 100       87 unless exists $groups->{ $param{group} };
175 1         3 $ratio = $mass / $groups->{ $param{group} }->[MASS];
176             } else {
177 1         3 $ratio = $mass / $total->[MASS];
178             }
179 3         9 for my $ref ( @$things, values %$groups, $total ) {
180 15         23 $ref->[MASS] *= $ratio;
181             }
182 3         10 return $self;
183             }
184              
185             1;
186             __END__