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

Lazarus Pascal Discussion :

Tri générique d'un tableau par insertion [Lazarus]


Sujet :

Lazarus Pascal

  1. #1
    Membre expert
    Avatar de BeanzMaster
    Homme Profil pro
    Amateur Passionné
    Inscrit en
    septembre 2015
    Messages
    1 331
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Suisse

    Informations professionnelles :
    Activité : Amateur Passionné
    Secteur : Tourisme - Loisirs

    Informations forums :
    Inscription : septembre 2015
    Messages : 1 331
    Points : 3 310
    Points
    3 310
    Billets dans le blog
    2
    Par défaut Tri générique d'un tableau par insertion
    Salut à tous, j'ai un petit problème avec un procédure de tri par insertion générique pour des tableaux (array)

    La méthode fonctionne mais je dois la lancer plusieurs fois pour arriver à avoir mon tableau parfaitement trié :

    Qu'est ce que j'aurais oublié ? , voyez vous une erreur ? Est-ce que je dois faire de la récursivité ? ou est-ce un comportement normal pour le tri par insertion ?

    Voici le code pour un tri sur des integer

    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
    function CompareInteger(Const elem1, elem2) : Integer;
    var
      i1 : integer absolute elem1;
      i2 : integer absolute elem2;
    begin
      if i1 = i2 then Result:=0
      else if i1 < i2 then Result:=-1
      else Result:=1;
    end;
     
    procedure TBZBaseArray.AnyInsertionSort(idxL, idxH, Dir : Integer; Stride : Integer; CompareFunc : TBZArraySortCompareFunc);
    var
      ps, cs,ls,hs : Integer;
      li,hi : Integer;
      pb, SwapBuf : pByte;
    begin
      pb:= PByte(FData);
     
      li :=idxL;
      hi :=idxH;
     
      ls := (li + 1) * Stride;
      hs := hi * Stride;
     
      SwapBuf := nil;
      GetMem(SwapBuf, Sizeof(T));  // T car c'est une classe générique
     
      Repeat
        Move(pb[ls], SwapBuf^, Stride);
        ps := ls;
        cs := ps;
        Dec(cs, Stride);
     
        If Dir >= 0 then
        begin
          While (ps > 0) and  (CompareFunc(pb[ps], pb[cs]) < 0) do
          begin
            Move(pb[cs], pb[ls] , Stride);
            dec(ps,stride);
            dec(cs,stride);
          end;
        end
        else
        begin
          While (ps > 0) and  (CompareFunc(pb[ps], pb[cs]) > 0) do
          begin
             Move(pb[cs], pb[ls] , Stride);
             dec(ps,stride);
             dec(cs,stride);
           end;
        end;
     
        if ps<>ls then Move(SwapBuf^, pb[ps], Stride);
        inc(ls, Stride);
     
      until ls > hs;
     
      FreeMem(Swapbuf);
      SwapBuf := nil;
    end;
     
    procedure TBZBaseArray.InsertionSort(Const Direction : byte; CompareFuncProc : TBZArraySortCompareFunc);
    begin
      AnyInsertionSort(0, FCount-1, Direction, SizeOf(T), CompareFuncProc);
    end;

    Merci d'avance

    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

  2. #2
    Membre actif

    Homme Profil pro
    Développeur informatique
    Inscrit en
    novembre 2013
    Messages
    138
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : novembre 2013
    Messages : 138
    Points : 294
    Points
    294
    Billets dans le blog
    2
    Par défaut Propale: Un Quicksort
    Bonjour,

    Tu peux t'inspirer de ceci. Je te laisse le soin d'adapter:

    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
    // types locaux
    type TViseesTopo2D = record
     ...
      Depth             : Double;                // Profondeur (distance à l'observateur);
    ...
    end;   
    // tri en profondeur
    procedure QSortDatasByDepth();
      procedure QSortByDepth(var FPolygonale: array of TViseesTopo2D; lidx, ridx: integer);
      var
        k, e, mid: integer;
        Buffer   : TViseesTopo2D;
      begin
     
          if (lidx >= ridx) then Exit;
          mid := (lidx + ridx) div 2;
          Buffer := FPolygonale[lidx];
          FPolygonale[lidx]:=FPolygonale[mid];
          FPolygonale[mid]:=Buffer;
          e:=lidx;
          for k:=lidx+1 to ridx do
          begin
            if (FPolygonale[k].Depth > FPolygonale[lidx].Depth)  then
            begin
              Inc(e);
              Buffer := FPolygonale[e];
              FPolygonale[e]:=FPolygonale[k];
              FPolygonale[k]:=Buffer;
            end;
          end;
          Buffer := FPolygonale[lidx];
          FPolygonale[lidx]:=FPolygonale[e];
          FPolygonale[e]:=Buffer;
          QSortByDepth(FPolygonale,lidx, e-1);
          QSortByDepth(FPolygonale,e+1, ridx);
     
      end;
    begin
      QSortByDepth(FPolygonale, 0, High(FPolygonale));  
    end;

  3. #3
    Membre expert
    Avatar de BeanzMaster
    Homme Profil pro
    Amateur Passionné
    Inscrit en
    septembre 2015
    Messages
    1 331
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Suisse

    Informations professionnelles :
    Activité : Amateur Passionné
    Secteur : Tourisme - Loisirs

    Informations forums :
    Inscription : septembre 2015
    Messages : 1 331
    Points : 3 310
    Points
    3 310
    Billets dans le blog
    2
    Par défaut
    Bonjour

    merci JP mais ta procedure utilises la l'algorithme QuickSort,

    J'ai trouvé le problème, je ne comparais pas la bonne valeur

    voici le code juste

    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
    procedure TBZBaseArray.AnyInsertionSort(idxL, idxH, Dir : Integer; Stride : Integer; CompareFunc : TBZArraySortCompareFunc);
    var
      ps, cs,ls,hs : Integer;
      li,hi : Integer;
      pb, SwapBuf : pByte;
    begin
     pb:= PByte(FData);
     
     li :=idxL;
     hi :=idxH;
     
     ls := (li + 1) * Stride;
     hs := hi * Stride;
     
     SwapBuf := nil;
     GetMem(SwapBuf, Sizeof(T));
     
     Repeat
       Move(pb[ls], SwapBuf^, Stride);
       ps := ls;
       cs := ps;
       Dec(cs, Stride);
       If Dir >= 0 then
       begin
         While (ps >= Stride) and  (CompareFunc(SwapBuf^, pb[cs]) < 0) do
         begin
           Move(pb[cs], pb[ps] , Stride);
           dec(ps,stride);
           dec(cs,stride);
         end;
       end
       else
       begin
         While (ps >= Stride) and  (CompareFunc(SwapBuf^, pb[cs]) > 0) do
         begin
           Move(pb[cs], pb[ps] , Stride);
           dec(ps,stride);
           dec(cs,stride);
         end;
       end;
       Move(SwapBuf^, pb[ps], Stride);
       inc(ls, Stride);
     until ls > hs;
     
     FreeMem(Swapbuf);
     SwapBuf := nil;
    end;
    A+

    Merci
    • "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

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 4
    Dernier message: 31/03/2012, 01h30
  2. Tri d'un tableau par un algorithme
    Par recome dans le forum Algorithmes et structures de données
    Réponses: 1
    Dernier message: 14/01/2009, 10h04
  3. Tri d'un tableau par ordre croissant
    Par goaks dans le forum Algorithmes et structures de données
    Réponses: 46
    Dernier message: 29/06/2007, 17h41
  4. Tri d'un tableau par ordre alphabétique
    Par arouze dans le forum VB.NET
    Réponses: 6
    Dernier message: 02/04/2007, 15h41
  5. [] Tri d'un tableau par ordre alphabétique
    Par cafeine dans le forum VB 6 et antérieur
    Réponses: 3
    Dernier message: 17/09/2002, 09h43

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo