Statistiques
| Révision:

root / Ludo / UFLudo.pas @ 3

Historique | Voir | Annoter | Télécharger (50,246 ko)

1 3 avalancogn
unit UFLudo;
2
3
interface
4
5
uses
6
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7
  Dialogs, ComCtrls, StdCtrls, Mask, JvExMask, JvToolEdit, JvExStdCtrls,
8
  JvCombobox, JvExComCtrls, JvComCtrls, JvSpeedButton, JvRadioButton,
9
  JvExControls, JvComponent, JvLabel, JvEdit, JvValidateEdit, JvSpin,
10
  JvStatusBar, JvGroupBox, DB, JvCsvData, Math, MidasLib, UVariables, ExtCtrls,
11
  Buttons, TeeProcs, TeEngine, Chart, ASGSQLite3, Series, dmath, Registry,
12
  XPMan;
13
14
type
15
  TFLudo = class(TForm)
16
    JvDEFolder:   TJvDirectoryEdit;
17
    JvFEImport:   TJvFilenameEdit;
18
    JvFEResult:   TJvFilenameEdit;
19
    JvCsvDSImport: TJvCsvDataSet;
20
    JvCsvDSResult: TJvCsvDataSet;
21
    JvFEBilan:    TJvFilenameEdit;
22
    JvCsvDSBilan: TJvCsvDataSet;
23
    PFolder:      TPanel;
24
    PC:           TPageControl;
25
    TSImport:     TTabSheet;
26
    TSObserv:     TTabSheet;
27
    TSCalibr:     TTabSheet;
28
    TSGraph:      TTabSheet;
29
    TSSimul:      TTabSheet;
30
    MImport:      TMemo;
31
    MSimul:       TMemo;
32
    LFolder:      TLabel;
33
    LImport:      TLabel;
34
    LBilan:       TLabel;
35
    LResult:      TLabel;
36
    LRation2:     TLabel;
37
    LSeqAli2:     TLabel;
38
    CBRation2:    TComboBox;
39
    CBSeqAli2:    TComboBox;
40
    SBImport:     TSpeedButton;
41
    SBSimul:      TSpeedButton;
42
    JvCsvDSObserv: TJvCsvDataSet;
43
    JvFEObserv:   TJvFilenameEdit;
44
    MObserv:      TMemo;
45
    LObserv:      TLabel;
46
    SBObserv:     TSpeedButton;
47
    LRation1:     TLabel;
48
    LSeqAli1:     TLabel;
49
    CBRation1:    TComboBox;
50
    CBSeqAli1:    TComboBox;
51
    SBCalibr:     TSpeedButton;
52
    MCalibr:      TMemo;
53
    LProfil:      TLabel;
54
    CBProfil:     TComboBox;
55
    CGraph:       TChart;
56
    LUnite:       TLabel;
57
    CBUnite:      TComboBox;
58
    LEquation:    TLabel;
59
    CBEquation:   TComboBox;
60
    GBAdLib:      TGroupBox;
61
    LY50:         TLabel;
62
    LY100:        TLabel;
63
    LCarcasse:    TLabel;
64
    LPDMoy:       TLabel;
65
    LPrecocite:   TLabel;
66
    LEntretien:   TLabel;
67
    LPVmr2:       TLabel;
68
    JvVECarcasse: TJvValidateEdit;
69
    JvVEPDMoy:    TJvValidateEdit;
70
    JvVEPrecocite: TJvValidateEdit;
71
    JvVEEntretien: TJvValidateEdit;
72
    JvVEPVmr2:    TJvValidateEdit;
73
    JvVEY50:      TJvValidateEdit;
74
    JvVEY100:     TJvValidateEdit;
75
    ASQLite3DBInraPorc: TASQLite3DB;
76
    ASQLite3TableObserv: TASQLite3Table;
77
    EY50:         TEdit;
78
    EY100:        TEdit;
79
    EPDMoy:       TEdit;
80
    EPrecocite:   TEdit;
81
    EEntretien:   TEdit;
82
    LineFeed:     TLineSeries;
83
    LineWeight:   TLineSeries;
84
    PointFeed:    TLineSeries;
85
    PointWeight:  TLineSeries;
86
    CheckBox1:    TCheckBox;
87
    CheckBox2:    TCheckBox;
88
    CheckBox3:    TCheckBox;
89
    CheckBox4:    TCheckBox;
90
    CheckBox5:    TCheckBox;
91
    CheckBox7:    TCheckBox;
92
    CheckBox8:    TCheckBox;
93
    CheckBox9:    TCheckBox;
94
    TSExport:     TTabSheet;
95
    LExport:      TLabel;
96
    SBExport:     TSpeedButton;
97
    JvFEExport:   TJvFilenameEdit;
98
    MExport:      TMemo;
99
    JvCsvDSExport: TJvCsvDataSet;
100
    XPManifestStyle: TXPManifest;
101
    GroupBoxFin:  TGroupBox;
102
    JvValidateEditDuree: TJvValidateEdit;
103
    JvValidateEditPVFin: TJvValidateEdit;
104
    RadioButtonPVFin: TRadioButton;
105
    RadioButtonDuree: TRadioButton;
106
    CheckBoxProfil: TCheckBox;
107
    CheckBox6: TCheckBox;
108
    CBAALimitCalibr: TCheckBox;
109
    EPVInit: TEdit;
110
    CBAALimitSimul: TCheckBox;
111
    CBAALimitGraph: TCheckBox;
112
    procedure JvDEFolderChange(Sender: TObject);
113
    procedure SBImportClick(Sender: TObject);
114
    procedure SBSimulClick(Sender: TObject);
115
    procedure FormShow(Sender: TObject);
116
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
117
    procedure SBObservClick(Sender: TObject);
118
    procedure SBCalibrClick(Sender: TObject);
119
    procedure CBProfilChange(Sender: TObject);
120
    procedure CBUniteChange(Sender: TObject);
121
    procedure FormCreate(Sender: TObject);
122
    procedure SBExportClick(Sender: TObject);
123
    procedure CheckBoxProfilClick(Sender: TObject);
124
  private
125
    { D?clarations priv?es }
126
    dUnite, mUnite: double;
127
    procedure LoadAliment;
128
    procedure LoadSeqAliP;
129
    procedure LoadRationP;
130
    procedure LoadProfilP;
131
    procedure FreeAliment;
132
    procedure FreeSeqAliP;
133
    procedure FreeRationP;
134
    procedure FreeProfilP;
135
    procedure FreeSimulP;
136
    procedure StringsSeqAliP(Liste: TStrings);
137
    procedure StringsRationP(Liste: TStrings);
138
    procedure StringsProfilP(Liste: TStrings);
139
    procedure SaveProfilP;
140
  public
141
    { D?clarations publiques }
142
  end;
143
144
var
145
  FLudo: TFLudo;
146
147
implementation
148
149
uses
150
  SHFolder, UFindRec, UUtil, UCalcul, UCalcSimulP;
151
152
{$R *.dfm}
153
154
const
155
  MaxIter = 100;
156
  Tol = MICRO;
157
158
type
159
  RecCalibr = record
160
    Age: integer;
161
    Id:  integer; // 1=Feed, 2=Weight, 3=Backfat, 4=Lean
162
    Observ: extended;
163
    Predict: extended;
164
  end;
165
  PRecCalibr = ^RecCalibr;
166
167
var
168
  ListRecCalibr: TList;
169
  NVar, NVarDep, NData: integer;
170
  X, G: TVector;
171
  H_inv: TMatrix;
172
  F_min, Det: Float;
173
  Inv: array[1..6] of Float;
174
  Nb:  array[1..4] of integer;
175
  Tot, M, w: array[1..4] of double;
176
177
// Fonction de minimisation des ?carts entre les valeurs pr?dites et celles observ?es
178
function Func(X: TVector): Float;
179
var
180
  i, jour: integer;
181
  Y50, Y100, cumul: Float;
182
  rec: PRecCalibr;
183
begin
184
  i := 0;
185
  if FLudo.CheckBox5.Checked
186
  then
187
  begin
188
    Inc(i);
189
    if X[i] <= 0 then
190
      PProfilP.PVInit := MILLI
191
    else
192
      PProfilP.PVInit := X[i];
193
    // Recalculer les poids initiaux de prot?ines et lipides
194
    PProfilP.ProtInit := CalcProt(PProfilP.PVInit);
195
    PProfilP.LipInit := CalcLipProt(PProfilP.PVInit, PProfilP.ProtInit);
196
  end;
197
  if FLudo.CheckBox6.Checked then
198
  begin
199
    Inc(i);
200
    Y50 := X[i];
201
    Inc(i);
202
    Y100 := X[i];
203
    try
204
      CalcCoef(PProfilP.Equation, PProfilP.Unite, Y50, Y100, PProfilP.a, PProfilP.b);
205
    except
206
      PProfilP.a := 0;
207
      PProfilP.b := 0;
208
    end;
209
  end;
210
  if FLudo.CheckBox7.Checked then
211
  begin
212
    Inc(i);
213
    if X[i] <= 0 then
214
      PProfilP.PDMoy := MILLI
215
    else
216
      PProfilP.PDMoy := X[i];
217
  end;
218
  if FLudo.CheckBox8.Checked then
219
  begin
220
    Inc(i);
221
    if X[i] <= 0 then
222
      PProfilP.BGompertz := MILLI
