1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 | uses crt; const nmax=100; type mas=array[0..nmax] of integer; procedure Vvod(var a:mas;var n:integer); var i:integer; begin repeat write('Размер массива от 5 до ',nmax,' n='); readln(n); until (n>4)and(n<=nmax); for i:=1 to n do a[i]:=random(1000); end; procedure Vyvod(a:mas;n:integer); var i:integer; begin for i:=1 to n do write(a[i]:4); writeln; end; function Prz(n:integer):integer; var m,p:integer; begin m:=n; p:=1; while m>0 do begin p:=p*(m mod 10); m:=m div 10; end; Prz:=p end; procedure Shell(var a:mas; n:integer); const b:array[1..5] of byte = (9,5,3,2,1); var i,j,k,x,t:integer; begin for k:=1 to 5 do begin x:=b[k]; for i:=x to n do begin t:=a[i]; j:=i-x; while (Prz(t)<Prz(a[j])) and (j>=x) do begin a[j+x]:=a[j]; j:=j-x; end; a[j+x]:=t; end; end; end; var a:mas; n:integer; w:char; begin randomize; clrscr; Vvod(a,n); writeln('Исходный массив:'); Vyvod(a,n); Shell(a,n); writeln('Отсортированный массив:'); Vyvod(a,n); readln end. |
пятница, 24 января 2014 г.
Дан одномерный массив целых чисел. Отсортировать его в порядке возрастания произведения цифр методом Шелла.
Подписаться на:
Комментарии к сообщению (Atom)
Комментариев нет:
Отправить комментарий