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__ |