_MEM Sort by SMcNeill

[The Librarian]

_MEM Sort

Contributor(s): @SMcNeill
Source: qb64 @ Freeformus
URL: http://qb64.freeforums.net/thread/28/mem-sort
Tags: [_MEM] [sort]

Description:
The following routine is a quick and efficient way to sort almost any type of array, regardless of data type. (The one thing it doesn't sort is variable-length strings, as _MEM doesn't support those at all.)

Source Code:

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(1280, 720, 256)
2. RANDOMIZE TIMER
3.  
4. DIM m AS _MEM
5. DIM x(5) AS _BYTE
6. DIM y(7) AS DOUBLE
7. DIM z(5) AS STRING * 5
8.  
9. 'Let's see if we can sort the integer array
10. 'Initialize Data
11. FOR i = 0 TO 5: x(i) = RND * 100: PRINT x(i),: NEXT: PRINT
12. PRINT "----------------------------------------------------------------------------------------------------------------------------------------------------------------"
13.  
14. 'Sort
15. m = _MEM(x())
16. Sort m
17. _MEMFREE m
18.  
19. 'Result
20. FOR i = 0 TO 5: PRINT x(i),: NEXT: PRINT
21.  
22. PRINT "----------------------------------------------------------------------------------------------------------------------------------------------------------------"
23. PRINT
24. PRINT
25.  
26.  
27. 'Try the same routine with a different data type array to sort
28. 'Initialize Data
29. FOR i = 0 TO 7: y(i) = RND * 100: PRINT y(i),: NEXT
30. PRINT
31. PRINT "----------------------------------------------------------------------------------------------------------------------------------------------------------------"
32.  
33. 'Sort
34. m = _MEM(y())
35. Sort m
36. _MEMFREE m
37.  
38. 'Result
39. FOR i = 0 TO 7: PRINT y(i),: NEXT: PRINT
40. PRINT "----------------------------------------------------------------------------------------------------------------------------------------------------------------"
41. PRINT
42. PRINT
43.  
44.  
45. 'To test with fixed length string arrays
46. z(0) = "Doggy": z(1) = "Pudding": z(2) = "Frog ": z(3) = "test2": z(4) = "Test2": z(5) = "test1"
47. FOR i = 0 TO 5: PRINT z(i),: NEXT: PRINT
48. PRINT "----------------------------------------------------------------------------------------------------------------------------------------------------------------"
49.  
50. m = _MEM(z())
51. Sort m
52. _MEMFREE m
53.  
54. 'Result
55. FOR i = 0 TO 5: PRINT z(i),: NEXT: PRINT
56.  
57. SLEEP
58. SYSTEM
59.  
60.  
61.  
62. SUB Sort (m AS _MEM)
63.     DIM i AS _UNSIGNED LONG
64.     $IF 64BIT THEN
65.         DIM ES AS _INTEGER64, EC AS _INTEGER64
66.     $ELSE
67.         DIM ES AS LONG, EC AS LONG
68.     $END IF
69.  
70.     IF NOT m.TYPE AND 65536 THEN EXIT SUB 'We won't work without an array
71.     IF m.TYPE AND 1024 THEN DataType = 10
72.     IF m.TYPE AND 1 THEN DataType = DataType + 1
73.     IF m.TYPE AND 2 THEN DataType = DataType + 2
74.     IF m.TYPE AND 4 THEN IF m.TYPE AND 128 THEN DataType = DataType + 4 ELSE DataType = 3
75.     IF m.TYPE AND 8 THEN IF m.TYPE AND 128 THEN DataType = DataType + 8 ELSE DataType = 5
76.     IF m.TYPE AND 32 THEN DataType = 6
77.     IF m.TYPE AND 512 THEN DataType = 7
78.  
79.     'Convert our offset data over to something we can work with
80.     DIM m1 AS _MEM: m1 = _MEMNEW(LEN(ES))
81.     _MEMPUT m1, m1.OFFSET, m.ELEMENTSIZE: _MEMGET m1, m1.OFFSET, ES 'Element Size
82.     _MEMPUT m1, m1.OFFSET, m.SIZE: _MEMGET m1, m1.OFFSET, EC 'Element Count will temporily hold the WHOLE array size
83.     _MEMFREE m1
84.  
85.     EC = EC / ES - 1 'Now we take the whole element size / the size of the elements and get our actual element count.  We subtract 1 so our arrays start at 0 and not 1.
86.     'And work with it!
87.     DIM o AS _OFFSET, o1 AS _OFFSET, counter AS _UNSIGNED LONG
88.  
89.     SELECT CASE DataType
90.         CASE 1 'BYTE
91.             DIM temp1(-128 TO 127) AS _UNSIGNED LONG
92.             DIM t1 AS _BYTE
93.             i = 0
94.             DO
95.                 _MEMGET m, m.OFFSET + i, t1
96.                 temp1(t1) = temp1(t1) + 1
97.                 i = i + 1
98.             LOOP UNTIL i > EC
99.             i1 = -128
100.             DO
101.                 DO UNTIL temp1(i1) = 0
102.                     _MEMPUT m, m.OFFSET + counter, i1 AS _BYTE
103.                     counter = counter + 1
104.                     temp1(i1) = temp1(i1) - 1
105.                     IF counter > EC THEN EXIT SUB
106.                 LOOP
107.                 i1 = i1 + 1
108.             LOOP UNTIL i1 > 127
109.         CASE 2: 'INTEGER
110.             DIM temp2(-32768 TO 32767) AS _UNSIGNED LONG
111.             DIM t2 AS INTEGER
112.             i = 0
113.             DO
114.                 _MEMGET m, m.OFFSET + i * 2, t2
115.                 temp2(t2) = temp2(t2) + 1
116.                 i = i + 1
117.             LOOP UNTIL i > EC
118.             i1 = -32768
119.             DO
120.                 DO UNTIL temp2(i1) = 0
121.                     _MEMPUT m, m.OFFSET + counter * 2, i1 AS INTEGER
122.                     counter = counter + 1
123.                     temp2(i1) = temp2(i1) - 1
124.                     IF counter > EC THEN EXIT SUB
125.                 LOOP
126.                 i1 = i1 + 1
127.             LOOP UNTIL i1 > 32767
128.         CASE 3 'SINGLE
129.             DIM T3a AS SINGLE, T3b AS SINGLE
130.             gap = EC
131.             DO
132.                 gap = 10 * gap \ 13
133.                 IF gap < 1 THEN gap = 1
134.                 i = 0
135.                 swapped = 0
136.                 DO
137.                     o = m.OFFSET + i * 4
138.                     o1 = m.OFFSET + (i + gap) * 4
139.                     IF _MEMGET(m, o, SINGLE) > _MEMGET(m, o1, SINGLE) THEN
140.                         _MEMGET m, o1, T3a
141.                         _MEMGET m, o, T3b
142.                         _MEMPUT m, o1, T3b
143.                         _MEMPUT m, o, T3a
144.                         swapped = -1
145.                     END IF
146.                     i = i + 1
147.                 LOOP UNTIL i + gap > EC
148.             LOOP UNTIL gap = 1 AND swapped = 0
149.         CASE 4 'LONG
150.             DIM T4a AS LONG, T4b AS LONG
151.             gap = EC
152.             DO
153.                 gap = 10 * gap \ 13
154.                 IF gap < 1 THEN gap = 1
155.                 i = 0
156.                 swapped = 0
157.                 DO
158.                     o = m.OFFSET + i * 4
159.                     o1 = m.OFFSET + (i + gap) * 4
160.                     IF _MEMGET(m, o, LONG) > _MEMGET(m, o1, LONG) THEN
161.                         _MEMGET m, o1, T4a
162.                         _MEMGET m, o, T4b
163.                         _MEMPUT m, o1, T4b
164.                         _MEMPUT m, o, T4a
165.                         swapped = -1
166.                     END IF
167.                     i = i + 1
168.                 LOOP UNTIL i + gap > EC
169.             LOOP UNTIL gap = 1 AND swapped = 0
170.         CASE 5 'DOUBLE
171.             DIM T5a AS DOUBLE, T5b AS DOUBLE
172.             gap = EC
173.             DO
174.                 gap = 10 * gap \ 13
175.                 IF gap < 1 THEN gap = 1
176.                 i = 0
177.                 swapped = 0
178.                 DO
179.                     o = m.OFFSET + i * 8
180.                     o1 = m.OFFSET + (i + gap) * 8
181.                     IF _MEMGET(m, o, DOUBLE) > _MEMGET(m, o1, DOUBLE) THEN
182.                         _MEMGET m, o1, T5a
183.                         _MEMGET m, o, T5b
184.                         _MEMPUT m, o1, T5b
185.                         _MEMPUT m, o, T5a
186.                         swapped = -1
187.                     END IF
188.                     i = i + 1
189.                 LOOP UNTIL i + gap > EC
190.             LOOP UNTIL gap = 1 AND swapped = 0
191.         CASE 6 ' _FLOAT
192.             DIM T6a AS _FLOAT, T6b AS _FLOAT
193.             gap = EC
194.             DO
195.                 gap = 10 * gap \ 13
196.                 IF gap < 1 THEN gap = 1
197.                 i = 0
198.                 swapped = 0
199.                 DO
200.                     o = m.OFFSET + i * 32
201.                     o1 = m.OFFSET + (i + gap) * 32
202.                     IF _MEMGET(m, o, _FLOAT) > _MEMGET(m, o1, _FLOAT) THEN
203.                         _MEMGET m, o1, T6a
204.                         _MEMGET m, o, T6b
205.                         _MEMPUT m, o1, T6b
206.                         _MEMPUT m, o, T6a
207.                         swapped = -1
208.                     END IF
209.                     i = i + 1
210.                 LOOP UNTIL i + gap > EC
211.             LOOP UNTIL gap = 1 AND swapped = 0
212.         CASE 7 'String
213.             DIM T7a AS STRING, T7b AS STRING, T7c AS STRING
214.             T7a = SPACE$(ES): T7b = SPACE$(ES): T7c = SPACE$(ES)
215.             gap = EC
216.             DO
217.                 gap = INT(gap / 1.247330950103979)
218.                 IF gap < 1 THEN gap = 1
219.                 i = 0
220.                 swapped = 0
221.                 DO
222.                     o = m.OFFSET + i * ES
223.                     o1 = m.OFFSET + (i + gap) * ES
224.                     _MEMGET m, o, T7a
225.                     _MEMGET m, o1, T7b
226.                     IF T7a > T7b THEN
227.                         T7c = T7b
228.                         _MEMPUT m, o1, T7a
229.                         _MEMPUT m, o, T7c
230.                         swapped = -1
231.                     END IF
232.                     i = i + 1
233.                 LOOP UNTIL i + gap > EC
234.             LOOP UNTIL gap = 1 AND swapped = false
235.         CASE 8 '_INTEGER64
236.             DIM T8a AS _INTEGER64, T8b AS _INTEGER64
237.             gap = EC
238.             DO
239.                 gap = 10 * gap \ 13
240.                 IF gap < 1 THEN gap = 1
241.                 i = 0
242.                 swapped = 0
243.                 DO
244.                     o = m.OFFSET + i * 8
245.                     o1 = m.OFFSET + (i + gap) * 8
246.                     IF _MEMGET(m, o, _INTEGER64) > _MEMGET(m, o1, _INTEGER64) THEN
247.                         _MEMGET m, o1, T8a
248.                         _MEMGET m, o, T8b
249.                         _MEMPUT m, o1, T8b
250.                         _MEMPUT m, o, T8a
251.                         swapped = -1
252.                     END IF
253.                     i = i + 1
254.                 LOOP UNTIL i + gap > EC
255.             LOOP UNTIL gap = 1 AND swapped = 0
256.         CASE 11: '_UNSIGNED _BYTE
257.             DIM temp11(0 TO 255) AS _UNSIGNED LONG
258.             DIM t11 AS _UNSIGNED _BYTE
259.             i = 0
260.             DO
261.                 _MEMGET m, m.OFFSET + i, t11
262.                 temp11(t11) = temp11(t11) + 1
263.                 i = i + 1
264.             LOOP UNTIL i > EC
265.             i1 = 0
266.             DO
267.                 DO UNTIL temp11(i1) = 0
268.                     _MEMPUT m, m.OFFSET + counter, i1 AS _UNSIGNED _BYTE
269.                     counter = counter + 1
270.                     temp11(i1) = temp11(i1) - 1
271.                     IF counter > EC THEN EXIT SUB
272.                 LOOP
273.                 i1 = i1 + 1
274.             LOOP UNTIL i1 > 255
275.         CASE 12 '_UNSIGNED INTEGER
276.             DIM temp12(0 TO 65535) AS _UNSIGNED LONG
277.             DIM t12 AS _UNSIGNED INTEGER
278.             i = 0
279.             DO
280.                 _MEMGET m, m.OFFSET + i * 2, t12
281.                 temp12(t12) = temp12(t12) + 1
282.                 i = i + 1
283.             LOOP UNTIL i > EC
284.             i1 = 0
285.             DO
286.                 DO UNTIL temp12(i1) = 0
287.                     _MEMPUT m, m.OFFSET + counter * 2, i1 AS _UNSIGNED INTEGER
288.                     counter = counter + 1
289.                     temp12(i1) = temp12(i1) - 1
290.                     IF counter > EC THEN EXIT SUB
291.                 LOOP
292.                 i1 = i1 + 1
293.             LOOP UNTIL i1 > 65535
294.         CASE 14 '_UNSIGNED LONG
295.             DIM T14a AS _UNSIGNED LONG, T14b AS _UNSIGNED LONG
296.             gap = EC
297.             DO
298.                 gap = 10 * gap \ 13
299.                 IF gap < 1 THEN gap = 1
300.                 i = 0
301.                 swapped = 0
302.                 DO
303.                     o = m.OFFSET + i * 4
304.                     o1 = m.OFFSET + (i + gap) * 4
305.                     IF _MEMGET(m, o, _UNSIGNED LONG) > _MEMGET(m, o1, _UNSIGNED LONG) THEN
306.                         _MEMGET m, o1, T14a
307.                         _MEMGET m, o, T14b
308.                         _MEMPUT m, o1, T14b
309.                         _MEMPUT m, o, T14a
310.                         swapped = -1
311.                     END IF
312.                     i = i + 1
313.                 LOOP UNTIL i + gap > EC
314.             LOOP UNTIL gap = 1 AND swapped = 0
315.         CASE 18: '_UNSIGNED _INTEGER64
316.             DIM T18a AS _UNSIGNED _INTEGER64, T18b AS _UNSIGNED _INTEGER64
317.             gap = EC
318.             DO
319.                 gap = 10 * gap \ 13
320.                 IF gap < 1 THEN gap = 1
321.                 i = 0
322.                 swapped = 0
323.                 DO
324.                     o = m.OFFSET + i * 8
325.                     o1 = m.OFFSET + (i + gap) * 8
326.                     IF _MEMGET(m, o, _UNSIGNED _INTEGER64) > _MEMGET(m, o1, _UNSIGNED _INTEGER64) THEN
327.                         _MEMGET m, o1, T18a
328.                         _MEMGET m, o, T18b
329.                         _MEMPUT m, o1, T18b
330.                         _MEMPUT m, o, T18a
331.                         swapped = -1
332.                     END IF
333.                     i = i + 1
334.                 LOOP UNTIL i + gap > EC
335.             LOOP UNTIL gap = 1 AND swapped = 0
336.     END SELECT
337. END SUB
338.