Procedure OrdenarA(var A:LPalabras;n:byte); Procedure ContarPosicionar(A,B:LPalabras;i:longint); Var j:longint; d:word; pos:array [64..90] of longword; Begin FillDWord(pos,27,0); for j:=low(A) to high(A) do Begin if i>length(A[j]) then d:=64 else d:=Word(A[j,i]); pos[d]:=pos[d]+1 End; for j:=64 to 89 do pos[j+1]:=pos[j]+pos[j+1]; for j:=high(A) downto low(A) do Begin if i>length(A[j]) then d:=64 else d:=Word(A[j,i]); pos[d]:=pos[d]-1; B[pos[d]]:=A[j]; End; End; Var i:longint; B:LPalabras; Begin SetLength(B,Length(A)); for i:=n downto 1 do if (i mod 2)=0 then ContarPosicionar(A,B,i) else ContarPosicionar(B,A,i); if (n mod 2)<>0 then for i:=low(A) to high(A) do A[i]:=B[i] End;