sort index in array
Author Message
sort index in array

Bonjour tous,

Merci de m'aider raliser le clas{*filter*}t des indices d'une liste numrique
dans
l'ordre croissant des valeurs contenues dans cette liste.

Uses crt;

Ranger dans Tab2 les indices des lments d'une liste numrique T de 12
lments en considrant
ces lments comme s'ils avaient t tris et classs en ordre croissant }

type T_index = Array[1..12] of integer;
var T1,T2,T3,T4,T5,T6, T7 : t_index;

Procedure IndexAsc (var T, tab3 : T_Index);
var tab2 : T_index;

var i, j, k       : byte;
n             : byte;
cpt           : byte;

begin

n := 12;
for i := 1 to n do Tab2[i] := T[i];
For j := 1 to n-1 do
Begin
for i := 1 to n-1 do
begin
if (Tab2[i] <= Tab2[i+1]) then
begin
k := Tab2[i];
Tab2[i] := Tab2[i+1];
Tab2[i+1] := k;
end;
end;
t3 := tab2;
end;

For i := 1 to n do
for j := 1 to n do
if (tab2[i] = T[j])  then
begin
if (i = 1)  then Tab2[i] :=j;
end
else
begin
if  (tab2[i-1] = j) then  Tab2[i] :=j;
end;
tab3 := tab2;

end;

Procedure initTab(var T : T_index);
var i : integer;

begin
fillchar(t1,sizeof(t1),0);
fillchar(t2,sizeof(t2),0);
fillchar(t3,sizeof(t3),0);
fillchar(t4,sizeof(t4),0);
fillchar(t5,sizeof(t5),0);
fillchar(t6,sizeof(t6),0);
fillchar(t7,sizeof(t7),0);
for i := 1 to 12 do t[i] := 1+random(12);
end;

Procedure affdeg;
var  i : integer;
Begin
write('  ');
for i := 1 to 12 do write(i:2,' ');
writeln;
end;

Procedure afftab (var t : t_index);
var  i : integer;
Begin
write('  ');
for i := 1 to 12 do write(T[i]:2,' ');
writeln;
end;

Procedure ClasserIndex;
var t, t1, t2  : t_index;

begin
writeln;writeln;
InitTab(t);
t1 := t;
indexasc(t1,t2);
affdeg;
Afftab(t);
writeln;
Afftab(t3);
Afftab(t2);

end;

Procedure TestA;
begin
ClasserIndex;
end;

Begin
Clrscr;
randomize;
TestA;
Writeln;
Writeln('  ok  ok ok ok ok ok ok ok ok ok ok ok ');
repeat until keypressed;
end.

Sun, 27 Oct 2002 03:00:00 GMT

 Page 1 of 1 [ 1 post ]

Relevant Pages