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 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
-rescue-
сообщение 17.03.2009 20:33
Сообщение #2





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

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


volvo, скриншот в Дельфи хочу smile.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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


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

 



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