HOME ПРИМЕРЫ THANKS НОВИЧКАМ ДОКИ LINKS JavaScript Mail | |||
| |||
|
Turbo Pascal Examples | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Графика:
Чтобы сравнить время исполнения сортировки различными методами, включена процедура подсчета времени выполнения. Я сравнил сортировку по Шеллу с сортировкой методом вставки для n=7000. Шелл выполнился за 0.29 сек, а вставки - за 3.24 сек. Так что делайте выводы. Кстати, а что надо исправить в программе, чтобы из метода Шелла вышел метод вставки? ;-) |
{ сортировка Шелла } uses crt,timeunit; const n=7000; type DataItem=integer; DataArray=array[0..n-1] of DataItem; var a:DataArray; i,nit:word; f:text; h, m, s, hund : Word; Procedure PrintArr(a:DataArray); begin for i:=0 to n-1 do write(a[i]:4); end; Procedure PrintArrF(s:string;k:integer;a:DataArray); begin write(f,nit:4,' h=',k,' ',s); nit:=nit+1; for i:=0 to n-1 do write(f,a[i]:4); writeln(f); end; procedure Shell(var item: DataArray; n:integer); const a:array[1..5] of byte = (9,5,3,2,1); var i,j,k,gap:integer; temp:DataItem; begin for k:=1 to 5 do begin gap:=a[k]; for i:=gap to n-1 do begin temp:=item[i]; j:=i-gap; while (temp<item[j]) and (j>=0) do begin item[j+gap]:=item[j]; j:=j-gap; {PrintArrF('j ',gap,item);} end; item[j+gap]:=temp; {PrintArrF('i ',gap,item);} end; end; end; begin writeln; randomize; for i:=0 to n-1 do begin a[i]:=random(30)-10; end; assign(f,'shell_rs.txt'); rewrite(f); nit:=0; PrintArrF('b ',0,a); {PrintArr(a);} ResetTimePoint; { Отметить начало отсчета времени } Shell(a,n); GetTimePoint(h,m,s,hund); writeln(' Сортировка заняла ',h,' часов ',m,' минут ',s,'.',hund,' секунд.'); writeln; {PrintArr(a);} PrintArrF('= ',0,a); close(f); end. (******************************) { Этот текст нужно скопировать в одтельный файл timeunit.pas } unit timeunit; interface Procedure ResetTimePoint; { Отметить начало отсчета времени } Procedure GetTimePoint(var dh, dm, ds, dhund : Word); { Выдать время от начала отсчета. См. процедуру SetTimePoint } implementation uses Dos; type mytime=record h, m, s, hund : Word; end; var timebeg,timecurr:mytime; Procedure ResetTimePoint; { Отметить начало отсчета времени } begin with timebeg do GetTime(h,m,s,hund); end; Procedure GetTimePoint(var dh, dm, ds, dhund : Word); Procedure DecHour(var t:mytime;dt:byte); begin if t.h>0 then dec(t.h); end; Procedure DecMin(var t:mytime;dt:byte); begin if t.m>dt-1 then dec(t.m,dt) else begin t.m:=60+t.m-dt; DecHour(t,1); end; end; Procedure DecSec(var t:mytime;dt:byte); begin if t.s>dt-1 then dec(t.s,dt) else begin t.s:=60+t.s-dt; DecMin(t,1); end; end; Procedure DecDSec(var t:mytime;dt:byte); begin if t.hund>dt-1 then dec(t.hund,dt) else begin t.hund:=60+t.hund-dt; DecSec(t,1); end; end; { Выдать время от начала отсчета. См. процедуру SetTimePoint } begin with timecurr do begin GetTime(h,m,s,hund); if hund>=timebeg.hund then dhund:=hund-timebeg.hund else begin dhund:=100+hund-timebeg.hund; DecSec(timecurr,1) end; if s>=timebeg.s then ds:=s-timebeg.s else begin ds:=60+s-timebeg.s; DecMin(timecurr,1) end; if m>=timebeg.m then dm:=m-timebeg.m else begin dm:=60+m-timebeg.m; DecHour(timecurr,1) end; if h>=timebeg.h then dh:=h-timebeg.h else dh:=24+h-timebeg.h; end; end; begin ResetTimePoint end. {Все. Дальше пошли справочные материалы. Сначала текст на С, а потом неработающий на Паскале } (* void shall_sort(int *array, int n) { int i, j, k, gap, temp; int a[] = {9, 5, 3, 2, 1}; for (k = 0; k < 5; k++) { gap = a[k]; for (i = gap; i < n; i++) { temp = array[i]; for (j = i-gap; temp < array[j] && j >= 0; j-=gap) array[j+gap] = array[j]; array[j+gap] = temp; } } } *) procedure Shell1(var item: DataArray; count:integer); { doesn't work } const t = 5; var i, j, k, s, m: integer; h: array[1..t] of integer; x: DataItem; begin h[1]:=9; h[2]:=5; h[3]:=3; h[4]:=2; h[5]:=1; for m := 1 to t do begin k:=h[m]; s:=-k; for i := k+1 to count do begin x := item[i]; j := i-k; if s=0 then begin s := -k; s := s+1; item[s] := x; end; while (x<item[j]) and (j<count) do begin item[j+k] := item[j]; j := j-k; end; item[j+k] := x; end; end; end; { конец сортировки Шелла }             |
HOME |