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
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: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) то оно их как то не пропускает "до конца" и получаетса не сортировка а каша.
А потому что я сказал тебе: 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
Цитата
скриншот в Дельфи хочу
Ну, хочешь - получи:
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.