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


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