|
Главная | Правила | Регистрация | Дневники | Справка | Пользователи | Календарь | Поиск | Сообщения за день | Все разделы прочитаны |
|
Опции темы | Опции просмотра |
09.12.2013, 23:02 | #1 (permalink) |
Member
Регистрация: 09.12.2013
Сообщений: 18
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Сортировка Turbo Pascal
Условие: Дан массив C(N). Преобразовать массив, упорядочив первую его половину элементов по возрастанию, а вторую по убыванию.(Известно, что N-четное). Применялся улучшенный метод: быстрая сортировка Хоара, но уже замучались с этим, не запускается и ошибки. Главное чтобы правильно сортировала по условию. Код:
Uses Crt; Const N = 50; Type T_Mas = Array [1..N] of Integer; Var Mas : T_Mas; Kol : Integer; Procedure Count (Var Kol:Integer); {Процедура определения размерности массива} Var IOR : Word; Begin Write('Введите размерность массива: '); Repeat {$I-} ReadLn(Kol); {$I+} IOR := IOResult; If odd(IOR) or (Kol>N) Then WriteLn('Ошибка. Повторите ввод.') Until (Kol<=N) and (IOR=0) End; Procedure Filling (Kol:Integer; Var A: T_Mas); {Процедура заполнения массива} Var I : Integer; Begin Randomize; For I := 1 To Kol Do A[I] := Random(N) End; Procedure Print (Kol:Integer; A: T_Mas); {Процедура вывода массива} Var I : Integer; Begin For I:=1 to Kol do Write (A[I], ' ') End; procedure quicksort1(var a: T_Mas; Lo,Hi: integer); procedure sort1(kol,l,r: integer); var i,j,x,y,k: integer; begin k:= Kol div 2; for i:=1 to k-1 do begin i:=l; j:=r; x := a[(r+l) div 2]; repeat while a[i]<x do i:=i+1; { a[i] > x - сортировка по убыванию} while x<a[j] do j:=j-1; { x > a[j] - сортировка по убыванию} if i<=j then begin if a[i] > a[j] then {это условие можно убрать} {a[i] < a[j] при сортировке по убыванию} begin y:=a[i]; a[i]:=a[j]; a[j]:=y; end; i:=i+1; j:=j-1; end; until i>=j; if l<j then sort1(l,j); if i<r then sort1(i,r); end; end; {sort} procedure sort2(kol,l, r : Integer); Var i, j, x, y, k: Integer; begin k:= Kol div 2; for i:=1 to k-1 do Begin i:=l; j:=r; x := a[(r+l) div 2]; repeat while a[i]>x do i:=i+1; { a[i] > x - сортировка по убыванию} while x>a[j] do j:=j-1; { x > a[j] - сортировка по убыванию} if i<=j then begin if a[i] < a[j] then {это условие можно убрать} {a[i] < a[j] при сортировке по убыванию} begin y:=a[i]; a[i]:=a[j]; a[j]:=y; end; i:=i+1; j:=j-1; end; until i>=j; if l<j then sort2(l,j); if i<r then sort2(i,r); end; End; begin {quicksort}; sort1(Lo,Hi); Lo := 11; Hi := 20; Sort2(Lo, Hi) end; {quicksort} Begin ClrScr; Count(Kol); Filling(Kol, Mas); WriteLn('Исходный массив'); Print (Kol, Mas); quickSort1(Mas, 1, 10); WriteLn; WriteLn('Отсортированный массив'); Print (Kol, Mas); Repeat until KeyPressed End. |
09.12.2013, 23:02 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
На форуме уже кто то создавал подобные обсуждения Turbo Pascal Turbo Pascal Turbo Pascal |
10.12.2013, 20:23 | #3 (permalink) |
Member
Регистрация: 09.12.2013
Сообщений: 18
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
да не говорите, уже всё перепробовали, но всё неправильно.
советовали сделать как-то без рекурсии, но ничего не понятно Спасибо, что отозвались, буду ждать вашей помощи! |
10.12.2013, 20:35 | #5 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
10.12.2013, 20:50 | #6 (permalink) |
Member
Регистрация: 09.12.2013
Сообщений: 18
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
да вот "счастье" такое, ну ладно как время будет
Ещё вопрос нам учитель просто задал сделать один базовый метод сортировки и один от него улучшенный, мы сделали базовую пузырьковая, а улучшенная получается быстрая сортировка, быстрая это и есть Хоара?(нам просто так объясняли) |
14.12.2013, 11:05 | #9 (permalink) | |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Цитата:
P.S. Впрочем, не исключено, что всё-таки повожусь с этим Хоаром. Уже для себя. Как говорил почтальон Печкин, "в порядке повышения образованности". |
|
14.12.2013, 11:25 | #10 (permalink) |
Member
Регистрация: 09.12.2013
Сообщений: 18
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
а с пирамидальной сортировкой не хотите повозиться?
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
Опции темы | |
Опции просмотра | |
|
|