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:fileof integer;
x:integer;
begin
randomize;
assign(f,'1.txt');
rewrite(f);
for i:=1to10000dobegin
x:=random(10000);
write(f,x);
end;
close(f);
end;
procedure fread(var a:mas);
var f:fileof integer;
idx:integer;
begin
idx:=1;
assign(f,'1.txt');
reset(f);
whilenot eof(f) dobegin
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;
beginif L<R thenbegin
p:=p+1;
x:=m[(l+r) div2];
i:=l; j:=r;
repeatwhile m[i]<x do inc(i);
while m[j]>x do dec(j);
if i<=j thenbegin
Por(i,j,pr);
Inc(i); Dec (j);
p:=p+1;
enduntil i>j;
Hoar(l,j,p,pr);
Hoar(i,r,p,pr);
endend;
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 downto1do writeln(f,m[i]);
close(f);
end;
begin
STV(i);
fread(m);
Hoar(1,n,kp,kpr);
fwrite(f);
end.
volvo
15.03.2009 17:14
Быстрая сортировка - не тот метод, где можно "пропускать" определенные значения аналогично методу вставок. Скорее всего, у тебя ничего не выйдет. Придется запоминать позиции, на которых находятся нули и после скончания сортировки восстанавливать их.
-rescue-
15.03.2009 17:21
Зачем такие задачи давать студентам
-rescue-
15.03.2009 19:52
volvo, то тогда заместь нуля на начале появитса новая цыфра ? а ноль заместь той цыфре ? Или я не то сделал, у меня получилось вот так - Просто цыфри: 1 6 0 3 7 Отсортированые(с восстановлениям нуля): 3 1 0 6 7
volvo
15.03.2009 20:34
Цитата
то тогда заместь нуля на начале появитса новая цыфра ? а ноль заместь той цыфре ?
Не совсем так... Надо будет сдвигать все от запомненной позиции нуля влево на один элемент (начинать справа, а не слева), и на освободившееся справа место устанавливать 0. И так - столько раз, сколько нулей было в массиве изначально... Move прекрасно решает эту проблему...
-rescue-
17.03.2009 21:44
volvo, смотрите я добавил к єтой умове -
if i<=j then
добавил ещё одно "если"
if (a[i]<>0) and (a[j]<>0) then ...
То если у меня в файле 3-2 нуля, то оно их нормально пропускает, а если больше примерно к 20-50 при масиве 10 000 то оно как сказать "вилетают" ис своих мест. Не пойму что делать
volvo
17.03.2009 21:56
Код "сохранения" и "замены" нулей - в студию...
-rescue-
17.03.2009 23:28
Цитата(volvo @ 17.03.2009 18:56)
Код "сохранения" и "замены" нулей - в студию...
Полностю код:
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:fileof integer;
x:integer;
begin
randomize;
assign(f,'1.txt');
rewrite(f);
for i:=1to10000dobegin
x:=random(10000);
write(f,x);
end;
close(f);
end;
procedure fread(var a:mas);
var f:fileof integer;
idx:integer;
begin
idx:=1;
assign(f,'1.txt');
reset(f);
whilenot eof(f) dobegin
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) DIV2];
repeatwhile a[ i ]<x do i:=i+1;
while x<a[ j ] do j:=j-1;
if (i<=j) then{***}beginif (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 downto1do 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) то оно их как то не пропускает "до конца" и получаетса не сортировка а каша.
А потому что я сказал тебе: QuickSort - это тебе не сортировка вставками... У тебя и при малом количестве нулей ничего не работает (программа, которая вылетает с Segmentation Fault не может считаться рабочей)... Я написал тебе выше, что надо делать. Если хочешь - покажу, как. Не хочешь - отлавливай глюки дальше... Как надоест - скажешь...
-rescue-
17.03.2009 23:53
Segmentation Fault ? Что это такое )) ? Как это не работало ? Работает (при 2-3 нуляг гг) !!!
volvo
18.03.2009 0:08
Если Turbo Pascal пропускает заведомо неправильную программу - это проблемы Turbo Pascal-я. Правильной от этого программа не становится. Попробуй прогнать эту программу под Free Pascal-ем (или Дельфи - консольное приложение), которые гораздо аккуратнее контролируют процесс выполнения - убедишься, что она не рабочая. Хочешь - покажу скриншот...
-rescue-
18.03.2009 0:33
volvo, скриншот в Дельфи хочу
volvo
18.03.2009 1:18
Цитата
скриншот в Дельфи хочу
Ну, хочешь - получи:
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.