223
    else
224
      PProfilP.BGompertz := X[i];
225
  end;
226
  if FLudo.CheckBox9.Checked then
227
  begin
228
    Inc(i);
229
    if X[i] <= 0 then
230
      PProfilP.Entretien := MILLI
231
    else
232
      PProfilP.Entretien := X[i];
233
  end;
234
  // Valeur des param?tres du cas ?valu?
235
  try
236
    // Affichage de la simulation
237
    CalcSimulP(-1, PProfilP.Num, PProfilP.SeqAli, PProfilP.Ration, -1, 1, PResSimulP, FLudo.CBAALimitCalibr.Checked);
238
  except // La simulation a ?chou?
239
    for i := 0 to ListRecCalibr.Count - 1 do
240
    begin
241
      rec := ListRecCalibr[i];
242
      rec.Predict := 0;
243
    end;
244
  end;
245
  // Evaluation du cas
246
  i := 0;
247
  rec := ListRecCalibr[i];
248
  cumul := 0;
249
  for jour := 1 to PResSimulP.NbJSim do
250
  begin
251
    while (i < ListRecCalibr.Count) and (PResSimulP.TabResult[1, jour] = rec.Age) do
252
    begin
253
      case rec.Id of
254
        1: // Feed
255
          rec.Predict := cumul;
256
        2: // Weight
257
          rec.Predict := PResSimulP.TabResult[2, jour];
258
        3: // Backfat (P2)
259
          rec.Predict := CalcP2(PResSimulP.TabResult[50, jour]);
260
        4: // Lean (TMP)
261
          rec.Predict := CalcTMP(PResSimulP.TabResult[48, jour],
262
            PResSimulP.TabResult[49, jour], PResSimulP.TabResult[50, jour]);
263
      end;
264
      Inc(i);
265
      if i < ListRecCalibr.Count then
266
        rec := ListRecCalibr[i];
267
    end;
268
    cumul := cumul + PResSimulP.TabResult[113, jour];
269
  end;
270
  // Ecart par rapport aux valeurs du profil
271
  Result := 0;
272
  for i := 0 to ListRecCalibr.Count - 1 do
273
  begin
274
    rec := ListRecCalibr[i];
275
    case rec.Id of
276
      1: // Feed
277
        if FLudo.CheckBox1.Checked then
278
          Result := Result + w[1] * Power(rec.Observ - rec.Predict, 2);
279
      2: // Weight
280
        if FLudo.CheckBox2.Checked then
281
          Result := Result + w[2] * Power(rec.Observ - rec.Predict, 2);
282
      3: // Backfat
283
        if FLudo.CheckBox3.Checked then
284
          Result := Result + w[3] * Power(rec.Observ - rec.Predict, 2);
285
      4: // Lean
286
        if FLudo.CheckBox4.Checked then
287
          Result := Result + w[4] * Power(rec.Observ - rec.Predict, 2);
288
    end;
289
  end;
290
end;
291
292
// Newton-Raphson method
293
// procedure HessGrad to compute the gradient G and the hessian H of the function at point X
294
{$I numhess.inc}
295
296
 // Broyden-Fletcher-Goldfarb-Shanno method
297
 // procedure Gradient to compute the gradient G of the function at point X
298
 //{$I numgrad.inc}
299
300
procedure TFLudo.FormCreate(Sender: TObject);
301
begin
302
  dUnite := cGammaEN;
303
end;
304
305
procedure TFLudo.FormShow(Sender: TObject);
306
var
307
  Buffer: Pointer;
308
  Version: PVSFixedFileInfo;
309
  BufferSize, VersionSize: DWORD;
310
  VolumeSerialNumber, MaximumComponentLength, FileSystemFlags: DWORD;
311
  Personal: array[0..MAX_PATH] of Char;
312
begin
313
  NFicAliment := 'Aliment.rec';
314
  NFicSeqAliP := 'SeqAliP.rec';
315
  NFicRationP := 'RationP2.rec';
316
  NFicProfilP := 'ProfilP2.rec';
317
  ListAliment := TList.Create;
318
  ListSeqAliP := TList.Create;
319
  ListRationP := TList.Create;
320
  ListProfilP := TList.Create;
321
  ListSimulP := TList.Create;
322
  // Version du programme
323
  MajorVersion := 0;
324
  MinorVersion := 0;
325
  ReleaseVersion := 0;
326
  BuildVersion := 0;
327
  BufferSize := GetFileVersionInfoSize(PChar(Application.ExeName), BufferSize);
328
  if BufferSize > 0
329
  then
330
  begin
331
    GetMem(Buffer, BufferSize);
332
    if GetFileVersionInfo(PChar(Application.ExeName), 0, BufferSize, Buffer)
333
    then
334
    begin
