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

[-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-]

Зачем такие задачи давать студентам

[-rescue-]

volvo, то тогда заместь нуля на начале появитса новая цыфра ? а ноль заместь той цыфре ? Или я не то сделал, у меня получилось вот так -
Просто цыфри:
1
6
0
3
7
Отсортированые(с восстановлениям нуля):
3
1
0
6
7

[volvo]

то тогда заместь нуля на начале появитса новая цыфра ? а ноль заместь той цыфре ?

Не совсем так... Надо будет сдвигать все от запомненной позиции нуля влево на один элемент (начинать справа, а не слева), и на освободившееся справа место устанавливать 0. И так - столько раз, сколько нулей было в массиве изначально... Move прекрасно решает эту проблему...

[-rescue-]

volvo, смотрите я добавил к єтой умове -

 if  i<=j then 

добавил ещё одно "если"

if (a[i]<>0) and (a[j]<>0) then ...

То если у меня в файле 3-2 нуля, то оно их нормально пропускает, а если больше примерно к 20-50 при масиве 10 000 то оно как сказать "вилетают" ис своих мест. Не пойму что делать

[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

[volvo]

А потому что я сказал тебе: QuickSort - это тебе не сортировка вставками... У тебя и при малом количестве нулей ничего не работает (программа, которая вылетает с Segmentation Fault не может считаться рабочей)... Я написал тебе выше, что надо делать. Если хочешь - покажу, как. Не хочешь - отлавливай глюки дальше... Как надоест - скажешь...

[-rescue-]

Segmentation Fault ? Что это такое )) ? Как это не работало ? Работает (при 2-3 нуляг гг) !!!

Сообщение отредактировано: -rescue- - 17.03.2009 23:56

[volvo]

Если Turbo Pascal пропускает заведомо неправильную программу - это проблемы Turbo Pascal-я. Правильной от этого программа не становится. Попробуй прогнать эту программу под Free Pascal-ем (или Дельфи - консольное приложение), которые гораздо аккуратнее контролируют процесс выполнения - убедишься, что она не рабочая. Хочешь - покажу скриншот...

[-rescue-]

volvo, скриншот в Дельфи хочу

[volvo]

скриншот в Дельфи хочу

Ну, хочешь - получи: