Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre averti
    Algorithme de Dijkstra pour recherche de plus court chemin dans un graphe
    Bjr à vous,

    Etant sur une implémentation d'un algo de recherche de plus court chemin dans un grand graphe, je cale complètement.

    J'utilise ce document comme base: https://www.ljll.math.upmc.fr/pegon/...T/TP06_cor.pdf

    Je suis dans la première partie de Q2 du corrigé, entre les lignes 7 et 20.

    Après correction d'un oubli, le 'While' se termine et me renvoie une liste de sommets parcourus
    je cale maintenant sur la seconde partie de l'algo (lignes 23 à 29 de l'algo): comme les sommets de mon graphe sont reliés par deux arcs de sens opposé, çà boucle indéfiniment.

    Par ailleurs, quels sont les tarifs pour une sous-traitance de ce petit développement ?

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
     
    function TGraphe.RechercherIdxNearestNodeOf(const QCurrNoeud: TGrapheNoeud; out QDistance: double): TNumeroNoeud;
    var
      i : integer;
      NbArcsEntrants, NbArcsSortants: Integer;
      EWE: String;
      QNoeud: TGrapheNoeud;
      QArc: TGrapheArc;
    begin
      FAfficherMessage(Format('RechercherIdxNearestNodeOf( %d )', [QCurrNoeud.IDStation]));
      QDistance := Infinity;
      Result := -1;
      NbArcsEntrants := length(QCurrNoeud.ListeArcsEntrants);
      if (NbArcsEntrants > 0) then
      begin
        EWE := '-- Arcs entrants: ';
        for i := 0 to NbArcsEntrants-1 do EWE += format('%d, ', [QCurrNoeud.ListeArcsEntrants[i]]);
        FAfficherMessage(EWE);
      end;
      FAfficherMessage('001');
      NbArcsSortants := length(QCurrNoeud.ListeArcsSortants);
      if (NbArcsSortants > 0) then
      begin
        EWE := '-- Arcs sortants: ';
        for i := 0 to NbArcsSortants-1 do EWE += format('%d, ', [QCurrNoeud.ListeArcsSortants[i]]);
        FAfficherMessage(EWE);
      end;
      if (0 = (NbArcsEntrants + NbArcsSortants)) then exit(-1);
      if (NbArcsEntrants > 0) then
      begin
        for i := 0 to NbArcsEntrants - 1 do
        begin
          QArc := GetArc(QCurrNoeud.ListeArcsEntrants[i]);
          QNoeud := GetNoeud(QArc.IdxNoeudDepart);
          if (QNoeud.NoeudVisite) then Continue;
          if (QArc.Longueur < QDistance) then
          begin
            QDistance  := QArc.Longueur;
            Result := QArc.IdxNoeudDepart;
          end;
        end;
      end;
      if (NbArcsSortants > 0) then
      begin
        for i := 0 to NbArcsSortants - 1 do
        begin
          QArc := GetArc(QCurrNoeud.ListeArcsSortants[i]);
          QNoeud := GetNoeud(QArc.IdxNoeudArrivee);
          if (QNoeud.NoeudVisite) then Continue;
          if (QArc.Longueur < QDistance) then
          begin
            QDistance  := QArc.Longueur;
            Result := QArc.IdxNoeudArrivee;
          end;
        end;
      end;
      FAfficherMessage(Format('*** RechercherIdxNearestNodeOf: %d - Dist = %.2f', [Result, QDistance]));
    end;


    Utilisation:
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
     
    program Dijkstra;
     
    {$mode delphi}{$H+}
     
    uses
      {$IFDEF UNIX}{$IFDEF UseCThreads}
      cthreads,
      {$ENDIF}{$ENDIF}
      Classes, SysUtils, CustApp,
      { you can add units after this }
      unitgraphes1
      ;
     
    type TGraphesDijkstra = class(TCustomApplication)
      private
        FGraphe: TGraphe;
        procedure AfficherMessage(const Msg: string; const DoClear: boolean = false);
        procedure CalculerGraphe(const Ser1, St1, Ser2, St2: integer);
        procedure FinaliserGraphe();
        procedure GenererGraphe();
     
      protected
        procedure DoRun; override;
      public
        constructor Create(TheOwner: TComponent); override;
        destructor Destroy; override;
        procedure WriteHelp; virtual;
      end;
     
    { TGraphesDijkstra }
     
    procedure TGraphesDijkstra.DoRun;
    var
      ErrorMsg: String;
    begin
      // quick check parameters
      ErrorMsg:=CheckOptions('h', 'help');
      if ErrorMsg<>'' then begin
        ShowException(Exception.Create(ErrorMsg));
        Terminate;
        Exit;
      end;
      // parse parameters
      if HasOption('h', 'help') then begin
        WriteHelp;
        Terminate;
        Exit;
      end;
      { add your program here }
      AfficherMessage('Algo de Dijkstra');
      GenererGraphe();
      CalculerGraphe(1,0, 1,7);
      FinaliserGraphe();
      // stop program loop
      Terminate;
    end;<img src="https://www.developpez.net/forums/attachments/p578986d1599780154/x/y/z/" style="float: CONFIG" border="0" alt="">
     
    constructor TGraphesDijkstra.Create(TheOwner: TComponent);
    begin
      inherited Create(TheOwner);
      StopOnException:=True;
    end;
     
    destructor TGraphesDijkstra.Destroy;
    begin
      inherited Destroy;
    end;
     
    procedure TGraphesDijkstra.WriteHelp;
    begin
      { add your help code here }
      writeln('Usage: ', ExeName, ' -h');
    end;
     
    procedure TGraphesDijkstra.AfficherMessage(const Msg: string; const DoClear: boolean = false);
    begin
      WriteLn(Msg);
    end;
     
    procedure TGraphesDijkstra.GenererGraphe();
    var
      MyStation, MyStationDep, MyStationArr, ST1, ST2: TGrapheNoeud;
      i, Nb, QSr, QSt,  QNbA, s: Integer;
      MyVisee, QArc: TGrapheArc;
      function DispMessageErreur(const ACaption: string): boolean;
      var
        EWE: TGrapheLastError;
      begin
        EWE := FGraphe.GetLastError();
        Result := (EWE.ErrCode <> 0);
        if (Result) then AfficherMessage(Format('*** %s : %d: %s', [ACaption, EWE.ErrCode, EWE.ErrMsg]));
      end;
    begin
      FGraphe := TGraphe.Create;
      //try
        FGraphe.Initialiser(AfficherMessage);
        FGraphe.BeginNodeList();
          FGraphe.AddStation(1, 0,   0.0,   0.0, 0.0);
          FGraphe.AddStation(1, 1,  10.0, 10.0, 0.0);
     
          FGraphe.AddStation(1, 2, 100.0,   0.0, 0.0);
          FGraphe.AddStation(1, 3, 200.0,   0.0, 0.0);
          FGraphe.AddStation(1, 4, 300.0,   0.0, 0.0);
          FGraphe.AddStation(1, 5, 300.0, 100.0, 0.0);
          FGraphe.AddStation(1, 6, 300.0, 200.0, 0.0);
          FGraphe.AddStation(1, 7, 450.0, 210.0, 0.0);
          FGraphe.AddStation(2, 1, 200.0, 100.0, 0.0);
          FGraphe.AddStation(2, 2, 100.0, 100.0, 0.0);
          FGraphe.AddStation(2, 3, 100.0, 200.0, 0.0);
          FGraphe.AddStation(2, 4,   0.0, 200.0, 0.0);
          FGraphe.AddStation(3, 1,   0.0, 100.0, 0.0);
          FGraphe.AddStation(4, 1, 200.0, 200.0, 0.0);
     
     
        FGraphe.EndNodesList();
        if (DispMessageErreur('Noeuds')) then exit;
        Nb := FGraphe.GetNbNoeuds();
        AfficherMessage(Format('%d noeuds', [Nb]));
     
     
        AfficherMessage('');
        FGraphe.BeginArcsList();
          FGraphe.AddArcBetweenStations(1,0, 1,1);
          FGraphe.AddArcBetweenStations(1,1, 1,2);
          FGraphe.AddArcBetweenStations(1,2, 1,3);
          FGraphe.AddArcBetweenStations(1,3, 1,4);
          FGraphe.AddArcBetweenStations(1,4, 1,5);
          FGraphe.AddArcBetweenStations(1,5, 1,6);
          FGraphe.AddArcBetweenStations(1,6, 1,7);
     
          FGraphe.AddArcBetweenStations(1,3, 2,1);
          FGraphe.AddArcBetweenStations(2,1, 2,2);
          FGraphe.AddArcBetweenStations(2,2, 2,3);
          FGraphe.AddArcBetweenStations(2,3, 2,4);
     
          FGraphe.AddArcBetweenStations(2,4, 3,1);
          FGraphe.AddArcBetweenStations(3,1, 1,1);
     
          FGraphe.AddArcBetweenStations(2,3, 4,1);
          FGraphe.AddArcBetweenStations(4,1, 1,6);
     
        FGraphe.EndArcsList();
         if (DispMessageErreur('Arcs')) then exit;
        FGraphe.ListerLesNoeuds('Graphe initial', True);
        FGraphe.ListerLesArcs('Graphe initial');
    end;
    procedure TGraphesDijkstra.CalculerGraphe(const Ser1, St1, Ser2, St2: integer);
    begin
      FGraphe.RechercherPlusCourtChemin(Ser1, St1, Ser2, St2);
    end;
     
    procedure TGraphesDijkstra.FinaliserGraphe();
    begin
      FGraphe.Finaliser();
      FreeAndNil(FGraphe);
    end;
     
     
    var
      Application: TGraphesDijkstra;
    begin
      Application:=TGraphesDijkstra.Create(nil);
      Application.Title:='Graphes et algo de Dijkstra';
      Application.Run;
      Application.Free;
    end.



    Unité implémentant le graphe:
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    427
    428
    429
    430
    431
    432
    433
    434
    435
    436
    437
    438
    439
    440
    441
    442
    443
    444
    445
    446
    447
    448
    449
    450
    451
    452
    453
    454
    455
    456
    457
    458
    459
    460
    461
    462
    463
    464
    465
    466
    467
    468
    469
    470
    471
    472
    473
    474
    475
    476
    477
    478
    479
    480
    481
    482
    483
    484
    485
    486
    487
    488
    489
    490
    491
    492
    493
    494
    495
    496
    497
    498
    499
    500
    501
    502
    503
    504
    505
    506
    507
    508
    509
    510
    511
    512
    513
    514
    515
    516
    517
    518
    519
    520
    521
    522
    523
    524
    525
    526
    527
    528
    529
    530
    531
    532
    533
    534
    535
    536
    537
    538
    539
    540
    541
    542
    543
    544
    545
    546
    547
    548
    549
    550
    551
    552
    553
    554
    555
    556
    557
    558
    559
    560
    561
    562
    563
    564
    565
    566
    567
    568
    569
    570
    571
    572
    573
    574
    575
    576
    577
    578
    579
    580
    581
    582
    583
    584
    585
    586
    587
    588
    589
    590
    591
    592
    593
    594
    595
    596
    597
    598
    599
    600
    601
    602
    603
    604
    605
    606
    607
    608
    609
    610
    611
    612
    613
    614
    615
    616
    617
    618
    619
    620
    621
    622
    623
    624
    625
    626
    627
    628
    629
    630
    631
    632
    633
    634
    635
    636
    637
    638
    639
    640
    641
    642
    643
    644
    645
    646
    647
    648
    649
    650
    651
    652
    653
    654
    655
    656
    657
    658
    659
    660
    661
    662
    663
    664
    665
    666
    667
    668
    669
    670
    671
    672
    673
    674
    675
    676
    677
    678
    679
    680
    681
    682
    683
    684
    685
    686
    687
    688
    689
    690
    691
    692
    693
    694
    695
    696
    697
    698
    699
    700
    701
    702
    703
    704
    705
    706
    707
    708
    709
    710
    711
    712
    713
    714
    715
    716
    717
    718
    719
    720
    721
    722
    723
    724
    725
    726
    727
    728
    729
    730
    731
    732
    733
    734
    735
    736
    737
    738
    739
    740
    741
    742
    743
    744
    745
    746
    747
    748
    749
    750
    751
    752
    753
    754
    755
    756
    757
    758
    759
    760
    761
    762
    763
    764
    765
    766
    767
    768
    769
    770
    771
    772
    773
    774
    775
    776
    777
    778
    779
    780
    781
    782
    783
    784
    785
    786
    787
    788
    789
    790
    791
    792
    793
    794
    795
    796
    797
    798
    799
    800
    801
    802
    803
    804
    805
    806
    807
    808
    809
    810
    811
    812
    813
    814
    815
    816
    817
    818
    819
    820
    821
    822
    823
    824
    825
    826
    827
    828
    829
    830
    831
    832
    833
    834
    835
    836
    837
    838
    839
    840
    841
    842
    843
    844
    845
    846
    847
    848
    849
    850
    851
    852
    853
    854
    855
    856
    857
    858
    859
    860
    861
    862
    863
    864
    865
    866
    867
    868
    869
    870
    871
    872
    873
    874
    875
    876
    877
    878
    879
    880
    881
    882
    883
    884
    885
    886
    887
    888
    889
    890
    891
    892
    893
    894
    895
    896
    897
    898
    899
    900
    901
    902
    903
    904
    905
    906
    907
    908
    909
    910
    911
    912
    913
    914
    915
    916
    917
    918
    919
    920
    921
    922
    923
    924
    925
    926
    927
    928
    929
    930
     
    unit UnitGraphes1;
    // Calcul du chemin minimal dans un réseau GHTopo
    {$WARNING: A exécuter sans débogage}
    {$mode delphi}
    interface
    uses
      Classes, SysUtils, math;
    // messages d'erreur
    const
      ERR_GRAPHE_NO_ERROR         : integer =  0;
      ERR_GRAPHE_INITIALISATION   : integer = -1;
      ERR_GRAPHE_EMPTY_LIST_NODES : integer = -2;
      ERR_GRAPHE_EMPTY_LIST_ARCS  : integer = -3;
     
      ERR_GRAPHE_NODE_NOT_FOUND   : integer = -4;
      ERR_GRAPHE_ARC_NOT_FOUND    : integer = -5;
     
      ERR_GRAPHE_SAME_START_END   : integer = -6;
     
     
    type TProcAfficherMessage = procedure(const Msg: string; const DoClear: boolean = false) of object;
    type TNumeroNoeud = type Integer;
    type TNumeroArc   = type Integer;
     
     
    // liste générique (fonctionne très bien)
    type TListeSimple<T> = class(TFPList)
      private
     
     
      public
        procedure ClearListe();
        function  GetNbElements(): integer; inline;
        procedure InsertElement(const Idx: integer; const E: T);
        procedure AddElement(const E: T);  // et Rros Minet
        function  GetElement(const Idx: integer): T; inline;
        procedure PutElement(const Idx: integer; const E: T); inline;
        function  RemoveElement(const Idx: integer): boolean;
        function  RemoveLastElement(): boolean;
     
    end;
    //******************************************************************************
     
    type TIDStation = type Int64;
    type TGrapheNoeud = record
      IDStation: TIDStation;
      X  : double;
      Y  : double;
      Z  : double;
      DistanceMin : double;
      NoeudVisite : boolean;
      ListeArcsSortants    : array of TNumeroArc;
      ListeArcsEntrants    : array of TNumeroArc;
      ListeIdxPredecesseurs: array of TNumeroNoeud;
      ListeIdxSuccesseurs  : array of TNumeroNoeud;
     
    end;
    type TGrapheArc = record
      IdxNoeudDepart  : TNumeroNoeud;
      IdxNoeudArrivee : TNumeroNoeud;
      Longueur        : double;
      Azimut          : double;
      Pente           : double;
      Parcouru        : boolean;
    end;
    type TGrapheLastError = record
      ErrCode: integer;
      ErrMsg : string;
    end;
    //******************************************************************************
    // liste des noeuds
    type   TGrapheListeDesNoeuds = class(TListeSimple<TGrapheNoeud>)
      private
      public
        procedure TrierParIDStations();
        procedure TrierParDistance();
     
    end;
     
    //******************************************************************************
    // liste des arcs
    type TGrapheListeDesArcs   = class(TListeSimple<TGrapheArc>)
      private
      public
    end;
     
    // liste des noeuds de passage du parcours
    type TGrapheChemin   = class(TListeSimple<TGrapheNoeud>)
      private
      public
    end;
    //******************************************************************************
     
    type  TGraphe = class
      strict private
        FXMini: double;
        FXMaxi: double;
        FYMini: double;
        FYMaxi: double;
        FLastError: TGrapheLastError;
        procedure MarquerNoeudFromIdx(const Idx: TNumeroNoeud; const B: boolean);
        function RechercherIdxNearestNodeOf(const QCurrNoeud: TGrapheNoeud; out QDistance: double): TNumeroNoeud;
     
        function SetLastError(const QErrCode: integer; const QErrMsg: string): boolean;
      private
        FListeDesNoeuds            : TGrapheListeDesNoeuds;
        FListeDesArcs              : TGrapheListeDesArcs;
        FLeCheminTrouve            : TGrapheChemin;
        //FListeDesStationsPartantes  : TGrapheListeDesStationsPartantes;
        FTabArcs                    : array of integer;
        FAfficherMessage            : TProcAfficherMessage;
        FNombreNoeudsVisites        : integer;
        function   FindNoeudByIDStation(const IDS: TIDStation; out ST: TGrapheNoeud; out IndexOf: TNumeroNoeud): boolean;
        procedure  RecenserLesLiaisons();
        procedure  SetMinMax();
        // complètement du graphe
        procedure  MakeArcsReciproques();
        function   GetNbNoeudsVisites(): integer;
        function   NoeudsTousVisites(): boolean;
      public
        property  XMini: double read FXMini;
        property  YMini: double read FYMini;
        property  XMaxi: double read FXMaxi;
        property  YMaxi: double read FYMaxi;
        // Les utilitaires
        function  Initialiser(const P: TProcAfficherMessage): boolean;
        procedure Finaliser();
        function  GetLastError(): TGrapheLastError;
        function  FormatterTIDStation(const QId: TIDStation): string;
        procedure ListerLesNoeuds(const Caption: string; const DoDisplayDependances: boolean = false);
        procedure ListerLesArcs(const Caption: string);
        // Les noeuds
        procedure  BeginNodeList();
        procedure  AddNoeud(const QNoeud: TGrapheNoeud);
        function   GetNoeud(const Idx: integer): TGrapheNoeud;
        procedure  PutNoeud(const Idx: integer; const QNoeud: TGrapheNoeud);
        function   GetNbNoeuds(): integer;
        procedure  AddStation(const QSerie, QStation: integer; const QX, QY, QZ: double);
        procedure  EndNodesList();
        // Les arcs
        procedure  BeginArcsList();
        procedure  AddArc(const QArc: TGrapheArc); overload;
        function   GetArc(const Idx: integer): TGrapheArc;
        procedure  PutArc(const Idx: integer; const QArc: TGrapheArc);
        function   GetNbArcs(): integer;
        procedure  AddArcBetweenStations(const Ser1, St1, Ser2, St2: integer); overload;
        procedure  EndArcsList();
        // spécifique stations topo
        function   GetNoeudCheminTrouve(const Idx: integer): TGrapheNoeud;
        function   GetNbNoeudsCheminTrouve(): integer;
        function   RechercherPlusCourtChemin(const Ser1, St1, Ser2, St2: integer): boolean;
    end;
    function  MakeTIDStation(const Ser, St: integer): integer;
    procedure ExtractSerStFromTIDStation(const ID: integer; out Ser, St: integer);
     
    implementation
    uses
      DummyUnit; // pour contrer l'erreur 'Fin du source non trouvée'
     
     
    const MULT_SERIES: integer = 100000;
     
    function MakeTIDStation(const Ser, St: integer): integer;
    begin
      Result := Ser * MULT_SERIES + St;
    end;
     
    procedure ExtractSerStFromTIDStation(const ID: integer; out Ser, St: integer);
    begin
      Ser := ID div MULT_SERIES;
      St  := ID mod MULT_SERIES;
    end;
     
    // Trier les GrapheStations par ZOrder
    function SortGrapheNoeudsByIDStation(Item1, Item2: Pointer): Integer;
    var
      E1, E2: ^TGrapheNoeud;
    begin
      E1 := Item1;
      E2 := Item2;
      if      (E1^.IDStation < E2^.IDStation) then Result := -1
      else if (E1^.IDStation = E2^.IDStation) then Result :=  0
      else                                         Result :=  1;
    end;
     
    // TODO: Revoir cette fonction (bug avec les grades)
    function GetAzimut(const dx, dy: Double; const Unite: double): double;
    const TWO_PI = 2 * PI;
    var
      a: double;
    begin
      a := ArcTan2(dy, dx + 1e-12);
      if (a < 0) then a := a + TWO_PI;
      a := 0.50 * PI - a;
      if (a < 0) then a := a + TWO_PI;
      Result := a * 0.50 * Unite / pi;
    end;
    // retourne la longueur, direction et pente pour dx, dy, dz
    procedure GetBearingInc(const dx, dy, dz: double;
                            var Dist, Az, Inc: double;
                            const fUB, fUC: Double);
    var
      dp: Double;
    begin;
      dp   := Hypot(dx, dy);
      Dist := Hypot(dp,dz);
      Inc  := ArcTan2(dz, dp) * 0.5 * fUC / pi;
      Az   := GetAzimut(dx,dy, fUB);
    end;
     
     
     
    ///////////////////////////////////////////////////////////////////////////////////////////
    procedure TListeSimple<T>.ClearListe();
    var
      i, n: Integer;
    begin
      //AfficherMessage(Format('%s.ClearListe()', [classname]));
      n := self.Count;
      if (n > 0) then
      for i:=Count-1 downto 0 Do
      begin
        if (self.Items[i] <> Nil) then Dispose(self.Items[i]); // Libération
        self.Delete(i);                                        // Suppression de l'élément
      end;
    end;
     
    function TListeSimple<T>.GetNbElements: integer;
    begin
      Result := self.Count;
    end;
     
    procedure  TListeSimple<T>.InsertElement(const Idx: integer; const E: T);
    var pE: ^T;
    begin
      New(pE);
      pE^ := E;
      self.Insert(Idx, pE);
    end;
    procedure TListeSimple<T>.AddElement(const E: T);
    var pE: ^T;
    begin
      New(pE);
      pE^ := E;
      self.Add(pE);
    end;
     
    function TListeSimple<T>.GetElement(const Idx: integer): T;
    begin
      Result := T(Items[Idx]^);
    end;
    procedure TListeSimple<T>.PutElement(const Idx: integer; const E: T);
    begin
      try
        if (Idx < 0) then exit;
        T(Items[Idx]^) := E;
      except
      end;
    end;
     
    function TListeSimple<T>.RemoveElement(const Idx: integer): boolean;
    begin
      Result := False;
      try
        Dispose(self.Items[Idx]);
        self.Delete(Idx);
        Result := True;
      except
      end;
    end;
     
    function TListeSimple<T>.RemoveLastElement(): boolean;
    var
      Nb: Integer;
     
    begin
      Nb := self.Count;
      if (0 = Nb) then Exit(false);
      result := self.RemoveElement(Nb - 1);
    end;
     
    //******************************************************************************
    { TGrapheListeDesNoeuds }
     
    procedure TGrapheListeDesNoeuds.TrierParIDStations();
    begin
      self.Sort(SortGrapheNoeudsByIDStation);
    end;
     
    procedure TGrapheListeDesNoeuds.TrierParDistance();
    begin
      ;;
    end;
    //******************************************************************************
    { TGraphe }
    function TGraphe.Initialiser(const P: TProcAfficherMessage): boolean;
    begin
      result := false;
      SetLastError(ERR_GRAPHE_NO_ERROR, '');
      FNombreNoeudsVisites      := 0;
      FAfficherMessage          := P;
      FListeDesNoeuds           := TGrapheListeDesNoeuds.Create;
      FListeDesArcs             := TGrapheListeDesArcs.Create;
      FLeCheminTrouve           := TGrapheChemin.Create;
     
     
      //FMinStations                := maxLongint; // initialisé à "plus l'infini" : on suppose qu'on ne prendra pas plus de 50 stations
      try
        FListeDesNoeuds.ClearListe();
        FListeDesArcs.ClearListe();
        FLeCheminTrouve.ClearListe();
        Result := True;
        SetLastError(ERR_GRAPHE_NO_ERROR, '');
        FAfficherMessage('Initialisation du graphe', True);
      except
        SetLastError(-1, 'Erreur d''initialisation');
      end;
    end;
     
    procedure TGraphe.Finaliser();
    begin
      try
        FListeDesNoeuds.ClearListe();
        FListeDesArcs.ClearListe();
        FLeCheminTrouve.ClearListe();
      finally
        FreeAndNil(FListeDesArcs);
        FreeAndNil(FListeDesNoeuds);
        FreeAndNil(FLeCheminTrouve);
      end;
    end;
     
    // Les utilitaires
    function TGraphe.SetLastError(const QErrCode: integer; const QErrMsg: string): boolean;
    begin
      FLastError.ErrCode := QErrCode;
      FLastError.ErrMsg  := QErrMsg;
      result := (FLastError.ErrCode <> ERR_GRAPHE_NO_ERROR);
    end;
    function  TGraphe.GetLastError(): TGrapheLastError;
    begin
      result := FLastError;
    end;
    function TGraphe.FormatterTIDStation(const QId: TIDStation): string;
    var
      Qser, QSt: integer;
    begin
      ExtractSerStFromTIDStation(QId, Qser, QSt);
      result := format('%d.%d', [Qser, QSt]);
    end;
    procedure TGraphe.SetMinMax();
    var
      Nb, i: Integer;
      MyNoeud: TGrapheNoeud;
    begin
      FXMini :=  Infinity;
      FYMini :=  Infinity;
      FXMaxi := -Infinity;
      FYMaxi := -Infinity;
      Nb := GetNbNoeuds();
      for i := 0 to Nb -1 do
      begin
        MyNoeud := GetNoeud(i);
        FXMaxi := Max(FXMaxi, MyNoeud.X);
        FYMaxi := Max(FYMaxi, MyNoeud.Y);
        FXMini := Min(FXMini, MyNoeud.X);
        FYMini := Min(FYMini, MyNoeud.Y);
      end;
    end;
    procedure TGraphe.ListerLesNoeuds(const Caption: string; const DoDisplayDependances: boolean = false);
    var
      Nb, i, s, QSr, QSt: Integer;
      QNbArcsEntrants, QNbArcsSortants: integer;
      MyStation, ST1, ST2: TGrapheNoeud;
      QArc: TGrapheArc;
    begin
      Nb := self.GetNbNoeuds();
      FAfficherMessage('');
      FAfficherMessage(Caption);
      FAfficherMessage(Format('%d noeuds (%f, %f) -> %f, %f', [Nb, self.XMini, self.YMini, self.XMaxi, self.YMaxi]));
      for i := 0 to Nb - 1 do
      begin
        MyStation := self.GetNoeud(i);
        ExtractSerStFromTIDStation(MyStation.IDStation, QSr, QSt);
     
     
     
     
     
        QNbArcsEntrants := Length(MyStation.ListeArcsEntrants);
        QNbArcsSortants := Length(MyStation.ListeArcsEntrants);
     
        FAfficherMessage(Format(' %d: %d: %d.%d %f, %f: %d arcs entrants, %d arcs sortants, DistMini: %.2f, Visité: %s',
                        [i, MyStation.IDStation, QSr, QSt, MyStation.X, MyStation.Y,
                         QNbArcsEntrants, QNbArcsSortants,
                         MyStation.DistanceMin, BoolToStr(MyStation.NoeudVisite, 'OUI', 'non')]));
        if (DoDisplayDependances) then
        begin
          FAfficherMessage('Arcs entrants:');
          if (QNbArcsEntrants > 0) then
          begin
            for s := 0 to QNbArcsEntrants - 1 do
            begin
              QArc := self.GetArc(Abs(MyStation.ListeArcsEntrants[s]));
              ST1  := self.GetNoeud(QArc.IdxNoeudDepart);
              ST2  := self.GetNoeud(QArc.IdxNoeudArrivee);
              FAfficherMessage(Format('---- %06d: %06d [%s] -> %06d [%s]',
                               [MyStation.ListeArcsEntrants[s],
                                QArc.IdxNoeudDepart , self.FormatterTIDStation(ST1.IDStation),
                                QArc.IdxNoeudArrivee, self.FormatterTIDStation(ST2.IDStation)]));
            end;
          end;
          FAfficherMessage('Arcs sortants:');
          if (QNbArcsSortants > 0) then
          begin
            for s := 0 to QNbArcsSortants - 1 do
            begin
              QArc := self.GetArc(Abs(MyStation.ListeArcsSortants[s]));
              ST1  := self.GetNoeud(QArc.IdxNoeudDepart);
              ST2  := self.GetNoeud(QArc.IdxNoeudArrivee);
              FAfficherMessage(Format('---- %06d: %06d [%s] -> %06d [%s]',
                               [MyStation.ListeArcsSortants[s],
                                QArc.IdxNoeudDepart , self.FormatterTIDStation(ST1.IDStation),
                                QArc.IdxNoeudArrivee, self.FormatterTIDStation(ST2.IDStation)]));
            end;
          end;
        end;
      end;
      FAfficherMessage('');
    end;
     
    procedure TGraphe.ListerLesArcs(const Caption: string);
    var
      i, Nb: Integer;
      MyVisee: TGrapheArc;
      MyStationArr, MyStationDep: TGrapheNoeud;
    begin
      Nb := self.GetNbArcs();
      FAfficherMessage('');
      FAfficherMessage(Caption);
      FAfficherMessage(Format('%d arcs', [Nb]));
     
      for i := 0 to Nb - 1 do
      begin
        MyVisee := self.GetArc(i);
        MyStationDep := self.GetNoeud(MyVisee.IdxNoeudDepart);
        MyStationArr := self.GetNoeud(MyVisee.IdxNoeudArrivee);
     
        FAfficherMessage(Format(' %d: Nd%d [%s] -> Nd%d [%s]: L = %.3f m, Az: %.2f, P: %.2f', [i, MyVisee.IdxNoeudDepart , self.FormatterTIDStation(MyStationDep.IDStation),
                                                                              MyVisee.IdxNoeudArrivee, self.FormatterTIDStation(MyStationArr.IDStation),
                                                                              MyVisee.Longueur, MyVisee.Azimut, MyVisee.Pente]));
      end;
      FAfficherMessage('');
    end;
     
    // Les noeuds
    procedure TGraphe.BeginNodeList();
    begin
      FListeDesNoeuds.ClearListe();
    end;
    procedure TGraphe.AddNoeud(const QNoeud: TGrapheNoeud);
    var
      EWE: TGrapheNoeud;
    begin
      EWE := QNoeud;
      EWE.DistanceMin := Infinity;
      EWE.NoeudVisite := false;
      Setlength(EWE.ListeArcsSortants, 0);
      Setlength(EWE.ListeArcsEntrants, 0);
      Setlength(EWE.ListeIdxPredecesseurs, 0);
      Setlength(EWE.ListeIdxSuccesseurs, 0);
     
      FListeDesNoeuds.AddElement(EWE);
    end;
     
    function TGraphe.GetNoeud(const Idx: integer): TGrapheNoeud;
    begin
      Result := FListeDesNoeuds.GetElement(Idx);
    end;
     
    procedure TGraphe.PutNoeud(const Idx: integer; const QNoeud: TGrapheNoeud);
    begin
      FListeDesNoeuds.PutElement(Idx, QNoeud);
    end;
    function TGraphe.GetNbNoeuds(): integer;
    begin
      Result := FListeDesNoeuds.GetNbElements();
    end;
     
    procedure TGraphe.AddStation(const QSerie, QStation: integer; const QX, QY, QZ: double);
    var
      ST: TGrapheNoeud;
    begin
      ST.IDStation := MakeTIDStation(QSerie, QStation);
      ST.X := QX;
      ST.Y := QY;
      ST.Z := QZ;
      AddNoeud(ST);
    end;
     
    procedure TGraphe.EndNodesList();
    var
      Nb: Integer;
    begin
      Nb := GetNbNoeuds();
      if (Nb > 0) then
      begin
        FListeDesNoeuds.TrierParIDStations();
        SetMinMax();
        SetLastError(ERR_GRAPHE_NO_ERROR, '');
      end
      else
        SetLastError(ERR_GRAPHE_EMPTY_LIST_NODES, 'La liste des noeuds est vide');
    end;
    function TGraphe.FindNoeudByIDStation(const IDS: TIDStation; out ST: TGrapheNoeud; out IndexOf: TNumeroNoeud): boolean;
      function FindDepth(const I1, I2: TNumeroNoeud; const QIDX: TIDStation): TNumeroNoeud;
      var
        PVT: integer;
        C1 : TGrapheNoeud;
      begin
        Result := -1;
        // coupure en deux => calcul index médian
        PVT := (I2 + I1) div 2;
        // début > fin >> sortie directe avec erreur
        if (I1 > I2) then Exit(-1);
        C1 := GetNoeud(PVT); //GetBasePoint(PVT);
        // comparaison. Si vrai >> sortie avec numéro d'index
        if (C1.IDStation = QIDX) then Exit(PVT);
        // sinon, recherche en profondeur avec un niveau supplémentaire
        if (QIDX < C1.IDStation) then
        begin
          Result := FindDepth(I1, PVT-1, QIDX);
          Exit;
        end;
        Result := FindDepth(PVT+1, I2, QIDX);
      end;
    begin
      Result := false;
      IndexOf := FindDepth(0, GetNbNoeuds() - 1, IDS);
      if (IndexOf >= 0) then
      begin
        ST     := GetNoeud(IndexOf);
        Exit(True);
      end;
    end;
    function TGraphe.GetNbNoeudsVisites(): integer;
    var
      i: Integer;
      Nd: TGrapheNoeud;
    begin
      Result := 0;
      for i := 0 to GetNbNoeuds() - 1 do
      begin
        Nd := GetNoeud(i);
        if (Nd.NoeudVisite) then Result += 1;
      end;
    end;
     
    procedure TGraphe.MarquerNoeudFromIdx(const Idx: TNumeroNoeud; const B: boolean);
    var
      EWE: TGrapheNoeud;
    begin
      EWE := GetNoeud(Idx);
      EWE.NoeudVisite := B;
      PutNoeud(Idx, EWE);
    end;
     
    function TGraphe.NoeudsTousVisites(): boolean;
    begin
      Result := (GetNbNoeuds() = FNombreNoeudsVisites);
    end;
     
    // Les arcs
    procedure TGraphe.BeginArcsList();
    begin
      FListeDesArcs.ClearListe();
    end;
     
    procedure TGraphe.AddArc(const QArc: TGrapheArc);
    begin
      FListeDesArcs.AddElement(QArc);
    end;
    function TGraphe.GetArc(const Idx: integer): TGrapheArc;
    begin
      Result := FListeDesArcs.GetElement(Idx);
    end;
     
    procedure TGraphe.PutArc(const Idx: integer; const QArc: TGrapheArc);
    begin
      FListeDesArcs.PutElement(Idx, QArc);
    end;
     
    function TGraphe.GetNbArcs(): integer;
    begin
       Result := FListeDesArcs.GetNbElements;
    end;
     
     
    procedure TGraphe.EndArcsList();
    var
      Nb: Integer;
    begin
      Nb := GetNbArcs();
      if (Nb > 0) then
      begin
        MakeArcsReciproques();
        RecenserLesLiaisons();
        SetLastError(ERR_GRAPHE_NO_ERROR, '');
      end
      else
        SetLastError(ERR_GRAPHE_EMPTY_LIST_ARCS, 'La liste des arcs est vide');
    end;
     
    procedure TGraphe.AddArcBetweenStations(const Ser1, St1, Ser2, St2: integer);
    var
      MyArc: TGrapheArc;
      BS1, BS2: TGrapheNoeud;
    begin
      FindNoeudByIDStation(MakeTIDStation(Ser1, St1), BS1, MyArc.IdxNoeudDepart);
      FindNoeudByIDStation(MakeTIDStation(Ser2, St2), BS2, MyArc.IdxNoeudArrivee);
      GetBearingInc(BS2.X - BS1.X, BS2.Y - BS1.Y, BS2.Z - BS1.Z, MyArc.Longueur, MyArc.Azimut, MyArc.Pente, 360.00, 360.00);
      self.AddArc(MyArc);
    end;
    // les galeries étant à double sens et le graphe orienté, construire les arcs opposés
    procedure TGraphe.MakeArcsReciproques();
    var
      i, Nb: Integer;
      MyArcIn, MyArcOut: TGrapheArc;
      QSt1, QSt2: TGrapheNoeud;
    begin
      Nb := GetNbArcs();
      for i := 0 to Nb - 1 do
      begin
        MyArcIn  := getArc(i);
        MyArcOut.Parcouru        := MyArcIn.Parcouru;
        MyArcOut.IdxNoeudDepart  := MyArcIn.IdxNoeudArrivee;
        MyArcOut.IdxNoeudArrivee := MyArcIn.IdxNoeudDepart;
        QSt1 := GetNoeud(MyArcOut.IdxNoeudDepart);
        QSt2 := GetNoeud(MyArcOut.IdxNoeudArrivee);
        GetBearingInc(QSt2.X - QSt1.X, QSt2.Y - QSt1.Y, QSt2.Z - QSt1.Z, MyArcOut.Longueur, MyArcOut.Azimut, MyArcOut.Pente, 360.00, 360.00);
        AddArc(MyArcOut);
      end;
    end;
     
     
     
     
    //******************************************************************************
    // Les fonctions de calcul
    procedure TGraphe.RecenserLesLiaisons();
    var
      NbNoeuds, NbArcs, N, A, nv: integer;
      MyNoeud: TGrapheNoeud;
      MyArc: TGrapheArc;
      procedure QAddIdxNdSuccesseur(var MN: TGrapheNoeud; const Idx: TNumeroNoeud);
      var
        wu: Integer;
      begin
        wu := length(MN.ListeIdxSuccesseurs);
        SetLength(MN.ListeIdxSuccesseurs, wu + 1);
        MN.ListeIdxSuccesseurs[wu] := Idx;
      end;
      procedure QAddIdxNdPredecesseur(var MN: TGrapheNoeud; const Idx: TNumeroNoeud);
      var
        wu: Integer;
      begin
        wu := length(MN.ListeIdxPredecesseurs);
        SetLength(MN.ListeIdxPredecesseurs, wu + 1);
        MN.ListeIdxPredecesseurs[wu] := Idx;
      end;
      procedure QAddIdxArcSortant(var MN: TGrapheNoeud; const Idx: TNumeroArc);
      var
        wu: Integer;
      begin
        wu := length(MN.ListeArcsSortants);
        SetLength(MN.ListeArcsSortants, wu + 1);
        MN.ListeArcsSortants[wu] := Idx;
      end;
      procedure QAddIdxArcEntrant(var MN: TGrapheNoeud; const Idx: TNumeroArc);
      var
        wu: Integer;
      begin
        wu := length(MN.ListeArcsEntrants);
        SetLength(MN.ListeArcsEntrants, wu + 1);
        MN.ListeArcsEntrants[wu] := Idx;
      end;
    begin
      NbNoeuds := GetNbNoeuds();
      NbArcs   := GetNbArcs();
      FAfficherMessage(Format('%s.RecenserLesLiaisons: %d noeuds, %d arcs', [classname, NbNoeuds, NbArcs]));
      if ((0 = NbNoeuds) or (0 = NbArcs)) then exit;
      for N := 0 to NbNoeuds - 1 do
      begin
        MyNoeud  := GetNoeud(N);
     
        for A := 0 to NbArcs - 1 do
        begin
          MyArc := GetArc(A);
          if (N = MyArc.IdxNoeudDepart) then
          begin
            // ajout du successeur
            QAddIdxNdSuccesseur(MyNoeud, MyArc.IdxNoeudArrivee);
            QAddIdxArcSortant(MyNoeud, A);
          end;
          if (N = MyArc.IdxNoeudArrivee) then
          begin
            // ajout du successeur
            QAddIdxNdPredecesseur(MyNoeud, MyArc.IdxNoeudDepart);
            QAddIdxArcEntrant(MyNoeud, A);
          end;
        end;
        PutNoeud(N, MyNoeud);
      end;
     
    end;
     
    function TGraphe.GetNoeudCheminTrouve(const Idx: integer): TGrapheNoeud;
    begin
      Result := FLeCheminTrouve.GetElement(Idx);
    end;
     
    function TGraphe.GetNbNoeudsCheminTrouve(): integer;
    begin
      result := FLeCheminTrouve.GetNbElements();
    end;
     
     
    // Noeud non visité le plus proche
    function TGraphe.RechercherIdxNearestNodeOf(const QCurrNoeud: TGrapheNoeud; out QDistance: double): TNumeroNoeud;
    var
      i : integer;
      NbArcsEntrants, NbArcsSortants: Integer;
      EWE: String;
      QNoeud: TGrapheNoeud;
      QArc: TGrapheArc;
    begin
      FAfficherMessage(Format('RechercherIdxNearestNodeOf( %d )', [QCurrNoeud.IDStation]));
      QDistance := Infinity;
      Result := -1;
      NbArcsEntrants := length(QCurrNoeud.ListeArcsEntrants);
      if (NbArcsEntrants > 0) then
      begin
        EWE := '-- Arcs entrants: ';
        for i := 0 to NbArcsEntrants-1 do EWE += format('%d, ', [QCurrNoeud.ListeArcsEntrants[i]]);
        FAfficherMessage(EWE);
      end;
      NbArcsSortants := length(QCurrNoeud.ListeArcsSortants);
      if (NbArcsSortants > 0) then
      begin
        EWE := '-- Arcs sortants: ';
        for i := 0 to NbArcsSortants-1 do EWE += format('%d, ', [QCurrNoeud.ListeArcsSortants[i]]);
        FAfficherMessage(EWE);
      end;
      if (0 = (NbArcsEntrants + NbArcsSortants)) then exit(-1);
      if (NbArcsEntrants > 0) then
      begin
        for i := 0 to NbArcsEntrants - 1 do
        begin
          QArc := GetArc(QCurrNoeud.ListeArcsEntrants[i]);
          FAfficherMessage(Format('-- Arc entrant: %d - L = %.2f, D = %.2f -> %d', [QCurrNoeud.ListeArcsEntrants[i], QArc.Longueur, QDistance, Result]));
          QNoeud := GetNoeud(QArc.IdxNoeudDepart);
          if (QNoeud.NoeudVisite) then Continue;
          if (QArc.Longueur < QDistance) then
          begin
            QDistance  := QArc.Longueur;
            Result := QArc.IdxNoeudDepart;
          end;
        end;
      end;
      if (NbArcsSortants > 0) then
      begin
        for i := 0 to NbArcsSortants - 1 do
        begin
          QArc := GetArc(QCurrNoeud.ListeArcsSortants[i]);
          FAfficherMessage(Format('-- Arc sortant: %d - L = %.2f, D = %.2f -> %d', [QCurrNoeud.ListeArcsSortants[i], QArc.Longueur, QDistance, Result]));
          QNoeud := GetNoeud(QArc.IdxNoeudArrivee);
          if (QNoeud.NoeudVisite) then Continue;
          if (QArc.Longueur < QDistance) then
          begin
            QDistance  := QArc.Longueur;
            Result := QArc.IdxNoeudArrivee;
          end;
        end;
      end;
      FAfficherMessage(Format('*** RechercherIdxNearestNodeOf: %d: %d - Dist = %.2f', [QCurrNoeud.IDStation, Result, QDistance]));
    end;
     
    function TGraphe.RechercherPlusCourtChemin(const Ser1, St1, Ser2, St2: integer): boolean;
    var
      QDistanceMin: Double;
      QNoeudDepart, QNoeudArrivee, QNoeudCourant, QST1, QNoeudSuccesseur: TGrapheNoeud;
      IdxNoeudDepart, IdxNoeudArrivee, QIdxPredecesseur: TNumeroNoeud;
     
      i, QIdxNearestNode, a, NbArcsSortants, NbPasses: integer;
      Q1, Q2: Boolean;
      QArc: TGrapheArc;
      qIdxArc: TNumeroArc;
      QDistance: double;
    begin
      Result := false;
      FNombreNoeudsVisites := 0;
      FLeCheminTrouve.ClearListe();
      SetLastError(0, '');
     
      Q1 := FindNoeudByIDStation(MakeTIDStation(Ser1, St1), QNoeudDepart, IdxNoeudDepart);
      if (Not Q1) then Exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, Format('Noeud "%d.%d" introuvable', [Ser1, St1])));
      Q1 := FindNoeudByIDStation(MakeTIDStation(Ser2, St2), QNoeudArrivee, IdxNoeudArrivee);
      if (Not Q1) then Exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, Format('Noeud "%d.%d" introuvable', [Ser2, St2])));
      FAfficherMessage(Format('%s.RechercherPlusCourtChemin(): %d: %d.%d -> %d: %d.%d', [ClassName, IdxNoeudDepart, Ser1, St1, IdxNoeudArrivee, Ser2, St2]));
      Q1 := (Ser1 = Ser2) and (St1 = St2);
      if (Q1) then Exit(SetLastError(ERR_GRAPHE_SAME_START_END, '-- Les stations de départ et arrivée sont identiques'));
      // acquittement de la recherche de noeuds
      QNoeudDepart  := GetNoeud(IdxNoeudDepart);
      QNoeudArrivee := GetNoeud(IdxNoeudArrivee);
      QNoeudCourant := QNoeudDepart;
      FNombreNoeudsVisites += 1;                                // et incrémenter le compteur de noeuds visités
      // sécurité: On met les distances minimales à +Inf et le statut Visité à False
      for i := 0 to GetNbNoeuds() - 1 do
      begin
        QST1 := GetNoeud(i);
        QST1.NoeudVisite := false; //(i = IdxNoeudDepart);
        QST1.DistanceMin := ifthen(i = IdxNoeudDepart, 0.00, Infinity);
        PutNoeud(i, QST1);
      end;
     
      ListerLesNoeuds('Après initialisation de la première itération', false);
      NbPasses := 0;
      QDistanceMin := Infinity;
      QDistance    := Infinity;
      while (Not NoeudsTousVisites()) do
      begin
        //if (NbPasses > 200) then break;
        // Noeud non visité de distance minimale
        QIdxNearestNode := RechercherIdxNearestNodeOf(QNoeudCourant, QDistanceMin);
        if (QIdxNearestNode = -1) then
        begin
          FAfficherMessage('Noeud non trouvé') ;
          exit;
        end;
        QNoeudCourant := GetNoeud(QIdxNearestNode);
        QNoeudCourant.NoeudVisite := True;
        QNoeudCourant.DistanceMin := QDistanceMin;
        PutNoeud(QIdxNearestNode, QNoeudCourant);
        if (QNoeudCourant.IDStation = QNoeudArrivee.IDStation) then
        begin
          FAfficherMessage(Format('%d == %d', [QNoeudCourant.IDStation , QNoeudArrivee.IDStation]));
          break;
        end;
        // Pour les arcs sortants
        NbArcsSortants := Length(QNoeudCourant.ListeArcsSortants);
        if (NbArcsSortants > 0) then
        begin
          FAfficherMessage(Format('%d: %d arcs sortants', [QNoeudCourant.IDStation, NbArcsSortants]));
          for a := 0 to NbArcsSortants - 1 do
          begin
            qIdxArc   := QNoeudCourant.ListeArcsSortants[a];
            QArc      := GetArc(qIdxArc);
            QDistance := QNoeudCourant.DistanceMin + QArc.Longueur;   // ???? Incompréhensible dans le corrigé
            // On attrappe le successeur
            QNoeudSuccesseur := GetNoeud(QArc.IdxNoeudArrivee);
            FAfficherMessage(Format('+++ Distance actuelle: %f, Distance du successeur: %d: %d: %f', [QDistance, a, QNoeudSuccesseur.IDStation, QNoeudSuccesseur.DistanceMin]));
            if (QDistance < QNoeudSuccesseur.DistanceMin) then
            begin
              QNoeudSuccesseur.DistanceMin := QDistance;
              QNoeudSuccesseur.NoeudVisite := True;
              PutNoeud(QArc.IdxNoeudArrivee, QNoeudSuccesseur);
              QArc.IdxNoeudDepart := QIdxNearestNode;
              PutArc(qIdxArc, QArc);
              FAfficherMessage(Format('Changement du noeud courant: %d devient %d', [QNoeudCourant.IDStation, QNoeudSuccesseur.IDStation]));
              QNoeudCourant := QNoeudSuccesseur;
            end;
          end;
        end;
        Inc(NbPasses);
        ListerLesNoeuds(Format('Passe %d', [NbPasses]));
      end; // while(Not NoeudsTousVisites()) do
     
      //exit;
      FAfficherMessage(Format('%d passes', [NbPasses]));
     
     
      // Le chemin
      //FLeCheminTrouve.ClearListe();
     
      // si le noeud d'arrivée a un prédécesseur:
      FAfficherMessage('Backtracking');
     
      if (Length(QNoeudArrivee.ListeArcsEntrants) > 0) then
      begin
     
        FAfficherMessage(Format('Le noeud %d a un prédécesseur', [QNoeudCourant.IDStation]));
        QNoeudCourant := QNoeudArrivee;
        FLeCheminTrouve.AddElement(QNoeudArrivee);
        NbPasses := 0;
        while (Length(QNoeudCourant.ListeArcsEntrants) > 0) do
        begin
          if (NbPasses > 200) then break;
          FAfficherMessage(Format('Noeud courant: %d', [QNoeudCourant.IDStation]));
          FLeCheminTrouve.InsertElement(0, QNoeudCourant);
     
          for i := 0 to Length(QNoeudCourant.ListeArcsEntrants) - 1 do
          begin
            QArc := GetArc(QNoeudCourant.ListeArcsEntrants[i]);
            QIdxPredecesseur := QArc.IdxNoeudDepart;
            QST1 := GetNoeud(QIdxPredecesseur);
     
            FAfficherMessage(Format('QNoeudCourant: %d: Arc entrant: %d provenant de %d [%d] - %s',
                             [QNoeudCourant.IDStation,
                              QNoeudCourant.ListeArcsEntrants[i],
                              QIdxPredecesseur, QST1.IDStation,
                              BooltoStr(QSt1.NoeudVisite, 'Visité', '--')]));
            if (QSt1.NoeudVisite) then break;
          end;
     
     
     
     
          if (QNoeudDepart.IDStation = QST1.IDStation) then Break;
          QNoeudCourant := QST1;
     
          Inc(NbPasses);
        end;
      end;
     
      FAfficherMessage('Parcours terminé');
      //*)
     
    end;
    end.


    Sortie

  2. #2
    Membre expert
    Salut, j'ai testé ton application de test, mais la sortie console est incompréhensible pour déboguer.
    A mon avis il faudrait déjà que tu partes sur un Graph de nœuds moins complexe et plus basique pour mettre en place l'algorithme. Je pense que tu te compliques un peu trop la tache dans un premier temps (cf Rosetta code) Une fois fait tu pourras rajouter les informations dont tu as besoin dans tes noeuds.

    Pour ma part je déclarerai la base des noeuds dans le genre :


    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    Type
      TNoeudArc = class
      public
        IdxStop :Integer; // Index du noeud de fin dans le graph
        Dist:integer; // Pre-calcul de la distance entre les noeuds ????
        // Autres infos ???? poids ???
      end;
      TNoeud = class
      public
         X,Y, Z : Integer;  // coordonées
         Idx : Integer;  // Index dans le graph
         Adjacent : Array of TNoeudArc; //  Liste des index des nœuds adjacents
         AdjacentCount : Integer;
         Informations : TObject; // Infos complémentaires du noeud
      end;
      TGraph = Class(TList<TNoeud>)
      public
          function cheminlepluscourt(out NoeudTraverses : Array of Integer) : Integer; // Retourne la distance et le tableau d'index des noeuds traversés pour le chemin le plus court
      end;


    Dans le code de l'algo, je pense à quelque chose dans le genre :

    Je ferai une liste recensant les distances. (Initialisée avec les distances minimum)

    Jusqu’à ce que la liste des distances soit vide, Je conserverai, une variable avec la distance minimum, je conserverai l'index du nœud en cours, je retirerai le noeud de la liste des distances, , puis je parcourrai la liste des nœuds adjacent pour effectuer les comparaisons, je mettrai la liste des distances à jour en fonction des résultats, j'ajouterai mon noeud dans le chemin et calculerai la distance totale du chemin et ainsi de suite.

    En espérant que cela t'aidera un peu

    A+

    Jérôme
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

  3. #3
    Membre averti
    Mode ANVIL ON
    Cà marche mieux avec cette correction (le While s'arrête) dans PutArc, qui était ... vide

    Quel boulet je fais !!! Que dis-je: Une enclume ! (un boulet, çà se déplace facilement en le roulant)

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
     
     
    procedure TGraphe.PutArc(const Idx: integer; const QArc: TGrapheArc);
    begin
        FListeDesArcs.PutElement(Idx, QArc);         
    end;

  4. #4
    Membre averti
    Citation Envoyé par BeanzMaster Voir le message
    Salut, j'ai testé ton application de test, mais la sortie console est incompréhensible pour déboguer.
    A mon avis il faudrait déjà que tu partes sur un Graph de nœuds moins complexe et plus basique pour mettre en place l'algorithme. Je pense que tu te compliques un peu trop la tache dans un premier temps (cf Rosetta code) Une fois fait tu pourras rajouter les informations dont tu as besoin dans tes noeuds.

    Pour ma part je déclarerai la base des noeuds dans le genre :


    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    Type
      TNoeudArc = class
      public
        IdxStop :Integer; // Index du noeud de fin dans le graph
        Dist:integer; // Pre-calcul de la distance entre les noeuds ????
        // Autres infos ???? poids ???
      end;
      TNoeud = class
      public
         X,Y, Z : Integer;  // coordonées
         Idx : Integer;  // Index dans le graph
         Adjacent : Array of TNoeudArc; //  Liste des index des nœuds adjacents
         AdjacentCount : Integer;
         Informations : TObject; // Infos complémentaires du noeud
      end;
      TGraph = Class(TList<TNoeud>)
      public
          function cheminlepluscourt(out NoeudTraverses : Array of Integer) : Integer; // Retourne la distance et le tableau d'index des noeuds traversés pour le chemin le plus court
      end;


    Dans le code de l'algo, je pense à quelque chose dans le genre :

    Je ferai une liste recensant les distances. (Initialisée avec les distances minimum)

    Jusqu’à ce que la liste des distances soit vide, Je conserverai, une variable avec la distance minimum, je conserverai l'index du nœud en cours, je retirerai le noeud de la liste des distances, , puis je parcourrai la liste des nœuds adjacent pour effectuer les comparaisons, je mettrai la liste des distances à jour en fonction des résultats, j'ajouterai mon noeud dans le chemin et calculerai la distance totale du chemin et ainsi de suite.

    En espérant que cela t'aidera un peu

    A+

    Jérôme
    Je bloque complètement. De plus, je n'ai plus beaucoup de temps devant moi, et je recherche désormais une solution clé en main, quitte à payer un développeur.

  5. #5
    Membre averti
    Nouvelle réorganisation de mon unité de graphes
    Bjr à vous,


    Je suis encore complètement bloqué sur mes problèmes de graphe.
    Le réseau exemple:


    est un graphe orienté. Chaque noeud est relié par deux arcs opposés

    Dans l'exemple, je dois aller de 1.1 (noeud 1) à 2.2 (noeud 9)
    Le chemin doit passer par les stations:
    1: 1.1
    2: 1.2
    3: 1.3
    8: 2.1
    9: 2.2

    L'exécution de l'algo échoue bien évidemment:
    - La station d'arrivée n'est jamais atteinte
    - Certains noeuds sont visités alors qu'ils ne le devraient pas



    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
     
    // Noeud non visité le plus proche
    function TGraphe.RechercherIdxNearestNodeOf(const QCurrNoeud: TGrapheNoeud; out QDistance: double): TNumeroNoeud;
    var
      i : integer;
      NbArcsEntrants, NbArcsSortants: Integer;
      EWE: String;
      QNoeud: TGrapheNoeud;
      QArc: TGrapheArc;
    begin
      FAfficherMessage(Format('RechercherIdxNearestNodeOf( %d )', [QCurrNoeud.IDStation]));
      QDistance := Infinity;
      Result := -1;
      NbArcsEntrants := length(QCurrNoeud.ListeArcsEntrants);
      NbArcsSortants := length(QCurrNoeud.ListeArcsSortants);
      if (0 = (NbArcsEntrants + NbArcsSortants)) then exit(-1);
      if (NbArcsEntrants > 0) then
      begin
        for i := 0 to NbArcsEntrants - 1 do
        begin
          QArc := GetArc(QCurrNoeud.ListeArcsEntrants[i]);
          QNoeud := GetNoeud(QArc.IdxNoeudDepart);
          FAfficherMessage(Format('-- Arc entrant: %d - L = %.2f, D = %.2f -> %d (%s)', [QCurrNoeud.ListeArcsEntrants[i], QArc.Longueur, QDistance, Result, BoolToStr(QNoeud.NoeudVisite, 'X', '')]));
          if (QNoeud.NoeudVisite) then Continue;
          if (QArc.Longueur < QDistance) then
          begin
            QDistance  := QArc.Longueur;
            Result := QArc.IdxNoeudDepart;
          end;
        end;
      end;
      if (NbArcsSortants > 0) then
      begin
        for i := 0 to NbArcsSortants - 1 do
        begin
          QArc := GetArc(QCurrNoeud.ListeArcsSortants[i]);
          QNoeud := GetNoeud(QArc.IdxNoeudArrivee);
          FAfficherMessage(Format('-- Arc entrant: %d - L = %.2f, D = %.2f -> %d (%s)', [QCurrNoeud.ListeArcsEntrants[i], QArc.Longueur, QDistance, Result, BoolToStr(QNoeud.NoeudVisite, 'X', '')]));
          if (QNoeud.NoeudVisite) then Continue;
          if (QArc.Longueur < QDistance) then
          begin
            QDistance  := QArc.Longueur;
            Result := QArc.IdxNoeudArrivee;
          end;
        end;
      end;
      //FAfficherMessage(Format('*** RechercherIdxNearestNodeOf: %d: %d - Dist = %.2f', [QCurrNoeud.IDStation, Result, QDistance]));
    end;

    et
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
     
    function TGraphe.RechercherPlusCourtChemin(const Ser1, St1, Ser2, St2: integer): boolean;
    var
      QDistanceMin: Double;
      QNoeudDepart, QNoeudArrivee, QNoeudCourant, QST1, QNoeudSuccesseur: TGrapheNoeud;
      IdxNoeudDepart, IdxNoeudArrivee, QIdxPredecesseur: TNumeroNoeud;
     
      i, QIdxNearestNode, a, NbArcsSortants, NbPasses: integer;
      Q1, Q2: Boolean;
      QArc: TGrapheArc;
      qIdxArc: TNumeroArc;
      QDistance: double;
      (*
      Dijkstra's algorithm: pseudocode
    for all vertices v,
    dist(v) = infinity;
    dist(first) = 0;
    place all vertices in set toBeChecked;
    while toBeChecked is not empty
      {in this version, also stop when shortest path to a specific destination is found}
      select v: min(dist(v)) in toBeChecked;
      remove v from toBeChecked;
      for u in toBeChecked, and path from v to u exists
      {i.e. for unchecked adjacents to v}
      do
        if dist(u) > dist(v) + weight({u,v}),
        then
           dist(u) = dist(v) + weight({u,v});
           set predecessor of u to v
           save minimum distance to u in array "d"
         endif
      enddo
    endwhile
    *)
    begin
      Result := false;
      FNombreNoeudsVisites := 0;
      FLeCheminTrouve.ClearListe();
      SetLastError(0, '');
     
      Q1 := FindNoeudByIDStation(MakeTIDStation(Ser1, St1), QNoeudDepart, IdxNoeudDepart);
      if (Not Q1) then Exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, Format('Noeud "%d.%d" introuvable', [Ser1, St1])));
      Q1 := FindNoeudByIDStation(MakeTIDStation(Ser2, St2), QNoeudArrivee, IdxNoeudArrivee);
      if (Not Q1) then Exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, Format('Noeud "%d.%d" introuvable', [Ser2, St2])));
     
     
      FAfficherMessage(Format('%s.RechercherPlusCourtChemin(): %d: %d.%d -> %d: %d.%d', [ClassName, IdxNoeudDepart, Ser1, St1, IdxNoeudArrivee, Ser2, St2]));
      Q1 := (Ser1 = Ser2) and (St1 = St2);
      if (Q1) then Exit(SetLastError(ERR_GRAPHE_SAME_START_END, '-- Les stations de départ et arrivée sont identiques'));
      QNoeudCourant := QNoeudDepart;
      FNombreNoeudsVisites += 1;                                // et incrémenter le compteur de noeuds visités
      // sécurité: On met les distances minimales à +Inf et le statut Visité à False
      for i := 0 to GetNbNoeuds() - 1 do
      begin
        QST1 := GetNoeud(i);
        QST1.NoeudVisite := false; //(i = IdxNoeudDepart);
        QST1.DistanceMin := ifthen(i = IdxNoeudDepart, 0.00, Infinity);
        PutNoeud(i, QST1);
      end;
      ListerLesNoeuds('Après initialisation de la première itération', false);
      NbPasses := 0;
     
      QDistanceMin := Infinity;
      QDistance    := Infinity;
      while (Not NoeudsTousVisites()) do
      begin
        if (NbPasses > 200) then break;
        QIdxNearestNode := RechercherIdxNearestNodeOf(QNoeudCourant, QDistanceMin);    // Noeud non visité de distance minimale
        if (QIdxNearestNode = -1) then
        begin
          FAfficherMessage('Noeud non trouvé') ;
          break;
        end;
        QNoeudCourant := GetNoeud(QIdxNearestNode);
        if (QNoeudCourant.IDStation = QNoeudArrivee.IDStation) then
        begin
          FAfficherMessage(Format('%d == %d', [QNoeudCourant.IDStation , QNoeudArrivee.IDStation]));
          break;
        end;
        QNoeudCourant.NoeudVisite := True;
        QNoeudCourant.DistanceMin := QDistanceMin;
        PutNoeud(QIdxNearestNode, QNoeudCourant);
        // Pour les arcs sortants
        NbArcsSortants := Length(QNoeudCourant.ListeArcsSortants);
        if (NbArcsSortants > 0) then
        begin
          FAfficherMessage(Format('%d: %d arcs sortants', [QNoeudCourant.IDStation, NbArcsSortants]));
          for a := 0 to NbArcsSortants - 1 do
          begin
            qIdxArc   := QNoeudCourant.ListeArcsSortants[a];
            QArc      := GetArc(qIdxArc);
            QDistance := QNoeudCourant.DistanceMin + QArc.Longueur;   // ???? Incompréhensible dans le corrigé
            // On attrappe le successeur
            QNoeudSuccesseur := GetNoeud(QArc.IdxNoeudArrivee);
            //FAfficherMessage(Format('+++ Distance actuelle: %f, Distance du successeur: %d: %d: %f', [QDistance, a, QNoeudSuccesseur.IDStation, QNoeudSuccesseur.DistanceMin]));
            if (QDistance < QNoeudSuccesseur.DistanceMin) then
            begin
              QNoeudSuccesseur.DistanceMin := QDistance;
              QNoeudSuccesseur.NoeudVisite := True;
              PutNoeud(QArc.IdxNoeudArrivee, QNoeudSuccesseur);
              QArc.IdxNoeudDepart := QIdxNearestNode;
              PutArc(qIdxArc, QArc);
              FAfficherMessage(Format('Changement du noeud courant: %d devient %d', [QNoeudCourant.IDStation, QNoeudSuccesseur.IDStation]));
              QNoeudCourant := QNoeudSuccesseur;
            end;
          end;
        end;
        Inc(NbPasses);
        ListerLesNoeuds(Format('Passe %d', [NbPasses]));
        FAfficherGraphe();
        //Sleep(1000);
      end;
     
      FAfficherMessage(Format('%d passes', [NbPasses]));
      //****************************************************************************
      exit;
      // Le chemin
      //FLeCheminTrouve.ClearListe();
     
      // si le noeud d'arrivée a un prédécesseur:
      FAfficherMessage('Backtracking');
     
      if (Length(QNoeudArrivee.ListeArcsEntrants) > 0) then
      begin
     
        FAfficherMessage(Format('Le noeud %d a un prédécesseur', [QNoeudCourant.IDStation]));
        QNoeudCourant := QNoeudArrivee;
        FLeCheminTrouve.AddElement(QNoeudArrivee);
        NbPasses := 0;
        while (Length(QNoeudCourant.ListeArcsEntrants) > 0) do
        begin
          if (NbPasses > 200) then break;
          FAfficherMessage(Format('Noeud courant: %d', [QNoeudCourant.IDStation]));
          FLeCheminTrouve.InsertElement(0, QNoeudCourant);
     
          for i := 0 to Length(QNoeudCourant.ListeArcsEntrants) - 1 do
          begin
            QArc := GetArc(QNoeudCourant.ListeArcsEntrants[i]);
            QIdxPredecesseur := QArc.IdxNoeudDepart;
            QST1 := GetNoeud(QIdxPredecesseur);
     
            FAfficherMessage(Format('QNoeudCourant: %d: Arc entrant: %d provenant de %d [%d] - %s',
                             [QNoeudCourant.IDStation,
                              QNoeudCourant.ListeArcsEntrants[i],
                              QIdxPredecesseur, QST1.IDStation,
                              BooltoStr(QSt1.NoeudVisite, 'Visité', '--')]));
            if (QSt1.NoeudVisite) then break;
          end;
          if (QNoeudDepart.IDStation = QST1.IDStation) then Break;
          QNoeudCourant := QST1;
          Inc(NbPasses);
        end;
      end;
     
      FAfficherMessage('Parcours terminé');
      //*)
     
    end;


    Mon code a été réorganisé comme suit:

    Types et quelques fonctions utilitaires issues de GHTopo
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
     
    unit UnitGraphesTypes;
     
    {$mode delphi}
     
    interface
    uses
      Classes, SysUtils, math;
     
    const MULT_SERIES: integer = 100000;
     
    // messages d'erreur
    const
      ERR_GRAPHE_NO_ERROR         : integer =  0;
      ERR_GRAPHE_INITIALISATION   : integer = -1;
      ERR_GRAPHE_EMPTY_LIST_NODES : integer = -2;
      ERR_GRAPHE_EMPTY_LIST_ARCS  : integer = -3;
     
      ERR_GRAPHE_NODE_NOT_FOUND   : integer = -4;
      ERR_GRAPHE_ARC_NOT_FOUND    : integer = -5;
     
      ERR_GRAPHE_SAME_START_END   : integer = -6;
     
     
    type TProcAfficherMessage = procedure(const Msg: string; const DoClear: boolean = false) of object;
    type TProcOjObject        = procedure of object;
    type TNumeroNoeud = type Integer;
    type TNumeroArc   = type Integer;
    type TIDStation = type Int64;
    type TGrapheNoeud = record
      IDStation: TIDStation;
      X  : double;
      Y  : double;
      Z  : double;
      DistanceMin : double;
      NoeudVisite : boolean;
      ListeArcsSortants    : array of TNumeroArc;
      ListeArcsEntrants    : array of TNumeroArc;
      ListeIdxPredecesseurs: array of TNumeroNoeud;
      ListeIdxSuccesseurs  : array of TNumeroNoeud;
     
    end;
    type TGrapheArc = record
      IdxNoeudDepart  : TNumeroNoeud;
      IdxNoeudArrivee : TNumeroNoeud;
      Longueur        : double;
      Azimut          : double;
      Pente           : double;
      Parcouru        : boolean;
    end;
    type TGrapheLastError = record
      ErrCode: integer;
      ErrMsg : string;
    end;
     
    function  MakeTIDStation(const Ser, St: integer): integer;
    procedure ExtractSerStFromTIDStation(const ID: integer; out Ser, St: integer);
     
    // Trier les GrapheStations par ZOrder
    function SortGrapheNoeudsByIDStation(Item1, Item2: Pointer): Integer;
     
    function GetAzimut(const dx, dy: Double; const Unite: double): double;
    procedure GetBearingInc(const dx, dy, dz: double;
                            var Dist, Az, Inc: double;
                            const fUB, fUC: Double);
     
    implementation
    uses
      DummyUnit; // pour contrer l'erreur 'Fin du source non trouvée'
     
    function MakeTIDStation(const Ser, St: integer): integer;
    begin
      Result := Ser * MULT_SERIES + St;
    end;
     
    procedure ExtractSerStFromTIDStation(const ID: integer; out Ser, St: integer);
    begin
      Ser := ID div MULT_SERIES;
      St  := ID mod MULT_SERIES;
    end;
     
    // Trier les GrapheStations par ZOrder
    function SortGrapheNoeudsByIDStation(Item1, Item2: Pointer): Integer;
    var
      E1, E2: ^TGrapheNoeud;
    begin
      E1 := Item1;
      E2 := Item2;
      if      (E1^.IDStation < E2^.IDStation) then Result := -1
      else if (E1^.IDStation = E2^.IDStation) then Result :=  0
      else                                         Result :=  1;
    end;
     
    function GetAzimut(const dx, dy: Double; const Unite: double): double;
    const TWO_PI = 2 * PI;
    var
      a: double;
    begin
      a := ArcTan2(dy, dx + 1e-12);
      if (a < 0) then a := a + TWO_PI;
      a := 0.50 * PI - a;
      if (a < 0) then a := a + TWO_PI;
      Result := a * 0.50 * Unite / pi;
    end;
    // retourne la longueur, direction et pente pour dx, dy, dz
    procedure GetBearingInc(const dx, dy, dz: double;
                            var Dist, Az, Inc: double;
                            const fUB, fUC: Double);
    var
      dp: Double;
    begin;
      dp   := Hypot(dx, dy);
      Dist := Hypot(dp,dz);
      Inc  := ArcTan2(dz, dp) * 0.5 * fUC / pi;
      Az   := GetAzimut(dx,dy, fUB);
    end;
    end.


    Listes simples génériques:
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
     
    unit UnitGraphesListesSimples;
     
    {$mode delphi}
     
    interface
     
    uses
      Classes, SysUtils,
      UnitGraphesTypes;
     
    // liste générique (fonctionne très bien)
    type TListeSimple<T> = class(TFPList)
      private
     
     
      public
        procedure ClearListe();
        function  GetNbElements(): integer; inline;
        procedure InsertElement(const Idx: integer; const E: T);
        procedure AddElement(const E: T);  // et Rros Minet
        function  GetElement(const Idx: integer): T; inline;
        procedure PutElement(const Idx: integer; const E: T); inline;
        function  RemoveElement(const Idx: integer): boolean;
        function  RemoveLastElement(): boolean;
     
    end;
    //******************************************************************************
    // liste des noeuds
    type   TGrapheListeDesNoeuds = class(TListeSimple<TGrapheNoeud>)
      private
      public
        procedure TrierParIDStations();
        procedure TrierParDistance();
     
    end;
     
    //******************************************************************************
    // liste des arcs
    type TGrapheListeDesArcs   = class(TListeSimple<TGrapheArc>)
      private
      public
    end;
     
    // liste des noeuds de passage du parcours
    type TGrapheChemin   = class(TListeSimple<TGrapheNoeud>)
      private
      public
    end;
     
    implementation
    uses
      DummyUnit; // pour contrer l'erreur 'Fin du source non trouvée'
     
    procedure TListeSimple<T>.ClearListe();
    var
      i, n: Integer;
    begin
      //AfficherMessage(Format('%s.ClearListe()', [classname]));
      n := self.Count;
      if (n > 0) then
      for i:=Count-1 downto 0 Do
      begin
        if (self.Items[i] <> Nil) then Dispose(self.Items[i]); // Libération
        self.Delete(i);                                        // Suppression de l'élément
      end;
    end;
     
    function TListeSimple<T>.GetNbElements: integer;
    begin
      Result := self.Count;
    end;
     
    procedure  TListeSimple<T>.InsertElement(const Idx: integer; const E: T);
    var pE: ^T;
    begin
      New(pE);
      pE^ := E;
      self.Insert(Idx, pE);
    end;
    procedure TListeSimple<T>.AddElement(const E: T);
    var pE: ^T;
    begin
      New(pE);
      pE^ := E;
      self.Add(pE);
    end;
     
    function TListeSimple<T>.GetElement(const Idx: integer): T;
    begin
      Result := T(Items[Idx]^);
    end;
    procedure TListeSimple<T>.PutElement(const Idx: integer; const E: T);
    begin
      try
        if (Idx < 0) then exit;
        T(Items[Idx]^) := E;
      except
      end;
    end;
     
    function TListeSimple<T>.RemoveElement(const Idx: integer): boolean;
    begin
      Result := False;
      try
        Dispose(self.Items[Idx]);
        self.Delete(Idx);
        Result := True;
      except
      end;
    end;
     
    function TListeSimple<T>.RemoveLastElement(): boolean;
    var
      Nb: Integer;
     
    begin
      Nb := self.Count;
      if (0 = Nb) then Exit(false);
      result := self.RemoveElement(Nb - 1);
    end;
     
    //******************************************************************************
    { TGrapheListeDesNoeuds }
    procedure TGrapheListeDesNoeuds.TrierParIDStations();
    begin
      self.Sort(SortGrapheNoeudsByIDStation);
    end;
     
    procedure TGrapheListeDesNoeuds.TrierParDistance();
    begin
      ;;
    end;
     
    end.


    et l'unité UnitGraphes1.pas modifiée
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    427
    428
    429
    430
    431
    432
    433
    434
    435
    436
    437
    438
    439
    440
    441
    442
    443
    444
    445
    446
    447
    448
    449
    450
    451
    452
    453
    454
    455
    456
    457
    458
    459
    460
    461
    462
    463
    464
    465
    466
    467
    468
    469
    470
    471
    472
    473
    474
    475
    476
    477
    478
    479
    480
    481
    482
    483
    484
    485
    486
    487
    488
    489
    490
    491
    492
    493
    494
    495
    496
    497
    498
    499
    500
    501
    502
    503
    504
    505
    506
    507
    508
    509
    510
    511
    512
    513
    514
    515
    516
    517
    518
    519
    520
    521
    522
    523
    524
    525
    526
    527
    528
    529
    530
    531
    532
    533
    534
    535
    536
    537
    538
    539
    540
    541
    542
    543
    544
    545
    546
    547
    548
    549
    550
    551
    552
    553
    554
    555
    556
    557
    558
    559
    560
    561
    562
    563
    564
    565
    566
    567
    568
    569
    570
    571
    572
    573
    574
    575
    576
    577
    578
    579
    580
    581
    582
    583
    584
    585
    586
    587
    588
    589
    590
    591
    592
    593
    594
    595
    596
    597
    598
    599
    600
    601
    602
    603
    604
    605
    606
    607
    608
    609
    610
    611
    612
    613
    614
    615
    616
    617
    618
    619
    620
    621
    622
    623
    624
    625
    626
    627
    628
    629
    630
    631
    632
    633
    634
    635
    636
    637
    638
    639
    640
    641
    642
    643
    644
    645
    646
    647
    648
    649
    650
    651
    652
    653
    654
    655
    656
    657
    658
    659
    660
    661
    662
    663
    664
    665
    666
    667
    668
    669
    670
    671
    672
    673
    674
    675
    676
    677
    678
    679
    680
    681
    682
    683
    684
    685
    686
    687
    688
    689
    690
    691
    692
    693
    694
    695
    696
    697
    698
    699
    700
    701
    702
    703
    704
    705
     
    unit UnitGraphes1;
    // Calcul du chemin minimal dans un réseau GHTopo
    {$WARNING: A exécuter sans débogage}
    {$mode delphi}
    interface
    uses
      Classes, SysUtils, math,
      UnitGraphesTypes,
      UnitGraphesListesSimples;
    type
     
    { TGraphe }
     
      TGraphe = class
      strict private
        FXMini: double;
        FXMaxi: double;
        FYMini: double;
        FYMaxi: double;
        FLastError: TGrapheLastError;
        FArrayDistancesMin: array of double;
        FArrayNoeudsVisites: array of boolean;
        function  RechercherIdxNearestNodeOf(const QCurrNoeud: TGrapheNoeud; out QDistance: double): TNumeroNoeud;
     
     
        function SetLastError(const QErrCode: integer; const QErrMsg: string): boolean;
        procedure ResetTableauDistancesMin();
        procedure ResetTableauNoeudsVisites();
      private
        FListeDesNoeuds            : TGrapheListeDesNoeuds;
        FListeDesArcs              : TGrapheListeDesArcs;
        FLeCheminTrouve            : TGrapheChemin;
        FAfficherMessage           : TProcAfficherMessage;
        FAfficherGraphe            : TProcOjObject;
        FNombreNoeudsVisites       : integer;
        function   FindNoeudByIDStation(const IDS: TIDStation; out ST: TGrapheNoeud; out IndexOf: TNumeroNoeud): boolean;
        procedure  RecenserLesLiaisons();
        procedure  SetMinMax();                // étendue du réseau
        procedure  MakeArcsReciproques();      // complètement du graphe
        function   GetNbNoeudsVisites(): integer;
        function   NoeudsTousVisites(): boolean;
      public
        property  XMini: double read FXMini;
        property  YMini: double read FYMini;
        property  XMaxi: double read FXMaxi;
        property  YMaxi: double read FYMaxi;
        // Les utilitaires
        function  Initialiser(const P: TProcAfficherMessage; const ProcAfficherGraphe: TProcOjObject): boolean;
        procedure Finaliser();
        function  GetLastError(): TGrapheLastError;
        function  FormatterTIDStation(const QId: TIDStation): string;
        procedure ListerLesNoeuds(const Caption: string; const DoDisplayDependances: boolean = false);
        procedure ListerLesArcs(const Caption: string);
        // Les noeuds
        procedure  BeginNodeList();
        procedure  AddNoeud(const QNoeud: TGrapheNoeud);
        function   GetNoeud(const Idx: integer): TGrapheNoeud;
        procedure  PutNoeud(const Idx: integer; const QNoeud: TGrapheNoeud);
        function   GetNbNoeuds(): integer;
        procedure  AddStation(const QSerie, QStation: integer; const QX, QY, QZ: double);
        procedure  EndNodesList();
        // Les arcs
        procedure  BeginArcsList();
        procedure  AddArc(const QArc: TGrapheArc); overload;
        function   GetArc(const Idx: integer): TGrapheArc;
        procedure  PutArc(const Idx: integer; const QArc: TGrapheArc);
        function   GetNbArcs(): integer;
        procedure  AddArcBetweenStations(const Ser1, St1, Ser2, St2: integer); overload;
        procedure  EndArcsList();
        // spécifique stations topo
        function   GetNoeudCheminTrouve(const Idx: integer): TGrapheNoeud;
        function   GetNbNoeudsCheminTrouve(): integer;
        function   RechercherPlusCourtChemin(const Ser1, St1, Ser2, St2: integer): boolean;
        function   NoeudEstVisite(const Idx: TNumeroNoeud): boolean;
    end;
     
     
    implementation
    uses
      DummyUnit; // pour contrer l'erreur 'Fin du source non trouvée'
     
     
     
     
     
    ///////////////////////////////////////////////////////////////////////////////////////////
     
    //******************************************************************************
    { TGraphe }
    function TGraphe.Initialiser(const P: TProcAfficherMessage;  const ProcAfficherGraphe: TProcOjObject): boolean;
    begin
      result := false;
      SetLastError(ERR_GRAPHE_NO_ERROR, '');
      FNombreNoeudsVisites      := 0;
      FAfficherMessage          := P;
      FAfficherGraphe           := ProcAfficherGraphe;
      FListeDesNoeuds           := TGrapheListeDesNoeuds.Create;
      FListeDesArcs             := TGrapheListeDesArcs.Create;
      FLeCheminTrouve           := TGrapheChemin.Create;
     
     
      //FMinStations                := maxLongint; // initialisé à "plus l'infini" : on suppose qu'on ne prendra pas plus de 50 stations
      try
        FListeDesNoeuds.ClearListe();
        FListeDesArcs.ClearListe();
        FLeCheminTrouve.ClearListe();
        Result := True;
        SetLastError(ERR_GRAPHE_NO_ERROR, '');
        SetLength(FArrayDistancesMin, 0);
        SetLength(FArrayNoeudsVisites, 0);
        FAfficherMessage('Initialisation du graphe', True);
      except
        SetLastError(-1, 'Erreur d''initialisation');
      end;
    end;
     
    procedure TGraphe.Finaliser();
    begin
      try
        FListeDesNoeuds.ClearListe();
        FListeDesArcs.ClearListe();
        FLeCheminTrouve.ClearListe();
      finally
        FreeAndNil(FListeDesArcs);
        FreeAndNil(FListeDesNoeuds);
        FreeAndNil(FLeCheminTrouve);
      end;
    end;
     
    // Les utilitaires
    function TGraphe.SetLastError(const QErrCode: integer; const QErrMsg: string): boolean;
    begin
      FLastError.ErrCode := QErrCode;
      FLastError.ErrMsg  := QErrMsg;
      result := (FLastError.ErrCode <> ERR_GRAPHE_NO_ERROR);
    end;
     
    procedure TGraphe.ResetTableauDistancesMin();
    var
      i, n: Integer;
    begin
      n := GetNbNoeuds();
      SetLength(FArrayDistancesMin, n);
      if (n > 0) then
        for i := 0 to N - 1 do FArrayDistancesMin[i] := Infinity;
    end;
     
     
    procedure TGraphe.ResetTableauNoeudsVisites();
    var
      i, n: Integer;
    begin
      n := GetNbNoeuds();
      SetLength(FArrayNoeudsVisites, n);
      if (n > 0) then
        for i := 0 to N - 1 do FArrayNoeudsVisites[i] := false;
    end;
     
     
    function TGraphe.NoeudEstVisite(const Idx: TNumeroNoeud): boolean;
    begin
      Result := FArrayNoeudsVisites[Idx];
    end;
     
     
     
    function  TGraphe.GetLastError(): TGrapheLastError;
    begin
      result := FLastError;
    end;
    function TGraphe.FormatterTIDStation(const QId: TIDStation): string;
    var
      Qser, QSt: integer;
    begin
      ExtractSerStFromTIDStation(QId, Qser, QSt);
      result := format('%d.%d', [Qser, QSt]);
    end;
    procedure TGraphe.SetMinMax();
    var
      Nb, i: Integer;
      MyNoeud: TGrapheNoeud;
    begin
      FXMini :=  Infinity;
      FYMini :=  Infinity;
      FXMaxi := -Infinity;
      FYMaxi := -Infinity;
      Nb := GetNbNoeuds();
      for i := 0 to Nb -1 do
      begin
        MyNoeud := GetNoeud(i);
        FXMaxi := Max(FXMaxi, MyNoeud.X);
        FYMaxi := Max(FYMaxi, MyNoeud.Y);
        FXMini := Min(FXMini, MyNoeud.X);
        FYMini := Min(FYMini, MyNoeud.Y);
      end;
    end;
    procedure TGraphe.ListerLesNoeuds(const Caption: string; const DoDisplayDependances: boolean = false);
    var
      Nb, i, s, QSr, QSt: Integer;
      QNbArcsEntrants, QNbArcsSortants: integer;
      MyStation, ST1, ST2: TGrapheNoeud;
      QArc: TGrapheArc;
    begin
      Nb := self.GetNbNoeuds();
      FAfficherMessage('');
      FAfficherMessage(Caption);
      FAfficherMessage(Format('%d noeuds (%f, %f) -> %f, %f', [Nb, self.XMini, self.YMini, self.XMaxi, self.YMaxi]));
      for i := 0 to Nb - 1 do
      begin
        MyStation := self.GetNoeud(i);
        ExtractSerStFromTIDStation(MyStation.IDStation, QSr, QSt);
        QNbArcsEntrants := Length(MyStation.ListeArcsEntrants);
        QNbArcsSortants := Length(MyStation.ListeArcsEntrants);
     
        FAfficherMessage(Format(' %d: %d: %d.%d %f, %f: %d arcs entrants, %d arcs sortants, DistMini: %.2f, Visité: %s',
                        [i, MyStation.IDStation, QSr, QSt, MyStation.X, MyStation.Y,
                         QNbArcsEntrants, QNbArcsSortants,
                         FArrayDistancesMin[i], BoolToStr(FArrayNoeudsVisites[i], 'OUI', 'non')]));
        if (DoDisplayDependances) then
        begin
          FAfficherMessage('Arcs entrants:');
          if (QNbArcsEntrants > 0) then
          begin
            for s := 0 to QNbArcsEntrants - 1 do
            begin
              QArc := self.GetArc(Abs(MyStation.ListeArcsEntrants[s]));
              ST1  := self.GetNoeud(QArc.IdxNoeudDepart);
              ST2  := self.GetNoeud(QArc.IdxNoeudArrivee);
              FAfficherMessage(Format('---- %06d: %06d [%s] -> %06d [%s]',
                               [MyStation.ListeArcsEntrants[s],
                                QArc.IdxNoeudDepart , self.FormatterTIDStation(ST1.IDStation),
                                QArc.IdxNoeudArrivee, self.FormatterTIDStation(ST2.IDStation)]));
            end;
          end;
          FAfficherMessage('Arcs sortants:');
          if (QNbArcsSortants > 0) then
          begin
            for s := 0 to QNbArcsSortants - 1 do
            begin
              QArc := self.GetArc(Abs(MyStation.ListeArcsSortants[s]));
              ST1  := self.GetNoeud(QArc.IdxNoeudDepart);
              ST2  := self.GetNoeud(QArc.IdxNoeudArrivee);
              FAfficherMessage(Format('---- %06d: %06d [%s] -> %06d [%s]',
                               [MyStation.ListeArcsSortants[s],
                                QArc.IdxNoeudDepart , self.FormatterTIDStation(ST1.IDStation),
                                QArc.IdxNoeudArrivee, self.FormatterTIDStation(ST2.IDStation)]));
            end;
          end;
        end;
      end;
      FAfficherMessage('');
    end;
     
    procedure TGraphe.ListerLesArcs(const Caption: string);
    var
      i, Nb: Integer;
      MyVisee: TGrapheArc;
      MyStationArr, MyStationDep: TGrapheNoeud;
    begin
      Nb := self.GetNbArcs();
      FAfficherMessage('');
      FAfficherMessage(Caption);
      FAfficherMessage(Format('%d arcs', [Nb]));
     
      for i := 0 to Nb - 1 do
      begin
        MyVisee := self.GetArc(i);
        MyStationDep := self.GetNoeud(MyVisee.IdxNoeudDepart);
        MyStationArr := self.GetNoeud(MyVisee.IdxNoeudArrivee);
     
        FAfficherMessage(Format(' %d: Nd%d [%s] -> Nd%d [%s]: L = %.3f m, Az: %.2f, P: %.2f', [i, MyVisee.IdxNoeudDepart , self.FormatterTIDStation(MyStationDep.IDStation),
                                                                              MyVisee.IdxNoeudArrivee, self.FormatterTIDStation(MyStationArr.IDStation),
                                                                              MyVisee.Longueur, MyVisee.Azimut, MyVisee.Pente]));
      end;
      FAfficherMessage('');
    end;
     
    // Les noeuds
    procedure TGraphe.BeginNodeList();
    begin
      FListeDesNoeuds.ClearListe();
    end;
    procedure TGraphe.AddNoeud(const QNoeud: TGrapheNoeud);
    var
      EWE: TGrapheNoeud;
    begin
      EWE := QNoeud;
      Setlength(EWE.ListeArcsSortants, 0);
      Setlength(EWE.ListeArcsEntrants, 0);
      Setlength(EWE.ListeIdxPredecesseurs, 0);
      Setlength(EWE.ListeIdxSuccesseurs, 0);
      FListeDesNoeuds.AddElement(EWE);
    end;
     
    function TGraphe.GetNoeud(const Idx: integer): TGrapheNoeud;
    begin
      Result := FListeDesNoeuds.GetElement(Idx);
    end;
     
    procedure TGraphe.PutNoeud(const Idx: integer; const QNoeud: TGrapheNoeud);
    begin
      FListeDesNoeuds.PutElement(Idx, QNoeud);
    end;
    function TGraphe.GetNbNoeuds(): integer;
    begin
      Result := FListeDesNoeuds.GetNbElements();
    end;
     
    procedure TGraphe.AddStation(const QSerie, QStation: integer; const QX, QY, QZ: double);
    var
      ST: TGrapheNoeud;
    begin
      ST.IDStation := MakeTIDStation(QSerie, QStation);
      ST.X := QX;
      ST.Y := QY;
      ST.Z := QZ;
      AddNoeud(ST);
    end;
     
    procedure TGraphe.EndNodesList();
    var
      i, Nb: Integer;
    begin
      Nb := GetNbNoeuds();
      if (Nb > 0) then
      begin
        FListeDesNoeuds.TrierParIDStations();
        ResetTableauNoeudsVisites();
        ResetTableauDistancesMin();
        SetMinMax();
        SetLastError(ERR_GRAPHE_NO_ERROR, '');
      end
      else
        SetLastError(ERR_GRAPHE_EMPTY_LIST_NODES, 'La liste des noeuds est vide');
    end;
    function TGraphe.FindNoeudByIDStation(const IDS: TIDStation; out ST: TGrapheNoeud; out IndexOf: TNumeroNoeud): boolean;
      function FindDepth(const I1, I2: TNumeroNoeud; const QIDX: TIDStation): TNumeroNoeud;
      var
        PVT: integer;
        C1 : TGrapheNoeud;
      begin
        Result := -1;
        // coupure en deux => calcul index médian
        PVT := (I2 + I1) div 2;
        // début > fin >> sortie directe avec erreur
        if (I1 > I2) then Exit(-1);
        C1 := GetNoeud(PVT); //GetBasePoint(PVT);
        // comparaison. Si vrai >> sortie avec numéro d'index
        if (C1.IDStation = QIDX) then Exit(PVT);
        // sinon, recherche en profondeur avec un niveau supplémentaire
        if (QIDX < C1.IDStation) then
        begin
          Result := FindDepth(I1, PVT-1, QIDX);
          Exit;
        end;
        Result := FindDepth(PVT+1, I2, QIDX);
      end;
    begin
      Result := false;
      IndexOf := FindDepth(0, GetNbNoeuds() - 1, IDS);
      if (IndexOf >= 0) then
      begin
        ST     := GetNoeud(IndexOf);
        Exit(True);
      end;
    end;
    function TGraphe.GetNbNoeudsVisites(): integer;
    var
      i, n: Integer;
      Nd: TGrapheNoeud;
    begin
      Result := 0;
      n := Length(FArrayNoeudsVisites);
      if (n = 0) then exit;
      for i := 0 to n - 1 do
        if (FArrayNoeudsVisites[i]) then Result += 1;
    end;
     
     
    function TGraphe.NoeudsTousVisites(): boolean;
    begin
      Result := (GetNbNoeuds() = FNombreNoeudsVisites);
    end;
     
    // Les arcs
    procedure TGraphe.BeginArcsList();
    begin
      FListeDesArcs.ClearListe();
    end;
     
    procedure TGraphe.AddArc(const QArc: TGrapheArc);
    begin
      FListeDesArcs.AddElement(QArc);
    end;
    function TGraphe.GetArc(const Idx: integer): TGrapheArc;
    begin
      Result := FListeDesArcs.GetElement(Idx);
    end;
     
    procedure TGraphe.PutArc(const Idx: integer; const QArc: TGrapheArc);
    begin
      FListeDesArcs.PutElement(Idx, QArc);
    end;
     
    function TGraphe.GetNbArcs(): integer;
    begin
       Result := FListeDesArcs.GetNbElements;
    end;
     
     
    procedure TGraphe.EndArcsList();
    var
      Nb: Integer;
    begin
      Nb := GetNbArcs();
      if (Nb > 0) then
      begin
        MakeArcsReciproques();
        RecenserLesLiaisons();
        SetLastError(ERR_GRAPHE_NO_ERROR, '');
      end
      else
        SetLastError(ERR_GRAPHE_EMPTY_LIST_ARCS, 'La liste des arcs est vide');
    end;
     
    procedure TGraphe.AddArcBetweenStations(const Ser1, St1, Ser2, St2: integer);
    var
      MyArc: TGrapheArc;
      BS1, BS2: TGrapheNoeud;
    begin
      FindNoeudByIDStation(MakeTIDStation(Ser1, St1), BS1, MyArc.IdxNoeudDepart);
      FindNoeudByIDStation(MakeTIDStation(Ser2, St2), BS2, MyArc.IdxNoeudArrivee);
      GetBearingInc(BS2.X - BS1.X, BS2.Y - BS1.Y, BS2.Z - BS1.Z, MyArc.Longueur, MyArc.Azimut, MyArc.Pente, 360.00, 360.00);
      self.AddArc(MyArc);
    end;
    // les galeries étant à double sens et le graphe orienté, construire les arcs opposés
    procedure TGraphe.MakeArcsReciproques();
    var
      i, Nb: Integer;
      MyArcIn, MyArcOut: TGrapheArc;
      QSt1, QSt2: TGrapheNoeud;
    begin
      Nb := GetNbArcs();
      for i := 0 to Nb - 1 do
      begin
        MyArcIn  := getArc(i);
        MyArcOut.Parcouru        := MyArcIn.Parcouru;
        MyArcOut.IdxNoeudDepart  := MyArcIn.IdxNoeudArrivee;
        MyArcOut.IdxNoeudArrivee := MyArcIn.IdxNoeudDepart;
        QSt1 := GetNoeud(MyArcOut.IdxNoeudDepart);
        QSt2 := GetNoeud(MyArcOut.IdxNoeudArrivee);
        GetBearingInc(QSt2.X - QSt1.X, QSt2.Y - QSt1.Y, QSt2.Z - QSt1.Z, MyArcOut.Longueur, MyArcOut.Azimut, MyArcOut.Pente, 360.00, 360.00);
        AddArc(MyArcOut);
      end;
    end;
     
     
     
     
    //******************************************************************************
    // Les fonctions de calcul
    procedure TGraphe.RecenserLesLiaisons();
    var
      NbNoeuds, NbArcs, N, A, nv: integer;
      MyNoeud: TGrapheNoeud;
      MyArc: TGrapheArc;
      procedure QAddIdxNdSuccesseur(var MN: TGrapheNoeud; const Idx: TNumeroNoeud);
      var
        wu: Integer;
      begin
        wu := length(MN.ListeIdxSuccesseurs);
        SetLength(MN.ListeIdxSuccesseurs, wu + 1);
        MN.ListeIdxSuccesseurs[wu] := Idx;
      end;
      procedure QAddIdxNdPredecesseur(var MN: TGrapheNoeud; const Idx: TNumeroNoeud);
      var
        wu: Integer;
      begin
        wu := length(MN.ListeIdxPredecesseurs);
        SetLength(MN.ListeIdxPredecesseurs, wu + 1);
        MN.ListeIdxPredecesseurs[wu] := Idx;
      end;
      procedure QAddIdxArcSortant(var MN: TGrapheNoeud; const Idx: TNumeroArc);
      var
        wu: Integer;
      begin
        wu := length(MN.ListeArcsSortants);
        SetLength(MN.ListeArcsSortants, wu + 1);
        MN.ListeArcsSortants[wu] := Idx;
      end;
      procedure QAddIdxArcEntrant(var MN: TGrapheNoeud; const Idx: TNumeroArc);
      var
        wu: Integer;
      begin
        wu := length(MN.ListeArcsEntrants);
        SetLength(MN.ListeArcsEntrants, wu + 1);
        MN.ListeArcsEntrants[wu] := Idx;
      end;
    begin
      NbNoeuds := GetNbNoeuds();
      NbArcs   := GetNbArcs();
      FAfficherMessage(Format('%s.RecenserLesLiaisons: %d noeuds, %d arcs', [classname, NbNoeuds, NbArcs]));
      if ((0 = NbNoeuds) or (0 = NbArcs)) then exit;
      for N := 0 to NbNoeuds - 1 do
      begin
        MyNoeud  := GetNoeud(N);
     
        for A := 0 to NbArcs - 1 do
        begin
          MyArc := GetArc(A);
          if (N = MyArc.IdxNoeudDepart) then
          begin
            // ajout du successeur
            QAddIdxNdSuccesseur(MyNoeud, MyArc.IdxNoeudArrivee);
            QAddIdxArcSortant(MyNoeud, A);
          end;
          if (N = MyArc.IdxNoeudArrivee) then
          begin
            // ajout du successeur
            QAddIdxNdPredecesseur(MyNoeud, MyArc.IdxNoeudDepart);
            QAddIdxArcEntrant(MyNoeud, A);
          end;
        end;
        PutNoeud(N, MyNoeud);
      end;
     
    end;
     
    function TGraphe.GetNoeudCheminTrouve(const Idx: integer): TGrapheNoeud;
    begin
      Result := FLeCheminTrouve.GetElement(Idx);
    end;
     
    function TGraphe.GetNbNoeudsCheminTrouve(): integer;
    begin
      result := FLeCheminTrouve.GetNbElements();
    end;
     
     
    // Noeud non visité le plus proche
    function TGraphe.RechercherIdxNearestNodeOf(const QCurrNoeud: TGrapheNoeud; out QDistance: double): TNumeroNoeud;
    var
      i : integer;
      NbArcsEntrants, NbArcsSortants: Integer;
      EWE: String;
      QNoeud: TGrapheNoeud;
      QArc: TGrapheArc;
    begin
      FAfficherMessage(Format('RechercherIdxNearestNodeOf( %d )', [QCurrNoeud.IDStation]));
      QDistance := Infinity;
      Result := -1;
      NbArcsEntrants := length(QCurrNoeud.ListeArcsEntrants);
      NbArcsSortants := length(QCurrNoeud.ListeArcsSortants);
      if (0 = (NbArcsEntrants + NbArcsSortants)) then exit(-1);
      if (NbArcsEntrants > 0) then
      begin
        for i := 0 to NbArcsEntrants - 1 do
        begin
          QArc := GetArc(QCurrNoeud.ListeArcsEntrants[i]);
          QNoeud := GetNoeud(QArc.IdxNoeudDepart);
          //FAfficherMessage(Format('-- Arc entrant: %d - L = %.2f, D = %.2f -> %d (%s)', [QCurrNoeud.ListeArcsEntrants[i], QArc.Longueur, QDistance, Result, BoolToStr(FArrayNoeudsVisites[QArc.IdxNoeudDepart], 'X', '')]));
     
          if (FArrayNoeudsVisites[QArc.IdxNoeudDepart]) then Continue;
          if (QArc.Longueur < QDistance) then
          begin
            QDistance  := QArc.Longueur;
            Result := QArc.IdxNoeudDepart;
          end;
        end;
      end;
      if (NbArcsSortants > 0) then
      begin
        for i := 0 to NbArcsSortants - 1 do
        begin
          QArc := GetArc(QCurrNoeud.ListeArcsSortants[i]);
          QNoeud := GetNoeud(QArc.IdxNoeudArrivee);
          //FAfficherMessage(Format('-- Arc entrant: %d - L = %.2f, D = %.2f -> %d (%s)', [QCurrNoeud.ListeArcsEntrants[i], QArc.Longueur, QDistance, Result, BoolToStr(QNoeud.NoeudVisite, 'X', '')]));
          if (FArrayNoeudsVisites[QArc.IdxNoeudArrivee]) then Continue;
          if (QArc.Longueur < QDistance) then
          begin
            QDistance  := QArc.Longueur;
            Result := QArc.IdxNoeudArrivee;
          end;
        end;
      end;
      //FAfficherMessage(Format('*** RechercherIdxNearestNodeOf: %d: %d - Dist = %.2f', [QCurrNoeud.IDStation, Result, QDistance]));
    end;
     
    function TGraphe.RechercherPlusCourtChemin(const Ser1, St1, Ser2, St2: integer): boolean;
    var
      QDistanceMin: Double;
      QNoeudDepart, QNoeudArrivee, QNoeudCourant, QST1, QNoeudSuccesseur: TGrapheNoeud;
      IdxNoeudDepart, IdxNoeudArrivee, QIdxPredecesseur, QIdxNoeudSuccesseur: TNumeroNoeud;
     
      i, QIdxNearestNode, a, NbArcsSortants, NbPasses: integer;
      Q1, Q2: Boolean;
      QArc: TGrapheArc;
      qIdxArc: TNumeroArc;
      QDistance: double;
      (*
      Dijkstra's algorithm: pseudocode
    for all vertices v,
    dist(v) = infinity;
    dist(first) = 0;
    place all vertices in set toBeChecked;
    while toBeChecked is not empty
      {in this version, also stop when shortest path to a specific destination is found}
      select v: min(dist(v)) in toBeChecked;
      remove v from toBeChecked;
      for u in toBeChecked, and path from v to u exists
      {i.e. for unchecked adjacents to v}
      do
        if dist(u) > dist(v) + weight({u,v}),
        then
           dist(u) = dist(v) + weight({u,v});
           set predecessor of u to v
           save minimum distance to u in array "d"
         endif
      enddo
    endwhile
    *)
    begin
      Result := false;
      FNombreNoeudsVisites := 0;
      FLeCheminTrouve.ClearListe();
      SetLastError(0, '');
     
      Q1 := FindNoeudByIDStation(MakeTIDStation(Ser1, St1), QNoeudDepart, IdxNoeudDepart);
      if (Not Q1) then Exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, Format('Noeud "%d.%d" introuvable', [Ser1, St1])));
      Q1 := FindNoeudByIDStation(MakeTIDStation(Ser2, St2), QNoeudArrivee, IdxNoeudArrivee);
      if (Not Q1) then Exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, Format('Noeud "%d.%d" introuvable', [Ser2, St2])));
     
     
      FAfficherMessage(Format('%s.RechercherPlusCourtChemin(): %d: %d.%d -> %d: %d.%d', [ClassName, IdxNoeudDepart, Ser1, St1, IdxNoeudArrivee, Ser2, St2]));
      Q1 := (Ser1 = Ser2) and (St1 = St2);
      if (Q1) then Exit(SetLastError(ERR_GRAPHE_SAME_START_END, '-- Les stations de départ et arrivée sont identiques'));
      QNoeudCourant := QNoeudDepart;
      FNombreNoeudsVisites += 1;                                // et incrémenter le compteur de noeuds visités
      // sécurité: On met les distances minimales à +Inf et le statut Visité à False
      ResetTableauDistancesMin();
      ResetTableauNoeudsVisites();
      ListerLesNoeuds('Après initialisation de la première itération', false);
      NbPasses := 0;
     
      QDistance    := Infinity;
      while (Not NoeudsTousVisites()) do
      begin
        if (NbPasses > 200) then break;
        QIdxNearestNode := RechercherIdxNearestNodeOf(QNoeudCourant, QDistanceMin);    // Noeud non visité de distance minimale
        if (QIdxNearestNode = -1) then
        begin
          FAfficherMessage('Noeud non trouvé') ;
          break;
        end;
        QNoeudCourant := GetNoeud(QIdxNearestNode);
          if (QNoeudCourant.IDStation = QNoeudArrivee.IDStation) then
          begin
            FAfficherMessage(Format('%d == %d', [QNoeudCourant.IDStation , QNoeudArrivee.IDStation]));
            break;
          end;
          FArrayNoeudsVisites[QIdxNearestNode] := True;
          FArrayDistancesMin[QIdxNearestNode] := QDistanceMin;
        PutNoeud(QIdxNearestNode, QNoeudCourant);
        // Pour les arcs sortants
        NbArcsSortants := Length(QNoeudCourant.ListeArcsSortants);
        if (NbArcsSortants > 0) then
        begin
          FAfficherMessage(Format('%d: %d arcs sortants', [QNoeudCourant.IDStation, NbArcsSortants]));
          for a := 0 to NbArcsSortants - 1 do
          begin
            qIdxArc   := QNoeudCourant.ListeArcsSortants[a];
            QArc      := GetArc(qIdxArc);
            QDistance := FArrayDistancesMin[QIdxNearestNode] + QArc.Longueur;   // ???? Incompréhensible dans le corrigé
     
            // On attrappe le successeur
            QIdxNoeudSuccesseur := QArc.IdxNoeudArrivee;
            QNoeudSuccesseur := GetNoeud(QIdxNoeudSuccesseur);
            //FAfficherMessage(Format('+++ Distance actuelle: %f, Distance du successeur: %d: %d: %f', [QDistance, a, QNoeudSuccesseur.IDStation, QNoeudSuccesseur.DistanceMin]));
            if (QDistance < FArrayDistancesMin[QIdxNoeudSuccesseur] + QArc.Longueur) then
            begin
              FArrayDistancesMin[QIdxNoeudSuccesseur] := QDistance;
              FArrayNoeudsVisites[QIdxNoeudSuccesseur] := True;
     
              QArc.IdxNoeudDepart := QIdxNearestNode;
              PutArc(qIdxArc, QArc);
              FAfficherMessage(Format('Changement du noeud courant: %d devient %d', [QNoeudCourant.IDStation, QNoeudSuccesseur.IDStation]));
              QNoeudCourant := QNoeudSuccesseur;
            end;
     
          end;
        end;
        Inc(NbPasses);
        ListerLesNoeuds(Format('Passe %d', [NbPasses]));
        FAfficherGraphe();
        //Sleep(1000);
      end;
     
      FAfficherMessage(Format('%d passes', [NbPasses]));
      //****************************************************************************
      exit;
      // Le chemin
     
    end;
    end.


    La sortie console:
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
     
    Traitement du graphe
    TGraphe.RechercherPlusCourtChemin(): 1: 1.1 -> 9: 2.2
     
    Après initialisation de la première itération
    15 noeuds (0,00, 0,00) -> 550,00, 350,00
     0: 100000: 1.0 0,00, 0,00: 1 arcs entrants, 1 arcs sortants, DistMini: +Inf, Visité: non
     1: 100001: 1.1 10,00, 10,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     2: 100002: 1.2 100,00, 0,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     3: 100003: 1.3 200,00, 0,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     4: 100004: 1.4 300,00, 0,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     5: 100005: 1.5 300,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     6: 100006: 1.6 300,00, 200,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     7: 100007: 1.7 550,00, 350,00: 1 arcs entrants, 1 arcs sortants, DistMini: +Inf, Visité: non
     8: 200001: 2.1 200,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     9: 200002: 2.2 100,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     10: 200003: 2.3 100,00, 200,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     11: 200004: 2.4 26,00, 200,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     12: 300001: 3.1 0,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     13: 400001: 4.1 200,00, 200,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     14: 400002: 4.2 200,00, 250,00: 1 arcs entrants, 1 arcs sortants, DistMini: +Inf, Visité: non
     
    RechercherIdxNearestNodeOf( 100001 )
    100000: 1 arcs sortants
    Changement du noeud courant: 100000 devient 100001
     
    Passe 1
    15 noeuds (0,00, 0,00) -> 550,00, 350,00
     0: 100000: 1.0 0,00, 0,00: 1 arcs entrants, 1 arcs sortants, DistMini: 14,14, Visité: OUI
     1: 100001: 1.1 10,00, 10,00: 3 arcs entrants, 3 arcs sortants, DistMini: 28,28, Visité: OUI
     2: 100002: 1.2 100,00, 0,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     3: 100003: 1.3 200,00, 0,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     4: 100004: 1.4 300,00, 0,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     5: 100005: 1.5 300,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     6: 100006: 1.6 300,00, 200,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     7: 100007: 1.7 550,00, 350,00: 1 arcs entrants, 1 arcs sortants, DistMini: +Inf, Visité: non
     8: 200001: 2.1 200,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     9: 200002: 2.2 100,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     10: 200003: 2.3 100,00, 200,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     11: 200004: 2.4 26,00, 200,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     12: 300001: 3.1 0,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     13: 400001: 4.1 200,00, 200,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     14: 400002: 4.2 200,00, 250,00: 1 arcs entrants, 1 arcs sortants, DistMini: +Inf, Visité: non
     
    RechercherIdxNearestNodeOf( 100001 )
    300001: 2 arcs sortants
    Changement du noeud courant: 300001 devient 200004
     
    Passe 2
    15 noeuds (0,00, 0,00) -> 550,00, 350,00
     0: 100000: 1.0 0,00, 0,00: 1 arcs entrants, 1 arcs sortants, DistMini: 14,14, Visité: OUI
     1: 100001: 1.1 10,00, 10,00: 3 arcs entrants, 3 arcs sortants, DistMini: 28,28, Visité: OUI
     2: 100002: 1.2 100,00, 0,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     3: 100003: 1.3 200,00, 0,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     4: 100004: 1.4 300,00, 0,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     5: 100005: 1.5 300,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     6: 100006: 1.6 300,00, 200,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     7: 100007: 1.7 550,00, 350,00: 1 arcs entrants, 1 arcs sortants, DistMini: +Inf, Visité: non
     8: 200001: 2.1 200,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     9: 200002: 2.2 100,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     10: 200003: 2.3 100,00, 200,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     11: 200004: 2.4 26,00, 200,00: 2 arcs entrants, 2 arcs sortants, DistMini: 193,88, Visité: OUI
     12: 300001: 3.1 0,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: 90,55, Visité: OUI
     13: 400001: 4.1 200,00, 200,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     14: 400002: 4.2 200,00, 250,00: 1 arcs entrants, 1 arcs sortants, DistMini: +Inf, Visité: non
     
    RechercherIdxNearestNodeOf( 200004 )
    200003: 3 arcs sortants
    Changement du noeud courant: 200003 devient 200004
     
    Passe 3
    15 noeuds (0,00, 0,00) -> 550,00, 350,00
     0: 100000: 1.0 0,00, 0,00: 1 arcs entrants, 1 arcs sortants, DistMini: 14,14, Visité: OUI
     1: 100001: 1.1 10,00, 10,00: 3 arcs entrants, 3 arcs sortants, DistMini: 28,28, Visité: OUI
     2: 100002: 1.2 100,00, 0,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     3: 100003: 1.3 200,00, 0,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     4: 100004: 1.4 300,00, 0,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     5: 100005: 1.5 300,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     6: 100006: 1.6 300,00, 200,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     7: 100007: 1.7 550,00, 350,00: 1 arcs entrants, 1 arcs sortants, DistMini: +Inf, Visité: non
     8: 200001: 2.1 200,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     9: 200002: 2.2 100,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     10: 200003: 2.3 100,00, 200,00: 3 arcs entrants, 3 arcs sortants, DistMini: 74,00, Visité: OUI
     11: 200004: 2.4 26,00, 200,00: 2 arcs entrants, 2 arcs sortants, DistMini: 148,00, Visité: OUI
     12: 300001: 3.1 0,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: 90,55, Visité: OUI
     13: 400001: 4.1 200,00, 200,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     14: 400002: 4.2 200,00, 250,00: 1 arcs entrants, 1 arcs sortants, DistMini: +Inf, Visité: non
     
    RechercherIdxNearestNodeOf( 200004 )
    Noeud non trouvé
    3 passes

  6. #6
    Membre expert
    Citation Envoyé par JP CASSOU Voir le message
    Je bloque complètement. De plus, je n'ai plus beaucoup de temps devant moi, et je recherche désormais une solution clé en main, quitte à payer un développeur.
    Citation Envoyé par JP CASSOU Voir le message
    Bjr à vous,

    Je suis encore complètement bloqué sur mes problèmes de graphe.
    Salut, j'ai commencé un petit truc la-dessus, par rapport à ce que je te suggérai. Je trouve le sujet intéressant. Je n'ai pas fini d'implémenter l'algo, mais c'est déja bien avancer. Il faut juste que je connecte les éléments correctement.

    J'ai du temps en début de semaine lundi, mardi. Je regardes et je te tiens au jus.

    En attendant voici 2 liens, qui pourront peut-être t'aider



    La, tout de suite je retourne à ma JAM avec mon projet je suis dans l'ago MinMax pour l'IA et ça bug

    A+

    Bon dimanche

    Jérôme
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

  7. #7
    Expert confirmé
    hello,
    je ne sais pas si cela correspond au type de graphe de cette discussion, mais il existe une bibliothèque d'algorithmes qui contient des algorithmes de recherche de chemin minimal. Voici un exemple de ce qu'elle est capable de faire pour trouver le chemin minimum de 5 à 3 :



    on pourrait penser que le chemin le plus court est 5-4-3 mais le poids est égal à 125 > 115

    Ami calmant, J.P
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  8. #8
    Membre averti
    Intéressant, ton exemple Jurassic Pork, de quelle bibliothèque, tu parles ?
    ----------------------------------------
    Site perso Dergen.fr
    Cartographe officiel du JDR Polaris

  9. #9
    Expert confirmé
    hello,
    il s'agit de la bibliothèque LGenerics de licence Apache 2.0. Attention cette bibliothèque nécessite une version récente de fpc ( >= 3.2) et de Lazarus ( >= 2.0 ) . En particulier pour trouver les chemins les plus courts il y a :
    Single source shortest paths:

    • Dijkstra with pairing heap, A*, Bellman-Ford-Moor with Tarjan's subtree disassembly(BFMT)


    le Lisez-moi :
    Collection of generic algorithms and data structures entirely written in/for FPC and Lazarus. Started as a self-education project, it now seems quite comfortable and fast. In order to use it (FPC 3.2 and higher and Lazarus 1.9.0 and higher):
    • open and compile package lgenerics/LGenerics.lpk.
    • add LGenerics package to project dependencies.


    Implemented primitives:



    • stack(unit LGStack)
    • queue(unit LGQueue)
    • deque(unit LGDeque)
    • vector(unit LGVector)
    • vector of bits(unit LGVector)
    • priority queue based on binary heap(unit LGPriorityQueue)
    • priority queue with key update and melding based on pairing heap(unit LGPriorityQueue)
    • sorted list(unit LGList)
    • hashed list - array based list with the ability to fast search by key(unit LGList)
    • hashset(unit LGHashSet)
    • fine-grained concurrent hashset(unit LGHashSet)
    • sorted set(unit LGTreeSet)
    • set of arbitrary size(unit LGUtil, TGSet)
    • hash multiset(unit LGHashMultiSet)
    • fine-grained concurrent hashmultiset(unit LGHashMultiSet)
    • sorted multiset(unit LGTreeMultiSet)
    • hashmap(unit LGHashMap)
    • fine-grained concurrent hashmap(unit LGHashMap)
    • sorted map(unit LGTreeMap)
    • hash multimap(unit LGMultiMap)
    • tree multimap(unit LGMultiMap)
    • list miltimap(unit LGMultiMap)
    • bijective map(unit LGBiMap)
    • sparse 2D table(unit LGTable2D)
    • disjoint set(unit LGHashSet)
    • AVL tree(unit LGAvlTree)
    • red-black tree(unit LGRbTree)
    • some treap variants(unit LGTreap)
    • general rooted tree(unit LGRootTree)
    • sparse labeled undirected graph(unit LGSimpleGraph)
    • sparse labeled directed graph(unit LGSimpleDigraph)

    features:

    • extended IEnumearble interface - filtering, mapping, etc.
    • lite containers based on advanced records


    Implemented graph features:



    • core functions:
      • vertices/edges addition/removal/query/enumeration, edge contraction, degree
      • load/save to own binary format, primitive export to DOT format

    • connectivity:
      • connected/strongly connected components, bipartite detection, degeneracy, k-core
      • articulation points, bridges, biconnected components
      • edge-connectivity

    • traversals:
      • BFS/DFS traversals with visitors,
      • cycle/negative cycle detection,
      • topological sort

    • operations:
      • induced subgraphs, complement, reverse, union, intersect, symmetric difference,

    • chordality testing
    • planarity testing: FMR Left-Right Planarity algorithm
    • distance within graph:
      • eccentricity, radius, diameter, center, periphery

    • matching:
      • maximum cardinality matching on bipartite/arbitrary graphs
      • minimum/maximum weight matching on bipartite graphs

    • dominators in flowgraps: simple iterative and Semi-NCA algorithms
    • some suggestions for NP-hard problems:
      • maximum independent set, maximal independent sets enumeration
      • maximum clique, cliques enumeration
      • minimum vertex cover, minimal vertex covers enumeration
      • vertex coloring, approximations and exact
      • minimum dominating set
      • Hamiltonian cycles and paths
      • local search TSP approximations, BnB TSP solver

    • minimum spanning trees: Prims's and Kruskal's algorithms
    • single source shortest paths:
      • Dijkstra with pairing heap, A*, Bellman-Ford-Moor with Tarjan's subtree disassembly(BFMT)

    • all pairs shortest paths:
      • Floyd–Warshall, Johnson, BFMT

    • networks:
      • maximum flow: push/relabel, capacity scaling Dinitz
      • minimum-cost flow: Busacker-Gowen, cost scaling push/relabel algorithm
      • global minimum cut: Stoer–Wagner, Nagamochi-Ibaraki



    Algorithms on arrays and vectors(mostly unit LGArrayHelpers):



    • reverse, right/left cyclic shifts
    • permutations
    • binary search
    • N-th order statistics
    • inversion counting
    • distinct values selection
    • quicksort
    • introsort
    • dual pivot quicksort
    • mergesort
    • timsort(unit LGMiscUtils)
    • counting sort
    • translation of Orson Peters' PDQSort algorithm
    • static segment tree
    • ...


    Other:



    • non-cryptogarphic hashes(unit ):
      • Yann Collet's xxHash32, xxHash64
      • Austin Appleby's MurmurHash2, MurmurHash2A, MurmurHash3_x86_32, MurmurHash64A

    • brief and dirty implementation of futures concept(unit LGAsync)
    • brief channel implementation(unit LGAsync)
    • brief implementation of thread pool(unit LGAsync)
    • 128-bit integers(unit LGInt128)

    Ami calmant, J.P
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  10. #10
    Membre averti
    Citation Envoyé par jurassic pork Voir le message
    hello,
    il s'agit de la bibliothèque LGenerics de licence Apache 2.0. Attention cette bibliothèque nécessite une version récente de fpc ( >= 3.2) et de Lazarus ( >= 2.0 ) . En particulier pour trouver les chemins les plus courts il y a :



    le Lisez-moi :


    Ami calmant, J.P
    Merci bcp,
    Je connais cette bibliothèque mais elle nécessite une version récente de FPC,

    Les algos de graphes sont très difficiles à comprendre pour moi, malgré le livre 'Algorithmes de graphes'


    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
     
    // Noeud non visité le plus proche
    function TGraphe.RechercherIdxNearestNodeOf(const QCurrNoeud: TGrapheNoeud; out QDistance: double): TNumeroNoeud;
    var
      i : integer;
      NbArcsEntrants, NbArcsSortants: Integer;
      QArc: TGrapheArc;
    begin
      FAfficherMessage(Format('RechercherIdxNearestNodeOf( %d )', [QCurrNoeud.IDStation]));
      QDistance := Infinity;
      Result    := -1;
      NbArcsEntrants := length(QCurrNoeud.ListeArcsEntrants);
      NbArcsSortants := length(QCurrNoeud.ListeArcsSortants);
      if (0 = (NbArcsEntrants + NbArcsSortants)) then exit(-1);
      if (NbArcsEntrants > 0) then
      begin
        for i := 0 to NbArcsEntrants - 1 do
        begin
          QArc := GetArc(QCurrNoeud.ListeArcsEntrants[i]);
          if (FArrayNoeudsVisites[QArc.IdxNoeudDepart]) then Continue;
          if (QArc.Longueur < QDistance) then
          begin
            QDistance  := QArc.Longueur;
            Result     := QArc.IdxNoeudDepart;
          end;
        end;
      end;
      if (NbArcsSortants > 0) then
      begin
        for i := 0 to NbArcsSortants - 1 do
        begin
          QArc := GetArc(QCurrNoeud.ListeArcsSortants[i]);
          if (FArrayNoeudsVisites[QArc.IdxNoeudArrivee]) then Continue;
          if (QArc.Longueur < QDistance) then
          begin
            QDistance  := QArc.Longueur;
            Result     := QArc.IdxNoeudArrivee;
          end;
        end;
      end;
      if (Result = -1) then
      begin
        FAfficherMessage(Format('*** %d:  Nb arcs entrants: %d, sortants: %d;', [QCurrNoeud.IDStation, NbArcsEntrants, NbArcsSortants]))
      end;
    end;
    function TGraphe.RechercherPlusCourtChemin(const Ser1, St1, Ser2, St2: integer): boolean;
    var
      QDistanceMinNoeudVoisin: Double;  // distance du noeud le plus proche du noeud courant
      QNoeudDepart, QNoeudArrivee, QNoeudCourant, QST1, QNoeudSuccesseur: TGrapheNoeud;
      IdxNoeudDepart, IdxNoeudArrivee, QIdxPredecesseur, QIdxNoeudSuccesseur: TNumeroNoeud;
     
      i, QIdxNoeudCourant, a, NbArcsSortants, NbPasses: integer;
      Q1, Q2: Boolean;
      QArc: TGrapheArc;
      qIdxArc: TNumeroArc;
      QDistance1, QDistance2: double;
    begin
      Result := false;
      FNombreNoeudsVisites := 0;
      FLeCheminTrouve.ClearListe();
      SetLastError(0, '');
      // Recherche des noeuds de départ et d'arrivée
      Q1 := FindNoeudByIDStation(MakeTIDStation(Ser1, St1), QNoeudDepart, IdxNoeudDepart);
      if (Not Q1) then Exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, Format('Noeud "%d.%d" introuvable', [Ser1, St1])));
      Q1 := FindNoeudByIDStation(MakeTIDStation(Ser2, St2), QNoeudArrivee, IdxNoeudArrivee);
      if (Not Q1) then Exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, Format('Noeud "%d.%d" introuvable', [Ser2, St2])));
      FAfficherMessage(Format('%s.RechercherPlusCourtChemin(): %d: %d.%d -> %d: %d.%d', [ClassName, IdxNoeudDepart, Ser1, St1, IdxNoeudArrivee, Ser2, St2]));
      // Stations identiques -->[ ]
      Q1 := (Ser1 = Ser2) and (St1 = St2);
      if (Q1) then Exit(SetLastError(ERR_GRAPHE_SAME_START_END, '-- Les stations de départ et arrivée sont identiques'));
      // sécurité: On met les distances minimales à +Inf et le statut Visité à False
      ResetTableauDistancesMin();
      ResetTableauNoeudsVisites();
     
      // Le noeud courant est le noeud de départ
      QIdxNoeudCourant := IdxNoeudDepart;
      QNoeudCourant    := GetNoeud(QIdxNoeudCourant);
     
      FAfficherMessage(Format('%s.RechercherPlusCourtChemin(): %d: %d.%d -> %d: %d.%d', [ClassName, IdxNoeudDepart, Ser1, St1, IdxNoeudArrivee, Ser2, St2]));
      // La distance du noeud de départ est mise à 0.00
      FArrayDistancesMin[QIdxNoeudCourant] := 0.00;
      // Doit-on marquer 'Visité' le noeud de départ ici ?
      FArrayNoeudsVisites[IdxNoeudDepart] := True;
      // Pour contrôle
      ListerLesNoeuds('Après initialisation de la première itération', false);
     
      NbPasses := 0;
      while (Not NoeudsTousVisites()) do
      begin
        //FAfficherMessage(format('Passe %d - Noeud traité: %d ', []));
        if (NbPasses > 200) then break;  // Butée d'arrêt pour éviter les boucles infinis lors de la mise au point
        // Recherche le noeud non visité le plus proche
        QIdxNoeudCourant := RechercherIdxNearestNodeOf(QNoeudCourant, QDistanceMinNoeudVoisin);    // Noeud non visité de distance minimale
        // Sécurité: On quitte si le noeud n'est pas trouvé (ne devrait jamais se produire)
        if (QIdxNoeudCourant = -1) then
        begin
          exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, 'Noeud non trouvé'));
        end;
        // Si le nouveaud noeud est le noeud d'arrivée, on sort de la boucle
        if (QIdxNoeudCourant = IdxNoeudArrivee) then
        begin
          FAfficherMessage(Format('%d == %d', [QNoeudCourant.IDStation , QNoeudArrivee.IDStation]));
          break;
        end;
        // le noeud courant devient le plus proche qui a été trouvé
        QNoeudCourant := GetNoeud(QIdxNoeudCourant);
        FArrayNoeudsVisites[QIdxNoeudCourant] := True;
         // on met à jour le tableau des distances
        FArrayDistancesMin[QIdxNoeudCourant]  += QDistanceMinNoeudVoisin;
     
        // Pour les arcs sortants
        NbArcsSortants := Length(QNoeudCourant.ListeArcsSortants);
        if (NbArcsSortants > 0) then
        begin
          FAfficherMessage(Format('%d: %d arcs sortants', [QNoeudCourant.IDStation, NbArcsSortants]));
          for a := 0 to NbArcsSortants - 1 do
          begin
            qIdxArc   := QNoeudCourant.ListeArcsSortants[a];
            QArc      := GetArc(qIdxArc);
            // On attrappe le successeur
            QIdxNoeudSuccesseur := QArc.IdxNoeudArrivee;
            QNoeudSuccesseur    := GetNoeud(QIdxNoeudSuccesseur);
            QDistance1 := FArrayDistancesMin[QIdxNoeudCourant]    + QArc.Longueur;
            QDistance2 := FArrayDistancesMin[QIdxNoeudSuccesseur] + QArc.Longueur;
            if (QDistance2 > QDistance1) then
            begin
              FArrayDistancesMin[QIdxNoeudSuccesseur]  := QDistance1;
              FArrayNoeudsVisites[QIdxNoeudSuccesseur] := True;
              // mise à jour du prédécesseur
              QArc.IdxNoeudDepart := QIdxNoeudCourant;
              PutArc(a, QArc);
              FAfficherMessage(Format('Changement du noeud courant: %d devient %d', [QNoeudCourant.IDStation, QNoeudSuccesseur.IDStation]));
              QIdxNoeudCourant := QIdxNoeudSuccesseur;
              QNoeudCourant := GetNoeud(QIdxNoeudCourant);
            end;
          end;
        end;
        Inc(NbPasses);
        // pour contrôle après la passe
        ListerLesNoeuds(Format('Passe %d', [NbPasses]));
        // Afficher le graphe
        FAfficherGraphe();
      end;
      FAfficherMessage(Format('%d passes', [NbPasses]));
      //****************************************************************************
      exit;
      // Le chemin
      //FLeCheminTrouve.ClearListe();
     
      // si le noeud d'arrivée a un prédécesseur:
      FAfficherMessage('Backtracking');
     
      if (Length(QNoeudArrivee.ListeArcsEntrants) > 0) then
      begin
     
        FAfficherMessage(Format('Le noeud %d a un prédécesseur', [QNoeudCourant.IDStation]));
        QNoeudCourant := QNoeudArrivee;
        FLeCheminTrouve.AddElement(QNoeudArrivee);
        NbPasses := 0;
        while (Length(QNoeudCourant.ListeArcsEntrants) > 0) do
        begin
          if (NbPasses > 200) then break;
          FAfficherMessage(Format('Noeud courant: %d', [QNoeudCourant.IDStation]));
          FLeCheminTrouve.InsertElement(0, QNoeudCourant);
          for i := 0 to Length(QNoeudCourant.ListeArcsEntrants) - 1 do
          begin
            QArc := GetArc(QNoeudCourant.ListeArcsEntrants[i]);
            QIdxPredecesseur := QArc.IdxNoeudDepart;
            QST1 := GetNoeud(QIdxPredecesseur);
     
            FAfficherMessage(Format('QNoeudCourant: %d: Arc entrant: %d provenant de %d [%d] - %s',
                             [QNoeudCourant.IDStation,
                              QNoeudCourant.ListeArcsEntrants[i],
                              QIdxPredecesseur, QST1.IDStation,
                              BooltoStr(FArrayNoeudsVisites[QIdxPredecesseur], 'Visité', '--')]));
            if (FArrayNoeudsVisites[QIdxPredecesseur]) then break;
          end;
          if (QNoeudDepart.IDStation = QST1.IDStation) then Break;
          QNoeudCourant := QST1;
          Inc(NbPasses);
        end;
      end;
     
      FAfficherMessage('Parcours terminé');
      //*)
    end;

  11. #11
    Membre averti
    Eléments de cahier des charges pour mon graphe
    Bjr,

    Je n'arrive à rien avec mon fameux problème de chemin minimal.
    La sous-traitance est envisagée: j'ai un congrès dans 15 jours et je dois présenter la méthode qui a été utilisée pour l'établissement du parcours à effectuer par les gendarmes et le GRIMP lors du sauvetage du 09/09/2020 dans les carrières de Citon-Cénac (33)

    Pour les intéressés, voici en guise de CdC:

    Types et fonctions utilitaires
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
     
    unit UnitGraphesTypes;
     
    {$mode delphi}
     
    interface
    uses
      Classes, SysUtils, math;
     
    const MULT_SERIES: integer = 100000;
     
    // messages d'erreur
    const
      ERR_GRAPHE_NO_ERROR         : integer =  0;
      ERR_GRAPHE_INITIALISATION   : integer = -1;
      ERR_GRAPHE_EMPTY_LIST_NODES : integer = -2;
      ERR_GRAPHE_EMPTY_LIST_ARCS  : integer = -3;
     
      ERR_GRAPHE_NODE_NOT_FOUND   : integer = -4;
      ERR_GRAPHE_ARC_NOT_FOUND    : integer = -5;
     
      ERR_GRAPHE_SAME_START_END   : integer = -6;
     
     
    type TProcAfficherMessage = procedure(const Msg: string; const DoClear: boolean = false) of object;
    type TProcOjObject        = procedure of object;
    type TNumeroNoeud = type Integer;
    type TNumeroArc   = type Integer;
    type TIDStation = type Int64;
    type TGrapheNoeud = record
      IDStation: TIDStation;
      X  : double;
      Y  : double;
      Z  : double;
      //DistanceMin : double;
      //NoeudVisite : boolean;
      ListeArcsSortants    : array of TNumeroArc;
      ListeArcsEntrants    : array of TNumeroArc;
      ListeIdxPredecesseurs: array of TNumeroNoeud;
      ListeIdxSuccesseurs  : array of TNumeroNoeud;
     
    end;
    type TGrapheArc = record
      IdxNoeudDepart  : TNumeroNoeud;
      IdxNoeudArrivee : TNumeroNoeud;
      Longueur        : double;
      Azimut          : double;
      Pente           : double;
      Parcouru        : boolean;
    end;
    type TGrapheLastError = record
      ErrCode: integer;
      ErrMsg : string;
    end;
     
    function  MakeTIDStation(const Ser, St: integer): integer;
    procedure ExtractSerStFromTIDStation(const ID: integer; out Ser, St: integer);
     
    // Trier les GrapheStations par ZOrder
    function SortGrapheNoeudsByIDStation(Item1, Item2: Pointer): Integer;
     
    function GetAzimut(const dx, dy: Double; const Unite: double): double;
    procedure GetBearingInc(const dx, dy, dz: double;
                            var Dist, Az, Inc: double;
                            const fUB, fUC: Double);
     
    implementation
    uses
      DummyUnit; // pour contrer l'erreur 'Fin du source non trouvée'
     
    function MakeTIDStation(const Ser, St: integer): integer;
    begin
      Result := Ser * MULT_SERIES + St;
    end;
     
    procedure ExtractSerStFromTIDStation(const ID: integer; out Ser, St: integer);
    begin
      Ser := ID div MULT_SERIES;
      St  := ID mod MULT_SERIES;
    end;
     
    // Trier les GrapheStations par ZOrder
    function SortGrapheNoeudsByIDStation(Item1, Item2: Pointer): Integer;
    var
      E1, E2: ^TGrapheNoeud;
    begin
      E1 := Item1;
      E2 := Item2;
      if      (E1^.IDStation < E2^.IDStation) then Result := -1
      else if (E1^.IDStation = E2^.IDStation) then Result :=  0
      else                                         Result :=  1;
    end;
     
    function GetAzimut(const dx, dy: Double; const Unite: double): double;
    const TWO_PI = 2 * PI;
    var
      a: double;
    begin
      a := ArcTan2(dy, dx + 1e-12);
      if (a < 0) then a := a + TWO_PI;
      a := 0.50 * PI - a;
      if (a < 0) then a := a + TWO_PI;
      Result := a * 0.50 * Unite / pi;
    end;
    // retourne la longueur, direction et pente pour dx, dy, dz
    procedure GetBearingInc(const dx, dy, dz: double;
                            var Dist, Az, Inc: double;
                            const fUB, fUC: Double);
    var
      dp: Double;
    begin;
      dp   := Hypot(dx, dy);
      Dist := Hypot(dp,dz);
      Inc  := ArcTan2(dz, dp) * 0.5 * fUC / pi;
      Az   := GetAzimut(dx,dy, fUB);
    end;
    end.

    Listes simples génériques
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
     
    unit UnitGraphesListesSimples;
     
    {$mode delphi}
     
    interface
     
    uses
      Classes, SysUtils,
      UnitGraphesTypes;
     
    // liste générique (fonctionne très bien)
    type TListeSimple<T> = class(TFPList)
      private
     
     
      public
        procedure ClearListe();
        function  GetNbElements(): integer; inline;
        procedure InsertElement(const Idx: integer; const E: T);
        procedure AddElement(const E: T);  // et Rros Minet
        function  GetElement(const Idx: integer): T; inline;
        procedure PutElement(const Idx: integer; const E: T); inline;
        function  RemoveElement(const Idx: integer): boolean;
        function  RemoveLastElement(): boolean;
     
    end;
    //******************************************************************************
    // liste des noeuds
    type   TGrapheListeDesNoeuds = class(TListeSimple<TGrapheNoeud>)
      private
      public
        procedure TrierParIDStations();
        procedure TrierParDistance();
     
    end;
     
    //******************************************************************************
    // liste des arcs
    type TGrapheListeDesArcs   = class(TListeSimple<TGrapheArc>)
      private
      public
    end;
     
    // liste des noeuds de passage du parcours
    type TGrapheChemin   = class(TListeSimple<TGrapheNoeud>)
      private
      public
    end;
     
    implementation
    uses
      DummyUnit; // pour contrer l'erreur 'Fin du source non trouvée'
     
    procedure TListeSimple<T>.ClearListe();
    var
      i, n: Integer;
    begin
      //AfficherMessage(Format('%s.ClearListe()', [classname]));
      n := self.Count;
      if (n > 0) then
      for i:=Count-1 downto 0 Do
      begin
        if (self.Items[i] <> Nil) then Dispose(self.Items[i]); // Libération
        self.Delete(i);                                        // Suppression de l'élément
      end;
    end;
     
    function TListeSimple<T>.GetNbElements: integer;
    begin
      Result := self.Count;
    end;
     
    procedure  TListeSimple<T>.InsertElement(const Idx: integer; const E: T);
    var pE: ^T;
    begin
      New(pE);
      pE^ := E;
      self.Insert(Idx, pE);
    end;
    procedure TListeSimple<T>.AddElement(const E: T);
    var pE: ^T;
    begin
      New(pE);
      pE^ := E;
      self.Add(pE);
    end;
     
    function TListeSimple<T>.GetElement(const Idx: integer): T;
    begin
      Result := T(Items[Idx]^);
    end;
    procedure TListeSimple<T>.PutElement(const Idx: integer; const E: T);
    begin
      try
        if (Idx < 0) then exit;
        T(Items[Idx]^) := E;
      except
      end;
    end;
     
    function TListeSimple<T>.RemoveElement(const Idx: integer): boolean;
    begin
      Result := False;
      try
        Dispose(self.Items[Idx]);
        self.Delete(Idx);
        Result := True;
      except
      end;
    end;
     
    function TListeSimple<T>.RemoveLastElement(): boolean;
    var
      Nb: Integer;
     
    begin
      Nb := self.Count;
      if (0 = Nb) then Exit(false);
      result := self.RemoveElement(Nb - 1);
    end;
     
    //******************************************************************************
    { TGrapheListeDesNoeuds }
    procedure TGrapheListeDesNoeuds.TrierParIDStations();
    begin
      self.Sort(SortGrapheNoeudsByIDStation);
    end;
     
    procedure TGrapheListeDesNoeuds.TrierParDistance();
    begin
      ;;
    end;
    end.



    Prototype de la classe:
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
     
    type TGraphe = class
      strict private
        FXMini: double;
        FXMaxi: double;
        FYMini: double;
        FYMaxi: double;
        FLastError: TGrapheLastError;
        FArrayDistancesMin: array of double;
        FArrayNoeudsVisites: array of boolean;
        function  RechercherIdxNearestNodeOf(const QCurrNoeud: TGrapheNoeud; out QDistance: double): TNumeroNoeud;
     
     
        function SetLastError(const QErrCode: integer; const QErrMsg: string): boolean;
        procedure ResetTableauDistancesMin();
        procedure ResetTableauNoeudsVisites();
      private
        FListeDesNoeuds            : TGrapheListeDesNoeuds;
        FListeDesArcs              : TGrapheListeDesArcs;
        FLeCheminTrouve            : TGrapheChemin;
        FAfficherMessage           : TProcAfficherMessage;
        FAfficherGraphe            : TProcOjObject;
        FNombreNoeudsVisites       : integer;
        function   FindNoeudByIDStation(const IDS: TIDStation; out ST: TGrapheNoeud; out IndexOf: TNumeroNoeud): boolean;
        procedure  RecenserLesLiaisons();
        procedure  SetMinMax();                // étendue du réseau
        procedure  MakeArcsReciproques();      // complètement du graphe
        function   GetNbNoeudsVisites(): integer;
        function   NoeudsTousVisites(): boolean;
      public
        property  XMini: double read FXMini;
        property  YMini: double read FYMini;
        property  XMaxi: double read FXMaxi;
        property  YMaxi: double read FYMaxi;
        // Les utilitaires
        function  Initialiser(const P: TProcAfficherMessage; const ProcAfficherGraphe: TProcOjObject): boolean;
        procedure Finaliser();
        function  GetLastError(): TGrapheLastError;
        function  FormatterTIDStation(const QId: TIDStation): string;
        procedure ListerLesNoeuds(const Caption: string; const DoDisplayDependances: boolean = false);
        procedure ListerLesArcs(const Caption: string);
        // Les noeuds
        procedure  BeginNodeList();  // initialise la liste des noeuds
        procedure  AddNoeud(const QNoeud: TGrapheNoeud);
        function   GetNoeud(const Idx: integer): TGrapheNoeud;
        procedure  PutNoeud(const Idx: integer; const QNoeud: TGrapheNoeud);
        function   GetNbNoeuds(): integer;
        // QSerie et QStation forment le label du sommet
        procedure  AddStation(const QSerie, QStation: integer; const QX, QY, QZ: double);
        procedure  EndNodesList();  // clôture cette liste et effectue les traitements préparatoires (tris, ...)
        // Les arcs
        procedure  BeginArcsList(); // initialise la liste des arcs
        procedure  AddArc(const QArc: TGrapheArc); overload;
        function   GetArc(const Idx: integer): TGrapheArc;
        procedure  PutArc(const Idx: integer; const QArc: TGrapheArc);
        function   GetNbArcs(): integer;
        // ajoute un arc entre deux noeuds étiquetés 'Ser1.St1' et 'Ser2.St2'
        procedure  AddArcBetweenStations(const Ser1, St1, Ser2, St2: integer); overload;
        procedure  EndArcsList();
        // spécifique stations topo
        function   GetNoeudCheminTrouve(const Idx: integer): TGrapheNoeud;
        function   GetNbNoeudsCheminTrouve(): integer;
        function   RechercherPlusCourtChemin(const Ser1, St1, Ser2, St2: integer): boolean;
        function   NoeudEstVisite(const Idx: TNumeroNoeud): boolean;
    end;


    Utilisation:
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
     
    FGraphe := TGraphe.Create;
      //try
        FGraphe.Initialiser(AfficherMessage, DessinerGraphe);
        FGraphe.BeginNodeList();
          FGraphe.AddStation(1, 0,   0.0,   0.0, 0.0);
          FGraphe.AddStation(1, 1,  10.0, 10.0, 0.0);
     
          FGraphe.AddStation(1, 2, 100.0,   0.0, 0.0);
          FGraphe.AddStation(1, 3, 200.0,   0.0, 0.0);
          FGraphe.AddStation(1, 4, 300.0,   0.0, 0.0);
          FGraphe.AddStation(1, 5, 300.0, 100.0, 0.0);
          FGraphe.AddStation(1, 6, 300.0, 200.0, 0.0);
          FGraphe.AddStation(1, 7, 550.0, 350.0, 0.0);
          FGraphe.AddStation(2, 1, 200.0, 100.0, 0.0);
          FGraphe.AddStation(2, 2, 100.0, 100.0, 0.0);
          FGraphe.AddStation(2, 3, 100.0, 200.0, 0.0);
          FGraphe.AddStation(2, 4,   26.0, 200.0, 0.0);
          FGraphe.AddStation(3, 1,   0.0, 100.0, 0.0);
          FGraphe.AddStation(4, 1, 200.0, 200.0, 0.0);
          FGraphe.AddStation(4, 2, 200.0, 250.0, 0.0);
        FGraphe.EndNodesList();
        if (MiouMiou('Noeuds')) then exit;
        Nb := FGraphe.GetNbNoeuds();
        AfficherMessage(Format('%d noeuds', [Nb]));
        AfficherMessage('');
        FGraphe.BeginArcsList();
          FGraphe.AddArcBetweenStations(1,0, 1,1);
          FGraphe.AddArcBetweenStations(1,1, 1,2);
          FGraphe.AddArcBetweenStations(1,2, 1,3);
     
          FGraphe.AddArcBetweenStations(1,3, 1,4);
          FGraphe.AddArcBetweenStations(1,4, 1,5);
          FGraphe.AddArcBetweenStations(1,5, 1,6);
     
          FGraphe.AddArcBetweenStations(1,6, 1,7);
     
          FGraphe.AddArcBetweenStations(1,3, 2,1);
          FGraphe.AddArcBetweenStations(2,1, 2,2);
          FGraphe.AddArcBetweenStations(2,2, 2,3);
          FGraphe.AddArcBetweenStations(2,3, 2,4);
     
          FGraphe.AddArcBetweenStations(2,4, 3,1);
          FGraphe.AddArcBetweenStations(3,1, 1,1);
     
          FGraphe.AddArcBetweenStations(2,3, 4,1);
          FGraphe.AddArcBetweenStations(1,6, 4,1);
          FGraphe.AddArcBetweenStations(4,1, 4,2);
     
     
        FGraphe.EndArcsList();
         if (MiouMiou('Arcs')) then exit;
     
        FGraphe.ListerLesNoeuds('Graphe initial', True);
        FGraphe.ListerLesArcs('Graphe initial');
        DessinerGraphe();


    Unité Graphes1 actualisée
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    427
    428
    429
    430
    431
    432
    433
    434
    435
    436
    437
    438
    439
    440
    441
    442
    443
    444
    445
    446
    447
    448
    449
    450
    451
    452
    453
    454
    455
    456
    457
    458
    459
    460
    461
    462
    463
    464
    465
    466
    467
    468
    469
    470
    471
    472
    473
    474
    475
    476
    477
    478
    479
    480
    481
    482
    483
    484
    485
    486
    487
    488
    489
    490
    491
    492
    493
    494
    495
    496
    497
    498
    499
    500
    501
    502
    503
    504
    505
    506
    507
    508
    509
    510
    511
    512
    513
    514
    515
    516
    517
    518
    519
    520
    521
    522
    523
    524
    525
    526
    527
    528
    529
    530
    531
    532
    533
    534
    535
    536
    537
    538
    539
    540
    541
    542
    543
    544
    545
    546
    547
    548
    549
    550
    551
    552
    553
    554
    555
    556
    557
    558
    559
    560
    561
    562
    563
    564
    565
    566
    567
    568
    569
    570
    571
    572
    573
    574
    575
    576
    577
    578
    579
    580
    581
    582
    583
    584
    585
    586
    587
    588
    589
    590
    591
    592
    593
    594
    595
    596
    597
    598
    599
    600
    601
    602
    603
    604
    605
    606
    607
    608
    609
    610
    611
    612
    613
    614
    615
    616
    617
    618
    619
    620
    621
    622
    623
    624
    625
    626
    627
    628
    629
    630
    631
    632
    633
    634
    635
    636
    637
    638
    639
    640
    641
    642
    643
    644
    645
    646
    647
    648
    649
    650
    651
    652
    653
    654
    655
    656
    657
    658
    659
    660
    661
    662
    663
    664
    665
    666
    667
    668
    669
    670
    671
    672
    673
    674
    675
    676
    677
    678
    679
    680
    681
    682
    683
    684
    685
    686
    687
    688
    689
    690
    691
    692
    693
    694
    695
    696
    697
    698
    699
    700
    701
    702
    703
    704
    705
    706
    707
    708
    709
    710
    711
     
    unit UnitGraphes1;
    // Calcul du chemin minimal dans un réseau GHTopo
    {$WARNING: A exécuter sans débogage}
    {$mode delphi}
    interface
    uses
      Classes, SysUtils, math,
      UnitGraphesTypes,
      UnitGraphesListesSimples;
    type TGraphe = class
      strict private
        FXMini: double;
        FXMaxi: double;
        FYMini: double;
        FYMaxi: double;
        FLastError: TGrapheLastError;
        FArrayDistancesMin: array of double;
        FArrayNoeudsVisites: array of boolean;
        function  RechercherIdxNearestNodeOf(const QCurrNoeud: TGrapheNoeud; out QDistance: double): TNumeroNoeud;
     
     
        function SetLastError(const QErrCode: integer; const QErrMsg: string): boolean;
        procedure ResetTableauDistancesMin();
        procedure ResetTableauNoeudsVisites();
      private
        FListeDesNoeuds            : TGrapheListeDesNoeuds;
        FListeDesArcs              : TGrapheListeDesArcs;
        FLeCheminTrouve            : TGrapheChemin;
        FAfficherMessage           : TProcAfficherMessage;
        FAfficherGraphe            : TProcOjObject;
        FNombreNoeudsVisites       : integer;
        function   FindNoeudByIDStation(const IDS: TIDStation; out ST: TGrapheNoeud; out IndexOf: TNumeroNoeud): boolean;
        procedure  RecenserLesLiaisons();
        procedure  SetMinMax();                // étendue du réseau
        procedure  MakeArcsReciproques();      // complètement du graphe
        function   GetNbNoeudsVisites(): integer;
        function   NoeudsTousVisites(): boolean;
      public
        property  XMini: double read FXMini;
        property  YMini: double read FYMini;
        property  XMaxi: double read FXMaxi;
        property  YMaxi: double read FYMaxi;
        // Les utilitaires
        function  Initialiser(const P: TProcAfficherMessage; const ProcAfficherGraphe: TProcOjObject): boolean;
        procedure Finaliser();
        function  GetLastError(): TGrapheLastError;
        function  FormatterTIDStation(const QId: TIDStation): string;
        procedure ListerLesNoeuds(const Caption: string; const DoDisplayDependances: boolean = false);
        procedure ListerLesArcs(const Caption: string);
        // Les noeuds
        procedure  BeginNodeList();  // initialise la liste des noeuds
        procedure  AddNoeud(const QNoeud: TGrapheNoeud);
        function   GetNoeud(const Idx: integer): TGrapheNoeud;
        procedure  PutNoeud(const Idx: integer; const QNoeud: TGrapheNoeud);
        function   GetNbNoeuds(): integer;
        // QSerie et QStation forment le label du sommet au format '%d.%d'
        procedure  AddStation(const QSerie, QStation: integer; const QX, QY, QZ: double);
        procedure  EndNodesList();  // clôture cette liste et effectue les traitements préparatoires (tris, ...)
        // Les arcs
        procedure  BeginArcsList(); // initialise la liste des arcs
        procedure  AddArc(const QArc: TGrapheArc); overload;
        function   GetArc(const Idx: integer): TGrapheArc;
        procedure  PutArc(const Idx: integer; const QArc: TGrapheArc);
        function   GetNbArcs(): integer;
        // ajoute un arc entre deux noeuds étiquetés 'Ser1.St1' et 'Ser2.St2'
        procedure  AddArcBetweenStations(const Ser1, St1, Ser2, St2: integer); overload;
        procedure  EndArcsList();
        // spécifique stations topo
        function   GetNoeudCheminTrouve(const Idx: integer): TGrapheNoeud;
        function   GetNbNoeudsCheminTrouve(): integer;
        function   RechercherPlusCourtChemin(const Ser1, St1, Ser2, St2: integer): boolean;
        function   NoeudEstVisite(const Idx: TNumeroNoeud): boolean;
    end;
     
     
    implementation
    uses
      DummyUnit; // pour contrer l'erreur 'Fin du source non trouvée'
    //******************************************************************************
    { TGraphe }
    function TGraphe.Initialiser(const P: TProcAfficherMessage;  const ProcAfficherGraphe: TProcOjObject): boolean;
    begin
      result := false;
      SetLastError(ERR_GRAPHE_NO_ERROR, '');
      FNombreNoeudsVisites      := 0;
      FAfficherMessage          := P;
      FAfficherGraphe           := ProcAfficherGraphe;
      FListeDesNoeuds           := TGrapheListeDesNoeuds.Create;
      FListeDesArcs             := TGrapheListeDesArcs.Create;
      FLeCheminTrouve           := TGrapheChemin.Create;
      try
        FListeDesNoeuds.ClearListe();
        FListeDesArcs.ClearListe();
        FLeCheminTrouve.ClearListe();
        Result := True;
        SetLastError(ERR_GRAPHE_NO_ERROR, '');
        SetLength(FArrayDistancesMin, 0);
        SetLength(FArrayNoeudsVisites, 0);
        FAfficherMessage('Initialisation du graphe', True);
      except
        SetLastError(-1, 'Erreur d''initialisation');
      end;
    end;
     
    procedure TGraphe.Finaliser();
    begin
      try
        FListeDesNoeuds.ClearListe();
        FListeDesArcs.ClearListe();
        FLeCheminTrouve.ClearListe();
      finally
        FreeAndNil(FListeDesArcs);
        FreeAndNil(FListeDesNoeuds);
        FreeAndNil(FLeCheminTrouve);
      end;
    end;
     
    // Les utilitaires
    function TGraphe.SetLastError(const QErrCode: integer; const QErrMsg: string): boolean;
    begin
      FLastError.ErrCode := QErrCode;
      FLastError.ErrMsg  := QErrMsg;
      result := (FLastError.ErrCode <> ERR_GRAPHE_NO_ERROR);
    end;
     
    procedure TGraphe.ResetTableauDistancesMin();
    var
      i, n: Integer;
    begin
      n := GetNbNoeuds();
      SetLength(FArrayDistancesMin, n);
      if (n > 0) then
        for i := 0 to N - 1 do FArrayDistancesMin[i] := Infinity;
    end;
     
     
    procedure TGraphe.ResetTableauNoeudsVisites();
    var
      i, n: Integer;
    begin
      n := GetNbNoeuds();
      SetLength(FArrayNoeudsVisites, n);
      if (n > 0) then
        for i := 0 to N - 1 do FArrayNoeudsVisites[i] := false;
    end;
     
    function TGraphe.NoeudEstVisite(const Idx: TNumeroNoeud): boolean;
    begin
      Result := FArrayNoeudsVisites[Idx];
    end;
     
    function  TGraphe.GetLastError(): TGrapheLastError;
    begin
      result := FLastError;
    end;
    function TGraphe.FormatterTIDStation(const QId: TIDStation): string;
    var
      Qser, QSt: integer;
    begin
      ExtractSerStFromTIDStation(QId, Qser, QSt);
      result := format('%d.%d', [Qser, QSt]);
    end;
    procedure TGraphe.SetMinMax();
    var
      Nb, i: Integer;
      MyNoeud: TGrapheNoeud;
    begin
      FXMini :=  Infinity;
      FYMini :=  Infinity;
      FXMaxi := -Infinity;
      FYMaxi := -Infinity;
      Nb := GetNbNoeuds();
      for i := 0 to Nb -1 do
      begin
        MyNoeud := GetNoeud(i);
        FXMaxi := Max(FXMaxi, MyNoeud.X);
        FYMaxi := Max(FYMaxi, MyNoeud.Y);
        FXMini := Min(FXMini, MyNoeud.X);
        FYMini := Min(FYMini, MyNoeud.Y);
      end;
    end;
    procedure TGraphe.ListerLesNoeuds(const Caption: string; const DoDisplayDependances: boolean = false);
    var
      Nb, i, s, QSr, QSt: Integer;
      QNbArcsEntrants, QNbArcsSortants: integer;
      MyStation, ST1, ST2: TGrapheNoeud;
      QArc: TGrapheArc;
    begin
      Nb := self.GetNbNoeuds();
      FAfficherMessage('');
      FAfficherMessage(Caption);
      FAfficherMessage(Format('%d noeuds (%f, %f) -> %f, %f', [Nb, self.XMini, self.YMini, self.XMaxi, self.YMaxi]));
      for i := 0 to Nb - 1 do
      begin
        MyStation := self.GetNoeud(i);
        ExtractSerStFromTIDStation(MyStation.IDStation, QSr, QSt);
        QNbArcsEntrants := Length(MyStation.ListeArcsEntrants);
        QNbArcsSortants := Length(MyStation.ListeArcsEntrants);
     
        FAfficherMessage(Format(' %d: %d: %d.%d %f, %f: %d arcs entrants, %d arcs sortants, DistMini: %.2f, Visité: %s',
                        [i, MyStation.IDStation, QSr, QSt, MyStation.X, MyStation.Y,
                         QNbArcsEntrants, QNbArcsSortants,
                         FArrayDistancesMin[i], BoolToStr(FArrayNoeudsVisites[i], 'OUI', 'non')]));
        if (DoDisplayDependances) then
        begin
          FAfficherMessage('Arcs entrants:');
          if (QNbArcsEntrants > 0) then
          begin
            for s := 0 to QNbArcsEntrants - 1 do
            begin
              QArc := self.GetArc(Abs(MyStation.ListeArcsEntrants[s]));
              ST1  := self.GetNoeud(QArc.IdxNoeudDepart);
              ST2  := self.GetNoeud(QArc.IdxNoeudArrivee);
              FAfficherMessage(Format('---- %06d: %06d [%s] -> %06d [%s]',
                               [MyStation.ListeArcsEntrants[s],
                                QArc.IdxNoeudDepart , self.FormatterTIDStation(ST1.IDStation),
                                QArc.IdxNoeudArrivee, self.FormatterTIDStation(ST2.IDStation)]));
            end;
          end;
          FAfficherMessage('Arcs sortants:');
          if (QNbArcsSortants > 0) then
          begin
            for s := 0 to QNbArcsSortants - 1 do
            begin
              QArc := self.GetArc(Abs(MyStation.ListeArcsSortants[s]));
              ST1  := self.GetNoeud(QArc.IdxNoeudDepart);
              ST2  := self.GetNoeud(QArc.IdxNoeudArrivee);
              FAfficherMessage(Format('---- %06d: %06d [%s] -> %06d [%s]',
                               [MyStation.ListeArcsSortants[s],
                                QArc.IdxNoeudDepart , self.FormatterTIDStation(ST1.IDStation),
                                QArc.IdxNoeudArrivee, self.FormatterTIDStation(ST2.IDStation)]));
            end;
          end;
        end;
      end;
      FAfficherMessage('');
    end;
     
    procedure TGraphe.ListerLesArcs(const Caption: string);
    var
      i, Nb: Integer;
      MyVisee: TGrapheArc;
      MyStationArr, MyStationDep: TGrapheNoeud;
    begin
      Nb := self.GetNbArcs();
      FAfficherMessage('');
      FAfficherMessage(Caption);
      FAfficherMessage(Format('%d arcs', [Nb]));
     
      for i := 0 to Nb - 1 do
      begin
        MyVisee := self.GetArc(i);
        MyStationDep := self.GetNoeud(MyVisee.IdxNoeudDepart);
        MyStationArr := self.GetNoeud(MyVisee.IdxNoeudArrivee);
     
        FAfficherMessage(Format(' %d: Nd%d [%s] -> Nd%d [%s]: L = %.3f m, Az: %.2f, P: %.2f', [i, MyVisee.IdxNoeudDepart , self.FormatterTIDStation(MyStationDep.IDStation),
                                                                              MyVisee.IdxNoeudArrivee, self.FormatterTIDStation(MyStationArr.IDStation),
                                                                              MyVisee.Longueur, MyVisee.Azimut, MyVisee.Pente]));
      end;
      FAfficherMessage('');
    end;
     
    // Les noeuds
    procedure TGraphe.BeginNodeList();
    begin
      FListeDesNoeuds.ClearListe();
    end;
    procedure TGraphe.AddNoeud(const QNoeud: TGrapheNoeud);
    var
      EWE: TGrapheNoeud;
    begin
      EWE := QNoeud;
      Setlength(EWE.ListeArcsSortants, 0);
      Setlength(EWE.ListeArcsEntrants, 0);
      Setlength(EWE.ListeIdxPredecesseurs, 0);
      Setlength(EWE.ListeIdxSuccesseurs, 0);
      FListeDesNoeuds.AddElement(EWE);
    end;
     
    function TGraphe.GetNoeud(const Idx: integer): TGrapheNoeud;
    begin
      Result := FListeDesNoeuds.GetElement(Idx);
    end;
     
    procedure TGraphe.PutNoeud(const Idx: integer; const QNoeud: TGrapheNoeud);
    begin
      FListeDesNoeuds.PutElement(Idx, QNoeud);
    end;
    function TGraphe.GetNbNoeuds(): integer;
    begin
      Result := FListeDesNoeuds.GetNbElements();
    end;
     
    procedure TGraphe.AddStation(const QSerie, QStation: integer; const QX, QY, QZ: double);
    var
      ST: TGrapheNoeud;
    begin
      ST.IDStation := MakeTIDStation(QSerie, QStation);
      ST.X := QX;
      ST.Y := QY;
      ST.Z := QZ;
      AddNoeud(ST);
    end;
     
    procedure TGraphe.EndNodesList();
    var
      i, Nb: Integer;
    begin
      Nb := GetNbNoeuds();
      if (Nb > 0) then
      begin
        FListeDesNoeuds.TrierParIDStations();
        ResetTableauNoeudsVisites();
        ResetTableauDistancesMin();
        SetMinMax();
        SetLastError(ERR_GRAPHE_NO_ERROR, '');
      end
      else
        SetLastError(ERR_GRAPHE_EMPTY_LIST_NODES, 'La liste des noeuds est vide');
    end;
    function TGraphe.FindNoeudByIDStation(const IDS: TIDStation; out ST: TGrapheNoeud; out IndexOf: TNumeroNoeud): boolean;
      function FindDepth(const I1, I2: TNumeroNoeud; const QIDX: TIDStation): TNumeroNoeud;
      var
        PVT: integer;
        C1 : TGrapheNoeud;
      begin
        Result := -1;
        // coupure en deux => calcul index médian
        PVT := (I2 + I1) div 2;
        // début > fin >> sortie directe avec erreur
        if (I1 > I2) then Exit(-1);
        C1 := GetNoeud(PVT); //GetBasePoint(PVT);
        // comparaison. Si vrai >> sortie avec numéro d'index
        if (C1.IDStation = QIDX) then Exit(PVT);
        // sinon, recherche en profondeur avec un niveau supplémentaire
        if (QIDX < C1.IDStation) then
        begin
          Result := FindDepth(I1, PVT-1, QIDX);
          Exit;
        end;
        Result := FindDepth(PVT+1, I2, QIDX);
      end;
    begin
      Result := false;
      IndexOf := FindDepth(0, GetNbNoeuds() - 1, IDS);
      if (IndexOf >= 0) then
      begin
        ST     := GetNoeud(IndexOf);
        Exit(True);
      end;
    end;
    function TGraphe.GetNbNoeudsVisites(): integer;
    var
      i, n: Integer;
      Nd: TGrapheNoeud;
    begin
      Result := 0;
      n := Length(FArrayNoeudsVisites);
      if (n = 0) then exit;
      for i := 0 to n - 1 do
        if (FArrayNoeudsVisites[i]) then Result += 1;
    end;
     
     
    function TGraphe.NoeudsTousVisites(): boolean;
    begin
      Result := (GetNbNoeuds() = FNombreNoeudsVisites);
    end;
     
    // Les arcs
    procedure TGraphe.BeginArcsList();
    begin
      FListeDesArcs.ClearListe();
    end;
     
    procedure TGraphe.AddArc(const QArc: TGrapheArc);
    begin
      FListeDesArcs.AddElement(QArc);
    end;
    function TGraphe.GetArc(const Idx: integer): TGrapheArc;
    begin
      Result := FListeDesArcs.GetElement(Idx);
    end;
     
    procedure TGraphe.PutArc(const Idx: integer; const QArc: TGrapheArc);
    begin
      FListeDesArcs.PutElement(Idx, QArc);
    end;
     
    function TGraphe.GetNbArcs(): integer;
    begin
       Result := FListeDesArcs.GetNbElements;
    end;
     
     
    procedure TGraphe.EndArcsList();
    var
      Nb: Integer;
    begin
      Nb := GetNbArcs();
      if (Nb > 0) then
      begin
        MakeArcsReciproques();
        RecenserLesLiaisons();
        SetLastError(ERR_GRAPHE_NO_ERROR, '');
      end
      else
        SetLastError(ERR_GRAPHE_EMPTY_LIST_ARCS, 'La liste des arcs est vide');
    end;
     
    procedure TGraphe.AddArcBetweenStations(const Ser1, St1, Ser2, St2: integer);
    var
      MyArc: TGrapheArc;
      BS1, BS2: TGrapheNoeud;
    begin
      FindNoeudByIDStation(MakeTIDStation(Ser1, St1), BS1, MyArc.IdxNoeudDepart);
      FindNoeudByIDStation(MakeTIDStation(Ser2, St2), BS2, MyArc.IdxNoeudArrivee);
      GetBearingInc(BS2.X - BS1.X, BS2.Y - BS1.Y, BS2.Z - BS1.Z, MyArc.Longueur, MyArc.Azimut, MyArc.Pente, 360.00, 360.00);
      self.AddArc(MyArc);
    end;
    // les galeries étant à double sens et le graphe orienté, construire les arcs opposés
    procedure TGraphe.MakeArcsReciproques();
    var
      i, Nb: Integer;
      MyArcIn, MyArcOut: TGrapheArc;
      QSt1, QSt2: TGrapheNoeud;
    begin
      Nb := GetNbArcs();
      for i := 0 to Nb - 1 do
      begin
        MyArcIn  := getArc(i);
        MyArcOut.Parcouru        := MyArcIn.Parcouru;
        MyArcOut.IdxNoeudDepart  := MyArcIn.IdxNoeudArrivee;
        MyArcOut.IdxNoeudArrivee := MyArcIn.IdxNoeudDepart;
        QSt1 := GetNoeud(MyArcOut.IdxNoeudDepart);
        QSt2 := GetNoeud(MyArcOut.IdxNoeudArrivee);
        GetBearingInc(QSt2.X - QSt1.X, QSt2.Y - QSt1.Y, QSt2.Z - QSt1.Z, MyArcOut.Longueur, MyArcOut.Azimut, MyArcOut.Pente, 360.00, 360.00);
        AddArc(MyArcOut);
      end;
    end;
     
     
     
     
    //******************************************************************************
    // Les fonctions de calcul
    procedure TGraphe.RecenserLesLiaisons();
    var
      NbNoeuds, NbArcs, N, A, nv: integer;
      MyNoeud: TGrapheNoeud;
      MyArc: TGrapheArc;
      procedure QAddIdxNdSuccesseur(var MN: TGrapheNoeud; const Idx: TNumeroNoeud);
      var
        wu: Integer;
      begin
        wu := length(MN.ListeIdxSuccesseurs);
        SetLength(MN.ListeIdxSuccesseurs, wu + 1);
        MN.ListeIdxSuccesseurs[wu] := Idx;
      end;
      procedure QAddIdxNdPredecesseur(var MN: TGrapheNoeud; const Idx: TNumeroNoeud);
      var
        wu: Integer;
      begin
        wu := length(MN.ListeIdxPredecesseurs);
        SetLength(MN.ListeIdxPredecesseurs, wu + 1);
        MN.ListeIdxPredecesseurs[wu] := Idx;
      end;
      procedure QAddIdxArcSortant(var MN: TGrapheNoeud; const Idx: TNumeroArc);
      var
        wu: Integer;
      begin
        wu := length(MN.ListeArcsSortants);
        SetLength(MN.ListeArcsSortants, wu + 1);
        MN.ListeArcsSortants[wu] := Idx;
      end;
      procedure QAddIdxArcEntrant(var MN: TGrapheNoeud; const Idx: TNumeroArc);
      var
        wu: Integer;
      begin
        wu := length(MN.ListeArcsEntrants);
        SetLength(MN.ListeArcsEntrants, wu + 1);
        MN.ListeArcsEntrants[wu] := Idx;
      end;
    begin
      NbNoeuds := GetNbNoeuds();
      NbArcs   := GetNbArcs();
      FAfficherMessage(Format('%s.RecenserLesLiaisons: %d noeuds, %d arcs', [classname, NbNoeuds, NbArcs]));
      if ((0 = NbNoeuds) or (0 = NbArcs)) then exit;
      for N := 0 to NbNoeuds - 1 do
      begin
        MyNoeud  := GetNoeud(N);
     
        for A := 0 to NbArcs - 1 do
        begin
          MyArc := GetArc(A);
          if (N = MyArc.IdxNoeudDepart) then
          begin
            // ajout du successeur
            QAddIdxNdSuccesseur(MyNoeud, MyArc.IdxNoeudArrivee);
            QAddIdxArcSortant(MyNoeud, A);
          end;
          if (N = MyArc.IdxNoeudArrivee) then
          begin
            // ajout du successeur
            QAddIdxNdPredecesseur(MyNoeud, MyArc.IdxNoeudDepart);
            QAddIdxArcEntrant(MyNoeud, A);
          end;
        end;
        PutNoeud(N, MyNoeud);
      end;
     
    end;
     
    function TGraphe.GetNoeudCheminTrouve(const Idx: integer): TGrapheNoeud;
    begin
      Result := FLeCheminTrouve.GetElement(Idx);
    end;
     
    function TGraphe.GetNbNoeudsCheminTrouve(): integer;
    begin
      result := FLeCheminTrouve.GetNbElements();
    end;
     
     
    // Noeud non visité le plus proche
    function TGraphe.RechercherIdxNearestNodeOf(const QCurrNoeud: TGrapheNoeud; out QDistance: double): TNumeroNoeud;
    var
      i : integer;
      NbArcsEntrants, NbArcsSortants: Integer;
      QArc: TGrapheArc;
    begin
      FAfficherMessage(Format('RechercherIdxNearestNodeOf( %d )', [QCurrNoeud.IDStation]));
      QDistance := Infinity;
      Result    := -1;
      NbArcsEntrants := length(QCurrNoeud.ListeArcsEntrants);
      NbArcsSortants := length(QCurrNoeud.ListeArcsSortants);
      if (0 = (NbArcsEntrants + NbArcsSortants)) then exit(-1);
      if (NbArcsEntrants > 0) then
      begin
        for i := 0 to NbArcsEntrants - 1 do
        begin
          QArc := GetArc(QCurrNoeud.ListeArcsEntrants[i]);
          if (FArrayNoeudsVisites[QArc.IdxNoeudDepart]) then Continue;
          if (QArc.Longueur < QDistance) then
          begin
            QDistance  := QArc.Longueur;
            Result     := QArc.IdxNoeudDepart;
          end;
        end;
      end;
      if (NbArcsSortants > 0) then
      begin
        for i := 0 to NbArcsSortants - 1 do
        begin
          QArc := GetArc(QCurrNoeud.ListeArcsSortants[i]);
          if (FArrayNoeudsVisites[QArc.IdxNoeudArrivee]) then Continue;
          if (QArc.Longueur < QDistance) then
          begin
            QDistance  := QArc.Longueur;
            Result     := QArc.IdxNoeudArrivee;
          end;
        end;
      end;
      if (Result = -1) then
      begin
        FAfficherMessage(Format('*** %d:  Nb arcs entrants: %d, sortants: %d;', [QCurrNoeud.IDStation, NbArcsEntrants, NbArcsSortants]))
      end;
    end;
     
    function TGraphe.RechercherPlusCourtChemin(const Ser1, St1, Ser2, St2: integer): boolean;
    var
      QDistanceMinNoeudVoisin: Double;  // distance du noeud le plus proche du noeud courant
      QNoeudDepart, QNoeudArrivee, QNoeudCourant, QST1, QNoeudSuccesseur: TGrapheNoeud;
      IdxNoeudDepart, IdxNoeudArrivee, QIdxPredecesseur, QIdxNoeudSuccesseur: TNumeroNoeud;
     
      i, QIdxNoeudCourant, a, NbArcsSortants, NbPasses: integer;
      Q1, Q2: Boolean;
      QArc: TGrapheArc;
      qIdxArc: TNumeroArc;
      QDistance1, QDistance2: double;
    begin
      Result := false;
      FNombreNoeudsVisites := 0;
      FLeCheminTrouve.ClearListe();
      SetLastError(0, '');
      // Recherche des noeuds de départ et d'arrivée
      Q1 := FindNoeudByIDStation(MakeTIDStation(Ser1, St1), QNoeudDepart, IdxNoeudDepart);
      if (Not Q1) then Exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, Format('Noeud "%d.%d" introuvable', [Ser1, St1])));
      Q1 := FindNoeudByIDStation(MakeTIDStation(Ser2, St2), QNoeudArrivee, IdxNoeudArrivee);
      if (Not Q1) then Exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, Format('Noeud "%d.%d" introuvable', [Ser2, St2])));
      FAfficherMessage(Format('%s.RechercherPlusCourtChemin(): %d: %d.%d -> %d: %d.%d', [ClassName, IdxNoeudDepart, Ser1, St1, IdxNoeudArrivee, Ser2, St2]));
      // Stations identiques -->[ ]
      Q1 := (Ser1 = Ser2) and (St1 = St2);
      if (Q1) then Exit(SetLastError(ERR_GRAPHE_SAME_START_END, '-- Les stations de départ et arrivée sont identiques'));
      // sécurité: On met les distances minimales à +Inf et le statut Visité à False
      ResetTableauDistancesMin();
      ResetTableauNoeudsVisites();
     
      // Le noeud courant est le noeud de départ
      QIdxNoeudCourant := IdxNoeudDepart;
      QNoeudCourant    := GetNoeud(QIdxNoeudCourant);
     
      FAfficherMessage(Format('%s.RechercherPlusCourtChemin(): %d: %d.%d -> %d: %d.%d', [ClassName, IdxNoeudDepart, Ser1, St1, IdxNoeudArrivee, Ser2, St2]));
      // La distance du noeud de départ est mise à 0.00
      FArrayDistancesMin[QIdxNoeudCourant] := 0.00;
      // Doit-on marquer 'Visité' le noeud de départ ici ?
      FArrayNoeudsVisites[IdxNoeudDepart] := True;
      // Pour contrôle
      ListerLesNoeuds('Après initialisation de la première itération', false);
     
      NbPasses := 0;
      while (Not NoeudsTousVisites()) do
      begin
        //FAfficherMessage(format('Passe %d - Noeud traité: %d ', []));
        if (NbPasses > 200) then break;  // Butée d'arrêt pour éviter les boucles infinis lors de la mise au point
        // Recherche le noeud non visité le plus proche
        QIdxNoeudCourant := RechercherIdxNearestNodeOf(QNoeudCourant, QDistanceMinNoeudVoisin);    // Noeud non visité de distance minimale
        // Sécurité: On quitte si le noeud n'est pas trouvé (ne devrait jamais se produire)
        if (QIdxNoeudCourant = -1) then
        begin
          exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, 'Noeud non trouvé'));
        end;
        // Si le nouveaud noeud est le noeud d'arrivée, on sort de la boucle
        if (QIdxNoeudCourant = IdxNoeudArrivee) then
        begin
          FAfficherMessage(Format('%d == %d', [QNoeudCourant.IDStation , QNoeudArrivee.IDStation]));
          break;
        end;
        // le noeud courant devient le plus proche qui a été trouvé
        QNoeudCourant := GetNoeud(QIdxNoeudCourant);
        FArrayNoeudsVisites[QIdxNoeudCourant] := True;
        FArrayDistancesMin[QIdxNoeudCourant]  += QDistanceMinNoeudVoisin;
        // Pour les arcs sortants
        NbArcsSortants := Length(QNoeudCourant.ListeArcsSortants);
        if (NbArcsSortants > 0) then
        begin
          FAfficherMessage(Format('%d: %d arcs sortants', [QNoeudCourant.IDStation, NbArcsSortants]));
          for a := 0 to NbArcsSortants - 1 do
          begin
            qIdxArc   := QNoeudCourant.ListeArcsSortants[a];
            QArc      := GetArc(qIdxArc);
            // On attrappe le successeur
            QIdxNoeudSuccesseur := QArc.IdxNoeudArrivee;
            QNoeudSuccesseur    := GetNoeud(QIdxNoeudSuccesseur);
            QDistance1 := FArrayDistancesMin[QIdxNoeudCourant]    + QArc.Longueur;
            QDistance2 := FArrayDistancesMin[QIdxNoeudSuccesseur] + QArc.Longueur;
            if (QDistance2 > QDistance1) then
            begin
              FArrayDistancesMin[QIdxNoeudSuccesseur]  := QDistance1 + QArc.Longueur;
              FArrayNoeudsVisites[QIdxNoeudSuccesseur] := True;
              // mise à jour du prédécesseur
              QArc.IdxNoeudDepart := QIdxNoeudCourant;
              PutArc(a, QArc);
              FAfficherMessage(Format('Changement du noeud courant: %d devient %d', [QNoeudCourant.IDStation, QNoeudSuccesseur.IDStation]));
              QIdxNoeudCourant := QIdxNoeudSuccesseur;
              QNoeudCourant := GetNoeud(QIdxNoeudCourant);
            end;
          end;
        end;
        Inc(NbPasses);
        // pour contrôle après la passe
        ListerLesNoeuds(Format('Passe %d', [NbPasses]));
        // Afficher le graphe
        FAfficherGraphe();
      end;
      FAfficherMessage(Format('%d passes', [NbPasses]));
      //****************************************************************************
      exit;
      // Le chemin
      //FLeCheminTrouve.ClearListe();
     
      // si le noeud d'arrivée a un prédécesseur:
      FAfficherMessage('Backtracking');
     
      if (Length(QNoeudArrivee.ListeArcsEntrants) > 0) then
      begin
     
        FAfficherMessage(Format('Le noeud %d a un prédécesseur', [QNoeudCourant.IDStation]));
        QNoeudCourant := QNoeudArrivee;
        FLeCheminTrouve.AddElement(QNoeudArrivee);
        NbPasses := 0;
        while (Length(QNoeudCourant.ListeArcsEntrants) > 0) do
        begin
          if (NbPasses > 200) then break;
          FAfficherMessage(Format('Noeud courant: %d', [QNoeudCourant.IDStation]));
          FLeCheminTrouve.InsertElement(0, QNoeudCourant);
          for i := 0 to Length(QNoeudCourant.ListeArcsEntrants) - 1 do
          begin
            QArc := GetArc(QNoeudCourant.ListeArcsEntrants[i]);
            QIdxPredecesseur := QArc.IdxNoeudDepart;
            QST1 := GetNoeud(QIdxPredecesseur);
     
            FAfficherMessage(Format('QNoeudCourant: %d: Arc entrant: %d provenant de %d [%d] - %s',
                             [QNoeudCourant.IDStation,
                              QNoeudCourant.ListeArcsEntrants[i],
                              QIdxPredecesseur, QST1.IDStation,
                              BooltoStr(FArrayNoeudsVisites[QIdxPredecesseur], 'Visité', '--')]));
            if (FArrayNoeudsVisites[QIdxPredecesseur]) then break;
          end;
          if (QNoeudDepart.IDStation = QST1.IDStation) then Break;
          QNoeudCourant := QST1;
          Inc(NbPasses);
        end;
      end;
     
      FAfficherMessage('Parcours terminé');
      //*)
    end;
     
    end.

  12. #12
    Membre expert
    Salut, j'ai fait une petite application test (avec BZScene) pour tester, j'ai monté l'algo de Djisktra depuis les liens que j'ai mentionné et mon idée de départ.
    Le concept est la, je pense que tu n'auras pas de mal à adapter les différentes classes pour tes besoins. Pour les calculs j'ai utilisé les distances euclidienne (comme poids), mais il te seras facile de changer par des distances mercuriales "latitude/longitude" (c'est comme ça que l'on dit je crois). Les classes devraient être assez facile à comprendre.

    Bref si tu as des questions n'hésites pas



    L' exécutable pour Windows est présent dans l'archive.

    Pour ajouter un point il suffit que cliquer avec le bouton gauche de la souris dans la grille
    Pour créer un lien il faut garder la touche "Shift" enfoncée, sélectionner le point de départ avec le bouton gauche de la souris et glisser jusqu'au point d'arriver et relâcher le bouton de la souris.

    Note : Les liaisons entre chaque noeud ne sont pas bidirectionnelles. Il faut dont créer les liaisons de..vers pour chaque noeud. Lorsque deux noeuds ont une liaison bidirectionnelle celle-ci s'affichera en bleu.

    Je n'ai pas trop peaufiné, vu que c'est assez urgent pour toi. Normalement il ne devrait pas y avoir d'erreurs.

    A+

    Jérôme

    EDIT : Pour le téléchargement des sources et de l'application compilée pour Windows 64 bit voir ce messgae
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

  13. #13
    Membre expert
    Citation Envoyé par jurassic pork Voir le message
    hello,
    il s'agit de la bibliothèque LGenerics de licence Apache 2.0. Attention cette bibliothèque nécessite une version récente de fpc ( >= 3.2) et de Lazarus ( >= 2.0 ) . En particulier pour trouver les chemins les plus courts il y a :

    Ami calmant, J.P
    Salut, cette bibliothèque est sympa, il y a plein de gestionnaire de listes et d'arbres, mais elle n'est pas évidente à prendre en main, si tu n'as pas l'habitude avec le concept des "generics"

    A+

    Jérôme
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

  14. #14
    Expert confirmé
    hello Jérôme,
    oui effectivement le concept des generics n'est pas évident mais la bibliothèque est parfois simple à utiliser. Par exemple pour résoudre le problème à J.P Cassou voici une solution en utilisant cette bibliothèque :
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    uses  Classes, LGUtils, LGArrayHelpers, LGSparseGraph,
      LGSimpleGraph, LGSimpleDigraph;
     
    type
        TIntWeight   = specialize TGSimpleWeight<Integer>;
        TInt64Weight = specialize TGSimpleWeight<Int64>;
        TGraphDi     = specialize TGWeightedDigraph<Integer, Integer, TIntWeight, Integer>;
        TGraph     = specialize TGWeightedGraph<Integer, Integer, TIntWeight, Integer>;
     
    procedure TForm1.Button4Click(Sender: TObject);
    var
      I : Integer;
      Graph1: TGraph;
      p: TintArray;
      w: Integer;
      resultat : String;
    begin
      Graph1 := TGraph.Create; 
      for I in [0..13] do
        Graph1.AddVertex(I);
      Graph1.AddEdge(0, 1, TIntWeight.Create(10));
      Graph1.AddEdge(1, 2, TIntWeight.Create(10));
      Graph1.AddEdge(1, 12, TIntWeight.Create(10));
      Graph1.AddEdge(2, 3, TIntWeight.Create(10));
      Graph1.AddEdge(3, 4, TIntWeight.Create(10));
      Graph1.AddEdge(3, 8, TIntWeight.Create(10));
      Graph1.AddEdge(4, 5, TIntWeight.Create(10));
      Graph1.AddEdge(5, 6, TIntWeight.Create(10));
      Graph1.AddEdge(6, 7, TIntWeight.Create(10));
      Graph1.AddEdge(6, 13, TIntWeight.Create(10));
      Graph1.AddEdge(8, 9, TIntWeight.Create(10));
      Graph1.AddEdge(9, 10, TIntWeight.Create(10));
      Graph1.AddEdge(10, 11, TIntWeight.Create(10));
      Graph1.AddEdge(10, 13, TIntWeight.Create(10));
      Graph1.AddEdge(11, 12, TIntWeight.Create(10));
      p := Graph1.MinPath(1, 9, w);
      Resultat := 'Resultat DjiKstra : Chemin -> ';
      for I := 0 to p.Length - 1 do
      begin
      Resultat += inttostr(p[I]) + ' - ';
      end;
      Resultat += ' poids total : ' +  inttostr(w);
      memo1.Clear;
      memo1.Append(Resultat);
      Graph1.Free;
    end;


    et voici le résultat :

    Resultat DjiKstra : Chemin -> 1 - 2 - 3 - 8 - 9 - poids total : 40
    Au fait Jérôme, j'ai téléchargé ton projet, quand j'exécute le programme rien ne s'affiche, et je n'arrive pas à installer les packages bzscene .

    Ami calmant, J.P
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  15. #15
    Membre expert
    Je viens de trouver un petit bug

    dans function TGraphNode.Dijkstra(FromIndex, ToIndex: Integer; out ShortestPath: TBZIntegerList): Single; à la fin de cette méthode

    il faut remplacer

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
     
       While (pred[i] <> i)  do
       begin


    par

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
     
        While (pred[i] <> i) and (i <> FromIndex) do
        begin


    Car sinon cela provoque une boucle infinie dans la recherche dans le cas ou par exemple le noeud "FromIndex" est plus grand que "ToIndex"

    A+

    Jérôme
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

  16. #16
    Membre averti
    BZScene ne compile pas sour Lazarus 2.0.2 FPC 3.0.4
    Erreur BZCustomShader.pas(390,56) Error: Incompatible types: got "TBZVector2f" expected "TBZVector2i"

  17. #17
    Membre expert
    Citation Envoyé par jurassic pork Voir le message
    hello Jérôme,
    oui effectivement le concept des generics n'est pas évident mais la bibliothèque est parfois simple à utiliser. Par exemple pour résoudre le problème à J.P Cassou voici une solution en utilisant cette bibliothèque :
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
     
    type
        TGraphDi     = specialize TGWeightedDigraph<Integer, Integer, TIntWeight, Integer>;
        TGraph     = specialize TGWeightedGraph<Integer, Integer, TIntWeight, Integer>;

    Oui, justement, c'est l'exemple parfait. Pour ma part j'ai du mal à me représenter (sous forme de tableau) la structure de ce genre de déclaration
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
     
    Type
     
      TGraph = Array of Array of Array of TIntWeight ????
     
      // ou
      TGraphItem = record
         W : TIntWeight;
         n : Integer;
      end;
     
      TMap = Array of Array of TGraphItem
      TGraph : TMap;


    Et pour ce qui est de l'utilisation c'est très limité, à mon avis, car on doit pré-calculer tous les poids à l'avance
    Citation Envoyé par jurassic pork Voir le message

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
     
    procedure TForm1.Button4Click(Sender: TObject);
    var
      I : Integer;
      Graph1: TGraph;
      p: TintArray;
      w: Integer;
      resultat : String;
    begin
      Graph1 := TGraph.Create; 
      for I in [0..13] do
        Graph1.AddVertex(I);
      Graph1.AddEdge(0, 1, TIntWeight.Create(10));
      Graph1.AddEdge(1, 2, TIntWeight.Create(10));

    Et comme le dit l'auteur

    Started as a self-education project

    Citation Envoyé par jurassic pork Voir le message


    Au fait Jérôme, j'ai téléchargé ton projet, quand j'exécute le programme rien ne s'affiche,
    Rien ne s'affiche ??? Bizarre ça , Un blocage par ton antivirus à tout hazard ?
    Si d'autre sont dans le même cas, dites moi l'exe est peut-corrompu. Je referais un zip

    Citation Envoyé par jurassic pork Voir le message

    et je n'arrive pas à installer les packages bzscene .
    Ou est ce que tu bloques ? tu as des messages d'erreurs ? tu as suivi les instructions dans la doc ? sinon regardes ici, cela résoudra peut-être ton problème

    Jérôme
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

  18. #18
    Membre expert
    Citation Envoyé par JP CASSOU Voir le message
    Erreur BZCustomShader.pas(390,56) Error: Incompatible types: got "TBZVector2f" expected "TBZVector2i"
    C'est à l'installation que tu as cette erreur ? Si c'est avec l'application test, bizarre car la paquet BZScene_Engine n'est pas dans les dépendances, c'est quoi la ligne de code exécuté avant cette erreur ?, dans quelle application démo ?
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

  19. #19
    Expert confirmé
    Citation Envoyé par BeanzMaster Voir le message


    Ou est ce que tu bloques ? tu as des messages d'erreurs ? tu as suivi les instructions dans la doc ? sinon regardes ici, cela résoudra peut-être ton problème

    Jérôme
    J'arrive à compiler les paquets mais c'est le projet qui ne trouve pas TBzThreadTimer qui normalement est dans un des paquets.

    EDIT : OK c'est bon maintenant en installant les paquets dt mais en voulant installer tous les paquets ensuite lazarus ne s'ouvre plus
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  20. #20
    Membre expert
    Citation Envoyé par jurassic pork Voir le message
    J'arrive à compiler les paquets mais c'est le projet qui ne trouve pas TBzThreadTimer qui normalement est dans un des paquets.
    TBzThreadTimer, est posé sur la fiche, Il faut installer le paquet de composant "bzscene_Tools_dt", "Utiliser --> Installer" et reconstruire l'EDI
    Au pire si tu ne veux pas installer les composants, tu peux le virer de la "Form" et supprimer la références dans le LFM, car je ne m'en suis pas servie au final.

    PS : La grille risque de changer lorsque tu créera une liaison. Un petit bug dans le dessin de la grille que j'ai découvert en coder cette application. Rien de bien méchant, c'est juste l'épaisseur des lignes.
    Je doit encore corrigé quelques bugs dans BZScene que j'ai découvert pendant la "game Jam" et je mettrai à jour les dépôts
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

###raw>template_hook.ano_emploi###