Пропуск нулей в быстрой сортировке(хоара)., Пропуск нулей Опции

[-rescue-]

Нада доделать задачу, чтобы сортировка пропускала 0. Тоесть сортирувало пропуская нули. Сортировка хоара (процедуры Por, Hoar ). Помагите пожалуйста !

const n=10000;
type mas=array[1..n] of integer;
var
		m:mas;
		i,kp,kpr:longint;  f:text;

Procedure Stv(i:Integer);
Var
		f:file of integer;
		x:integer;
begin
		randomize;
		assign(f,'1.txt');
		rewrite(f);
		for i:=1 to 10000 do
begin
		x:=random(10000);
		write(f,x);
end;
		close(f);
end;


procedure fread(var a:mas);
var f:file of integer;
	idx:integer;
begin
	 idx:=1;
	 assign(f,'1.txt');
	 reset(f);
	 while not eof(f) do
begin
	 read(f,a[idx]);
	 idx:=idx+1;
end;
	close(f);
end;

Procedure  Por(i,j:integer; Var pr:longint);
Var		b:integer;
begin
		   b:=m[i]; m[i]:=m[j]; m[j]:=b;
		   pr:=pr+1;
end;

Procedure Hoar (l,r:integer; Var p,pr:longint);
var i,j,x,y : integer;
begin

	 if L<R then begin
	 p:=p+1;
	 x:=m[(l+r) div 2];
	 i:=l; j:=r;
	 repeat
	while m[i]<x do inc(i);
	while m[j]>x do dec(j);

	if  i<=j  then
begin
	 Por(i,j,pr);
	 Inc(i); Dec (j);
	 p:=p+1;
end
	 until i>j;
	 Hoar(l,j,p,pr);
	 Hoar(i,r,p,pr);

 end
end;




procedure fwrite(Var f:text);
var
	   i:integer;
begin
		assign(f,'2.txt');
		rewrite(f);
		writeln(f,kp);
		writeln(f,kpr);
		writeln (f,'');
		for i:=n downto 1 do writeln(f,m[i]);
		close(f);
end;
begin
	 STV(i);
	 fread(m);
	 Hoar(1,n,kp,kpr);
	 fwrite(f);
end.

[volvo]

Код "сохранения" и "замены" нулей - в студию...

[-rescue-]

Код "сохранения" и "замены" нулей - в студию...

Полностю код:

const n=10000;
type mas=array[1..n] of integer;
var
		m:mas;
		i,kp,kpr:longint;  f:text;

Procedure Stv(i:Integer);
Var
		f:file of integer;
		x:integer;
begin
		randomize;
		assign(f,'1.txt');
		rewrite(f);
		for i:=1 to 10000 do
begin
		x:=random(10000);
		write(f,x);
end;
		close(f);
end;


procedure fread(var a:mas);
var f:file of integer;
	idx:integer;
begin
	 idx:=1;
	 assign(f,'1.txt');
	 reset(f);
	 while not eof(f) do
begin
	 read(f,a[idx]);
	 idx:=idx+1;
end;
	close(f);
end;


procedure quicksort(var a:mas; Lo,Hi: integer );

procedure sort(l,r: integer; var p,pr:longint);
var
  i,j,x,y: integer;
begin
		i:=l; j:=r; p:=p+1;
		x:=a[(l+r) DIV 2];
repeat
		while a[ i ]<x do i:=i+1;
		while x<a[ j ] do j:=j-1;
		if (i<=j) then
{***} begin
		if (a[ i ]<>0) and (a[ j ]<>0) then {***}
begin   y:=a[ i ]; a[ i ]:=a[ j ];
		a[ j ]:=y; pr:=pr+1;
end;
		i:=i+1; j:=j-1;
end;
		 until i>j;
		 if l<j then sort(l,j,p,pr);
		 if i<r then sort(i,r,p,pr);
end;

begin
  sort(Lo,Hi,kp,kpr);
end;




procedure fwrite(Var a:mas; var  f:text);
var
	   i:integer;
begin
		assign(f,'2.txt');
		rewrite(f);
		writeln(f,kp);
		writeln(f,kpr);
		writeln (f,'');
		for i:=n downto 1 do writeln(f,a[ i ]);
		close(f);
end;
begin
	 STV(i);
	 fread(m);
	 QuickSort(m,1,n);
	 fwrite(m,f);
end.

При этом рендоме (10 000) нули будут попадатса редко, за весь текстовый файл максимум 3 или вобше их не будет, и спокойно пропускать будет. А если задать например рендомом (100-4) то нулей может быть дочерта ( у меня попадалась под 20-30) то оно их как то не пропускает "до конца" и получаетса не сортировка а каша.

(100-4)
Любые
"Сортированый"

Сообщение отредактировано: volvo - 13.03.2010 20:23