Radix Sorting

[Phlashlite]

I only found one Radix sorting procedure, out in the world,  for QB64 and it was pretty complex.  So, I made a simpler one.  I like the exercise anyway. :) 

I was a little disappointed that it was only ~.1 seconds faster than QuickSort over 1000000 iterations.  But, faster is faster I guess.

Anyway, enjoy!

Code: QB64: [Select]

1. _TITLE "Radix Sort Demo"
2.  
3. 'Radix Sorting procedure Demo.
4. 'Based on multitudes of other examples in C, JS, and Python that I studied.
5. 'Sorts 1000000 (the max a this setup will accommodate) in a little over .5 seconds.
6.  
7. 'By: Phlashlite
8.  
9. 'For demo======================================================================
10. CONST WDTH = 1000
11. CONST HGHT = 1000
12.  
13. SCREEN _NEWIMAGE(WDTH, HGHT, 32)
14.  
15. CONST ARRAY_SIZE = WDTH * HGHT
16.  
17. DIM SHARED DemoArray(ARRAY_SIZE)
18.  
19. FOR i = 0 TO ARRAY_SIZE
20.     DemoArray(i) = INT(RND * 255)
21. NEXT
22.  
23. i = 0
24. FOR x = 0 TO WDTH - 1
25.     FOR y = 0 TO HGHT - 1
26.         PSET (x, y), _RGB(DemoArray(i), DemoArray(i), DemoArray(i))
27.         i = i + 1
28.     NEXT
29. NEXT
30. INPUT "Press ENTER to Sort Array", a$
31.  
32. '==============================================================================
33.  
34.  
35. 'Used in procedures____________________________________________________________
36. DIM SHARED ArrayLength
37. ArrayLength = ARRAY_LENGTH(DemoArray())
38. DIM SHARED Place%
39. ts = TIMER
40. RADIX_SORT DemoArray()
41. tf = TIMER
42. Delta = tf - ts
43. '______________________________________________________________________________
44.  
45.  
46. '==============================================================================
47. i = 0
48. FOR x = 0 TO WDTH - 1
49.     FOR y = 0 TO HGHT - 1
50.         PSET (x, y), _RGB(DemoArray(i), DemoArray(i), DemoArray(i))
51.         i = i + 1
52.     NEXT
53. NEXT
54.  
55. PRINT "Set of 1000000 members sorted in"; Delta; "seconds."
56.  
57. '==============================================================================
58.  
59.  
60. '______________________________________________________________________________
61.  
62. 'Sub for radix sort
63. SUB RADIX_SORT (Array())
64.  
65.     'Find largest element in the Array
66.     MaxArrayValue% = ARRAY_MAX_VALUE(Array(), ArrayLength)
67.  
68.     'Counting sort is performed based on Place, like ones Place, tens Place and so on.
69.     Place% = 1
70.     WHILE MaxArrayValue% \ Place% > 0
71.         CALL COUNT_SORT(Array(), Place%)
72.         Place% = Place% * 10
73.     WEND
74.  
75. END SUB
76.  
77. '_______________________________________________________________________________
78. SUB COUNT_SORT (Array(), Place%)
79.  
80.     DIM OwtPut(ArrayLength)
81.  
82.     'Range of the number is 0-9 for each Place considered.
83.     DIM Count(10)
84.  
85.     'Enumerate Place member occurrences in Count()
86.     FOR i = 0 TO ArrayLength - 1
87.         Index% = Array(i) \ Place%
88.         Count(Index% MOD 10) = Count(Index% MOD 10) + 1
89.     NEXT
90.  
91.     'Change Count() so that Count() now contains actual Place position of this
92.     'each digit in OwtPut()
93.     FOR i% = 1 TO 10
94.         Count(i%) = Count(i%) + Count(i% - 1)
95.     NEXT
96.  
97.     'Build the OwtPut() array
98.     i = ArrayLength - 1
99.     WHILE i >= 0
100.         Index% = Array(i) \ Place%
101.         OwtPut(Count(Index% MOD 10) - 1) = Array(i)
102.         Count(Index% MOD 10) = Count(Index% MOD 10) - 1
103.         i = i - 1
104.     WEND
105.  
106.     i = 0
107.     FOR i = 0 TO ArrayLength - 1
108.         Array(i) = OwtPut(i)
109.     NEXT
110.  
111.  
112. END SUB
113.  
114.  
115. '______________________________________________________________________________
116.  
117. 'Find the largest member of an array set.
118. FUNCTION ARRAY_MAX_VALUE (Array(), ArrayLength)
119.     FOR i = 0 TO ArrayLength
120.         IF Array(i) > tmx% THEN tmx% = Array(i)
121.     NEXT
122.     ARRAY_MAX_VALUE = tmx%
123. END FUNCTION
124.  
125. '______________________________________________________________________________
126.  
127. 'Calculate the size of an array.
128. FUNCTION ARRAY_LENGTH (Array())
129.     ARRAY_LENGTH = UBOUND(Array) - LBOUND(Array)
130. END FUNCTION
131.  

[Phlashlite]

Here is the same demo using Quick Sort, for comparison:

Code: QB64: [Select]

1. _TITLE "QuickSort Demo"
2.  
3. 'For demo======================================================================
4. CONST WDTH = 1000
5. CONST HGHT = 1000
6.  
7. SCREEN _NEWIMAGE(WDTH, HGHT, 32)
8.  
9. CONST ARRAY_SIZE = WDTH * HGHT
10.  
11. DIM SHARED DemoArray(ARRAY_SIZE)
12.  
13. FOR i = 0 TO ARRAY_SIZE
14.     DemoArray(i) = INT(RND * 255)
15. NEXT
16.  
17. i = 0
18. FOR x = 0 TO WDTH - 1
19.     FOR y = 0 TO HGHT - 1
20.         PSET (x, y), _RGB(DemoArray(i), DemoArray(i), DemoArray(i))
21.         i = i + 1
22.     NEXT
23. NEXT
24. INPUT "Sort Array?", a$
25.  
26. '==============================================================================
27.  
28. DIM SHARED ArrayLength
29. ArrayLength = ARRAY_LENGTH(DemoArray())
30. DIM SHARED Place%
31. ts = TIMER
32. QuickSort 0, 999999, DemoArray()
33. tf = TIMER
34. Delta = tf - ts
35.  
36.  
37. '==============================================================================
38. i = 0
39. FOR x = 0 TO WDTH - 1
40.     FOR y = 0 TO HGHT - 1
41.         PSET (x, y), _RGB(DemoArray(i), DemoArray(i), DemoArray(i))
42.         i = i + 1
43.     NEXT
44. NEXT
45.  
46. PRINT "1000000 members sorted in"; Delta; "seconds"
47.  
48. '==============================================================================
49.  
50.  
51. SUB QuickSort (start, finish, array())
52.     'Straight from the QB64 wiki
53.     DIM Hi, Lo, Middle
54.     Hi = finish
55.     Lo = start
56.     Middle = array((Lo + Hi) / 2) 'find middle of array
57.  
58.     DO
59.         DO WHILE array(Lo) < Middle
60.             Lo = Lo + 1
61.         LOOP
62.  
63.         DO WHILE array(Hi) > Middle
64.             Hi = Hi - 1
65.         LOOP
66.  
67.         IF Lo <= Hi THEN
68.             SWAP array(Lo), array(Hi)
69.             Lo = Lo + 1
70.             Hi = Hi - 1
71.         END IF
72.     LOOP UNTIL Lo > Hi
73.  
74.     IF Hi > start THEN CALL QuickSort(start, Hi, array())
75.     IF Lo < finish THEN CALL QuickSort(Lo, finish, array())
76.  
77. END SUB
78.  
79. '______________________________________________________________________________
80.  
81. 'Find the largest member of an array set.
82. FUNCTION ARRAY_MAX_VALUE (Array(), ArrayLength)
83.     FOR i = 0 TO ArrayLength
84.         IF Array(i) > tmx% THEN tmx% = Array(i)
85.     NEXT
86.     ARRAY_MAX_VALUE = tmx%
87. END FUNCTION
88.  
89. '______________________________________________________________________________
90.  
91. 'Calculate the size of an array.
92. FUNCTION ARRAY_LENGTH (Array())
93.     ARRAY_LENGTH = UBOUND(Array) - LBOUND(Array)
94. END FUNCTION
95.  
96.  

