Tri par comptage avec un seul tableau

Version imprimable

Bonjour tout le monde

Voici mon programme d'essai mais j'ai connu un problème dans le cas où un élément se répète. Est-ce que quelqu'un peut m'aider à résoudre ce dernier svp ?

Code:

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
program tri_1tab;
 
type tab=array[1..100]of longint;
 
var   t:tab;l:longint;
 
 
 
 procedure lect_1d (var a : tab;var b :longint);
 
 var i : integer;
 
 begin
 
 writeln('donner la taille du tableau')
 
 ;readln(b);
 
 for i :=1 to b do
 
 begin
 
 write('T[',i,']=');
 
 readln( a [i] );
 
 end;
 
 end;
 
 function nb_petit(t:tab;l:longint;a:longint):longint;
 
 var i, cpt,cp,c:longint;
 
 begin
 
 c:=a; cpt:=0;
 
 for i:=1to l do
 
 begin
 
 if t[i]< t[c]   then cpt := cpt+1;
 
   end; nb_petit:=cpt;
 
 end;
 
 
 
procedure permut(var a,b:longint);
 
var c :longint;
 
begin
 
c:=a;
 
a:=b;
 
b:=c
 
end;
 
 
 
procedure tri_1tab(var t:tab;var l:longint);
 
var  i:longint;
 
 
begin
 
 for i:=1 to (l) do
 
 begin
 
 
   while ( i<> (nb_petit(t,l,i)+1)) do
 
   begin
 
    permut(t[i],t[nb_petit(t,l,i)+1]);
 
 
  end ;
 
 
 
 end;
 
end;
 
 
 
 
 
 
 
 procedure ecrire_1d (var T3:tab ;var l:longint);
 
 var i:longint;
 
 begin
 
  writeln('la table triee est =');
 
 for i:= 1 to l do
 
 writeln('T[',i,'] = ',T3[i]);
 
 end;
 
 
 
 begin
 
 lect_1d(t,l);
 
 tri_1tab(t,l); 
 
ecrire_1d(t,l);            readln;
 
 end.

01/02/2011, 13h59
darrylsite

C'est quoi le principe de ton tri par comptage avec un seul tableau?

J'ai regardé cet article sur wikipedia : http://fr.wikipedia.org/wiki/Tri_comptage, mais vu ton code, je ne pense pas que c'est ce que tu éssaies de faire
01/02/2011, 16h18
ima_med

