求数串的原始排列(number.pas)

var a:array[1..1000] of word

n,i,j,dep:word

begin

write('N(1-1000)=')readln(n)

if (n=0) or (n>1000) then begin writeln('Input error.')readlnhalt

end

fillchar(a,sizeof(a),0)a[1]:=1dep:=1

for i:=2 to n do begin

j:=3while (j>0) do begin

dep:=dep mod n+1

if a[dep]=0 then dec(j)

end

a[dep]:=i

end

for i:=1 to n do write(a[i]:5)

writelnreadln

end.

var i,n:longint

a:array[0..300000] of longint

procedure qsort(l,r:longint)

var i,j,m,t:longint

begin

i:=l j:=r m:=a[(l+r) div 2]

while (i<=j) do

begin

while(a[i]<m) do inc(i)

while(m<a[j]) do dec(j)

if (i<=j) then

begin

t:=a[i]a[i]:=a[j]a[j]:=t

inc(i)dec(j)

end

end

if (l<j) then qsort(l,j)

if (i<r) then qsort(i,r)

end

begin

assign(input,'num.in')reset(input)

assign(output,'num.out')rewrite(output)

readln(n)

for i:=1 to n do read(a[i])

qsort(1,n)

for i:=1 to n do write(a[i],' ')

close(input)close(output)

end.

---