[bplus]

Looks like my kind of Quick Sort :-))

But be careful with Types, Single the default is not same as something from RGB Integers/Long

[Phlashlite]

A couple of caveats:

- Only works on arrays up to 1M in  its current configuration.
- Does not accommodate negative numbers either.

[bplus]

QuickSort is Faster now:

Code: QB64: [Select]

1. _Title "QuickSort Demo"
2.  
3. 'For demo======================================================================
4. Const WDTH = 1000
5. Const HGHT = 1000
6.  
7. Screen _NewImage(WDTH, HGHT, 32)
8.  
9. Const ARRAY_SIZE = WDTH * HGHT
10.  
11. Dim Shared DemoArray(ARRAY_SIZE) As Long
12.  
13. For i = 0 To ARRAY_SIZE
14.     DemoArray(i) = Int(Rnd * 255)
15. Next
16.  
17. i = 0
18. For x = 0 To WDTH - 1
19.     For y = 0 To HGHT - 1
20.         PSet (x, y), _RGB(DemoArray(i), DemoArray(i), DemoArray(i))
21.         i = i + 1
22.     Next
23. Next
24. Input "Sort Array?", a$
25.  
26. '==============================================================================
27.  
28. Dim Shared ArrayLength
29. ArrayLength = ARRAY_LENGTH(DemoArray())
30. ' Dim Shared Place%  ' not used
31. ts = Timer
32. QuickSort 0, 999999, DemoArray()
33. tf = Timer
34. Delta = tf - ts
35.  
36.  
37. '==============================================================================
38. i = 0
39. For x = 0 To WDTH - 1
40.     For y = 0 To HGHT - 1
41.         PSet (x, y), _RGB(DemoArray(i), DemoArray(i), DemoArray(i))
42.         i = i + 1
43.     Next
44. Next
45.  
46. Print "1000000 members sorted in"; Delta; "seconds"
47.  
48. '==============================================================================
49.  
50.  
51. Sub QuickSort (start, finish, array() As Long)
52.     'Straight from the QB64 wiki
53.     Dim As Long Hi, Lo, Middle
54.     Hi = finish
55.     Lo = start
56.     Middle = array((Lo + Hi) / 2) 'find middle of array
57.  
58.     Do
59.         Do While array(Lo) < Middle
60.             Lo = Lo + 1
61.         Loop
62.  
63.         Do While array(Hi) > Middle
64.             Hi = Hi - 1
65.         Loop
66.  
67.         If Lo <= Hi Then
68.             Swap array(Lo), array(Hi)
69.             Lo = Lo + 1
70.             Hi = Hi - 1
71.         End If
72.     Loop Until Lo > Hi
73.  
74.     If Hi > start Then Call QuickSort(start, Hi, array())
75.     If Lo < finish Then Call QuickSort(Lo, finish, array())
76.  
77. End Sub
78.  
79. '______________________________________________________________________________
80.  
81. 'Find the largest member of an array set.
82. Function ARRAY_MAX_VALUE (Array() As Long, ArrayLength)
83.     For i = 0 To ArrayLength
84.         If Array(i) > tmx& Then tmx& = Array(i)
85.     Next
86.     ARRAY_MAX_VALUE = tmx&
87. End Function
88.  
89. '______________________________________________________________________________
90.  
91. 'Calculate the size of an array.
92. Function ARRAY_LENGTH (Array() As Long)
93.     ARRAY_LENGTH = UBound(Array) - LBound(Array)
94. End Function
95.  
96.  
97.  
98.  

Probably can apply same trick to Radix, I like the visual you gave this.

[Phlashlite]

Guess I won't be sorting those size arrays on my Tandy 1000EX anyway... HAHA!

I think it's a toss up now?  But I did see some ~.27 on this code.  Must depend on current CPU load and what the data in the array looks like.  I'd have to run a batch and average the results to get a more accurate picture... or, for that matter, using LONG numbers increases the possible array size too.

Code: QB64: [Select]

1. _TITLE "Radix Sort Demo"
2.  
3. 'Radix Sorting procedure Demo.
4. 'Based on multitudes of other examples in C, JS, and Python that I studied.
5. 'Sorts 1000000 (the max a this setup will accomodate) in a little over .5 seconds.
6.  
7. 'By: Phlashlite
8.  
9. 'For demo======================================================================
10.  
11. CONST WDTH = 1000
12. CONST HGHT = 1000
13. CONST ARRAY_SIZE = WDTH * HGHT
14. SCREEN _NEWIMAGE(WDTH, HGHT, 32)
15.  
16.  
17. DIM SHARED DemoArray(ARRAY_SIZE) AS LONG 'Used in procedures___________________
18.  
19.  
20. FOR i& = 0 TO ARRAY_SIZE
21.     DemoArray(i&) = INT(RND * 255)
22. NEXT
23.  
24. i& = 0
25. FOR x& = 0 TO WDTH - 1
26.     FOR y& = 0 TO HGHT - 1
27.         PSET (x&, y&), _RGB(DemoArray(i&), DemoArray(i&), DemoArray(i&))
28.         i& = i& + 1
29.     NEXT
30. NEXT
31. INPUT "Press ENTER to Sort Array", a$
32.  
33. '==============================================================================
34.  
35.  
36. 'Used in procedures____________________________________________________________
37. DIM SHARED ArrayLength AS LONG
38. ArrayLength = ARRAY_LENGTH(DemoArray())
39. DIM SHARED Place AS LONG
40. ts = TIMER
41. RADIX_SORT DemoArray()
42. tf = TIMER
43. Delta = tf - ts
44. '______________________________________________________________________________
45.  
46.  
47. '==============================================================================
48. i& = 0
49. FOR x& = 0 TO WDTH - 1
50.     FOR y& = 0 TO HGHT - 1
51.         PSET (x&, y&), _RGB(DemoArray(i&), DemoArray(i&), DemoArray(i&))
52.         i& = i& + 1
53.     NEXT
54. NEXT
55.  
56. PRINT "Set of 1000000 members sorted in"; Delta; "seconds."
57.  
58. '==============================================================================
59.  
60.  
61. '______________________________________________________________________________
62.  
63. 'Sub for radix sort
64. SUB RADIX_SORT (Array() AS LONG)
65.  
66.     'Find largest element in the Array
67.     DIM MaxArrayValue AS LONG
68.     MaxArrayValue = ARRAY_MAX_VALUE(Array(), ArrayLength)
69.  
70.     'Counting sort is performed based on Place, like ones Place, tens Place and so on.
71.     Place = 1
72.     WHILE MaxArrayValue \ Place > 0
73.         CALL COUNT_SORT(Array(), Place)
74.         Place = Place * 10
75.     WEND
76.  
77. END SUB
78.  
79. '_______________________________________________________________________________
80. SUB COUNT_SORT (Array() AS LONG, Place)
81.  
82.     DIM OwtPut(ArrayLength) AS LONG
83.  
84.     'Range of the number is 0-9 for each Place considered.
85.     DIM Count(10) AS LONG
86.  
87.     'Enumerate Place member occurrences in Count()
88.     DIM Index AS LONG
89.  
90.     FOR i& = 0 TO ArrayLength - 1
91.         Index = Array(i&) \ Place
92.         Count(Index MOD 10) = Count(Index MOD 10) + 1
93.     NEXT
94.  
95.     'Change Count() so that Count() now contains actual Place position of this
96.     'each digit in OwtPut()
97.     FOR i& = 1 TO 10
98.         Count(i&) = Count(i&) + Count(i& - 1)
99.     NEXT
100.  
101.     'Build the OwtPut() array
102.     i& = ArrayLength - 1
103.     WHILE i& >= 0
104.         Index& = Array&(i&) \ Place
105.         OwtPut(Count(Index& MOD 10) - 1) = Array(i&)
106.         Count(Index& MOD 10) = Count(Index& MOD 10) - 1
107.         i& = i& - 1
108.     WEND
109.  
110.     i& = 0
111.     FOR i& = 0 TO ArrayLength - 1
112.         Array(i&) = OwtPut(i&)
113.     NEXT
114.  
115.  
116. END SUB
117.  
118. '______________________________________________________________________________
119.  
120. 'Find the largest member of an array set.
121. FUNCTION ARRAY_MAX_VALUE (Array() AS LONG, ArrayLength)
122.     FOR i& = 0 TO ArrayLength
123.         IF Array&(i&) > tmx& THEN tmx& = Array&(i&)
124.     NEXT
125.     ARRAY_MAX_VALUE = tmx&
126. END FUNCTION
127.  
128. '______________________________________________________________________________
129.  
130. 'Calculate the size of an array.
131. FUNCTION ARRAY_LENGTH (Array() AS LONG)
132.     ARRAY_LENGTH = UBOUND(Array&) - LBOUND(Array&)
133. END FUNCTION
134.  