le principe de ce tri est de trié le tableau sans utilisé le tableau de comtage en gardant le principe de tri par comtage (donc j remplaçai le tableau par une variable cptqui compte le nombre d'element inferieur a un element);

donc pour un element je compte le nombre d'element qui lui sont inferieur puis je permut cet element avc cel de l'indice cpt+1;
je repet ça pour le meme element jusqu'a ce que le nombre (cpt+1) = a l indice de l'element lui meme et je passe au deuxieme je refait la meme chose jusq'au dernier

exemple
les indices 1 2 3 4 5
les elements 4 7 5 2 9
pour le 4 cpt = (1) donc je permute 4 avec l'elemnt de l'indice (1)+1 qui est le 7
===> 7 4 5 2 9
===> 2 4 5 7 9
===> C bon pour le 2 cpt= 0 je le permut avc cel de lindice (0)+1
qui est le meme indice de 2 donc je passe
===> 2 4 5 7 9 meme chose pour 4
===> pour 5 et 7 et 9 donc j'arrive au dernier element et mon tableau est trié .
mais dans le cas ou un element ce repette y a un blocage
exemple
les indices 1 2 3 4
les elements 6 3 6 7
==> 3 6 6 7
2emme element reste je passe au troisieme
==> 3 6 6 7
==> pour 6 cpt =1 comme le 6 donc je le permut
==> 3 6 6 7
et j'aura un blocage de permutation entre les deux elemet 6 6
01/02/2011, 17h10
labbet
bonjour ima_med

En premier lieu, il faut faire l'effort d'indenter ton code; là c'est illisible il y a même une erreur de syntaxe :
Code:

1 2 3 4 5 6 ... tri_1tab(t,l;( ecrire_1d(t,l); readln; ...
Ensuite à la lecture de de ton exemple, tu es sur le cas particulier où tu as plusieurs élements avec la même valeur.
Le plus simple serait d'utiliser l'algo du lien indiqué par darrylsite :
1. avec le tableau chargé ( voire pendant son chargement ;) ) construire le tableau de comptage
2. parcourir le tableau de comptage pour ré-écrire le tableau avec les valeur triée
01/02/2011, 18h40
ima_med

Merci pour la remarque de l'erreur labbet.
Pour le lien, moi je veux trier un tableau sans utiliser la table de comptage, c'est ça ce qui est demandé... De plus, il existe plusieurs algorithmes de tri : par bulle, transposition, sélection et par comptage, de même comptage avec trois tableaux ou bien deux ou bien un seul; moi je veux ce dernier mais je n'ai pas trouvé l'astuce pour rendre ce programme valable pour tous les cas. :)

ne pleure pas ;)

J'ai lu et re-lu tes exemples et j'avoue que cela fait un peu mal à la tête :D

Ton algo se bloque (boucle infinie) quand tu as deux valeurs identiques.
A l'intuit' (je n'ai rien vérifié) il y a deux pistes pour s'en sortir :

1/ essayer de voir si cpt doit contenir le nombre de valeurs "strictement inférieures" OU "inférieures ou égales" à la valeur en cours.

2/ compter le nombre de valeurs strictement inférieures à la valeur en cours ( je pense que c'est ce que tu as dans "cpt" ) ET le nombre de valeurs identiques à la valeur en cours (bref tu refais le "comptage" mais sans le stocker dans un tableau).

... enfin mais c'est la solution de facilité tu peux toujours comparer
http://selkis.developpez.com/tutorie...xemples/#LIV.4
et ta procedure tri_1tab et comprendre où tu t'es trompé

Code:

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
program tri_1tab;
  type tab = array [1..100] of longint;
  var   
    t:tab; 
    l:longint;
 
    procedure lect_1d (var a : tab;var b :longint);
    var 
       i : integer;
    begin
        writeln('donner la taille du tableau');
        readln(b);
        for i :=1 to b do begin
            write('T[',i,']=');
            readln( a [i] );
        end;
    end;
 
    function nb_petit( t : tab; l : longint; a : longint) :longint;
    var 
        i, cpt, cp, c : longint;
    begin
        c := a;
        cpt := 0;
        for i:= 1 to l do begin
            if t[i] < t[c] then cpt := cpt + 1;
        end;
        nb_petit := cpt;
    end;
 
    procedure permut(var a, b : longint);
    var 
        c : longint;
    begin
        c:=a;
        a:=b;
        b:=c
    end;
 
    procedure tri_1tab(var t : tab ; var l : longint);
    var  
        i : longint;
    begin
        for i := 1 to l do begin
            while ( i <> ( nb_petit (t , l , i ) + 1 ) ) do begin
                permut( t[i] , t[nb_petit(t,l,i)+1] );
            end ;
        end;
    end;
 
    procedure ecrire_1d (var T3 : tab ; var l : longint);
    var 
        i : longint;
    begin
        writeln('la table triee est =');
        for i := 1 to l do
            writeln('T[',i,'] = ',T3[i]);
    end;
 
begin
    lect_1d ( t , l );
    tri_1tab( t , l ); 
    ecrire_1d( t , l );
    readln;
end.

Salut

Bien que je trouve cette solution très contre-performante, voila une solution qui marche ...

Il faut modifier :

Code:

1
2
3
4
5
6
7
8
9
10
    procedure tri_1tab(var t : tab ; var l : longint);
    var  
        i : longint;
    begin
        for i := 1 to l do begin
            while ( i > ( nb_petit (t , l , i ) + 1 ) ) do begin
                permut( t[i] , t[nb_petit(t,l,i)+1] );
            end ;
        end;
    end;

Code:

1
2
3
4
5
6
7
8
9
10
11
12
    function nb_petit( t : tab; l : longint; a : longint) :longint;
    var
        i, cpt, cp, c : longint;
    begin
        c := a;
        cpt := 0;
        for i:= 1 to l do begin
            if t[i] < t[c] then cpt := cpt + 1;
            if (t[i] = t[c]) and (i<c) then cpt := cpt + 1;
        end;
        nb_petit := cpt;
    end;

Pour reduire le nombres de calculs, on peut faire :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
    procedure tri_1tab(var t : tab ; var l : longint);
    var
        i : longint;
        Temp : longint;
    begin
        for i := 1 to l do begin
          Temp:=nb_petit (t , l , i );
            while ( i > Temp + 1 ) do begin
                permut( t[i] , t[Temp + 1] );
                Temp:=nb_petit (t , l , i );
            end ;
        end;
    end;

Mais bon, tout cela me semble inutile, il existe des techniques bien plus rapides et efficaces, tout en étant tres courtes :

Code:

1
2
3
4
5
6
7
8
    procedure tri_1tab(var t : tab ; var l : longint);
    var
        i, j : longint;
    begin
      for i := 1 to l do
      for j := i+1 to l do
        if t[i]>t[j] then permut( t[i] , t[j] );
    end;

Bonne chance !