Shell Sorting by Bel

 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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
program shell_sort;
uses crt;
type
tlist=^treclist;
treclist=record
inf:integer;
next:tlist;
prev:tlist
end;
var genfirst: tlist;
procedure create_list(var first:tlist; inp:string);
var p:tlist; f:text;
begin
assign(f,inp);
reset(f);
new(p);
first:=p;
while not eof(f) do
begin
new(p^.next);
p^.next^.prev:=p;
p:=p^.next;
read(f,p^.inf);
p^.next:=nil;
end;
end;
procedure output_list(first:tlist; out:string; q:boolean);
var p:tlist; f:text;
begin
assign(f,out);
if not q
then rewrite(f)
else
begin
append(f);
writeln(f)
end;
p:=first;
while p^.next<>nil do
begin
p:=p^.next;
write(f,p^.inf,' ')
end;
close(f)
end;
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;
if h mod 2 = 0 then b:=true;
h:=(h+1) div 2;
while h>1 do
begin
writeln(h);
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;
end;
begin
create_list(genfirst,'input.inp');
output_list(genfirst,'output.out',false);
shellsort(genfirst);
output_list(genfirst,'output.out',true)
end.