[SMcNeill]

I still hold MemSort up as being the fastest possible sort method, for many use cases.

Try it out with this little code here:

Code: QB64: [Select]

1. _Title "Radix Sort Demo"
2.  
3. 'Radix Sorting procedure Demo.
4. 'Based on multitudes of other examples in C, JS, and Python that I studied.
5. 'Sorts 1000000 (the max a this setup will accomodate) in a little over .5 seconds.
6.  
7. 'By: Phlashlite
8.  
9. 'For demo======================================================================
10.  
11. Const WDTH = 1000
12. Const HGHT = 1000
13. Const ARRAY_SIZE = WDTH * HGHT
14. Screen _NewImage(WDTH, HGHT, 32)
15.  
16.  
17. Dim Shared DemoArray(ARRAY_SIZE) As Long 'Used in procedures___________________
18.  
19. Dim Shared DemoArrayCopy(ARRAY_SIZE) As Integer 'Used in procedures___________________
20. Dim m As _MEM: m = _Mem(DemoArrayCopy())
21.  
22.  
23. For i& = 0 To ARRAY_SIZE
24.     DemoArray(i&) = Int(Rnd * 255)
25.     DemoArrayCopy(i&) = DemoArray(i&)
26. Next
27.  
28. i& = 0
29. For x& = 0 To WDTH - 1
30.     For y& = 0 To HGHT - 1
31.         PSet (x&, y&), _RGB(DemoArray(i&), DemoArray(i&), DemoArray(i&))
32.         i& = i& + 1
33.     Next
34. Next
35. Input "Press ENTER to Sort Array", a$
36.  
37. '==============================================================================
38.  
39.  
40. 'Used in procedures____________________________________________________________
41. Dim Shared ArrayLength As Long
42. ArrayLength = ARRAY_LENGTH(DemoArray())
43. Dim Shared Place As Long
44. ts = Timer
45. RADIX_SORT DemoArray()
46.  
47. tf = Timer
48. Delta = tf - ts
49. '______________________________________________________________________________
50.  
51.  
52. '==============================================================================
53. i& = 0
54. For x& = 0 To WDTH - 1
55.     For y& = 0 To HGHT - 1
56.         PSet (x&, y&), _RGB(DemoArray(i&), DemoArray(i&), DemoArray(i&))
57.         i& = i& + 1
58.     Next
59. Next
60.  
61. Print "Set of 1000000 members sorted in"; Delta; "seconds."
62.  
63. '==============================================================================
64. Sleep
65.  
66. 'Restore the background to the original state
67. i& = 0
68. For x& = 0 To WDTH - 1
69.     For y& = 0 To HGHT - 1
70.         PSet (x&, y&), _RGB(DemoArrayCopy(i&), DemoArrayCopy(i&), DemoArrayCopy(i&))
71.         i& = i& + 1
72.     Next
73. Next
74.  
75. Sleep
76.  
77. ts = Timer
78. Sort m
79.  
80. tf = Timer
81. Delta = tf - ts
82. '______________________________________________________________________________
83.  
84.  
85. '==============================================================================
86. i& = 0
87. For x& = 0 To WDTH - 1
88.     For y& = 0 To HGHT - 1
89.         PSet (x&, y&), _RGB(DemoArray(i&), DemoArray(i&), DemoArray(i&))
90.         i& = i& + 1
91.     Next
92. Next
93.  
94. Print "Set of 1000000 members sorted in"; Delta; "seconds."
95.  
96.  
97. End
98.  
99.  
100.  
101.  
102.  
103. '______________________________________________________________________________
104. Sub Sort (m As _MEM)
105.     Dim i As _Unsigned Long
106.     $If 64BIT Then
107.         Dim ES As _Integer64, EC As _Integer64
108.     $Else
109.         DIM ES AS LONG, EC AS LONG
110.     $End If
111.  
112.     If Not m.TYPE And 65536 Then Exit Sub 'We won't work without an array
113.     If m.TYPE And 1024 Then DataType = 10
114.     If m.TYPE And 1 Then DataType = DataType + 1
115.     If m.TYPE And 2 Then DataType = DataType + 2
116.     If m.TYPE And 4 Then If m.TYPE And 128 Then DataType = DataType + 4 Else DataType = 3
117.     If m.TYPE And 8 Then If m.TYPE And 128 Then DataType = DataType + 8 Else DataType = 5
118.     If m.TYPE And 32 Then DataType = 6
119.     If m.TYPE And 512 Then DataType = 7
120.  
121.     'Convert our offset data over to something we can work with
122.     Dim m1 As _MEM: m1 = _MemNew(Len(ES))
123.     _MemPut m1, m1.OFFSET, m.ELEMENTSIZE: _MemGet m1, m1.OFFSET, ES 'Element Size
124.     _MemPut m1, m1.OFFSET, m.SIZE: _MemGet m1, m1.OFFSET, EC 'Element Count will temporily hold the WHOLE array size
125.     _MemFree m1
126.  
127.     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.
128.     'And work with it!
129.     Dim o As _Offset, o1 As _Offset, counter As _Unsigned Long
130.  
131.     Select Case DataType
132.         Case 1 'BYTE
133.             Dim temp1(-128 To 127) As _Unsigned Long
134.             Dim t1 As _Byte
135.             i = 0
136.             Do
137.                 _MemGet m, m.OFFSET + i, t1
138.                 temp1(t1) = temp1(t1) + 1
139.                 i = i + 1
140.             Loop Until i > EC
141.             i1 = -128
142.             Do
143.                 Do Until temp1(i1) = 0
144.                     _MemPut m, m.OFFSET + counter, i1 As _BYTE
145.                     counter = counter + 1
146.                     temp1(i1) = temp1(i1) - 1
147.                     If counter > EC Then Exit Sub
148.                 Loop
149.                 i1 = i1 + 1
150.             Loop Until i1 > 127
151.         Case 2: 'INTEGER
152.             Dim temp2(-32768 To 32767) As _Unsigned Long
153.             Dim t2 As Integer
154.             i = 0
155.             Do
156.                 _MemGet m, m.OFFSET + i * 2, t2
157.                 temp2(t2) = temp2(t2) + 1
158.                 i = i + 1
159.             Loop Until i > EC
160.             i1 = -32768
161.             Do
162.                 Do Until temp2(i1) = 0
163.                     _MemPut m, m.OFFSET + counter * 2, i1 As INTEGER
164.                     counter = counter + 1
165.                     temp2(i1) = temp2(i1) - 1
166.                     If counter > EC Then Exit Sub
167.                 Loop
168.                 i1 = i1 + 1
169.             Loop Until i1 > 32767
170.         Case 3 'SINGLE
171.             Dim T3a As Single, T3b As Single
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 * 4
180.                     o1 = m.OFFSET + (i + gap) * 4
181.                     If _MemGet(m, o, Single) > _MemGet(m, o1, Single) Then
182.                         _MemGet m, o1, T3a
183.                         _MemGet m, o, T3b
184.                         _MemPut m, o1, T3b
185.                         _MemPut m, o, T3a
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 4 'LONG
192.             Dim T4a As Long, T4b As Long
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 * 4
201.                     o1 = m.OFFSET + (i + gap) * 4
202.                     If _MemGet(m, o, Long) > _MemGet(m, o1, Long) Then
203.                         _MemGet m, o1, T4a
204.                         _MemGet m, o, T4b
205.                         _MemPut m, o1, T4b
206.                         _MemPut m, o, T4a
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 5 'DOUBLE
213.             Dim T5a As Double, T5b As Double
214.             gap = EC
215.             Do
216.                 gap = 10 * gap \ 13
217.                 If gap < 1 Then gap = 1
218.                 i = 0
219.                 swapped = 0
220.                 Do
221.                     o = m.OFFSET + i * 8
222.                     o1 = m.OFFSET + (i + gap) * 8
223.                     If _MemGet(m, o, Double) > _MemGet(m, o1, Double) Then
224.                         _MemGet m, o1, T5a
225.                         _MemGet m, o, T5b
226.                         _MemPut m, o1, T5b
227.                         _MemPut m, o, T5a
228.                         swapped = -1
229.                     End If
230.                     i = i + 1
231.                 Loop Until i + gap > EC
232.             Loop Until gap = 1 And swapped = 0
233.         Case 6 ' _FLOAT
234.             Dim T6a As _Float, T6b As _Float
235.             gap = EC
236.             Do
237.                 gap = 10 * gap \ 13
238.                 If gap < 1 Then gap = 1
239.                 i = 0
240.                 swapped = 0
241.                 Do
242.                     o = m.OFFSET + i * 32
243.                     o1 = m.OFFSET + (i + gap) * 32
244.                     If _MemGet(m, o, _Float) > _MemGet(m, o1, _Float) Then
245.                         _MemGet m, o1, T6a
246.                         _MemGet m, o, T6b
247.                         _MemPut m, o1, T6b
248.                         _MemPut m, o, T6a
249.                         swapped = -1
250.                     End If
251.                     i = i + 1
252.                 Loop Until i + gap > EC
253.             Loop Until gap = 1 And swapped = 0
254.         Case 7 'String
255.             Dim T7a As String, T7b As String, T7c As String
256.             T7a = Space$(ES): T7b = Space$(ES): T7c = Space$(ES)
257.             gap = EC
258.             Do
259.                 gap = Int(gap / 1.247330950103979)
260.                 If gap < 1 Then gap = 1
261.                 i = 0
262.                 swapped = 0
263.                 Do
264.                     o = m.OFFSET + i * ES
265.                     o1 = m.OFFSET + (i + gap) * ES
266.                     _MemGet m, o, T7a
267.                     _MemGet m, o1, T7b
268.                     If T7a > T7b Then
269.                         T7c = T7b
270.                         _MemPut m, o1, T7a
271.                         _MemPut m, o, T7c
272.                         swapped = -1
273.                     End If
274.                     i = i + 1
275.                 Loop Until i + gap > EC
276.             Loop Until gap = 1 And swapped = false
277.         Case 8 '_INTEGER64
278.             Dim T8a As _Integer64, T8b As _Integer64
279.             gap = EC
280.             Do
281.                 gap = 10 * gap \ 13
282.                 If gap < 1 Then gap = 1
283.                 i = 0
284.                 swapped = 0
285.                 Do
286.                     o = m.OFFSET + i * 8
287.                     o1 = m.OFFSET + (i + gap) * 8
288.                     If _MemGet(m, o, _Integer64) > _MemGet(m, o1, _Integer64) Then
289.                         _MemGet m, o1, T8a
290.                         _MemGet m, o, T8b
291.                         _MemPut m, o1, T8b
292.                         _MemPut m, o, T8a
293.                         swapped = -1
294.                     End If
295.                     i = i + 1
296.                 Loop Until i + gap > EC
297.             Loop Until gap = 1 And swapped = 0
298.         Case 11: '_UNSIGNED _BYTE
299.             Dim temp11(0 To 255) As _Unsigned Long
300.             Dim t11 As _Unsigned _Byte
301.             i = 0
302.             Do
303.                 _MemGet m, m.OFFSET + i, t11
304.                 temp11(t11) = temp11(t11) + 1
305.                 i = i + 1
306.             Loop Until i > EC
307.             i1 = 0
308.             Do
309.                 Do Until temp11(i1) = 0
310.                     _MemPut m, m.OFFSET + counter, i1 As _UNSIGNED _BYTE
311.                     counter = counter + 1
312.                     temp11(i1) = temp11(i1) - 1
313.                     If counter > EC Then Exit Sub
314.                 Loop
315.                 i1 = i1 + 1
316.             Loop Until i1 > 255
317.         Case 12 '_UNSIGNED INTEGER
318.             Dim temp12(0 To 65535) As _Unsigned Long
319.             Dim t12 As _Unsigned Integer
320.             i = 0
321.             Do
322.                 _MemGet m, m.OFFSET + i * 2, t12
323.                 temp12(t12) = temp12(t12) + 1
324.                 i = i + 1
325.             Loop Until i > EC
326.             i1 = 0
327.             Do
328.                 Do Until temp12(i1) = 0
329.                     _MemPut m, m.OFFSET + counter * 2, i1 As _UNSIGNED INTEGER
330.                     counter = counter + 1
331.                     temp12(i1) = temp12(i1) - 1
332.                     If counter > EC Then Exit Sub
333.                 Loop
334.                 i1 = i1 + 1
335.             Loop Until i1 > 65535
336.         Case 14 '_UNSIGNED LONG
337.             Dim T14a As _Unsigned Long, T14b As _Unsigned Long
338.             gap = EC
339.             Do
340.                 gap = 10 * gap \ 13
341.                 If gap < 1 Then gap = 1
342.                 i = 0
343.                 swapped = 0
344.                 Do
345.                     o = m.OFFSET + i * 4
346.                     o1 = m.OFFSET + (i + gap) * 4
347.                     If _MemGet(m, o, _Unsigned Long) > _MemGet(m, o1, _Unsigned Long) Then
348.                         _MemGet m, o1, T14a
349.                         _MemGet m, o, T14b
350.                         _MemPut m, o1, T14b
351.                         _MemPut m, o, T14a
352.                         swapped = -1
353.                     End If
354.                     i = i + 1
355.                 Loop Until i + gap > EC
356.             Loop Until gap = 1 And swapped = 0
357.         Case 18: '_UNSIGNED _INTEGER64
358.             Dim T18a As _Unsigned _Integer64, T18b As _Unsigned _Integer64
359.             gap = EC
360.             Do
361.                 gap = 10 * gap \ 13
362.                 If gap < 1 Then gap = 1
363.                 i = 0
364.                 swapped = 0
365.                 Do
366.                     o = m.OFFSET + i * 8
367.                     o1 = m.OFFSET + (i + gap) * 8
368.                     If _MemGet(m, o, _Unsigned _Integer64) > _MemGet(m, o1, _Unsigned _Integer64) Then
369.                         _MemGet m, o1, T18a
370.                         _MemGet m, o, T18b
371.                         _MemPut m, o1, T18b
372.                         _MemPut m, o, T18a
373.                         swapped = -1
374.                     End If
375.                     i = i + 1
376.                 Loop Until i + gap > EC
377.             Loop Until gap = 1 And swapped = 0
378.     End Select
379. End Sub
380.  
381.  
382. 'Sub for radix sort
383. Sub RADIX_SORT (Array() As Long)
384.  
385.     'Find largest element in the Array
386.     Dim MaxArrayValue As Long
387.     MaxArrayValue = ARRAY_MAX_VALUE(Array(), ArrayLength)
388.  
389.     'Counting sort is performed based on Place, like ones Place, tens Place and so on.
390.     Place = 1
391.     While MaxArrayValue \ Place > 0
392.         Call COUNT_SORT(Array(), Place)
393.         Place = Place * 10
394.     Wend
395.  
396. End Sub
397.  
398. '_______________________________________________________________________________
399. Sub COUNT_SORT (Array() As Long, Place)
400.  
401.     Dim OwtPut(ArrayLength) As Long
402.  
403.     'Range of the number is 0-9 for each Place considered.
404.     Dim Count(10) As Long
405.  
406.     'Enumerate Place member occurrences in Count()
407.     Dim Index As Long
408.  
409.     For i& = 0 To ArrayLength - 1
410.         Index = Array(i&) \ Place
411.         Count(Index Mod 10) = Count(Index Mod 10) + 1
412.     Next
413.  
414.     'Change Count() so that Count() now contains actual Place position of this
415.     'each digit in OwtPut()
416.     For i& = 1 To 10
417.         Count(i&) = Count(i&) + Count(i& - 1)
418.     Next
419.  
420.     'Build the OwtPut() array
421.     i& = ArrayLength - 1
422.     While i& >= 0
423.         Index& = Array&(i&) \ Place
424.         OwtPut(Count(Index& Mod 10) - 1) = Array(i&)
425.         Count(Index& Mod 10) = Count(Index& Mod 10) - 1
426.         i& = i& - 1
427.     Wend
428.  
429.     i& = 0
430.     For i& = 0 To ArrayLength - 1
431.         Array(i&) = OwtPut(i&)
432.     Next
433.  
434.  
435. End Sub
436.  
437. '______________________________________________________________________________
438.  
439. 'Find the largest member of an array set.
440. Function ARRAY_MAX_VALUE (Array() As Long, ArrayLength)
441.     For i& = 0 To ArrayLength
442.         If Array&(i&) > tmx& Then tmx& = Array&(i&)
443.     Next
444.     ARRAY_MAX_VALUE = tmx&
445. End Function
446.  
447. '______________________________________________________________________________
448.  
449. 'Calculate the size of an array.
450. Function ARRAY_LENGTH (Array() As Long)
451.     ARRAY_LENGTH = UBound(Array&) - LBound(Array&)
452. End Function
453.  
454.  

