Нихуя не Шелл

 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
67
68
69
procedure shellsort(first: tlist);
var p,q:tlist; i,h,temp:integer; b:boolean;
begin
clrscr;
h:=0;
p:=first;
while p^.next<>nil do
begin
p:=p^.next;
inc(h)
end;
h:=(h+1) div 2;
while h>1 do
begin
p:=first;
q:=p^.next;
p:=q;
for i:=1 to h-1 do p:=p^.next;
while p<>nil do
begin
if q^.inf>p^.inf
then
begin
temp:=q^.inf;
q^.inf:=p^.inf;
p^.inf:=temp
end;
q:=q^.next;
p:=p^.next
end;
h:=(h+1) div 2;
end;
{ppc}
p:=first;
b:=true;
while (p^.next<>nil) and (b=true) do
begin
p:=p^.next;
if p^.inf>p^.next^.inf then b:=false
end;
while b=false do
begin
if b=false then
begin
p:=first;
q:=p^.next;
p:=q^.next;
while p<>nil do
begin
if q^.inf>p^.inf
then
begin
temp:=q^.inf;
q^.inf:=p^.inf;
p^.inf:=temp
end;
q:=q^.next;
p:=p^.next
end
end;
p:=first;
b:=true;
while (p^.next<>nil) and (b=true) do
begin
p:=p^.next;
if p^.inf>p^.next^.inf then b:=false
end;
end
end;