A voir également:
- Algo tri shell+ tri rapide+ tri fusion
- Tri excel - Guide
- Logiciel tri photo gratuit - Guide
- Acces rapide - Guide
- En cours de traitement sur le site de tri local ✓ - Forum Consommation & Internet
- Peut on récupérer un colis au centre de tri chronopost - Forum Mobile
3 réponses
Kharec
Messages postés
4146
Date d'inscription
dimanche 20 avril 2008
Statut
Contributeur
Dernière intervention
8 mai 2011
509
30 mars 2009 à 19:52
30 mars 2009 à 19:52
Cherche un peu, fainéasse...
=)
=)
program principal
pas:=pas_max(n);
procedure tri_shell(var t:tab;n,pas:integer);
begin
repeat
pas:=pas div 3;
for i:= pas to n do
begin
aux:=t[i];
j:=i;
while (t[j-pas]>aux and j>pas) do
begin
t[j]:=t[j-pas];
j:=j-pas;
end;
t[j]:=aux;
end;
until pas=1;
end.
#****pas max******#
function pas_max(n:integer):integer;
begin
pas:=1;
repeat
pas:=3*pas+1;
until pas >=n;
end.
c mieux pour voux
vive le RoCk **********metal*******
pas:=pas_max(n);
procedure tri_shell(var t:tab;n,pas:integer);
begin
repeat
pas:=pas div 3;
for i:= pas to n do
begin
aux:=t[i];
j:=i;
while (t[j-pas]>aux and j>pas) do
begin
t[j]:=t[j-pas];
j:=j-pas;
end;
t[j]:=aux;
end;
until pas=1;
end.
#****pas max******#
function pas_max(n:integer):integer;
begin
pas:=1;
repeat
pas:=3*pas+1;
until pas >=n;
end.
c mieux pour voux
vive le RoCk **********metal*******
program tri;
uses wincrt;
type
tab=array [1..100] of integer;
var
n:integer;
T:tab;
procedure saisie_n(var n:integer);
begin
if(n<=0) then saisie_n(n);
end;
procedure remplir(var t :tab;n:integer);
begin
if n=1 then readln (T[n])
else remplir(t,n-1);
end;
function Recherche_min(i,n:integer;T:tab):integer;
begin
if(n=1) then Recherche_min:=T[1]
else if(i>n) then
Recherche_min:=Recherche_min(i+1,n,T);
end;
procedure permuter(var x,y:integer);
var aux:integer;
begin
aux:=x;
x:=y;
y:=aux;
end;
procedure decaler(var t:tab;aux,p:integer);
begin
while((p>1) and(aux>T[p-1])) do
begin
T[p]:=T[p-1];
p:=p-1;
end;
end;
procedure tri_sel(i,n:integer;var t :tab);
var min:integer;
begin
min:=Recherche_min(i,n,t);
if(min<>i) then permuter(T[i],T[min]);
if (i+1<>n) then tri_sel(i+1,n,T);
end;
procedure tri_bul(var t :tab;n:integer);
var i:integer;
begin
if (n>1) then begin
for i:=2 to n do
if (T[i]>T[i-1]) then
permuter (T[i],T[i-1]);
end;
tri_bul(T,n-1);
end;
procedure tri_inser(var t :tab;n,i:integer);
var aux,j:integer;
begin
if(i<=n) then begin
aux:=T[i];
j:=i;
decaler(T,aux,i);
T[j]:=T[j-1];
tri_inser(T,n,i+1);
end;
end;
{h est mle pas **}
procedure tri_shell(var t :tab;n,h:integer);
Var aux,i : integer;
begin
If h > 0 Then
Begin
If n > h Then
begin
Tri_Shell (t,n - h,h);
If t[n] < t[n - h] Then
Begin
aux:= t[n];
i := n;
Repeat
t[i] := t[i - h];
i := i - h;
Until (i = h) Or (aux > t[i - h]);
t[i] := aux;
End;
End;
Tri_Shell (t,n,h Div 3);
End;
End;
procedure affichage(t :tab;n:integer);
begin
if n=1 then writeln (T[1])
else affichage(t,n-1);
end;
begin
saisie_n(n);
remplir(T,n);
writeln('*Les élements de tableau avant le tri *');
affichage(T,n);
writeln('*Les élements de tableau aprés le tri sélection*');
tri_sel(1,n,T);
affichage(T,n);
writeln('*Les élements de tableau aprés le tri à bulles *');
affichage(T,n);
writeln('*Les élements de tableau aprés le tri insertion*');
affichage(t,n);
writeln('*Les élements de tableau aprés le tri shell *');
tri_shell(t,n,5);
affichage(t,n);
end.
uses wincrt;
type
tab=array [1..100] of integer;
var
n:integer;
T:tab;
procedure saisie_n(var n:integer);
begin
if(n<=0) then saisie_n(n);
end;
procedure remplir(var t :tab;n:integer);
begin
if n=1 then readln (T[n])
else remplir(t,n-1);
end;
function Recherche_min(i,n:integer;T:tab):integer;
begin
if(n=1) then Recherche_min:=T[1]
else if(i>n) then
Recherche_min:=Recherche_min(i+1,n,T);
end;
procedure permuter(var x,y:integer);
var aux:integer;
begin
aux:=x;
x:=y;
y:=aux;
end;
procedure decaler(var t:tab;aux,p:integer);
begin
while((p>1) and(aux>T[p-1])) do
begin
T[p]:=T[p-1];
p:=p-1;
end;
end;
procedure tri_sel(i,n:integer;var t :tab);
var min:integer;
begin
min:=Recherche_min(i,n,t);
if(min<>i) then permuter(T[i],T[min]);
if (i+1<>n) then tri_sel(i+1,n,T);
end;
procedure tri_bul(var t :tab;n:integer);
var i:integer;
begin
if (n>1) then begin
for i:=2 to n do
if (T[i]>T[i-1]) then
permuter (T[i],T[i-1]);
end;
tri_bul(T,n-1);
end;
procedure tri_inser(var t :tab;n,i:integer);
var aux,j:integer;
begin
if(i<=n) then begin
aux:=T[i];
j:=i;
decaler(T,aux,i);
T[j]:=T[j-1];
tri_inser(T,n,i+1);
end;
end;
{h est mle pas **}
procedure tri_shell(var t :tab;n,h:integer);
Var aux,i : integer;
begin
If h > 0 Then
Begin
If n > h Then
begin
Tri_Shell (t,n - h,h);
If t[n] < t[n - h] Then
Begin
aux:= t[n];
i := n;
Repeat
t[i] := t[i - h];
i := i - h;
Until (i = h) Or (aux > t[i - h]);
t[i] := aux;
End;
End;
Tri_Shell (t,n,h Div 3);
End;
End;
procedure affichage(t :tab;n:integer);
begin
if n=1 then writeln (T[1])
else affichage(t,n-1);
end;
begin
saisie_n(n);
remplir(T,n);
writeln('*Les élements de tableau avant le tri *');
affichage(T,n);
writeln('*Les élements de tableau aprés le tri sélection*');
tri_sel(1,n,T);
affichage(T,n);
writeln('*Les élements de tableau aprés le tri à bulles *');
affichage(T,n);
writeln('*Les élements de tableau aprés le tri insertion*');
affichage(t,n);
writeln('*Les élements de tableau aprés le tri shell *');
tri_shell(t,n,5);
affichage(t,n);
end.