For the Radix_Sort, my PC takes between 1.4 and 2.2 seconds.   For the Memsort, the value is between 0 (too small to measure) and 0.051 seconds. 

(Of course, if you look closely, I *cough* *cough* cheated a little bit and swapped memsort to sorting out an Integer array, as I've encoded a different sorting method for bytes and integers than the simple comb sort which I have implemented for use with other variable types.)

When it comes to bytes and integers, *nothing* beats my little method here.  For other variable types, the performance is still good (less than a second to sort the whole array as longs), but there are other methods out there that are faster.  Not a whole lot that are more flexible (memSort works with all variable types that mem will work with), but there are several methods that are faster than the simple combsort which most of the routines call upon.

[Phlashlite]

Yep, that's way faster!  I had to up the array count to 5000000 to get it to show up.  1.8 Second for Radix on my machine.  .38 for Mem.

Code: QB64: [Select]

1. _TITLE "Radix Sort Demo"
2.  
3. 'Radix Sorting procedure Demo.
4. 'Based on multitudes of other examples in C, JS, and Python that I studied.
5. 'Sorts 1000000 (the max a this setup will accomodate) in a little over .5 seconds.
6.  
7. 'By: Phlashlite
8.  
9. 'For demo======================================================================
10.  
11. CONST WDTH = 5000
12. CONST HGHT = 1000
13. CONST ARRAY_SIZE = WDTH * HGHT
14. SCREEN _NEWIMAGE(WDTH, HGHT, 32)
15.  
16.  
17. DIM SHARED DemoArray(ARRAY_SIZE) AS LONG 'Used in procedures___________________
18.  
19. DIM SHARED DemoArrayCopy(ARRAY_SIZE) AS INTEGER 'Used in procedures___________________
20. DIM m AS _MEM: m = _MEM(DemoArrayCopy())
21.  
22.  
23. FOR i& = 0 TO ARRAY_SIZE
24.     DemoArray(i&) = INT(RND * 255)
25.     DemoArrayCopy(i&) = DemoArray(i&)
26. NEXT
27.  
28. i& = 0
29. FOR x& = 0 TO WDTH - 1
30.     FOR y& = 0 TO HGHT - 1
31.         PSET (x&, y&), _RGB(DemoArray(i&), DemoArray(i&), DemoArray(i&))
32.         i& = i& + 1
33.     NEXT
34. NEXT
35. INPUT "Press ENTER to Sort Array", a$
36.  
37. '==============================================================================
38.  
39.  
40. 'Used in procedures____________________________________________________________
41. DIM SHARED ArrayLength AS LONG
42. ArrayLength = ARRAY_LENGTH(DemoArray())
43. DIM SHARED Place AS LONG
44. ts = TIMER
45. RADIX_SORT DemoArray()
46.  
47. tf = TIMER
48. Delta = tf - ts
49. '______________________________________________________________________________
50.  
51.  
52. '==============================================================================
53. i& = 0
54. FOR x& = 0 TO WDTH - 1
55.     FOR y& = 0 TO HGHT - 1
56.         PSET (x&, y&), _RGB(DemoArray(i&), DemoArray(i&), DemoArray(i&))
57.         i& = i& + 1
58.     NEXT
59. NEXT
60.  
61. PRINT "   Set of"; WDTH * HGHT; "members sorted in"; Delta; "seconds with Radix Sort"
62.  
63. '==============================================================================
64.  
65.  
66. SLEEP
67.  
68. 'Restore the background to the original state
69. i& = 0
70. FOR x& = 0 TO WDTH - 1
71.     FOR y& = 0 TO HGHT - 1
72.         PSET (x&, y&), _RGB(DemoArrayCopy(i&), DemoArrayCopy(i&), DemoArrayCopy(i&))
73.         i& = i& + 1
74.     NEXT
75. NEXT
76.  
77. SLEEP
78.  
79. ts = TIMER
80.  
81. Sort m
82.  
83. tf = TIMER
84. Delta = tf - ts
85.  
86. i& = 0
87. FOR x& = 0 TO WDTH - 1
88.     FOR y& = 0 TO HGHT - 1
89.         PSET (x&, y&), _RGB(DemoArray(i&), DemoArray(i&), DemoArray(i&))
90.         i& = i& + 1
91.     NEXT
92. NEXT
93.  
94. PRINT "   Set of"; WDTH * HGHT; "members sorted in"; Delta; "seconds with Mem Sort"
95.  
96.  
97. END
98.  
99.  
100.  
101. '______________________________________________________________________________
102. SUB Sort (m AS _MEM)
103.     DIM i AS _UNSIGNED LONG
104.     $IF 64BIT THEN
105.         DIM ES AS _INTEGER64, EC AS _INTEGER64
106.     $ELSE
107.         DIM ES AS LONG, EC AS LONG
108.     $END IF
109.  
110.     IF NOT m.TYPE AND 65536 THEN EXIT SUB 'We won't work without an array
111.     IF m.TYPE AND 1024 THEN DataType = 10
112.     IF m.TYPE AND 1 THEN DataType = DataType + 1
113.     IF m.TYPE AND 2 THEN DataType = DataType + 2
114.     IF m.TYPE AND 4 THEN IF m.TYPE AND 128 THEN DataType = DataType + 4 ELSE DataType = 3
115.     IF m.TYPE AND 8 THEN IF m.TYPE AND 128 THEN DataType = DataType + 8 ELSE DataType = 5
116.     IF m.TYPE AND 32 THEN DataType = 6
117.     IF m.TYPE AND 512 THEN DataType = 7
118.  
119.     'Convert our offset data over to something we can work with
120.     DIM m1 AS _MEM: m1 = _MEMNEW(LEN(ES))
121.     _MEMPUT m1, m1.OFFSET, m.ELEMENTSIZE: _MEMGET m1, m1.OFFSET, ES 'Element Size
122.     _MEMPUT m1, m1.OFFSET, m.SIZE: _MEMGET m1, m1.OFFSET, EC 'Element Count will temporily hold the WHOLE array size
123.     _MEMFREE m1
124.  
125.     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.
126.     'And work with it!
127.     DIM o AS _OFFSET, o1 AS _OFFSET, counter AS _UNSIGNED LONG
128.  
129.     SELECT CASE DataType
130.         CASE 1 'BYTE
131.             DIM temp1(-128 TO 127) AS _UNSIGNED LONG
132.             DIM t1 AS _BYTE
133.             i = 0
134.             DO
135.                 _MEMGET m, m.OFFSET + i, t1
136.                 temp1(t1) = temp1(t1) + 1
137.                 i = i + 1
138.             LOOP UNTIL i > EC
139.             i1 = -128
140.             DO
141.                 DO UNTIL temp1(i1) = 0
142.                     _MEMPUT m, m.OFFSET + counter, i1 AS _BYTE
143.                     counter = counter + 1
144.                     temp1(i1) = temp1(i1) - 1
145.                     IF counter > EC THEN EXIT SUB
146.                 LOOP
147.                 i1 = i1 + 1
148.             LOOP UNTIL i1 > 127
149.         CASE 2: 'INTEGER
150.             DIM temp2(-32768 TO 32767) AS _UNSIGNED LONG
151.             DIM t2 AS INTEGER
152.             i = 0
153.             DO
154.                 _MEMGET m, m.OFFSET + i * 2, t2
155.                 temp2(t2) = temp2(t2) + 1
156.                 i = i + 1
157.             LOOP UNTIL i > EC
158.             i1 = -32768
159.             DO
160.                 DO UNTIL temp2(i1) = 0
161.                     _MEMPUT m, m.OFFSET + counter * 2, i1 AS INTEGER
162.                     counter = counter + 1
163.                     temp2(i1) = temp2(i1) - 1
164.                     IF counter > EC THEN EXIT SUB
165.                 LOOP
166.                 i1 = i1 + 1
167.             LOOP UNTIL i1 > 32767
168.         CASE 3 'SINGLE
169.             DIM T3a AS SINGLE, T3b AS SINGLE
170.             gap = EC
171.             DO
172.                 gap = 10 * gap \ 13
173.                 IF gap < 1 THEN gap = 1
174.                 i = 0
175.                 swapped = 0
176.                 DO
177.                     o = m.OFFSET + i * 4
178.                     o1 = m.OFFSET + (i + gap) * 4
179.                     IF _MEMGET(m, o, SINGLE) > _MEMGET(m, o1, SINGLE) THEN
180.                         _MEMGET m, o1, T3a
181.                         _MEMGET m, o, T3b
182.                         _MEMPUT m, o1, T3b
183.                         _MEMPUT m, o, T3a
184.                         swapped = -1
185.                     END IF
186.                     i = i + 1
187.                 LOOP UNTIL i + gap > EC
188.             LOOP UNTIL gap = 1 AND swapped = 0
189.         CASE 4 'LONG
190.             DIM T4a AS LONG, T4b AS LONG
191.             gap = EC
192.             DO
193.                 gap = 10 * gap \ 13
194.                 IF gap < 1 THEN gap = 1
195.                 i = 0
196.                 swapped = 0
197.                 DO
198.                     o = m.OFFSET + i * 4
199.                     o1 = m.OFFSET + (i + gap) * 4
200.                     IF _MEMGET(m, o, LONG) > _MEMGET(m, o1, LONG) THEN
201.                         _MEMGET m, o1, T4a
202.                         _MEMGET m, o, T4b
203.                         _MEMPUT m, o1, T4b
204.                         _MEMPUT m, o, T4a
205.                         swapped = -1
206.                     END IF
207.                     i = i + 1
208.                 LOOP UNTIL i + gap > EC
209.             LOOP UNTIL gap = 1 AND swapped = 0
210.         CASE 5 'DOUBLE
211.             DIM T5a AS DOUBLE, T5b AS DOUBLE
212.             gap = EC
213.             DO
214.                 gap = 10 * gap \ 13
215.                 IF gap < 1 THEN gap = 1
216.                 i = 0
217.                 swapped = 0
218.                 DO
219.                     o = m.OFFSET + i * 8
220.                     o1 = m.OFFSET + (i + gap) * 8
221.                     IF _MEMGET(m, o, DOUBLE) > _MEMGET(m, o1, DOUBLE) THEN
222.                         _MEMGET m, o1, T5a
223.                         _MEMGET m, o, T5b
224.                         _MEMPUT m, o1, T5b
225.                         _MEMPUT m, o, T5a
226.                         swapped = -1
227.                     END IF
228.                     i = i + 1
229.                 LOOP UNTIL i + gap > EC
230.             LOOP UNTIL gap = 1 AND swapped = 0
231.         CASE 6 ' _FLOAT
232.             DIM T6a AS _FLOAT, T6b AS _FLOAT
233.             gap = EC
234.             DO
235.                 gap = 10 * gap \ 13
236.                 IF gap < 1 THEN gap = 1
237.                 i = 0
238.                 swapped = 0
239.                 DO
240.                     o = m.OFFSET + i * 32
241.                     o1 = m.OFFSET + (i + gap) * 32
242.                     IF _MEMGET(m, o, _FLOAT) > _MEMGET(m, o1, _FLOAT) THEN
243.                         _MEMGET m, o1, T6a
244.                         _MEMGET m, o, T6b
245.                         _MEMPUT m, o1, T6b
246.                         _MEMPUT m, o, T6a
247.                         swapped = -1
248.                     END IF
249.                     i = i + 1
250.                 LOOP UNTIL i + gap > EC
251.             LOOP UNTIL gap = 1 AND swapped = 0
252.         CASE 7 'String
253.             DIM T7a AS STRING, T7b AS STRING, T7c AS STRING
254.             T7a = SPACE$(ES): T7b = SPACE$(ES): T7c = SPACE$(ES)
255.             gap = EC
256.             DO
257.                 gap = INT(gap / 1.247330950103979)
258.                 IF gap < 1 THEN gap = 1
259.                 i = 0
260.                 swapped = 0
261.                 DO
262.                     o = m.OFFSET + i * ES
263.                     o1 = m.OFFSET + (i + gap) * ES
264.                     _MEMGET m, o, T7a
265.                     _MEMGET m, o1, T7b
266.                     IF T7a > T7b THEN
267.                         T7c = T7b
268.                         _MEMPUT m, o1, T7a
269.                         _MEMPUT m, o, T7c
270.                         swapped = -1
271.                     END IF
272.                     i = i + 1
273.                 LOOP UNTIL i + gap > EC
274.             LOOP UNTIL gap = 1 AND swapped = false
275.         CASE 8 '_INTEGER64
276.             DIM T8a AS _INTEGER64, T8b AS _INTEGER64
277.             gap = EC
278.             DO
279.                 gap = 10 * gap \ 13
280.                 IF gap < 1 THEN gap = 1
281.                 i = 0
282.                 swapped = 0
283.                 DO
284.                     o = m.OFFSET + i * 8
285.                     o1 = m.OFFSET + (i + gap) * 8
286.                     IF _MEMGET(m, o, _INTEGER64) > _MEMGET(m, o1, _INTEGER64) THEN
287.                         _MEMGET m, o1, T8a
288.                         _MEMGET m, o, T8b
289.                         _MEMPUT m, o1, T8b
290.                         _MEMPUT m, o, T8a
291.                         swapped = -1
292.                     END IF
293.                     i = i + 1
294.                 LOOP UNTIL i + gap > EC
295.             LOOP UNTIL gap = 1 AND swapped = 0
296.         CASE 11: '_UNSIGNED _BYTE
297.             DIM temp11(0 TO 255) AS _UNSIGNED LONG
298.             DIM t11 AS _UNSIGNED _BYTE
299.             i = 0
300.             DO
301.                 _MEMGET m, m.OFFSET + i, t11
302.                 temp11(t11) = temp11(t11) + 1
303.                 i = i + 1
304.             LOOP UNTIL i > EC
305.             i1 = 0
306.             DO
307.                 DO UNTIL temp11(i1) = 0
308.                     _MEMPUT m, m.OFFSET + counter, i1 AS _UNSIGNED _BYTE
309.                     counter = counter + 1
310.                     temp11(i1) = temp11(i1) - 1
311.                     IF counter > EC THEN EXIT SUB
312.                 LOOP
313.                 i1 = i1 + 1
314.             LOOP UNTIL i1 > 255
315.         CASE 12 '_UNSIGNED INTEGER
316.             DIM temp12(0 TO 65535) AS _UNSIGNED LONG
317.             DIM t12 AS _UNSIGNED INTEGER
318.             i = 0
319.             DO
320.                 _MEMGET m, m.OFFSET + i * 2, t12
321.                 temp12(t12) = temp12(t12) + 1
322.                 i = i + 1
323.             LOOP UNTIL i > EC
324.             i1 = 0
325.             DO
326.                 DO UNTIL temp12(i1) = 0
327.                     _MEMPUT m, m.OFFSET + counter * 2, i1 AS _UNSIGNED INTEGER
328.                     counter = counter + 1
329.                     temp12(i1) = temp12(i1) - 1
330.                     IF counter > EC THEN EXIT SUB
331.                 LOOP
332.                 i1 = i1 + 1
333.             LOOP UNTIL i1 > 65535
334.         CASE 14 '_UNSIGNED LONG
335.             DIM T14a AS _UNSIGNED LONG, T14b AS _UNSIGNED LONG
336.             gap = EC
337.             DO
338.                 gap = 10 * gap \ 13
339.                 IF gap < 1 THEN gap = 1
340.                 i = 0
341.                 swapped = 0
342.                 DO
343.                     o = m.OFFSET + i * 4
344.                     o1 = m.OFFSET + (i + gap) * 4
345.                     IF _MEMGET(m, o, _UNSIGNED LONG) > _MEMGET(m, o1, _UNSIGNED LONG) THEN
346.                         _MEMGET m, o1, T14a
347.                         _MEMGET m, o, T14b
348.                         _MEMPUT m, o1, T14b
349.                         _MEMPUT m, o, T14a
350.                         swapped = -1
351.                     END IF
352.                     i = i + 1
353.                 LOOP UNTIL i + gap > EC
354.             LOOP UNTIL gap = 1 AND swapped = 0
355.         CASE 18: '_UNSIGNED _INTEGER64
356.             DIM T18a AS _UNSIGNED _INTEGER64, T18b AS _UNSIGNED _INTEGER64
357.             gap = EC
358.             DO
359.                 gap = 10 * gap \ 13
360.                 IF gap < 1 THEN gap = 1
361.                 i = 0
362.                 swapped = 0
363.                 DO
364.                     o = m.OFFSET + i * 8
365.                     o1 = m.OFFSET + (i + gap) * 8
366.                     IF _MEMGET(m, o, _UNSIGNED _INTEGER64) > _MEMGET(m, o1, _UNSIGNED _INTEGER64) THEN
367.                         _MEMGET m, o1, T18a
368.                         _MEMGET m, o, T18b
369.                         _MEMPUT m, o1, T18b
370.                         _MEMPUT m, o, T18a
371.                         swapped = -1
372.                     END IF
373.                     i = i + 1
374.                 LOOP UNTIL i + gap > EC
375.             LOOP UNTIL gap = 1 AND swapped = 0
376.     END SELECT
377. END SUB
378.  
379.  
380. 'Sub for radix sort
381. SUB RADIX_SORT (Array() AS LONG)
382.  
383.     'Find largest element in the Array
384.     DIM MaxArrayValue AS LONG
385.     MaxArrayValue = ARRAY_MAX_VALUE(Array(), ArrayLength)
386.  
387.     'Counting sort is performed based on Place, like ones Place, tens Place and so on.
388.     Place = 1
389.     WHILE MaxArrayValue \ Place > 0
390.         CALL COUNT_SORT(Array(), Place)
391.         Place = Place * 10
392.     WEND
393.  
394. END SUB
395.  
396. '_______________________________________________________________________________
397. SUB COUNT_SORT (Array() AS LONG, Place)
398.  
399.     DIM OwtPut(ArrayLength) AS LONG
400.  
401.     'Range of the number is 0-9 for each Place considered.
402.     DIM Count(10) AS LONG
403.  
404.     'Enumerate Place member occurrences in Count()
405.     DIM Index AS LONG
406.  
407.     FOR i& = 0 TO ArrayLength - 1
408.         Index = Array(i&) \ Place
409.         Count(Index MOD 10) = Count(Index MOD 10) + 1
410.     NEXT
411.  
412.     'Change Count() so that Count() now contains actual Place position of this
413.     'each digit in OwtPut()
414.     FOR i& = 1 TO 10
415.         Count(i&) = Count(i&) + Count(i& - 1)
416.     NEXT
417.  
418.     'Build the OwtPut() array
419.     i& = ArrayLength - 1
420.     WHILE i& >= 0
421.         Index& = Array&(i&) \ Place
422.         OwtPut(Count(Index& MOD 10) - 1) = Array(i&)
423.         Count(Index& MOD 10) = Count(Index& MOD 10) - 1
424.         i& = i& - 1
425.     WEND
426.  
427.     i& = 0
428.     FOR i& = 0 TO ArrayLength - 1
429.         Array(i&) = OwtPut(i&)
430.     NEXT
431.  
432.  
433. END SUB
434.  
435. '______________________________________________________________________________
436.  
437. 'Find the largest member of an array set.
438. FUNCTION ARRAY_MAX_VALUE (Array() AS LONG, ArrayLength)
439.     FOR i& = 0 TO ArrayLength
440.         IF Array&(i&) > tmx& THEN tmx& = Array&(i&)
441.     NEXT
442.     ARRAY_MAX_VALUE = tmx&
443. END FUNCTION
444.  
445. '______________________________________________________________________________
446.  
447. 'Calculate the size of an array.
448. FUNCTION ARRAY_LENGTH (Array() AS LONG)
449.     ARRAY_LENGTH = UBOUND(Array&) - LBOUND(Array&)
450. END FUNCTION
451.  
452.  
453.  

[SMcNeill]

If you're curious about the method to sort so quickly, here's a hint:  Memsort *doesn't* sort bytes or integers (signed or unsigned)!!

Here's the epiphany I had for how it works:

Let's go with something simple to illustrate the process -- coin tosses!!

DATA: HTHTTHTHTTHTHTHTHHTTTTTHHHHTTTTHTHTHTHTHTHTHTHTHTHTHTHTHTHTHTHT

And now we can sort that data...  Any sort method you choose has to make multiple passes and comparisons to sort the data...

BUT...

What if we count the data instead??   ONE PASS is all that's needed!

FOR I = 1 to DATA_COUNT
   IF ARRAY(I) = "H" THEN Head_Count = Head_Count + 1 ELSE Tail_Count = Tail_Count + 1
NEXT

Run that and we get 12 heads, 17 tails....

And then we rebuilt the array in one pass with that info!

For i = 1 TO Head_Count
    ARRAY(i) = "H"
NEXT
For i = Head_Count + 1 TO Head_Count + Tail_Count + 1
   ARRAY(i) = "T"
NEXT


More or less like the above, but with a counter with 255 elements for bytes and 65k elements for integers, which then builds the array from the counters.

It's *NOT* sorting at all!  It's just counting!!

And that's why you won't find any faster sort routines than the not-sort hidden in my mem-sort.  😁

[bplus]

I think a count sort not only clever but it should count as a sort.

[Phlashlite]

Thanks! 

Yeah, counting is how radix works too... But it isn't purely linear, they call it a hybrid.  If you look inside at the COUNT_SORT.  It just counts.... ...   

Code: QB64: [Select]

1. SUB COUNT_SORT (Array() AS LONG, Place)
2.  
3.     DIM OwtPut(ArrayLength) AS LONG
4.  
5.     'Range of the number is 0-9 for each Place considered.
6.     DIM Count(10) AS LONG
7.  
8.     'Enumerate Place member occurrences in Count()
9.     DIM Index AS LONG
10.  
11.     FOR i& = 0 TO ArrayLength - 1
12.         Index = Array(i&) \ Place
13.         Count(Index MOD 10) = Count(Index MOD 10) + 1
14.     NEXT
15.  
16.     'Change Count() so that Count() now contains actual Place position of this
17.     'each digit in OwtPut()
18.     FOR i& = 1 TO 10
19.         Count(i&) = Count(i&) + Count(i& - 1)
20.     NEXT
21.  
22.     'Build the OwtPut() array
23.     i& = ArrayLength - 1
24.     WHILE i& >= 0
25.         Index& = Array&(i&) \ Place
26.         OwtPut(Count(Index& MOD 10) - 1) = Array(i&)
27.         Count(Index& MOD 10) = Count(Index& MOD 10) - 1
28.         i& = i& - 1
29.     WEND
30.  
31.     i& = 0
32.     FOR i& = 0 TO ArrayLength - 1
33.         Array(i&) = OwtPut(i&)
34.     NEXT
35.  
36.  
37. END SUB

there are no comparisons in there...
Then that is done for each "place" in any given number.... one, tens, hundreds ect...  I think the hybrid part comes in the combination of the sums at the end... It's really interesting stuff for someone like me who doesn't think about the mechanics of sorting on a regular basis. 

Here is a cool site: https://www.bigocheatsheet.com/

@SMcNeill ,I do like your explanation and examples!  Sometimes these algorithms are difficult to digest and that was the best explanation I have heard yet!

[SMcNeill]

I think a count sort not only clever but it should count as a sort.

Biggest advantage to a counting method is you can completely eliminate IF comparisons.

Say you have an array of 1,000,000 elements, with a data range from 0 to 10:

FOR I= 1 TO 1000000
    Array(I) = INT(RND * 11)
NEXT

Sort it with:

FOR I = 1 TO 1000000
    Counter(Array(I)) = Counter(Array(I)) + 1
NEXT

No comparisons at all, but you now have it sorted:

123104 zeros...  132564 ones....  79854 twos...

Just rebuild your array now with the values you counted.


You won't find any faster method out there!

[Phlashlite]

That's for sure... it's actually been mathematically proven!

And, if you thought of that on your own then you are up there with the BIG brains :)

History:
Although radix sorting itself dates back far longer, counting sort, and its application to radix sorting, were both invented by Harold H. Seward in 1954.[1][4][8]

[DANILIN]

I think it's more interesting visualization is slower
then where to insert in program ... _delay ?

youtube + Sorting visualization:

https://codeproject.com/Articles/1087568/Visualization-and-Comparison-of-sorting-algorith

https://panthema.net/2013/1024-Sound-of-Sorting-KIT-Informatik/
https://panthema.net/2013/sound-of-sorting/

https://toptal.com/developers/sorting-algorithms

https://rosettacode.org/wiki/Sorting_algorithms/Radix_sort#QB64

youtube.com/results?search_query=radix+sort+visualization