335
      VerQueryValue(Buffer, '\', Pointer(Version), VersionSize);
336
      MajorVersion := Version.dwFileVersionMS shr 16;
337
      MinorVersion := Version.dwFileVersionMS and $FFFF;
338
      ReleaseVersion := Version.dwFileVersionLS shr 16;
339
      BuildVersion := Version.dwFileVersionLS and $FFFF;
340
    end;
341
    FreeMem(Buffer, BufferSize);
342
  end ;
343
  VersionString := Format('%d.%d.%d.%d', [MajorVersion, MinorVersion, ReleaseVersion, BuildVersion]);
344
  // Num?ro de s?rie du volume
345
  Drive := IncludeTrailingPathDelimiter(ExtractFileDrive(Application.ExeName));
346
  GetVolumeInformation(PChar(Drive), nil, 0, @VolumeSerialNumber, MaximumComponentLength, FileSystemFlags, nil, 0);
347
  Volume := IntToHex(HiWord(VolumeSerialNumber), 4) + '-' + IntToHex(LoWord(VolumeSerialNumber), 4);
348
  // LoadLicense
349
  Reg := TRegistry.Create;
350
  Reg.RootKey := HKEY_CURRENT_USER;
351
  LicenseType := BdRReadInteger('\Software\InraPorc\License', 'LicenseType', 0);
352
  LicenseNumber := BdRReadInteger('\Software\InraPorc\License', 'LicenseNumber', 0);
353
  FirstName := BdRReadString('\Software\InraPorc\License', 'FirstName', '');
354
  LastName := BdRReadString('\Software\InraPorc\License', 'LastName', '');
355
  Company := BdRReadString('\Software\InraPorc\License', 'Company', '');
356
  Address1 := BdRReadString('\Software\InraPorc\License', 'Address1', '');
357
  Address2 := BdRReadString('\Software\InraPorc\License', 'Address2', '');
358
  PostalCode := BdRReadString('\Software\InraPorc\License', 'PostalCode', '');
359
  City := BdRReadString('\Software\InraPorc\License', 'City', '');
360
  Country := BdRReadString('\Software\InraPorc\License', 'Country', '');
361
  Phone := BdRReadString('\Software\InraPorc\License', 'Phone', '');
362
  Fax := BdRReadString('\Software\InraPorc\License', 'Fax', '');
363
  Mail := BdRReadString('\Software\InraPorc\License', 'Mail', '');
364
  Course := BdRReadString('\Software\InraPorc\License', 'Course', '');
365
  FinalDate := BdRReadString('\Software\InraPorc\License', 'FinalDate', '31/12/2099');
366
  SoftwareEnableKey := BdRReadString('\Software\InraPorc\License', 'SoftwareEnableKey', '');
367
  // LoadConfig
368
  SHGetFolderPath(0, CSIDL_PERSONAL, 0, SHGFP_TYPE_CURRENT, Personal);
369
  Folder := BdRReadString('\Software\InraPorc\Config\Data', 'Folder', IncludeTrailingPathDelimiter(Personal) + 'InraPorc');
370
  JvDEFolder.Text := Reg.ReadString('Folder');
371
  Reg.Free;
372
  // V?rification de la licence
373
  if not IsComplete then
374
  begin
375
    MessageDlg('Licence non valide !',
376
      mtError, [mbOK], 0);
377
    Close;
378
    Exit;
379
  end;
380
  // Liste des num?ros autoris?s
381
  if (LicenseNumber <> 1)      //   1 = Alain Valancogne
382
    and (LicenseNumber <> 2)   //   2 = Jaap van Milgen
383
    and (LicenseNumber <> 20)  //  20 = Ludovic Brossard
384
    and (LicenseNumber <> 352) // 352 = Ludovic Brossard (portable)
385
    and (LicenseNumber <> 301) // 301 = Ludovic Brossard (Alice Cadero)
386
    and (LicenseNumber <> 372) // 372 = Florence Garcia-Launay
387
    and (LicenseNumber <> 347) // 347 = Florence Garcia-Launay
388
    and (LicenseNumber <> 16)  //  16 = Nathalie Quiniou
389
    and (LicenseNumber <> 412) // 412 = Lisanne Verschuren (Topigs)
390
    and (LicenseNumber <> 418) // 418 = Faezeh Soleimani-Jevinani (th?se H?l?ne Gilbert)
391
  then
392
  begin
393
    MessageDlg('Num?ro de licence non autoris? !',
394
      mtError, [mbOK], 0);
395
    Close;
396
    Exit;
397
  end;
398
  PC.ActivePageIndex := 0;
399
end;
400
401
procedure TFLudo.FormClose(Sender: TObject; var Action: TCloseAction);
402
begin
403
  FreeAliment;
404
  ListAliment.Free;
405
  FreeSeqAliP;
406
  ListSeqAliP.Free;
407
  FreeRationP;
408
  ListRationP.Free;
409
  FreeProfilP;
410
  ListProfilP.Free;
411
  ListSimulP.Free;
412
end;
413
414
procedure TFLudo.JvDEFolderChange(Sender: TObject);
415
begin
416
  FreeAliment;
417
  FreeSeqAliP;
418
  FreeRationP;
419
  FreeProfilP;
420
  FreeSimulP;
421
  MImport.Lines.Clear;
422
  MSimul.Lines.Clear;
423
  if not DirectoryExists(JvDEFolder.LongName) then
424
    Exit;
425
  SetCurrentDir(JvDEFolder.LongName);
426
  JvFEImport.InitialDir := GetCurrentDir;
427
  ASQLite3DBInraPorc.DefaultDir := GetCurrentDir;
428
  JvFEObserv.InitialDir := GetCurrentDir;
429
  JvFEResult.InitialDir := GetCurrentDir;
430
  JvFEBilan.InitialDir  := GetCurrentDir;
431
  if FileExists(NFicAliment) then
432
    LoadAliment;
433
  if FileExists(NFicSeqAliP) then
434
    LoadSeqAliP;
435
  StringsSeqAliP(CBSeqAli1.Items);
436
  StringsSeqAliP(CBSeqAli2.Items);
437
  if FileExists(NFicRationP) then
438
    LoadRationP;
439
  StringsRationP(CBRation1.Items);
440
  StringsRationP(CBRation2.Items);
441
  if FileExists(NFicProfilP) then
442
  begin
443
    LoadProfilP;
444
    StringsProfilP(CBProfil.Items);
445
    CBProfilChange(nil);
446
  end;
447
end;
448
449
// Onglet Importation
450
451
procedure TFLudo.SBImportClick(Sender: TObject);
452
begin
453
  if not FileExists(JvFEImport.Text) then
454
  begin
455
    MessageDlg('Indiquer le fichier ? importer !', mtWarning, [mbOK], 0);
456
    ActiveControl := JvFEImport;
457
    Exit;
458
  end;
459
  if ListProfilP.Count > 0 then
460
  begin
461
    MessageDlg('Il existe d?j? un (ou plusieurs) profil(s) !', mtError, [mbOK], 0);
462
    Exit;
463
  end;
464
  // Importation
465
  Screen.Cursor := crHourGlass;
466
  MImport.Lines.Clear;
467
  Application.ProcessMessages;
468
  JvCsvDSImport.FileName := JvFEImport.Text;
469
  JvCsvDSImport.Active := True;
470
  JvCsvDSImport.First;
471
  while not JvCsvDSImport.EOF do
472
  begin
473
    New(PProfilP);
474
    with PProfilP^ do
475
    begin
476
      Num := JvCsvDSImport.RecNo + 1;
477
      Nom := ansistring(JvCsvDSImport.Fields[0].AsString);
478
      Memo := '';
479
      Sexe := JvCsvDSImport.Fields[1].AsInteger;
480
      SeqAli := -1;
481
      Ration := -1;
482
      AgeInit := JvCsvDSImport.Fields[2].AsInteger;
483
      PVInit := JvCsvDSImport.Fields[3].AsFloat;
484
      ProtInit := CalcProt(PVInit);
485
      LipInit := CalcLipProt(PVInit, ProtInit);
486
      ModeFin := JvCsvDSImport.Fields[4].AsInteger;
487
      Duree := JvCsvDSImport.Fields[5].AsInteger;
488
      PVFin := JvCsvDSImport.Fields[6].AsFloat;
489
      Carcasse := JvCsvDSImport.Fields[7].AsFloat;
490
      Unite := JvCsvDSImport.Fields[8].AsInteger;
491
      Equation := JvCsvDSImport.Fields[9].AsInteger;
492
      a := JvCsvDSImport.Fields[10].AsFloat;
493
      b := JvCsvDSImport.Fields[11].AsFloat;
494
      PDMoy := JvCsvDSImport.Fields[12].AsFloat;
495
      BGompertz := JvCsvDSImport.Fields[13].AsFloat;
496
      Entretien := JvCsvDSImport.Fields[14].AsFloat;
497
      PVmr2 := JvCsvDSImport.Fields[15].AsFloat;
498
    end;
499
    ListProfilP.Add(PProfilP);
500
    MImport.Lines.Add(Format('%s (%d/%d)', [PProfilP.Nom, PProfilP.Num,
501
      JvCsvDSImport.RecordCount]));
502
    Application.ProcessMessages;
503
    JvCsvDSImport.Next;
504
  end;
505
  JvCsvDSImport.Active := False;
506
  SaveProfilP;
507
  Screen.Cursor := crDefault;
508
  StringsProfilP(CBProfil.Items);
509
  CBProfilChange(nil);
510
end;
511
512
// Onglet Observations
513
514
procedure TFLudo.CBUniteChange(Sender: TObject);
515
begin
516
  if (CBUnite.ItemIndex = 0) or (CBUnite.ItemIndex = 4) then // kg (QI ou MS)
517
    JvVEY50.DecimalPlaces := 3
518
  else // MJ (ED, EM ou EN)
519
    JvVEY50.DecimalPlaces := 2;
520
  JvVEY100.DecimalPlaces := JvVEY50.DecimalPlaces;
521
  case CBUnite.ItemIndex of
522
    0: // Quantit? (kg/j)
523
      mUnite := cGammaFrais;
524
    1: // ED (MJ/j)
525
      mUnite := cGammaED;
526
    2: // EM (MJ/j)
527
      mUnite := cGammaEM;
528
    3: // EN (MJ/j)
529
      mUnite := cGammaEN;
530
    4: // MS (kg/j)
531
      mUnite := cGammaMS;
532
    else
533
      mUnite := 1;
534
  end;
535
  if dUnite <> mUnite then
536
  begin
537
    JvVEY50.AsFloat := mUnite * JvVEY50.AsFloat / dUnite;
538
    JvVEY50.AsFloat := mUnite * JvVEY50.AsFloat / dUnite;
539
    dUnite := mUnite;
540
  end;
541
end;
542
543
procedure TFLudo.SBObservClick(Sender: TObject);
544
var
545
  ligne: integer;
546
  cumul: double;
547
begin
548
  if not FileExists(JvFEObserv.Text) then
549
  begin
550
    MessageDlg('Indiquer le fichier ? importer !', mtWarning, [mbOK], 0);
551
    ActiveControl := JvFEObserv;
552
    Exit;
553
  end;
554
  if ListProfilP.Count > 0 then
555
  begin
556
    MessageDlg('Il existe d?j? un (ou plusieurs) profil(s) !', mtError, [mbOK], 0);
557
    Exit;
558
  end;
559
  if not FileExists(ASQLite3DBInraPorc.Database) then
560
  begin
561
    MessageDlg('Le dossier ne contient pas de base SQLite pour stocker les observations  !', mtError, [mbOK], 0);
562
    Exit;
563
  end;
564
  ASQLite3TableObserv.Open;
565
  if not ASQLite3TableObserv.IsEmpty then
566
  begin
567
    MessageDlg('Il existe d?j? une (ou plusieurs) observation(s) !',
568
      mtError, [mbOK], 0);
569
    Exit;
570
  end;
571
  // Observations
572
  Screen.Cursor := crHourGlass;
573
  MObserv.Lines.Clear;
574
  Application.ProcessMessages;
575
  ASQLite3TableObserv.DisableControls;
576
  ASQLite3TableObserv.StartTransaction;
577
  JvCsvDSObserv.FileName := JvFEObserv.Text;
578
  JvCsvDSObserv.DisableControls;
579
  JvCsvDSObserv.Active := True;
580
  JvCsvDSObserv.First;
581
  ligne := 0;
582
  cumul := 0;
583
  while not JvCsvDSObserv.EOF do
584
  begin
585
    if (ligne > 0) and (ansistring(JvCsvDSObserv.Fields[0].AsString) <> PProfilP.Nom)
586
    then // Rupture profil
587
    begin
588
      PProfilP.Duree := ASQLite3TableObserv.FieldByName('Age').AsInteger -
589
        PProfilP.AgeInit + 1;
590
      ListProfilP.Add(PProfilP);
591
      MObserv.Lines.Add(Format('%s : %d observations', [PProfilP.Nom, ligne]));
592
      Application.ProcessMessages;
593
      ligne := 0;
594
      cumul := 0;
595
    end;
596
    if (ligne = 0) and not JvCsvDSObserv.Fields[4].IsNull then
597
      // Initialisation profil
598
    begin
599
      New(PProfilP);
600
      with PProfilP^ do
601
      begin
602
        Num  := ListProfilP.Count + 1;
603
        Nom  := ansistring(JvCsvDSObserv.Fields[0].AsString);
604
        Memo := '';
605
        if JvCsvDSObserv.Fields[1].IsNull then
606
          Sexe := -1
607
        else
608
          Sexe := JvCsvDSObserv.Fields[1].AsInteger;
609
        SeqAli := -1;
610
        Ration := -1;
611
        AgeInit := JvCsvDSObserv.Fields[2].AsInteger;
612
        PVInit := JvCsvDSObserv.Fields[4].AsFloat;
613
        ProtInit := CalcProt(PVInit);
614
        LipInit := CalcLipProt(PVInit, ProtInit);
615
        ModeFin := 0; // Dur?e
616
        PVFin := 0;
617
        Carcasse := JvVECarcasse.AsFloat / 100;
618
        Unite := CBUnite.ItemIndex;
619
        Equation := CBEquation.ItemIndex;
620
        CalcCoef(Equation, Unite, JvVEY50.AsFloat, JvVEY100.AsFloat, a, b);
621
        PDMoy := JvVEPDMoy.AsFloat;
622
        BGompertz := JvVEPrecocite.AsFloat;
623
        Entretien := JvVEEntretien.AsFloat;
624
        PVmr2 := JvVEPVmr2.AsFloat;
625
      end;
626
    end;
627
    if (ligne > 0) or not JvCsvDSObserv.Fields[4].IsNull then
628
      // Prise en compte de l'enregistrement
629
    begin
630
      ligne := ligne + 1;
631
      with ASQLite3TableObserv do
632
      begin
633
        Append;
634
        FieldByName('Profile').AsInteger := PProfilP.Num;
635
        FieldByName('Line').AsInteger := ligne;
636
        FieldByName('Age').AsInteger := JvCsvDSObserv.Fields[2].AsInteger;
637
        FieldByName('Feed').AsFloat := cumul;
638
        if not JvCsvDSObserv.Fields[4].IsNull then
639
          FieldByName('Weight').AsFloat := JvCsvDSObserv.Fields[4].AsFloat;
640
        if not JvCsvDSObserv.Fields[5].IsNull then
641
          FieldByName('Backfat').AsFloat := JvCsvDSObserv.Fields[5].AsFloat;
642
        if not JvCsvDSObserv.Fields[6].IsNull then
643
          FieldByName('Lean').AsFloat := JvCsvDSObserv.Fields[6].AsFloat;
644
        Post;
645
      end;
646
      cumul := cumul + JvCsvDSObserv.Fields[3].AsFloat;
647
    end;
648
    JvCsvDSObserv.Next;
649
  end;
650
  if ligne > 0 then // Enregistrement du dernier profil
651
  begin
652
    PProfilP.Duree := ASQLite3TableObserv.FieldByName('Age').AsInteger -
653
      PProfilP.AgeInit + 1;
654
    ListProfilP.Add(PProfilP);
655
    MObserv.Lines.Add(Format('%s : %d observations', [PProfilP.Nom, ligne]));
656
    Application.ProcessMessages;
657
  end;
658
  JvCsvDSObserv.Active := False;
659
  JvCsvDSObserv.EnableControls;
660
  try
661
    ASQLite3TableObserv.Commit;
662
  except
663
    ASQLite3TableObserv.RollBack;
664
  end;
665
  ASQLite3TableObserv.EnableControls;
666
  ASQLite3DBInraPorc.Close;
667
  SaveProfilP;
668
  Screen.Cursor := crDefault;
669
  StringsProfilP(CBProfil.Items);
670
  CBProfilChange(nil);
671
end;
672
673
// Onglet Calibrage
674
675
procedure TFLudo.SBCalibrClick(Sender: TObject);
676
var
677
  i, profil: integer;
678
  wTot: double;
679
  rec:  PRecCalibr;
680
  SSt, SSr: array[1..4] of double;
681
  Log:  TextFile;
682
683
  procedure Uncheck;
684
  begin
685
    CheckBox1.Checked := False; // Feed
686
    CheckBox2.Checked := False; // Weight
687
    CheckBox3.Checked := False; // Backfat
688
    CheckBox4.Checked := False; // Lean
689
    CheckBox5.Checked := False; // PVInit
690
    CheckBox6.Checked := False; // Y50 & Y100
691
    CheckBox7.Checked := False; // PDMean
692
    CheckBox8.Checked := False; // Precocity
693
    CheckBox9.Checked := False; // Maintenance
694
  end;
695
696
  procedure Calibration;
697
  var
698
    n: integer;
699
  begin
700
    // Initialisation des structures
701
    NVarDep := 0;
702
    if CheckBox1.Checked then
703
      Inc(NVarDep);
704
    if CheckBox2.Checked then
705
      Inc(NVarDep);
706
    if CheckBox3.Checked then
707
      Inc(NVarDep);
708
    if CheckBox4.Checked then
709
      Inc(NVarDep);
710
    NData := 0;
711
    if CheckBox1.Checked then
712
      NData := NData + Nb[1];
713
    if CheckBox2.Checked then
714
      NData := NData + Nb[2];
715
    if CheckBox3.Checked then
716
      NData := NData + Nb[3];
717
    if CheckBox4.Checked then
718
      NData := NData + Nb[4];
719
    NVar := 0;
720
    if CheckBox5.Checked then
721
      Inc(NVar);
722
    if CheckBox6.Checked then
723
      Inc(NVar, 2);
724
    if CheckBox7.Checked then
725
      Inc(NVar);
726
    if CheckBox8.Checked then
727
      Inc(NVar);
728
    if CheckBox9.Checked then
729
      Inc(NVar);
730
    DimVector(X, NVar);
731
    DimVector(G, NVar);
732
    DimMatrix(H_inv, NVar, NVar);
733
    n := 0;
734
    if CheckBox5.Checked then
735
    begin
736
      Inc(n);
737
      X[n] := PProfilP.PVInit;
738
    end;
739
    if CheckBox6.Checked then
740
    begin
741
      Inc(n);
742
      X[n] := CalcIngere(PProfilP.Equation, PProfilP.Unite, PProfilP.a, PProfilP.b, 50);
743
      Inc(n);
744
      X[n] := CalcIngere(PProfilP.Equation, PProfilP.Unite, PProfilP.a, PProfilP.b, 100);
745
    end;
746
    if CheckBox7.Checked then
747
    begin
748
      Inc(n);
749
      X[n] := PProfilP.PDMoy;
750
    end;
751
    if CheckBox8.Checked then
752
    begin
753
      Inc(n);
754
      X[n] := PProfilP.BGompertz;
755
    end;
756
    if CheckBox9.Checked then
757
    begin
758
      Inc(n);
759
      X[n] := PProfilP.Entretien;
760
    end;
761
    Marquardt(Func, HessGrad, X, 1, NVar, MaxIter, Tol, F_min, G, H_inv, Det);
762
    for n := 1 to NVar do
763
      Inv[n] := H_inv[n, n];
764
  end;
765
766
  // SBCalibrClick
767
begin
768
  if (ListAliment.Count = 0) or (ListSeqAliP.Count = 0) or
769
    (ListRationP.Count = 0) or (ListProfilP.Count = 0) then
770
  begin
771
    MessageDlg(
772
      'Choisir un dossier contenant au moins les aliments, s?quences alimentaires, plans de rationnement et profils !',
773
      mtWarning, [mbOK], 0);
774
    ActiveControl := JvDEFolder;
775
    Exit;
776
  end;
777
  if CBSeqAli1.ItemIndex = -1 then
778
  begin
779
    MessageDlg('S?lectionner une s?quence alimentaire !', mtWarning, [mbOK], 0);
780
    ActiveControl := CBSeqAli1;
781
    Exit;
782
  end;
783
  if CBRation1.ItemIndex = -1 then
784
  begin
785
    MessageDlg('S?lectionner un plan de rationnement !', mtWarning, [mbOK], 0);
786
    ActiveControl := CBRation1;
787
    Exit;
788
  end;
789
  // Calibrage
790
  Screen.Cursor := crHourGlass;
791
  MCalibr.Lines.Clear;
792
  AssignFile(Log, 'Calibr.log');
793
  Rewrite(Log);
794
  WriteLn(Log, 'Profil' + AnsiChar(#9) + 'R?(Feed)' + AnsiChar(#9) +
795
    'R?(Weight)' + AnsiChar(#9) + 'R?(Backfat)' + AnsiChar(#9) + 'R?(Lean)');
796
  Application.ProcessMessages;
797
  ASQLite3TableObserv.DisableControls;
798
  for profil := 0 to ListProfilP.Count - 1 do
799
  begin
800
    PProfilP := ListProfilP[profil];
801
    PSeqAliP := ListSeqAliP[FindIdxSeqAliP(CBSeqAli1.Text)];
802
    PProfilP.SeqAli := PSeqAliP.Num;
803
    PRationP := ListRationP[FindIdxRationP(CBRation1.Text)];
804
    PProfilP.Ration := PRationP.Num;
805
    ListRecCalibr := TList.Create;
806
    with ASQLite3TableObserv do
807
    begin
808
      Filter := Format('Profile = %d', [PProfilP.Num]);
809
      Filtered := True;
810
      Open;
811
      MCalibr.Lines.Add(Format('%s (%d/%d) : %d observations',
812
        [PProfilP.Nom, profil + 1, ListProfilP.Count, RecordCount]));
813
      Application.ProcessMessages;
814
      First;
815
      while not EOF do
816
      begin
817
        if (FieldByName('Line').AsInteger > 1) and not FieldByName('Feed').IsNull then
818
        begin
819
          Inc(Nb[1]);
820
          Tot[1] := Tot[1] + FieldByName('Feed').AsFloat;
821
          New(rec);
822
          rec.Age := FieldByName('Age').AsInteger;
823
          rec.Id  := 1;
824
          rec.Observ := FieldByName('Feed').AsFloat;
825
          ListRecCalibr.Add(rec);
826
        end;
827
        if not FieldByName('Weight').IsNull then
828
        begin
829
          Inc(Nb[2]);
830
          Tot[2] := Tot[2] + FieldByName('Weight').AsFloat;
831
          New(rec);
832
          rec.Age := FieldByName('Age').AsInteger;
833
          rec.Id  := 2;
834
          rec.Observ := FieldByName('Weight').AsFloat;
835
          ListRecCalibr.Add(rec);
836
        end;
837
        if not FieldByName('Backfat').IsNull then
838
        begin
839
          Inc(Nb[3]);
840
          Tot[3] := Tot[3] + FieldByName('Backfat').AsFloat;
841
          New(rec);
842
          rec.Age := FieldByName('Age').AsInteger;
843
          rec.Id  := 3;
844
          rec.Observ := FieldByName('Backfat').AsFloat;
845
          ListRecCalibr.Add(rec);
846
        end;
847
        if not FieldByName('Lean').IsNull then
848
        begin
849
          Inc(Nb[4]);
850
          Tot[4] := Tot[4] + FieldByName('Lean').AsFloat;
851
          New(rec);
852
          rec.Age := FieldByName('Age').AsInteger;
853
          rec.Id  := 4;
854
          rec.Observ := FieldByName('Lean').AsFloat;
855
          ListRecCalibr.Add(rec);
856
        end;
857
        Next;
858
      end;
859
      Close;
860
    end;
861
    // Moyennes observations
862
    for i := 1 to 4 do
863
      if Nb[i] <> 0 then
864
        M[i] := Tot[i] / Nb[i];
865
    // Pond?rations observations
866
    for i := 1 to 4 do
867
      if M[i] <> 0 then
868
        w[i] := 1 / (Nb[i] * Power(M[i], 2));
869
    // R?ajustement des pond?rations en fonction de la pond?ration totale
870
    wTot := 0;
871
    for i := 1 to 4 do
872
      wTot := wTot + w[i];
873
    for i := 1 to 4 do
874
      w[i] := w[i] / wTot;
875
    New(PResSimulP);
876
    // Cycle 1 : Feed -> Y50 + Y100
877
    Uncheck;
878
    CheckBox1.Checked := True; // Feed
879
    CheckBox6.Checked := True; // Y50 & Y100
880
    Calibration;
881
    // Cycle 2 : Weight -> PVInit + PDMean
882
    Uncheck;
883
    CheckBox2.Checked := True; // Weight
884
    CheckBox5.Checked := True; // PVInit
885
    CheckBox7.Checked := True; // PDMean
886
    // Cycle 3 : Feed + Weight -> PVInit + Y50 + Y100 + PDMean
887
    CheckBox1.Checked := True; // Feed
888
    CheckBox6.Checked := True; // Y50 & Y100
889
    Calibration;
890
    // Cycle 4 : Weight -> PVInit + PDMean + Precocity
891
    Uncheck;
892
    CheckBox2.Checked := True; // Weight
893
    CheckBox5.Checked := True; // PVInit
894
    CheckBox7.Checked := True; // PDMean
895
    CheckBox8.Checked := True; // Precocity
896
    Calibration;
897
    // Cycle 5 : Feed + Weight -> PVInit + Y50 + Y100 + PDMean + Precocity
898
    CheckBox1.Checked := True; // Feed
899
    CheckBox6.Checked := True; // Y50 & Y100
900
    Calibration;
901
    if PProfilP.ModeFin = 0 then // Dur?e
902
      PProfilP.PVFin := PResSimulP.TabResult[2, PResSimulP.NbJSim] +
903
        PResSimulP.TabResult[84, PResSimulP.NbJSim];
904
    Dispose(PResSimulP);
905
    // Calcul des statistiques
906
    for i := 1 to 4 do
907
    begin
908
      SSt[i] := 0;
909
      SSr[i] := 0;
910
    end;
911
    for i := 0 to ListRecCalibr.Count - 1 do
912
    begin
913
      rec := ListRecCalibr[i];
914
      case rec.Id of
915
        1: // Feed
916
          if CheckBox1.Checked then
917
          begin
918
            SSt[1] := SSt[1] + Power(rec.Observ - M[1], 2);
919
            SSr[1] := SSr[1] + Power(rec.Observ - rec.Predict, 2);
920
          end;
921
        2: // Weight
922
          if CheckBox2.Checked then
923
          begin
924
            SSt[2] := SSt[2] + Power(rec.Observ - M[2], 2);
925
            SSr[2] := SSr[2] + Power(rec.Observ - rec.Predict, 2);
926
          end;
927
        3: // Backfat
928
          if CheckBox3.Checked then
929
          begin
930
            SSt[3] := SSt[3] + Power(rec.Observ - M[3], 2);
931
            SSr[3] := SSr[3] + Power(rec.Observ - rec.Predict, 2);
932
          end;
933
        4: // Lean
934
          if CheckBox4.Checked then
935
          begin
936
            SSt[4] := SSt[4] + Power(rec.Observ - M[4], 2);
937
            SSr[4] := SSr[4] + Power(rec.Observ - rec.Predict, 2);
938
          end;
939
      end;
940
    end;
941
    // Enregistrement des statistiques
942
    Write(Log, PProfilP.Nom + AnsiChar(#9));
943
    if SSt[1] <> 0 then
944
      Write(Log, Format('%1.2f %%', [100 - SSr[1] / SSt[1] * 100]));
945
    Write(Log, AnsiChar(#9));
946
    if SSt[2] <> 0 then
947
      Write(Log, Format('%1.2f %%', [100 - SSr[2] / SSt[2] * 100]));
948
    Write(Log, AnsiChar(#9));
949
    if SSt[3] <> 0 then
950
      Write(Log, Format('%1.2f %%', [100 - SSr[3] / SSt[3] * 100]));
951
    Write(Log, AnsiChar(#9));
952
    if SSt[4] <> 0 then
953
      Write(Log, Format('%1.2f %%', [100 - SSr[4] / SSt[4] * 100]));
954
    WriteLn(Log);
955
    if ListRecCalibr.Count > 0 then
956
      for i := 0 to ListRecCalibr.Count - 1 do
957
      begin
958
        rec := ListRecCalibr[i];
959
        Dispose(rec);
960
      end;
961
    ListRecCalibr.Free;
962
  end;
963
  ASQLite3TableObserv.EnableControls;
964
  ASQLite3DBInraPorc.Close;
965
  CloseFile(Log);
966
  SaveProfilP;
967
  Screen.Cursor := crDefault;
968
end;
969
970
// Onglet Graphique
971
972
procedure TFLudo.CBProfilChange(Sender: TObject);
973
var
974
  jour: integer;
975
  cumul, x, y: double;
976
begin
977
  LineFeed.Clear;
978
  LineWeight.Clear;
979
  PointFeed.Clear;
980
  PointWeight.Clear;
981
  if CBProfil.ItemIndex = -1 then
982
    Exit;
983
  PProfilP := ListProfilP[FindIdxProfilP(CBProfil.Text)];
984
  EPVInit.Text := FloatToStrF(PProfilP.PVInit, ffFixed, 15, 1);
985
  if (PProfilP.Unite = 0) or (PProfilP.Unite = 4) then // kg (QI ou MS)
986
  begin
987
    EY50.Text  := FloatToStrF(CalcIngere(PProfilP.Equation, PProfilP.Unite,
988
      PProfilP.a, PProfilP.b, 50), ffFixed, 15, 3);
989
    EY100.Text := FloatToStrF(CalcIngere(PProfilP.Equation, PProfilP.Unite,
990
      PProfilP.a, PProfilP.b, 100), ffFixed, 15, 3);
991
  end
992
  else // MJ (ED, EM ou EN)
993
  begin
994
    EY50.Text  := FloatToStrF(CalcIngere(PProfilP.Equation, PProfilP.Unite,
995
      PProfilP.a, PProfilP.b, 50), ffFixed, 15, 2);
996
    EY100.Text := FloatToStrF(CalcIngere(PProfilP.Equation, PProfilP.Unite,
997
      PProfilP.a, PProfilP.b, 100), ffFixed, 15, 2);
998
  end;
999
  EPDMoy.Text := FloatToStrF(PProfilP.PDMoy, ffFixed, 15, 2);
1000
  EPrecocite.Text := FloatToStrF(PProfilP.BGompertz, ffFixed, 15, 5);
1001
  EEntretien.Text := FloatToStrF(PProfilP.Entretien, ffFixed, 15, 3);
1002
  with ASQLite3TableObserv do
1003
  begin
1004
    Filter := Format('Profile = %d', [PProfilP.Num]);
1005
    Filtered := True;
1006
    Open;
1007
    DisableControls;
1008
    First;
1009
    while not EOF do
1010
    begin
1011
      x := FieldByName('Age').AsInteger;
1012
      if (FieldByName('Line').AsInteger > 1) and not FieldByName('Feed').IsNull then
1013
      begin
1014
        y := FieldByName('Feed').AsFloat;
1015
        PointFeed.AddXY(x, y, '', clTeeColor);
1016
      end;
1017
      if not FieldByName('Weight').IsNull then
1018
      begin
1019
        y := FieldByName('Weight').AsFloat;
1020
        PointWeight.AddXY(x, y, '', clTeeColor);
1021
      end;
1022
      Next;
1023
    end;
1024
    EnableControls;
1025
  end;
1026
  ASQLite3DBInraPorc.Close;
1027
  if (PProfilP.SeqAli = -1) or (PProfilP.Ration = -1) then
1028
    Exit;
1029
  New(PResSimulP);
1030
  CalcSimulP(-1, PProfilP.Num, PProfilP.SeqAli, PProfilP.Ration, -1, 1, PResSimulP, FLudo.CBAALimitGraph.Checked);
1031
  cumul := 0;
1032
  for jour := 1 to PResSimulP.NbJSim do
1033
  begin
1034
    x := PResSimulP.TabResult[1, jour];
1035
    y := PResSimulP.TabResult[2, jour];
1036
    LineFeed.AddXY(x, cumul, '', clTeeColor);
1037
    LineWeight.AddXY(x, y, '', clTeeColor);
1038
    cumul := cumul + PResSimulP.TabResult[113, jour];
1039
  end;
1040
  Dispose(PResSimulP);
1041
end;
1042
1043
// Onglet Simulation
1044
1045
procedure TFLudo.CheckBoxProfilClick(Sender: TObject);
1046
begin
1047
  RadioButtonDuree.Enabled := not CheckBoxProfil.Checked;
1048
  JvValidateEditDuree.Enabled  := not CheckBoxProfil.Checked;
1049
  RadioButtonPVFin.Enabled := not CheckBoxProfil.Checked;
1050
  JvValidateEditPVFin.Enabled  := not CheckBoxProfil.Checked;
1051
end;
1052
1053
procedure TFLudo.SBSimulClick(Sender: TObject);
1054
var
1055
  i, j, k:  integer;
1056
  Aliment1, Aliment2: integer;
1057
  CC1, CC2: CompositionChimique;
1058
  IngereFrais, Distrib, Gaspillage: double;
1059
  IngereSec1, IngereSec2, Taux1, Taux2: double;
1060
  Ptot, Ptot1, Ptot2, Pdig, Pdig1, Pdig2: double;
1061
  Ingere, Digestible, Depose: double;
1062
  PV, PVV, PVfin, PVVfin, GMQ, PD, LD, p, l: double;
1063
  CumulIngere, CumulDistrib, Cout: double;
1064
begin
1065
  if (ListAliment.Count = 0) or (ListSeqAliP.Count = 0) or
1066
    (ListRationP.Count = 0) or (ListProfilP.Count = 0) then
1067
  begin
1068
    MessageDlg(
1069
      'Choisir un dossier contenant au moins les aliments, s?quences alimentaires, plans de rationnement et profils !',
1070
      mtWarning, [mbOK], 0);
1071
    ActiveControl := JvDEFolder;
1072
    Exit;
1073
  end;
1074
  if CBSeqAli2.ItemIndex = -1 then
1075
  begin
1076
    MessageDlg('S?lectionner une s?quence alimentaire !', mtWarning, [mbOK], 0);
1077
    ActiveControl := CBSeqAli2;
1078
    Exit;
1079
  end;
1080
  if CBRation2.ItemIndex = -1 then
1081
  begin
1082
    MessageDlg('S?lectionner un plan de rationnement !', mtWarning, [mbOK], 0);
1083
    ActiveControl := CBRation2;
1084
    Exit;
1085
  end;
1086
  if JvFEResult.Text = '' then
1087
  begin
1088
    MessageDlg('Indiquer un nom de fichier pour les r?sultats d?taill?s !',
1089
      mtError, [mbOK], 0);
1090
    ActiveControl := JvFEResult;
1091
    Exit;
1092
  end;
1093
  if JvFEBilan.Text = '' then
1094
  begin
1095
    MessageDlg('Indiquer un nom de fichier pour le bilan !', mtError, [mbOK], 0);
1096
    ActiveControl := JvFEBilan;
1097
    Exit;
1098
  end;
1099
  if FileExists(JvFEResult.Text) then
1100
    if MessageDlg(Format('Le fichier %s existe d?j? !' + sLineBreak +
1101
      'Faut-il l''?craser ?', [JvFEResult.Text]), mtConfirmation, [mbYes, mbNo], 0) =
1102
      mrYes then
1103
      DeleteFile(JvFEResult.Text)
1104
    else
1105
      Exit;
1106
  if FileExists(JvFEBilan.Text) then
1107
    if MessageDlg(Format('Le fichier %s existe d?j? !' + sLineBreak +
1108
      'Faut-il l''?craser ?', [JvFEBilan.Text]), mtConfirmation, [mbYes, mbNo], 0) =
1109
      mrYes then
1110
      DeleteFile(JvFEBilan.Text)
1111
    else
1112
      Exit;
1113
  // Simulation
1114
  Screen.Cursor := crHourGlass;
1115
  MSimul.Lines.Clear;
1116
  Application.ProcessMessages;
1117
  JvCsvDSResult.FileName := JvFEResult.Text;
1118
  JvCsvDSResult.Active := True;
1119
  JvCsvDSBilan.FileName := JvFEBilan.Text;
1120
  JvCsvDSBilan.Active := True;
1121
  for i := 0 to ListProfilP.Count - 1 do
1122
  begin
1123
    PProfilP := ListProfilP[i];
1124
    PSeqAliP := ListSeqAliP[FindIdxSeqAliP(CBSeqAli2.Text)];
1125
    PRationP := ListRationP[FindIdxRationP(CBRation2.Text)];
1126
    New(PSimulP);
1127
    with PSimulP^ do
1128
    begin
1129
      Num := PProfilP.Num;
1130
      Nom := PProfilP.Nom;
1131
      Application.ProcessMessages;
1132
      Memo := '';
1133
      Profil := PProfilP.Num;
1134
      SeqAli := PSeqAliP.Num;
1135
      Ration := PRationP.Num;
1136
      AgeInitProfil := True;
1137
      PVInitProfil := True;
1138
      ProtLipInitProfil := True;
1139
      AgeInit := 0;
1140
      PVInit := 0;
1141
      ProtInit := 0;
1142
      LipInit := 0;
1143
      FinProfil := CheckBoxProfil.Checked;
1144
      if RadioButtonDuree.Checked then
1145
        ModeFin := 0
1146
      else
1147
        ModeFin := 1;
1148
      Duree := JvValidateEditDuree.AsInteger;
1149
      PVFin := JvValidateEditPVFin.AsFloat;
1150
    end;
1151
    ListSimulP.Add(PSimulP);
1152
    New(PResSimulP);
1153
    try
1154
      CalcSimulP(PSimulP.Num, PSimulP.Profil, PSimulP.SeqAli, PSimulP.Ration, -1, 1, PResSimulP, FLudo.CBAALimitSimul.Checked);
1155
    finally
1156
      MSimul.Lines.Add(Format('%s (%d/%d) : %d jours',
1157
        [PSimulP.Nom, i + 1, ListProfilP.Count, PResSimulP.NbJSim]));
1158
      Application.ProcessMessages;
1159
    end;
1160
    CumulIngere := 0;
1161
    CumulDistrib := 0;
1162
    Cout := 0;
1163
    for j := 1 to PResSimulP.NbJSim do
1164
      with JvCsvDSResult do
1165
      begin
1166
        PV := PResSimulP.TabResult[2, j];
1167
        PVV := CalcPVV(PV);
1168
        PVfin := PResSimulP.TabResult[83, j];
1169
        PVVfin := CalcPVV(PVfin);
1170
        GMQ := PResSimulP.TabResult[84, j];
1171
        PD := PResSimulP.TabResult[79, j];
1172
        LD := PResSimulP.TabResult[80, j];
1173
        p := PResSimulP.TabResult[49, j];
1174
        l := PResSimulP.TabResult[50, j];
1175
        // Composition des aliments
1176
        IngereFrais := PresSimulP.TabResult[11, j];
1177
        Distrib := PresSimulP.TabResult[113, j];
1178
        Gaspillage := PResSimulP.TabResult[112, j];
1179
        // Aliment 1
1180
        Aliment1 := Trunc(PresSimulP.TabResult[7, j]);
1181
        if Aliment1 = -1 then
1182
          CC1 := CCVide
1183
        else
1184
        begin
1185
          PAliment := ListAliment[FindIdxAliment(FindNomAliment(Aliment1))];
1186
          CC1 := PAliment.CC;
1187
        end;
1188
        Taux1 := PresSimulP.TabResult[9, j] / 100;
1189
        IngereSec1 := IngereFrais * Taux1 * CC1.MS / 1000;
1190
        Ptot1 := IngereSec1 * CC1.P;
1191
        if Aliment1 = -1 then
1192
          Pdig1 := 0
1193
        else
1194
        if PAliment.Presentation = 0 then // Granul?s
1195
          Pdig1 := IngereSec1 * PAliment.CC.PdigG
1196
        else // Farine
1197
          Pdig1 := IngereSec1 * PAliment.CC.PdigF;
1198
        // Aliment 2
1199
        Aliment2 := Trunc(PresSimulP.TabResult[8, j]);
1200
        if Aliment2 = -1 then
1201
          CC2 := CCVide
1202
        else
1203
        begin
1204
          PAliment := ListAliment[FindIdxAliment(FindNomAliment(Aliment2))];
1205
          CC2 := PAliment.CC;
1206
        end;
1207
        Taux2 := PresSimulP.TabResult[10, j] / 100;
1208
        IngereSec2 := IngereFrais * Taux2 * CC2.MS / 1000;
1209
        Ptot2 := IngereSec2 * CC2.P;
1210
        if Aliment2 = -1 then
1211
          Pdig2 := 0
1212
        else
1213
        if PAliment.Presentation = 0 then // Granul?s
1214
          Pdig2 := IngereSec2 * PAliment.CC.PdigG
1215
        else // Farine
1216
          Pdig2 := IngereSec2 * PAliment.CC.PdigF;
1217
        // Cumul
1218
        Ptot := Ptot1 + Ptot2;
1219
        Pdig := Pdig1 + Pdig2;
1220
        // R?sultats d?taill?s
1221
        Append;
1222
        Fields[0].AsAnsiString := PProfilP.Nom;
1223
        Fields[1].AsInteger := Trunc(PResSimulP.TabResult[1, j]);
1224
        Fields[2].AsFloat  := PV;
1225
        Fields[3].AsAnsiString := PSeqAliP.Nom;
1226
        Fields[4].AsAnsiString := PRationP.Nom;
1227
        Fields[5].AsInteger := Aliment1;
1228
        Fields[6].AsInteger := Aliment2;
1229
        Fields[7].AsFloat  := Taux1 * 100;
1230
        Fields[8].AsFloat  := Taux2 * 100;
1231
        Fields[9].AsFloat  := Distrib;
1232
        Fields[10].AsFloat := IngereFrais;
1233
        Fields[11].AsFloat := PResSimulP.TabResult[78, j];
1234
        Fields[12].AsFloat := PResSimulP.TabResult[106, j];
1235
        Fields[13].AsFloat := p;
1236
        Fields[14].AsFloat := l;
1237
        Fields[15].AsFloat := PD;
1238
        Fields[16].AsFloat := LD;
1239
        Fields[17].AsFloat := GMQ;
1240
        if PResSimulP.TabResult[84, j] <> 0 then
1241
          Fields[18].AsFloat := Distrib / GMQ;
1242
        Fields[19].AsFloat := CalcP2(l);
1243
        Fields[20].AsFloat := CalcTMP(PVV, p, l);
1244
        Fields[21].AsFloat := CalcRC(PResSimulP.TabResult[2, PResSimulP.NbJSim],
1245
          CalcRCStd(PProfilP.PVFin, PProfilP.Carcasse), PV) * 100;
1246
        Fields[22].AsFloat := PResSimulP.TabResult[90, j] * IngereFrais;
1247
        // Apport total AA
1248
        for k := 0 to 12 do
1249
          Fields[23 + k].AsFloat := PResSimulP.TabResult[93 + k, j];
1250
        // Apport digestible AA
1251
        for k := 0 to 12 do
1252
          Fields[36 + k].AsFloat := PResSimulP.TabResult[19 + k, j];
1253
        // Besoin AA
1254
        for k := 0 to 12 do
1255
          Fields[49 + k].AsFloat :=
1256
            // Energie
1257
            PResSimulP.TabResult[77, j] {py1} / GEProtJaap * AAbody[k] / kAA[k]
1258
            // Entretien
1259
            + AAm75[k] * Power(Fields[2].AsFloat {PV}, 0.75)
1260
            // Basal
1261
            + (IngereSec1 + IngereSec2) {IngereSec} * AAendogene[k];
1262
        // Azote
1263
        Ingere := (IngereSec1 * CC1.MAT + IngereSec2 * CC2.MAT) * 0.16;
1264
        Digestible := (IngereSec1 * CC1.MAT * CC1.dMAT_C / 100 +
1265
          IngereSec2 * CC2.MAT * CC2.dMAT_C / 100) * 0.16;
1266
        Depose := PD * 0.16;
1267
        Fields[62].AsFloat := Ingere / (1 - Gaspillage) - Ingere;
1268
        Fields[63].AsFloat := Ingere - Digestible;
1269
        Fields[64].AsFloat := Math.Max(Digestible - Depose, 0);
1270
        Fields[65].AsFloat := Math.Min(Digestible, Depose);
1271
        // Phosphore
1272
        Ingere := Ptot;
1273
        Digestible := Pdig;
1274
        Depose := (5.4199 - 2 * 0.002857 * PV) * GMQ;
1275
        Fields[66].AsFloat := Ingere / (1 - Gaspillage) - Ingere;
1276
        Fields[67].AsFloat := Ingere - Digestible;
1277
        Fields[68].AsFloat := Math.Max(Digestible - Depose, 0);
1278
        Fields[69].AsFloat := Math.Min(Digestible, Depose);
1279
        // Calcium
1280
        Ingere := IngereSec1 * CC1.Ca + IngereSec2 * CC2.Ca;
1281
        Depose := -0.00180 * (Power(PVVfin, 2) - Power(PVV, 2)) +
1282
          8.64633 * (PVVfin - PVV);
1283
        Fields[70].AsFloat := Ingere / (1 - Gaspillage) - Ingere;
1284
        Fields[71].AsFloat := Math.Max(Ingere - Depose, 0);
1285
        Fields[72].AsFloat := Math.Min(Ingere, Depose);
1286
        // Potassium
1287
        Ingere := IngereSec1 * CC1.K + IngereSec2 * CC2.K;
1288
        Depose := -0.00345 * (Power (PVVfin, 2) - Power (PVV, 2)) +
1289
          2.53338 * (PVVfin - PVV);
1290
        Fields[73].AsFloat := Ingere / (1 - Gaspillage) - Ingere;
1291
        Fields[74].AsFloat := Math.Max(Ingere - Depose, 0);
1292
        Fields[75].AsFloat := Math.Min(Ingere, Depose);
1293
        // Cuivre
1294
        Ingere := IngereSec1 * CC1.Cu + IngereSec2 * CC2.Cu;
1295
        Depose := -0.00251 * (Power(PVVfin, 2) - Power(PVV, 2)) +
1296
          1.05393 * (PVVfin - PVV);
1297
        Fields[76].AsFloat := Ingere / (1 - Gaspillage) - Ingere;
1298
        Fields[77].AsFloat := Math.Max(Ingere - Depose, 0);
1299
        Fields[78].AsFloat := Math.Min(Ingere, Depose);
1300
        // Zinc
1301
        Ingere := IngereSec1 * CC1.Zn + IngereSec2 * CC2.Zn;
1302
        Depose := 21.8 * (PVVfin - PVV);
1303
        Fields[79].AsFloat := Ingere / (1 - Gaspillage) - Ingere;
1304
        Fields[80].AsFloat := Math.Max(Ingere - Depose, 0);
1305
        Fields[81].AsFloat := Math.Min(Ingere, Depose);
1306
        Post;
1307
        CumulIngere  := CumulIngere + IngereFrais;
1308
        CumulDistrib := CumulDistrib + Distrib;
1309
        if Aliment1 <> -1 then // Aliment 1
1310
        begin
1311
          PAliment := ListAliment[FindIdxAliment(FindNomAliment(Aliment1))];
1312
          Cout := Cout + Distrib * Taux1 * PAliment.Prix / 1000;
1313
        end;
1314
        if Aliment2 <> -1 then // Aliment 2
1315
        begin
1316
          PAliment := ListAliment[FindIdxAliment(FindNomAliment(Aliment2))];
1317
          Cout := Cout + Distrib * Taux2 * PAliment.Prix / 1000;
1318
        end;
1319
      end;
1320
    // Bilan
1321
    with JvCsvDSBilan do
1322
    begin
1323
      Append;
1324
      Fields[0].AsAnsiString := PProfilP.Nom;
1325
      Fields[1].AsAnsiString := PSeqAliP.Nom;
1326
      Fields[2].AsAnsiString := PRationP.Nom;
1327
      if PProfilP.ModeFin = 0 then
1328
        Fields[3].AsString := 'Dur?e'
1329
      else
1330
        Fields[3].AsString := 'Poids vif';
1331
      Fields[4].AsInteger := Trunc(PResSimulP.TabResult[1, 1]);
1332
      Fields[5].AsInteger := Trunc(PResSimulP.TabResult[1, PResSimulP.NbJSim]) + 1;
1333
      Fields[6].AsFloat  := PResSimulP.TabResult[2, 1];
1334
      Fields[7].AsFloat  := PResSimulP.TabResult[2, PResSimulP.NbJSim] +
1335
        PResSimulP.TabResult[84, PResSimulP.NbJSim];
1336
      Fields[8].AsFloat  := PResSimulP.TabResult[49, 1];
1337
      Fields[9].AsFloat  := PResSimulP.TabResult[49, PResSimulP.NbJSim] +
1338
        PResSimulP.TabResult[79, PResSimulP.NbJSim] / 1000;
1339
      Fields[10].AsFloat := PResSimulP.TabResult[50, 1];
1340
      Fields[11].AsFloat := PResSimulP.TabResult[50, PResSimulP.NbJSim] +
1341
        PResSimulP.TabResult[80, PResSimulP.NbJSim] / 1000;
1342
      Fields[12].AsFloat := CumulIngere;
1343
      Fields[13].AsFloat := CumulDistrib;
1344
      Fields[14].AsFloat := Cout;
1345
      Fields[15].AsFloat := CalcRC(Fields[7].AsFloat,
1346
        CalcRCStd(PProfilP.PVFin, PProfilP.Carcasse), Fields[7].AsFloat) * 100;
1347
      Post;
1348
    end;
1349
    Dispose(PResSimulP);
1350
  end;
1351
  JvCsvDSResult.Active := False;
1352
  JvCsvDSBilan.Active := False;
1353
  Screen.Cursor := crDefault;
1354
  FreeSimulP;
1355
end;
1356
1357
// Onglet Exportation
1358
1359
procedure TFLudo.SBExportClick(Sender: TObject);
1360
var
1361
  i: integer;
1362
begin
1363
  if (ListAliment.Count = 0) or (ListSeqAliP.Count = 0) or
1364
    (ListRationP.Count = 0) or (ListProfilP.Count = 0) then
1365
  begin
1366
    MessageDlg(
1367
      'Choisir un dossier contenant au moins les aliments, s?quences alimentaires, plans de rationnement et profils !',
1368
      mtWarning, [mbOK], 0);
1369
    ActiveControl := JvDEFolder;
1370
    Exit;
1371
  end;
1372
  if JvFEExport.Text = '' then
1373
  begin
1374
    MessageDlg('Indiquer un nom de fichier pour l''exportation !', mtWarning, [mbOK], 0);
1375
    ActiveControl := JvFEExport;
1376
    Exit;
1377
  end;
1378
  // Exportation
1379
  Screen.Cursor := crHourGlass;
1380
  MExport.Lines.Clear;
1381
  Application.ProcessMessages;
1382
  JvCsvDSExport.FileName := JvFEExport.Text;
1383
  JvCsvDSExport.Active := True;
1384
  for i := 0 to ListProfilP.Count - 1 do
1385
  begin
1386
    PProfilP := ListProfilP[i];
1387
    with JvCsvDSExport do
1388
    begin
1389
      Append;
1390
      Fields[0].AsAnsiString := PProfilP.Nom;
1391
      Fields[1].AsInteger := PProfilP.Sexe;
1392
      Fields[2].AsInteger := PProfilP.AgeInit;
1393
      Fields[3].AsFloat  := PProfilP.PVInit;
1394
      Fields[4].AsInteger := PProfilP.ModeFin;
1395
      Fields[5].AsInteger := PProfilP.Duree;
1396
      Fields[6].AsFloat  := PProfilP.PVFin;
1397
      Fields[7].AsFloat  := PProfilP.Carcasse;
1398
      Fields[8].AsInteger := PProfilP.Unite;
1399
      Fields[9].AsInteger := PProfilP.Equation;
1400
      Fields[10].AsFloat := PProfilP.a;
1401
      Fields[11].AsFloat := PProfilP.b;
1402
      Fields[12].AsFloat := PProfilP.PDMoy;
1403
      Fields[13].AsFloat := PProfilP.BGompertz;
1404
      Fields[14].AsFloat := PProfilP.Entretien;
1405
      Fields[15].AsFloat := PProfilP.PVmr2;
1406
      Post;
1407
    end;
1408
    MExport.Lines.Add(Format('%s (%d/%d)', [PProfilP.Nom, i + 1, ListProfilP.Count]));
1409
    Application.ProcessMessages;
1410
  end;
1411
  JvCsvDSExport.Active := False;
1412
  Screen.Cursor := crDefault;
1413
end;
1414
1415
// Aliment
1416
1417
procedure TFLudo.LoadAliment;
1418
var
1419
  fic: file of RecAliment;
1420
  rec: PRecAliment;
1421
begin
1422
  // chargement du fichier
1423
  AssignFile(fic, NFicAliment);
1424
  Reset(fic);
1425
  while not EOF(fic) do
1426
  begin
1427
    New(rec);
1428
    Read(fic, rec^);
1429
    ListAliment.Add(rec);
1430
  end;
1431
  CloseFile(fic);
1432
end;
1433
1434
procedure TFLudo.FreeAliment;
1435
var
1436
  i: integer;
1437
  rec: PRecAliment;
1438
begin
1439
  if ListAliment.Count > 0 then
1440
    for i := 0 to ListAliment.Count - 1 do
1441
    begin
1442
      rec := ListAliment[i];
1443
      Dispose(rec);
1444
    end;
1445
  ListAliment.Clear;
1446
end;
1447
1448
// S?quence alimentaire porc
1449
1450
procedure TFLudo.LoadSeqAliP;
1451
var
1452
  fic: file of RecSeqAliP;
1453
  rec: PRecSeqAliP;
1454
begin
1455
  // chargement du fichier
1456
  AssignFile(fic, NFicSeqAliP);
1457
  Reset(fic);
1458
  while not EOF(fic) do
1459
  begin
1460
    New(rec);
1461
    Read(fic, rec^);
1462
    ListSeqAliP.Add(rec);
1463
  end;
1464
  CloseFile(fic);
1465
end;
1466
1467
procedure TFLudo.FreeSeqAliP;
1468
var
1469
  i: integer;
1470
  rec: PRecSeqAliP;
1471
begin
1472
  if ListSeqAliP.Count > 0 then
1473
    for i := 0 to ListSeqAliP.Count - 1 do
1474
    begin
1475
      rec := ListSeqAliP[i];
1476
      Dispose(rec);
1477
    end;
1478
  ListSeqAliP.Clear;
1479
end;
1480
1481
procedure TFLudo.StringsSeqAliP(Liste: TStrings);
1482
var
1483
  i: integer;
1484
  rec: PRecSeqAliP;
1485
begin
1486
  Liste.Clear;
1487
  if ListSeqAliP.Count > 0 then
1488
    for i := 0 to ListSeqAliP.Count - 1 do
1489
    begin
1490
      rec := ListSeqAliP[i];
1491
      Liste.Add(rec.Nom);
1492
    end;
1493
end;
1494
1495
// Plan de rationnement porc
1496
1497
procedure TFLudo.LoadRationP;
1498
var
1499
  fic: file of RecRationP;
1500
  rec: PRecRationP;
1501
begin
1502
  // chargement du fichier
1503
  AssignFile(fic, NFicRationP);
1504
  Reset(fic);
1505
  while not EOF(fic) do
1506
  begin
1507
    New(rec);
1508
    Read(fic, rec^);
1509
    ListRationP.Add(rec);
1510
  end;
1511
  CloseFile(fic);
1512
end;
1513
1514
procedure TFLudo.FreeRationP;
1515
var
1516
  i: integer;
1517
  rec: PRecRationP;
1518
begin
1519
  if ListRationP.Count > 0 then
1520
    for i := 0 to ListRationP.Count - 1 do
1521
    begin
1522
      rec := ListRationP[i];
1523
      Dispose(rec);
1524
    end;
1525
  ListRationP.Clear;
1526
end;
1527
1528
procedure TFLudo.StringsRationP(Liste: TStrings);
1529
var
1530
  i: integer;
1531
  rec: PRecRationP;
1532
begin
1533
  Liste.Clear;
1534
  if ListRationP.Count > 0 then
1535
    for i := 0 to ListRationP.Count - 1 do
1536
    begin
1537
      rec := ListRationP[i];
1538
      Liste.Add(rec.Nom);
1539
    end;
1540
end;
1541
1542
// Profil porc
1543
1544
procedure TFLudo.LoadProfilP;
1545
var
1546
  fic: file of RecProfilP;
1547
  rec: PRecPRofilP;
1548
begin
1549
  // chargement du fichier
1550
  AssignFile(fic, NFicProfilP);
1551
  Reset(fic);
1552
  while not EOF(fic) do
1553
  begin
1554
    New(rec);
1555
    Read(fic, rec^);
1556
    ListProfilP.Add(rec);
1557
  end;
1558
  CloseFile(fic);
1559
end;
1560
1561
procedure TFLudo.FreeProfilP;
1562
var
1563
  i: integer;
1564
  rec: PRecProfilP;
1565
begin
1566
  if ListProfilP.Count > 0 then
1567
    for i := 0 to ListProfilP.Count - 1 do
1568
    begin
1569
      rec := ListProfilP[i];
1570
      Dispose(rec);
1571
    end;
1572
  ListProfilP.Clear;
1573
end;
1574
1575
procedure TFLudo.StringsProfilP(Liste: TStrings);
1576
var
1577
  i: integer;
1578
  rec: PRecProfilP;
1579
begin
1580
  Liste.Clear;
1581
  if ListProfilP.Count > 0 then
1582
    for i := 0 to ListProfilP.Count - 1 do
1583
    begin
1584
      rec := ListProfilP[i];
1585
      Liste.Add(rec.Nom);
1586
    end;
1587
end;
1588
1589
procedure TFLudo.SaveProfilP;
1590
var
1591
  i: integer;
1592
  fic: file of RecProfilP;
1593
  rec: PRecProfilP;
1594
begin
1595
  AssignFile(fic, NFicProfilP);
1596
  Rewrite(fic);
1597
  if ListProfilP.Count > 0 then
1598
    for i := 0 to ListProfilP.Count - 1 do
1599
    begin
1600
      rec := ListProfilP[i];
1601
      Write(fic, rec^);
1602
    end;
1603
  CloseFile(fic);
1604
end;
1605
1606
// Simulation porc
1607
1608
procedure TFLudo.FreeSimulP;
1609
var
1610
  i: integer;
1611
  rec: PRecSimulP;
1612
begin
1613
  if ListSimulP.Count > 0 then
1614
    for i := 0 to ListSimulP.Count - 1 do
1615
    begin
1616
      rec := ListSimulP[i];
1617
      Dispose(rec);
1618
    end;
1619
  ListSimulP.Clear;
1620
end;
1621
1622
end.