]>
Commit | Line | Data |
---|---|---|
38cbfe40 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3084fecd | 3 | -- GNAT RUN-TIME COMPONENTS -- |
38cbfe40 RK |
4 | -- -- |
5 | -- G N A T . H E A P _ S O R T _ A -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
4b490c1e | 9 | -- Copyright (C) 1995-2020, AdaCore -- |
38cbfe40 RK |
10 | -- -- |
11 | -- GNAT is free software; you can redistribute it and/or modify it under -- | |
12 | -- terms of the GNU General Public License as published by the Free Soft- -- | |
607d0635 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
38cbfe40 RK |
14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
607d0635 AC |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
17 | -- -- | |
18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
19 | -- additional permissions described in the GCC Runtime Library Exception, -- | |
20 | -- version 3.1, as published by the Free Software Foundation. -- | |
21 | -- -- | |
22 | -- You should have received a copy of the GNU General Public License and -- | |
23 | -- a copy of the GCC Runtime Library Exception along with this program; -- | |
24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
25 | -- <http://www.gnu.org/licenses/>. -- | |
38cbfe40 | 26 | -- -- |
fbf5a39b AC |
27 | -- GNAT was originally developed by the GNAT team at New York University. -- |
28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
38cbfe40 RK |
29 | -- -- |
30 | ------------------------------------------------------------------------------ | |
31 | ||
0355e3eb | 32 | pragma Compiler_Unit_Warning; |
2d9ea47f | 33 | |
38cbfe40 RK |
34 | package body GNAT.Heap_Sort_A is |
35 | ||
36 | ---------- | |
37 | -- Sort -- | |
38 | ---------- | |
39 | ||
40 | -- We are using the classical heapsort algorithm (i.e. Floyd's Treesort3) | |
41 | -- as described by Knuth ("The Art of Programming", Volume III, first | |
42 | -- edition, section 5.2.3, p. 145-147) with the modification that is | |
43 | -- mentioned in exercise 18. For more details on this algorithm, see | |
44 | -- Robert B. K. Dewar PhD thesis "The use of Computers in the X-ray | |
45 | -- Phase Problem". University of Chicago, 1968, which was the first | |
46 | -- publication of the modification, which reduces the number of compares | |
47 | -- from 2NlogN to NlogN. | |
48 | ||
49 | procedure Sort (N : Natural; Move : Move_Procedure; Lt : Lt_Function) is | |
50 | ||
51 | Max : Natural := N; | |
52 | -- Current Max index in tree being sifted | |
53 | ||
54 | procedure Sift (S : Positive); | |
55 | -- This procedure sifts up node S, i.e. converts the subtree rooted | |
56 | -- at node S into a heap, given the precondition that any sons of | |
57 | -- S are already heaps. On entry, the contents of node S is found | |
58 | -- in the temporary (index 0), the actual contents of node S on | |
59 | -- entry are irrelevant. This is just a minor optimization to avoid | |
60 | -- what would otherwise be two junk moves in phase two of the sort. | |
61 | ||
62 | procedure Sift (S : Positive) is | |
63 | C : Positive := S; | |
64 | Son : Positive; | |
65 | Father : Positive; | |
66 | ||
67 | begin | |
68 | -- This is where the optimization is done, normally we would do a | |
69 | -- comparison at each stage between the current node and the larger | |
70 | -- of the two sons, and continue the sift only if the current node | |
71 | -- was less than this maximum. In this modified optimized version, | |
72 | -- we assume that the current node will be less than the larger | |
73 | -- son, and unconditionally sift up. Then when we get to the bottom | |
74 | -- of the tree, we check parents to make sure that we did not make | |
e14c931f | 75 | -- a mistake. This roughly cuts the number of comparisons in half, |
38cbfe40 RK |
76 | -- since it is almost always the case that our assumption is correct. |
77 | ||
78 | -- Loop to pull up larger sons | |
79 | ||
80 | loop | |
81 | Son := 2 * C; | |
82 | exit when Son > Max; | |
83 | ||
84 | if Son < Max and then Lt (Son, Son + 1) then | |
85 | Son := Son + 1; | |
86 | end if; | |
87 | ||
88 | Move (Son, C); | |
89 | C := Son; | |
90 | end loop; | |
91 | ||
92 | -- Loop to check fathers | |
93 | ||
94 | while C /= S loop | |
95 | Father := C / 2; | |
96 | ||
97 | if Lt (Father, 0) then | |
98 | Move (Father, C); | |
99 | C := Father; | |
100 | else | |
101 | exit; | |
102 | end if; | |
103 | end loop; | |
104 | ||
105 | -- Last step is to pop the sifted node into place | |
106 | ||
107 | Move (0, C); | |
108 | end Sift; | |
109 | ||
110 | -- Start of processing for Sort | |
111 | ||
112 | begin | |
113 | -- Phase one of heapsort is to build the heap. This is done by | |
114 | -- sifting nodes N/2 .. 1 in sequence. | |
115 | ||
116 | for J in reverse 1 .. N / 2 loop | |
117 | Move (J, 0); | |
118 | Sift (J); | |
119 | end loop; | |
120 | ||
121 | -- In phase 2, the largest node is moved to end, reducing the size | |
122 | -- of the tree by one, and the displaced node is sifted down from | |
123 | -- the top, so that the largest node is again at the top. | |
124 | ||
125 | while Max > 1 loop | |
126 | Move (Max, 0); | |
127 | Move (1, Max); | |
128 | Max := Max - 1; | |
129 | Sift (1); | |
130 | end loop; | |
131 | ||
132 | end Sort; | |
133 | ||
134 | end GNAT.Heap_Sort_A; |