]>
Commit | Line | Data |
---|---|---|
fbf5a39b AC |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3084fecd | 3 | -- GNAT RUN-TIME COMPONENTS -- |
fbf5a39b AC |
4 | -- -- |
5 | -- G N A T . H E A P _ S O R T -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
a2cb348e | 9 | -- Copyright (C) 1995-2005, AdaCore -- |
fbf5a39b AC |
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- -- | |
13 | -- ware Foundation; either version 2, or (at your option) any later ver- -- | |
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 -- | |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- | |
17 | -- for more details. You should have received a copy of the GNU General -- | |
18 | -- Public License distributed with GNAT; see file COPYING. If not, write -- | |
cb5fee25 KC |
19 | -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- |
20 | -- Boston, MA 02110-1301, USA. -- | |
fbf5a39b AC |
21 | -- -- |
22 | -- As a special exception, if other files instantiate generics from this -- | |
23 | -- unit, or you link this unit with other files to produce an executable, -- | |
24 | -- this unit does not by itself cause the resulting executable to be -- | |
25 | -- covered by the GNU General Public License. This exception does not -- | |
26 | -- however invalidate any other reasons why the executable file might be -- | |
27 | -- covered by the GNU Public License. -- | |
28 | -- -- | |
29 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
30 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
31 | -- -- | |
32 | ------------------------------------------------------------------------------ | |
33 | ||
34 | package body GNAT.Heap_Sort 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; Xchg : Xchg_Procedure; Lt : Lt_Function) is | |
50 | Max : Natural := N; | |
51 | -- Current Max index in tree being sifted. Note that we make Max | |
52 | -- Natural rather than Positive so that the case of sorting zero | |
53 | -- elements is correctly handled (i.e. does nothing at all). | |
54 | ||
55 | procedure Sift (S : Positive); | |
56 | -- This procedure sifts up node S, i.e. converts the subtree rooted | |
57 | -- at node S into a heap, given the precondition that any sons of | |
58 | -- S are already heaps. | |
59 | ||
60 | ---------- | |
61 | -- Sift -- | |
62 | ---------- | |
63 | ||
64 | procedure Sift (S : Positive) is | |
65 | C : Positive := S; | |
66 | Son : Positive; | |
67 | Father : Positive; | |
68 | ||
69 | begin | |
70 | -- This is where the optimization is done, normally we would do a | |
71 | -- comparison at each stage between the current node and the larger | |
72 | -- of the two sons, and continue the sift only if the current node | |
73 | -- was less than this maximum. In this modified optimized version, | |
74 | -- we assume that the current node will be less than the larger | |
75 | -- son, and unconditionally sift up. Then when we get to the bottom | |
76 | -- of the tree, we check parents to make sure that we did not make | |
77 | -- a mistake. This roughly cuts the number of comparisions in half, | |
78 | -- since it is almost always the case that our assumption is correct. | |
79 | ||
80 | -- Loop to pull up larger sons | |
81 | ||
82 | loop | |
83 | Son := C + C; | |
84 | ||
85 | if Son < Max then | |
86 | if Lt (Son, Son + 1) then | |
87 | Son := Son + 1; | |
88 | end if; | |
89 | elsif Son > Max then | |
90 | exit; | |
91 | end if; | |
92 | ||
93 | Xchg (Son, C); | |
94 | C := Son; | |
95 | end loop; | |
96 | ||
97 | -- Loop to check fathers | |
98 | ||
99 | while C /= S loop | |
100 | Father := C / 2; | |
101 | ||
102 | if Lt (Father, C) then | |
103 | Xchg (Father, C); | |
104 | C := Father; | |
105 | else | |
106 | exit; | |
107 | end if; | |
108 | end loop; | |
109 | end Sift; | |
110 | ||
111 | -- Start of processing for Sort | |
112 | ||
113 | begin | |
114 | -- Phase one of heapsort is to build the heap. This is done by | |
115 | -- sifting nodes N/2 .. 1 in sequence. | |
116 | ||
117 | for J in reverse 1 .. N / 2 loop | |
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 | Xchg (1, Max); | |
127 | Max := Max - 1; | |
128 | Sift (1); | |
129 | end loop; | |
130 | end Sort; | |
131 | ||
132 | end GNAT.Heap_Sort; |