Statistiques
| Révision:

root / UCalcul.pas

Historique | Voir | Annoter | Télécharger (9,811 ko)

1
unit UCalcul;
2

    
3
interface
4

    
5
// Conversion PV en PVV
6
function CalcPVV(PV: double): double;
7
// Conversion PVV en PV
8
function CalcPV(PVV: double): double;
9
// Calcul du poids de prot?ines en fonction du poids vif
10
function CalcProt(PV: double): double;
11
// Calcul du poids de lipides en fonction du poids vif et du poids de prot?ines
12
function CalcLipProt(PV, p: double): double;
13
// Calcul du poids de prot?ines en fonction du poids vif et du poids de lipides
14
function CalcProtLip(PV, l: double): double;
15
// Calcul du rendement carcasse standardis? (t?te, pieds et queue)
16
function CalcRCStd(PVFin, RCFin: double): double;
17
// Calcul du rendement carcasse
18
function CalcRC(PVFin, RCStd, PV: double): double;
19
// Calcul de l'?paisseur de lard (P2)
20
function CalcP2(l: double): double;
21
// Calcul de l'?paisseur de lard (?quation utilisateur)
22
function CalcUserFat(PVV, p, l: double): double;
23
{
24
// Calcul du pourcentage de muscle
25
function CalcMuscle(PVV, l: double): double;
26
// Calcul de la teneur en viande maigre (TVM)
27
function CalcTVM(PVV, l: double): double;
28
}
29
// Calcul du taux de muscle des pi?ces (TMP)
30
function CalcTMP(PVV, p, l: double): double;
31
// Calcul du maigre (?quation utilisateur)
32
function CalcUserLean(PVV, p, l: double): double;
33
// Valeur de courbe curvilin?aire
34
function CLvaleur(Initial, Moyenne: double; Jour, Duree: integer): double;
35
// Valeur de courbe lin?aire-plateau
36
function LPvaleur(Initial, Additionnel, Moyenne: double; Jour, Duree: integer): double;
37
// Calcul des coefficients a et b en fonction de l'ing?r? ? 50 et 100kg
38
procedure CalcCoef(Equation, Unite: integer; Ing50, Ing100: double; var a, b: double);
39
// Calcul de l'ing?r? en fonction du poids vif et des coeeficients a et b
40
function CalcIngere(Equation, Unite: integer; a, b, PV: double): double;
41

    
42
implementation
43

    
44
uses
45
  Math, UVariables;
46

    
47
// Conversion PV en PVV
48
function CalcPVV(PV: double): double;
49
begin
50
  Result := aPVV * Power(PV, bPVV);
51
end;
52

    
53
// Conversion PVV en PV
54
function CalcPV(PVV: double): double;
55
begin
56
  Result := Power(PVV / aPVV, 1 / bPVV);
57
end;
58

    
59
// Calcul du poids de prot?ines en fonction du poids vif
60
function CalcProt(PV: double): double;
61
begin
62
  Result := CalcPVV(PV) * 0.16;
63
end;
64

    
65
// Calcul du poids de lipides en fonction du poids vif et du poids de prot?ines
66
function CalcLipProt(PV, p: double): double;
67
var
68
  x: double;
69
begin
70
  if p > 0 then
71
  begin
72
    x := (1000 * CalcPVV(PV) - Pallom * Exp(Ballom * Ln(1000 * p))) / Lallom;
73
    if x > 0 then
74
      Result := Exp(-(-Ln(x) + Ballom * Ln(1000)) / Ballom)
75
    else
76
      Result := 0;
77
  end
78
  else
79
    Result := 0;
80
end;
81

    
82
// Calcul du poids de prot?ines en fonction du poids vif et du poids de lipides
83
function CalcProtLip(PV, l: double): double;
84
var
85
  x: double;
86
begin
87
  if l > 0 then
88
  begin
89
    x := (1000 * CalcPVV(PV) - Lallom * Exp(Ballom * Ln(1000 * l))) / Pallom;
90
    if x > 0 then
91
      Result := Exp(-(-Ln(x) + Ballom * Ln(1000)) / Ballom)
92
    else
93
      Result := 0;
94
  end
95
  else
96
    Result := 0;
97
end;
98

    
99
// Calcul du rendement carcasse standardis? (t?te, pieds et queue)
100
function CalcRCStd(PVFin, RCFin: double): double;
101
var
102
  PC: double;
103
begin
104
  // Poids de la carcasse selon param?trage
105
  PC := RCFin * PVFin;
106
  // Conversion en poids de carcasse standardis?
107
  if not CarTete then
108
    PC := PC + TeteTPQ * aTPQ * Power(PVFin, bTPQ)
109
  else if not CarQueue then
110
    PC := PC + aLangue * PVFin;
111
  if not CarPieds then
