Line data Source code
1 : % Copyright (C) 2012-2021,2022 John E. Davis
2 : %
3 : % This file is part of the S-Lang Library and may be distributed under the
4 : % terms of the GNU General Public License. See the file COPYING for
5 : % more information.
6 : %---------------------------------------------------------------------------
7 1 : require ("arrayfuns");
8 :
9 : private define user_sort_cmp (cd, i, j)
10 : {
11 3755 : variable list = cd.list;
12 3755 : return (@cd.cmp) (list[i], list[j]);
13 : }
14 :
15 : private define default_sort_cmp (list, i, j)
16 : {
17 1896 : if (list[i] > list[j]) return 1;
18 618 : if (list[i] == list[j]) return 0;
19 618 : return -1;
20 : }
21 :
22 :
23 : define list_sort (list)
24 : {
25 136 : variable dir = qualifier ("dir", 1);
26 136 : variable cmp = qualifier ("cmp");
27 :
28 136 : variable n = length (list);
29 : variable i;
30 136 : if (cmp == NULL)
31 136 : i = array_sort (list, &default_sort_cmp, n; dir=dir);
32 : else
33 272 : i = array_sort (struct {list=list, cmp=cmp}, &user_sort_cmp, n; dir=dir);
34 :
35 136 : variable inplace = qualifier ("inplace", 0);
36 136 : if (inplace == 0)
37 68 : return i;
38 :
39 68 : rearrange (list, i);
40 : }
41 :
42 : % Heap Implementation
43 :
44 : private define heap_length (h)
45 : {
46 1190 : return length (h.list);
47 : }
48 :
49 : private define upheap (list, k, cmp)
50 : {
51 578 : variable obj = list[k];
52 578 : variable k2 = (k-1)/2;
53 1153 : while (k && (@cmp)(obj,list[k2]) > 0)
54 : {
55 575 : list[k] = list[k2];
56 575 : k = k2;
57 575 : k2 = (k-1)/2;
58 : }
59 578 : list[k] = obj;
60 : }
61 :
62 : private define downheap (list, k, cmp)
63 : {
64 1056 : variable obj = list[k];
65 2112 : variable n = length(list), n2 = n/2;
66 1056 : n--;
67 : % 0
68 : % 1 2
69 : % 3 4 5 6
70 : % 7 8 9 10 11 12 13 14
71 3417 : while (k < n2)
72 : {
73 2513 : variable j = 2*k + 1;
74 2513 : if ((j < n)
75 : && ((@cmp)(list[j], list[j+1]) < 0))
76 1013 : j++;
77 2513 : if ((@cmp)(obj, list[j]) >= 0)
78 152 : break;
79 2361 : list[k] = list[j];
80 2361 : k = j;
81 : }
82 1056 : list[k] = obj;
83 : }
84 :
85 :
86 : private define heap_add (h, obj)
87 : {
88 578 : variable list = h.list;
89 578 : list_append (list, obj);
90 578 : upheap (list, length(list)-1, h.cmp);
91 : }
92 :
93 : private define heap_pop (h)
94 : {
95 1122 : variable list = h.list;
96 1122 : variable obj = list[0];
97 1122 : variable last = list_pop(list, -1);
98 1122 : if (length (list))
99 : {
100 1056 : list[0] = last;
101 1056 : downheap (list, 0, h.cmp);
102 : }
103 1122 : return obj;
104 : }
105 :
106 : private define heap_peek (h)
107 : {
108 1122 : return h.list[0];
109 : }
110 :
111 : private define default_heap_cmp (a, b)
112 : {
113 4032 : if (a > b) return 1;
114 3936 : if (a < b) return -1;
115 0 : return 0;
116 : }
117 :
118 : private define default_heap_cmp_rev (a, b)
119 : {
120 4875 : if (a > b) return -1;
121 2010 : if (a < b) return 1;
122 0 : return 0;
123 : }
124 :
125 :
126 : define heap_new ()
127 : {
128 69 : if (_NARGS == 0)
129 1 : usage (`
130 : h = new_heap (list; cmp=&cmpfun, dir=val);
131 : len = h.length();
132 : h.add (item);
133 : top = h.remove();
134 : top = h.peek ();
135 : `
136 : );
137 :
138 68 : variable list = ();
139 68 : variable cmp = qualifier ("cmp");
140 68 : variable dir = qualifier ("dir", -1);
141 :
142 : % The conventional interpretation of a heap is that the largest
143 : % element is at the root, and smaller ones below. For this reason,
144 : % dir=-1 (ascending order) is the default for sorting.
145 204 : list_sort (list; cmp=cmp, dir=dir, inplace);
146 :
147 68 : if (cmp == NULL)
148 : {
149 68 : cmp = (dir <= 0) ? &default_heap_cmp : &default_heap_cmp_rev;
150 : }
151 :
152 68 : variable h = struct
153 : {
154 68 : list = list,
155 68 : cmp = cmp,
156 68 : length = &heap_length,
157 68 : add = &heap_add,
158 68 : remove = &heap_pop,
159 68 : peek = &heap_peek,
160 : };
161 68 : return h;
162 : }
|
