### Author Topic: _MEM Sort by SMcNeill  (Read 3981 times)

0 Members and 1 Guest are viewing this topic.

#### The Librarian

• Moderator
• Newbie
• Posts: 39
##### _MEM Sort by SMcNeill
« on: August 11, 2019, 12:51:49 pm »
_MEM Sort

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

« Last Edit: March 07, 2020, 01:20:08 am by The Librarian »