14.12.2013, 19:36 | #1 (permalink) |
Member
Регистрация: 09.12.2013
Сообщений: 18
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Turbo Pascal: сортировка вставками
Условие было такое:Дан одномерный массив, отсортировать первую его половину по возрастанию, а вторую по убыванию. Здесь применялась сортировка вставками, но в самой процедуре ошибки. Помогите исправить, чтобы заработало. Код:
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 Vstavkami (Kol:Integer; var A: T_Mas); var k,i,j,buf:byte; begin k:= Kol div 2; {сортировка вставками по возрастанию первой половины} for i:=2 to k-1 do begin buf:=a[i]; j:=i-1; while (j>=1) and (a[j]>buf) do begin a[j+1]:=a[j]; j:=j-1; end; a[j+1]:=buf; end; end; {сортировка вставками по убыванию второй половины} for i:=2 to Kol-1 do begin buf:=a[i]; j:=i-1; while (j>=1) and (a[j]<buf) do begin a[j+1]:=a[j]; j:=j-1; end; a[j+1]:=buf; end; end; Begin ClrScr; Count(Kol); Filling(Kol, Mas); WriteLn('Исходный массив'); Print (Kol, Mas); Vstavkami (Kol, Mas); WriteLn; WriteLn('Отсортированный массив'); Print (Kol, Mas); Repeat until KeyPressed End. |
14.12.2013, 19:36 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
Можно поискать нужные ответы тут Turbo Pascal Пирамидальная сортировка Сортировка Turbo Pascal Turbo Pascal Turbo Pascal Turbo Pascal Turbo Pascal |
15.12.2013, 10:02 | #4 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
И тем не менее (вдруг пригодится; в частности, фильтр ввода размера массива у Вас сделан безобразно):
Код:
Uses Crt; Const N = 50; Type T_Mas = Array [0..N+1] of Integer; Var Mas: T_Mas; Kol: Integer; Procedure Count (Var Kl:Integer); Var IOR:Word; B:boolean; Begin {$I-} Write('Enter the array dimension: '); Repeat B:=true; ReadLn(Kl); IOR:= IOResult; If IOR<>0 then begin Writeln('Enter the integer value!'); B:=false; end; If B and ((Kl<2) or (Kl>N)) then begin Writeln('Value out of range!'); B:=false; end; If B and Odd(Kl) then begin Writeln('Dimension must be even!'); B:=false; end; If Not(B) then Write('Error. New value: ') Until B; {$I+} End; Procedure Filling (Kl:Integer; Var A: T_Mas); Var i:Integer; Begin Randomize; For i:= 1 to Kl do A[i]:= Random(N) End; Procedure Print(Kl:Integer; A: T_Mas); Var i: Integer; Begin For i:=1 to Kl do Write(A[i]:4) End; Procedure Vstavkami (Kl:integer; var A: T_Mas); var k,i,j,buf,q:byte; begin A[0]:=0; A[Kl+1]:=0; k:= Kl div 2; {First half Insert sorting} for i:=2 to k do begin j:=i; while A[j-1]>A[j] do begin buf:=A[j-1]; A[j-1]:=A[j]; A[j]:=buf; Dec(j); end; end; {Second half Insert sorting} for i:=Kl-1 downto k+1 do begin j:=i; while A[j+1]>A[j] do begin buf:=A[j+1]; A[j+1]:=A[j]; A[j]:=buf; Inc(j); end; end; end; Begin ClrScr; Count(Kol); Filling(Kol, Mas); WriteLn('Initial array:'); Print (Kol, Mas); Vstavkami (Kol, Mas); WriteLn; WriteLn('Sorted array:'); Print (Kol, Mas); ReadKey End. |
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
|
|