112
    PC := PC + PiedsTPQ * aTPQ * Power(PVFin, bTPQ);
113
  if not CarQueue then
114
    PC := PC + QueueTPQ * aTPQ * Power(PVFin, bTPQ);
115
  if CarHampe then
116
    PC := PC - aHampe * Power(PVFin, bHampe);
117
  if CarPanne then
118
    PC := PC - aPanne * Power(PVFin, bPanne);
119
  // Calcul du rendement
120
  Result := PC / PVFin;
121
end;
122

    
123
// Calcul du rendement carcasse
124
function CalcRC(PVFin, RCStd, PV: double): double;
125
var
126
  PC: double;
127
begin
128
  // Poids de carcasse standardis?
129
  PC := RCStd * Power(PVFin, 1 - bCarcasse) * Power(PV, bCarcasse);
130
  // Conversion en poids de carcasse selon param?trage
131
  if not CarTete then
132
    PC := PC - TeteTPQ * aTPQ * Power(PV, bTPQ)
133
  else if not CarQueue then
134
    PC := PC - aLangue * PV;
135
  if not CarPieds then
136
    PC := PC - PiedsTPQ * aTPQ * Power(PV, bTPQ);
137
  if not CarQueue then
138
    PC := PC - QueueTPQ * aTPQ * Power(PV, bTPQ);
139
  if CarHampe then
140
    PC := PC + aHampe * Power(PV, bHampe);
141
  if CarPanne then
142
    PC := PC + aPanne * Power(PV, bPanne);
143
  // Calcul du rendement
144
  Result := PC / PV;
145
end;
146

    
147
// Calcul de l'?paisseur de lard (P2)
148
function CalcP2(l: double): double;
149
begin
150
  Result := 6.96 + 0.375 * l;
151
end;
152

    
153
// Calcul de l'?paisseur de lard (?quation utilisateur)
154
function CalcUserFat(PVV, p, l: double): double;
155
begin
156
  if UserFatPVV then
157
    if PVV > 0 then
158
      Result := UserFatA + UserFatB * p / PVV + UserFatC * l / PVV
159
    else
160
      Result := 0
161
  else
162
    Result := UserFatA + UserFatB * p + UserFatC * l;
163
end;
164

    
165
{
166
// Calcul du pourcentage de muscle
167
function CalcMuscle(PVV, l: double): double;
168
begin
169
  if PVV > 0
170
  then
171
    result := 74.61054295 - 82.63784389 * l / PVV
172
  else
173
    result := 0;
174
end;
175

176
// Calcul de la teneur en viande maigre (TVM)
177
function CalcTVM(PVV, l: double): double;
178
begin
179
  if PVV > 0
180
  then
181
    result := 72.57799266 - 43.48869610 * l / PVV
182
  else
183
    result := 0;
184
end;
185
}
186

    
187
// Calcul du taux de muscle des pi?ces (TMP)
188
function CalcTMP(PVV, p, l: double): double;
189
begin
190
  if PVV > 0 then
191
    Result := 57.43 + 95.68 * p / PVV - 62.68 * l / PVV
192
  else
193
    Result := 0;
194
end;
195

    
196
// Calcul du maigre (?quation utilisateur)
197
function CalcUserLean(PVV, p, l: double): double;
198
begin
199
  if UserLeanPVV then
200
    if PVV > 0 then
201
      Result := UserLeanA + UserLeanB * p / PVV + UserLeanC * l / PVV
202
    else
203
      Result := 0
204
  else
205
    Result := UserLeanA + UserLeanB * p + UserLeanC * l;
206
end;
207

    
208
// Valeur de courbe curvilin?aire
209
function CLvaleur(Initial, Moyenne: double; Jour, Duree: integer): double;
210
const
211
  CLmax = 7.75610189567227;
212
  CLpas = 10;
213
  CLa = 0.0873409939712299;
214
  CLb = 1.32485469132323;
215
var
216
  i, j: integer;
217
  CLe, CLtyp, CLtot, CLcor: double;
218
begin
219
  if Duree > 0 then
220
  begin
221
    CLe := 0;
222
    CLcor := 0;
223
    i := 0;
224
    while (i <= Int((Moyenne * 3) * CLpas)) and
225
      (CLmax * (1 - Exp(-CLa * Power(1 + CLe, CLb))) * CLcor < Initial) do
226
    begin
227
      CLtot := 0;
228
      for j := 1 to Duree do
229
        CLtot := CLtot + CLmax * (1 - Exp(-CLa * Power(j + i / CLpas, CLb)));
230
      CLcor := (Moyenne * Duree) / CLtot;
231
      CLe := i / CLpas;
232
      Inc(i);
233
    end;
234
    if Jour < Duree then
235
      CLtyp := CLmax * (1 - Exp(-CLa * Power(Jour + CLe, CLb)))
236
    else
