请大佬翻译完毕后私信我谢谢!
var
a,b,c,d,f:array[1..1000]of longint;
i,j,k,n,m,o:longint;
procedure zx(p,q:longint);
var
i,j:longint;
begin
i:=0;
while (i/(q-p+1))<(o/100) do
begin
inc(i);
k:=k+b[p+i-1]+1;
if i=1 then dec(k);
a[d[p+i-1]]:=b[p+i-1]+1;
if a[d[p+i-1]]>m then a[d[p+i-1]]:=m;
end;
if (p+i-1)=q then exit;
for j:=p+i to q do a[d[j]]:=0;
end;
procedure qsort(l,r:longint);
var
i,j,mid,p,m1:longint;
begin
i:=l;j:=r;
mid:=b[(l+r) div 2];
m1:=d[(l+r) div 2];
repeat
while (b[i]<mid)or((b[i]=mid)and(d[i]<m1)) do inc(i);
while (b[j]>mid)or((b[j]=mid)and(d[j]>m1)) do dec(j);
if (i<=j) then
begin
p:=b[i]; b[i]:=b[j]; b[j]:=p;
p:=d[i]; d[i]:=d[j]; d[j]:=p;
inc(i);
dec(j);
end;
until i>j;
if l<j then qsort(l,j);
if i<r then qsort(i,r);
end;
begin
readln(n,m,o);
for i:=n downto 1 do
begin
c[i]:=i;
b:=a;
if i<>n then for j:=n downto i+1 do f[j]:=a[j];
d:=c;
k:=0;
if i<>n then qsort(i+1,n);
fillchar(a,sizeof(a),0);
if i<>n then zx(i,n);
a[i]:=m-k;
if a[i]<0 then
begin
for j:=n downto i+1 do a[j]:=f[j];
a[i]:=-1;
end;
end;
for i:=1 to n do write(a[i],' ');
end.
pascal->c++
再次感谢大佬!