22.03.2017, 15:39 | #11 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Код:
Type Ar=Array[1..255] of Byte; Var A:Ar; k,N,i:Byte; Procedure Exch(q:byte; var C:Ar); Var Mx1,Mx2:Integer; D,m,p:byte; begin p:=1+q; Mx1:=-1; for m:=1+q to N do if (C[m]>Mx1) and ((C[m] mod 2)=1) then begin p:=m; Mx1:=C[p]; end; if Mx1>-1 then begin D:=C[1+q]; C[1+q]:=C[p]; C[p]:=D; end; p:=1+q; Mx2:=-1; for m:=1+q to N-q do if (C[m]>Mx2) and ((C[m] mod 2)=0) then begin p:=m; Mx2:=C[p]; end; if Mx2>-1 then begin D:=C[N-q]; C[N-q]:=C[p]; C[p]:=D; end; end; Begin Randomize; Write(' N = '); Readln(N); Writeln('Initial array:'); for i:=1 to N do begin A[i]:=Random(100); write(A[i]:4); end; writeln; writeln; for k:=0 to N-1 do Exch(k,A); Writeln('Ordered array:'); for i:=1 to N do write(A[i]:4); Readln End. |
22.03.2017, 15:39 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
Решение этой проблемы можно ускорить, прочитав похожие темы Опять массивы вирус про бонус, опять не пускают ВКонтакте, так глупо опять попалась при распаковке Массивы, C |
22.03.2017, 21:21 | #12 (permalink) |
Member
Регистрация: 31.03.2010
Адрес: Тульская область
Сообщений: 1,309
Сказал(а) спасибо: 11
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 13090
|
Да, вроде, и ничего сложного.
Код:
uses Crt; const n=10; var a:array[1..n] of integer; i,t,ti,k,m,p:integer; begin ClrScr; Randomize; for i:=1 to n do begin a[i]:=Random(99)+1; Write(a[i]:4); end; Writeln; Writeln; m:=1; k:=n; p:=0; repeat Inc(p); t:=0; for i:=m to k do if a[i]>t then begin t:=a[i]; ti:=i; end; if (p mod 2)<>0 then begin for i:=ti downto m+1 do a[i]:=a[i-1]; a[m]:=t; Inc(m); end else begin for i:=ti to k-1 do a[i]:=a[i+1]; a[k]:=t; Dec(k); end; until (m=k); for i:=1 to n do Write(a[i]:4); Readkey; end. |
22.03.2017, 21:48 | #13 (permalink) |
Banned
Регистрация: 06.03.2017
Сообщений: 788
Сказал(а) спасибо: 0
Поблагодарили 18 раз(а) в 4 сообщениях
Репутация: 5680
|
Вариантов решения задач - масса. Главное, чтобы они были понятны студентам.
Так-то вообще все решается в "одну строчку" ar.Sort(lambda); Для студентов более понятен метод "разделяй и властвуй" и более высокоуровневый стиль. Пример работы над массивом "на месте", но с разделением обработки четных и нечетных чисел. Процедуры сортировки могут быть объединены в одну, но это - снижение наглядности. Код:
var arRnd: array of integer; const maxValue = 60; // Max value of rnd maxLen = 31; // arRnd.Length function Even_ahead(ar: array of integer): integer; var k: integer = 0; var x: integer; begin for var i :=0 to ar.Length-1 do if not Odd(ar[i]) then begin x := ar[i]; for var j := i downto k+1 do ar[j] := ar[j-1]; ar[k] := x; Inc(k); end; Result := k; end; procedure _Swap(ar: array of integer; i,j: integer); var x: integer; begin x := ar[i]; ar[i]:=ar[j]; ar[j]:=x; end; procedure Odd_Sort(ar: array of integer; k: integer); var x: integer; begin for var i := k to ar.Length-2 do for var j :=i to ar.Length-1 do if ar[i] > ar[j] then _Swap(ar,i,j); end; procedure Even_Sort(ar: array of integer; k: integer); var x: integer; begin for var i:=0 to k-2 do for var j :=i to k-1 do if ar[i] < ar[j] then _Swap(ar,i,j); end; begin SetLength(arRnd, maxLen); for var i := Low(arRnd) to High(arRnd) do arRnd[i] := random(MaxValue + 1); write('rnd=', arRnd.Length,' ', arRnd); writeln(); var k: integer = 0; // Тело основного цикла k := Even_Ahead(arRnd); Even_Sort(arRnd, k); Odd_Sort(arRnd, k); write('rnd=', arRnd.Length,' ', arRnd); writeln(); end. |
23.03.2017, 02:49 | #14 (permalink) |
Banned
Регистрация: 06.03.2017
Сообщений: 788
Сказал(а) спасибо: 0
Поблагодарили 18 раз(а) в 4 сообщениях
Репутация: 5680
|
Ну и, наверное, для метода поочередной обработки массива по частям - минимальный вариант:
Опять же - код прозрачен и легко понимаем. Код:
var ar: array of integer; const maxValue = 60; // Max value of rnd maxLen = 19; // ar.Length procedure _Swap(ar: array of integer; i,j: integer); var x: integer; begin x := ar[i]; ar[i]:=ar[j]; ar[j]:=x; end; begin // Init SetLength(ar, maxLen); for var i := Low(ar) to High(ar) do ar[i] := random(MaxValue + 1); write('rnd= ', ar.Length,' ', ar); writeln(); // Body var k: integer = 0; var x: integer; // Even to head for var i :=0 to ar.High do if not Odd(ar[i]) then begin x := ar[i]; for var j := i downto k+1 do ar[j] := ar[j-1]; ar[k] := x; Inc(k); end; // Sort even for var i:=0 to k-2 do for var j :=i to k-1 do if ar[i] < ar[j] then _Swap(ar,i,j); // Sort odd for var i := k to ar.High-1 do for var j :=i to ar.High do if ar[i] > ar[j] then _Swap(ar,i,j); write('sort=', ar.Length,' ', ar); writeln(); end. |
24.03.2017, 22:42 | #15 (permalink) |
Member
Регистрация: 11.12.2016
Сообщений: 26
Сказал(а) спасибо: 1
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Вы все правильно поняли, это и подразумевалось. Понятно было ваше решение, он подходило под мой случай больше остальных. Сам как-то не задумывался что , поэтому им тоже благодарен, задачку нашел в интернете, решал для себя, про вторую интерпретацию не подумал, извините что-ли, из-за путаницы
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
29.03.2017, 01:05 | #16 (permalink) |
Banned
Регистрация: 06.03.2017
Сообщений: 788
Сказал(а) спасибо: 0
Поблагодарили 18 раз(а) в 4 сообщениях
Репутация: 5680
|
Не здесь, но зашел среди профи междусобойчик о самом кратком, но и понятном коде решения этой задачи, причем на разных языках.
Наверное, самый короткий, но и понятный для студентов вариант, получился на PascalABC.Net ( используются лямбда-функции и массив остается без изменений): Код:
begin var ar := Seq(45,46,8,11,5,29,37,0,21,43,4,5,58,34,14,18,40,46,30); ar.Where(x -> x mod 2 = 0).SortedDescending.Print; Print(''); ar.Where(x -> x mod 2 <> 0).Sorted.Print; end. Код:
58 46 46 40 34 30 18 14 8 4 0 5 5 11 21 29 37 43 45 |
29.03.2017, 09:44 | #17 (permalink) | |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Цитата:
A[1] → B[1], A[2] → B[n], A[3] → B[2] A[4] → B[n-1]... У меня и эта задачка решена, вы же оба, дорогие коллеги, зациклились на четности. |
|
29.03.2017, 15:28 | #18 (permalink) |
Banned
Регистрация: 06.03.2017
Сообщений: 788
Сказал(а) спасибо: 0
Поблагодарили 18 раз(а) в 4 сообщениях
Репутация: 5680
|
Постом #15 ТС подтвердил, что разделение на четные-нечетные - правильное понимание его задачи. Сделать так, как я понял в начале - не проблема, но, в данном случае, я всего лишь демонстрирую своим примером краткость и понятность кода, присущие высокоуровенному подходу.
|
29.03.2017, 15:37 | #19 (permalink) | |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Цитата:
|
|
29.03.2017, 15:43 | #20 (permalink) |
Banned
Регистрация: 06.03.2017
Сообщений: 788
Сказал(а) спасибо: 0
Поблагодарили 18 раз(а) в 4 сообщениях
Репутация: 5680
|
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
Опции темы | |
Опции просмотра | |
|
|