IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Пропуск нулей в быстрой сортировке(хоара)., Пропуск нулей
-rescue-
сообщение 15.03.2009 13:02
Сообщение #1





Группа: Пользователи
Сообщений: 7
Пол: Мужской
Реальное имя: Саша

Репутация: -  0  +


Нада доделать задачу, чтобы сортировка пропускала 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.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 29.07.2025 4:25
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"