237
      CLtyp := CLmax * (1 - Exp(-CLa * Power(Duree + CLe, CLb)));
238
    Result := CLtyp * CLcor;
239
  end
240
  else
241
    Result := 0;
242
end;
243

    
244
// Valeur de courbe lin?aire-plateau
245
function LPvaleur(Initial, Additionnel, Moyenne: double; Jour, Duree: integer): double;
246
var
247
  i: integer;
248
  LPtyp, LPmax, LPtot, LPcum: double;
249
begin
250
  LPtot := Moyenne * Duree;
251
  LPmax := 0;
252
  LPtyp := Initial;
253
  LPcum := LPtyp;
254
  i := 1;
255
  while (i < Duree) and (LPtyp < (LPtot - LPcum) / (Duree - i)) do
256
  begin
257
    LPmax := (LPtot - LPcum) / (Duree - i);
258
    LPtyp := Initial + Additionnel * i;
259
    LPcum := LPcum + LPtyp;
260
    Inc(i);
261
  end;
262
  LPtyp := Initial + Additionnel * (Jour - 1);
263
  if LPtyp < LPmax then
264
    Result := LPtyp
265
  else
266
    Result := LPmax;
267
end;
268

    
269
// Calcul des coefficients a et b en fonction de l'ing?r? ? 50 et 100kg
270
procedure CalcCoef(Equation, Unite: integer; Ing50, Ing100: double; var a, b: double);
271
var
272
  c, d: double;
273
begin
274
  try
275
    case Equation of
276
      0: // Mod?le lin?aire
277
      begin
278
        a := 2 * Ing50 - Ing100;
279
        b := 1 / 50 * Ing100 - 1 / 50 * Ing50;
280
      end;
281
      1: // Mod?le puissance
282
      begin
283
        a := Ing100 / Exp(Ln(100) * Ln(Ing100 / Ing50) / Ln(2));
284
        b := Ln(Ing100 / Ing50) / Ln(2);
285
      end;
286
      2: // Mod?le exponentiel
287
      begin
288
        a := -Power(Ing50, 2) / (Ing100 - 2 * Ing50);
289
        b := -1 / 50 * Ln((Ing100 - Ing50) / Ing50);
290
      end;
291
      3: // Mod?le Gamma
292
      begin
293
        case Unite of
294
          0: // Quantit? (kg/j)
295
            c := cGammaFrais;
296
          1: // ED (MJ/j)
297
            c := cGammaED;
298
          2: // EM (MJ/j)
299
            c := cGammaEM;
300
          3: // EN (MJ/j)
301
            c := cGammaEN;
302
          4: // MS (kg/j)
303
            c := cGammaMS;
304
          else
305
            c := 0;
306
        end;
307
        d := dGamma;
308
        a := -2 * Power((Ing50 - c * Exp(Ln(50) * d)), 2) * Exp(-d * Ln(25)) /
309
          (c * (-Ln(-1 / 2 * (-Ing100 + c * Exp(Ln(100) * d)) / (Ing50 - c * Exp(Ln(50) * d))) +
310
          d * Ln(2)) * (-Ing100 + c * Exp(Ln(100) * d)));
311
        b := -1 / 50 * Ln(-1 / 2 * (-Ing100 + c * Exp(Ln(100) * d)) /
312
          (Ing50 - c * Exp(Ln(50) * d))) + 1 / 50 * d * Ln(2);
313
      end;
314
      else
315
      begin
316
        a := 0;
317
        b := 0;
318
      end;
319
    end;
320
  except
321
    a := 0;
322
    b := 0;
323
  end;
324
end;
325

    
326
// Calcul de l'ing?r? en fonction du poids vif et des coeeficients a et b
327
function CalcIngere(Equation, Unite: integer; a, b, PV: double): double;
328
var
329
  c, d: double;
330
begin
331
  case Equation of
332
    0: // Mod?le lin?aire
333
      Result := a + b * PV;
334
    1: // Mod?le puissance
335
      Result := a * Power(PV, b);
336
    2: // Mod?le exponentiel
337
      Result := a * (1 - Exp(-b * PV));
338
    3: // Mod?le Gamma
339
    begin
340
      case Unite of
341
        0: // Quantit? (kg/j)
342
          c := cGammaFrais;
343
        1: // ED (MJ/j)
344
          c := cGammaED;
345
        2: // EM (MJ/j)
346
          c := cGammaEM;
347
        3: // EN (MJ/j)
348
          c := cGammaEN;
349
        4: // MS (kg/j)
350
          c := cGammaMS;
351
        else
352
          c := 0;
353
      end;
354
      d := dGamma;
355
      Result := (a * (b * PV * Exp(-b * PV)) + 1) * c * Power(PV, d);
356
    end;
357
    else
358
      Result := 0;
359
  end;
360
end;
361

    
362
end.