0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

#### Phlashlite

• Newbie
• Posts: 50
« on: February 02, 2022, 12:41:13 pm »
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]
2.
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.
22. i = 0
23. FOR x = 0 TO WDTH - 1
24.     FOR y = 0 TO HGHT - 1
25.         PSET (x, y), _RGB(DemoArray(i), DemoArray(i), DemoArray(i))
26.         i = i + 1
27. INPUT "Press ENTER to Sort Array", a\$
28.
29. '==============================================================================
30.
31.
32. 'Used in procedures____________________________________________________________
33. DIM SHARED ArrayLength
34. ArrayLength = ARRAY_LENGTH(DemoArray())
35. DIM SHARED Place%
36. ts = TIMER
38. tf = TIMER
39. Delta = tf - ts
40. '______________________________________________________________________________
41.
42.
43. '==============================================================================
44. i = 0
45. FOR x = 0 TO WDTH - 1
46.     FOR y = 0 TO HGHT - 1
47.         PSET (x, y), _RGB(DemoArray(i), DemoArray(i), DemoArray(i))
48.         i = i + 1
49.
50. PRINT "Set of 1000000 members sorted in"; Delta; "seconds."
51.
52. '==============================================================================
53.
54.
55. '______________________________________________________________________________
56.
59.
60.     'Find largest element in the Array
61.     MaxArrayValue% = ARRAY_MAX_VALUE(Array(), ArrayLength)
62.
63.     'Counting sort is performed based on Place, like ones Place, tens Place and so on.
64.     Place% = 1
65.     WHILE MaxArrayValue% \ Place% > 0
66.         CALL COUNT_SORT(Array(), Place%)
67.         Place% = Place% * 10
68.
69.
70. '_______________________________________________________________________________
71. SUB COUNT_SORT (Array(), Place%)
72.
73.     DIM OwtPut(ArrayLength)
74.
75.     'Range of the number is 0-9 for each Place considered.
76.     DIM Count(10)
77.
78.     'Enumerate Place member occurrences in Count()
79.     FOR i = 0 TO ArrayLength - 1
80.         Index% = Array(i) \ Place%
81.         Count(Index% MOD 10) = Count(Index% MOD 10) + 1
82.
83.     'Change Count() so that Count() now contains actual Place position of this
84.     'each digit in OwtPut()
85.     FOR i% = 1 TO 10
86.         Count(i%) = Count(i%) + Count(i% - 1)
87.
88.     'Build the OwtPut() array
89.     i = ArrayLength - 1
90.     WHILE i >= 0
91.         Index% = Array(i) \ Place%
92.         OwtPut(Count(Index% MOD 10) - 1) = Array(i)
93.         Count(Index% MOD 10) = Count(Index% MOD 10) - 1
94.         i = i - 1
95.
96.     i = 0
97.     FOR i = 0 TO ArrayLength - 1
98.         Array(i) = OwtPut(i)
99.
100.
101.
102.
103. '______________________________________________________________________________
104.
105. 'Find the largest member of an array set.
106. FUNCTION ARRAY_MAX_VALUE (Array(), ArrayLength)
107.     FOR i = 0 TO ArrayLength
108.         IF Array(i) > tmx% THEN tmx% = Array(i)
109.     ARRAY_MAX_VALUE = tmx%
110.
111. '______________________________________________________________________________
112.
113. 'Calculate the size of an array.
114. FUNCTION ARRAY_LENGTH (Array())
115.     ARRAY_LENGTH = UBOUND(Array) - LBOUND(Array)
116.

#### Phlashlite

• Newbie
• Posts: 50
« Reply #1 on: February 02, 2022, 12:43:07 pm »
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.
16. i = 0
17. FOR x = 0 TO WDTH - 1
18.     FOR y = 0 TO HGHT - 1
19.         PSET (x, y), _RGB(DemoArray(i), DemoArray(i), DemoArray(i))
20.         i = i + 1
21. INPUT "Sort Array?", a\$
22.
23. '==============================================================================
24.
25. DIM SHARED ArrayLength
26. ArrayLength = ARRAY_LENGTH(DemoArray())
27. DIM SHARED Place%
28. ts = TIMER
29. QuickSort 0, 999999, DemoArray()
30. tf = TIMER
31. Delta = tf - ts
32.
33.
34. '==============================================================================
35. i = 0
36. FOR x = 0 TO WDTH - 1
37.     FOR y = 0 TO HGHT - 1
38.         PSET (x, y), _RGB(DemoArray(i), DemoArray(i), DemoArray(i))
39.         i = i + 1
40.
41. PRINT "1000000 members sorted in"; Delta; "seconds"
42.
43. '==============================================================================
44.
45.
46. SUB QuickSort (start, finish, array())
47.     'Straight from the QB64 wiki
48.     DIM Hi, Lo, Middle
49.     Hi = finish
50.     Lo = start
51.     Middle = array((Lo + Hi) / 2) 'find middle of array
52.
53.         DO WHILE array(Lo) < Middle
54.             Lo = Lo + 1
55.
56.         DO WHILE array(Hi) > Middle
57.             Hi = Hi - 1
58.
59.         IF Lo <= Hi THEN
60.             SWAP array(Lo), array(Hi)
61.             Lo = Lo + 1
62.             Hi = Hi - 1
63.     LOOP UNTIL Lo > Hi
64.
65.     IF Hi > start THEN CALL QuickSort(start, Hi, array())
66.     IF Lo < finish THEN CALL QuickSort(Lo, finish, array())
67.
68.
69. '______________________________________________________________________________
70.
71. 'Find the largest member of an array set.
72. FUNCTION ARRAY_MAX_VALUE (Array(), ArrayLength)
73.     FOR i = 0 TO ArrayLength
74.         IF Array(i) > tmx% THEN tmx% = Array(i)
75.     ARRAY_MAX_VALUE = tmx%
76.
77. '______________________________________________________________________________
78.
79. 'Calculate the size of an array.
80. FUNCTION ARRAY_LENGTH (Array())
81.     ARRAY_LENGTH = UBOUND(Array) - LBOUND(Array)
82.
83.

#### bplus

• Global Moderator
• Forum Resident
• Posts: 8053
• b = b + ...
« Reply #2 on: February 02, 2022, 12:44:28 pm »
Looks like my kind of Quick Sort :-))

But be careful with Types, Single the default is not same as something from RGB Integers/Long
« Last Edit: February 02, 2022, 12:55:09 pm by bplus »

#### Phlashlite

• Newbie
• Posts: 50
« Reply #3 on: February 02, 2022, 12:45:46 pm »
A couple of caveats:

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

#### bplus

• Global Moderator
• Forum Resident
• Posts: 8053
• b = b + ...
« Reply #4 on: February 02, 2022, 12:57:18 pm »
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.
16. i = 0
17. For x = 0 To WDTH - 1
18.     For y = 0 To HGHT - 1
19.         PSet (x, y), _RGB(DemoArray(i), DemoArray(i), DemoArray(i))
20.         i = i + 1
21. Input "Sort Array?", a\$
22.
23. '==============================================================================
24.
25. Dim Shared ArrayLength
26. ArrayLength = ARRAY_LENGTH(DemoArray())
27. ' Dim Shared Place%  ' not used
28. ts = Timer
29. QuickSort 0, 999999, DemoArray()
30. tf = Timer
31. Delta = tf - ts
32.
33.
34. '==============================================================================
35. i = 0
36. For x = 0 To WDTH - 1
37.     For y = 0 To HGHT - 1
38.         PSet (x, y), _RGB(DemoArray(i), DemoArray(i), DemoArray(i))
39.         i = i + 1
40.
41. Print "1000000 members sorted in"; Delta; "seconds"
42.
43. '==============================================================================
44.
45.
46. Sub QuickSort (start, finish, array() As Long)
47.     'Straight from the QB64 wiki
48.     Dim As Long Hi, Lo, Middle
49.     Hi = finish
50.     Lo = start
51.     Middle = array((Lo + Hi) / 2) 'find middle of array
52.
53.         Do While array(Lo) < Middle
54.             Lo = Lo + 1
55.
56.         Do While array(Hi) > Middle
57.             Hi = Hi - 1
58.
59.         If Lo <= Hi Then
60.             Swap array(Lo), array(Hi)
61.             Lo = Lo + 1
62.             Hi = Hi - 1
63.     Loop Until Lo > Hi
64.
65.     If Hi > start Then Call QuickSort(start, Hi, array())
66.     If Lo < finish Then Call QuickSort(Lo, finish, array())
67.
68.
69. '______________________________________________________________________________
70.
71. 'Find the largest member of an array set.
72. Function ARRAY_MAX_VALUE (Array() As Long, ArrayLength)
73.     For i = 0 To ArrayLength
74.         If Array(i) > tmx& Then tmx& = Array(i)
75.     ARRAY_MAX_VALUE = tmx&
76.
77. '______________________________________________________________________________
78.
79. 'Calculate the size of an array.
80. Function ARRAY_LENGTH (Array() As Long)
81.     ARRAY_LENGTH = UBound(Array) - LBound(Array)
82.
83.
84.
85.

Probably can apply same trick to Radix, I like the visual you gave this.
« Last Edit: February 02, 2022, 01:06:28 pm by bplus »

#### Phlashlite

• Newbie
• Posts: 50
« Reply #5 on: February 02, 2022, 04:03:54 pm »
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]
2.
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.
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. INPUT "Press ENTER to Sort Array", a\$
29.
30. '==============================================================================
31.
32.
33. 'Used in procedures____________________________________________________________
34. DIM SHARED ArrayLength AS LONG
35. ArrayLength = ARRAY_LENGTH(DemoArray())
36. ts = TIMER
38. tf = TIMER
39. Delta = tf - ts
40. '______________________________________________________________________________
41.
42.
43. '==============================================================================
44. i& = 0
45. FOR x& = 0 TO WDTH - 1
46.     FOR y& = 0 TO HGHT - 1
47.         PSET (x&, y&), _RGB(DemoArray(i&), DemoArray(i&), DemoArray(i&))
48.         i& = i& + 1
49.
50. PRINT "Set of 1000000 members sorted in"; Delta; "seconds."
51.
52. '==============================================================================
53.
54.
55. '______________________________________________________________________________
56.
58. SUB RADIX_SORT (Array() AS LONG)
59.
60.     'Find largest element in the Array
61.     DIM MaxArrayValue AS LONG
62.     MaxArrayValue = ARRAY_MAX_VALUE(Array(), ArrayLength)
63.
64.     'Counting sort is performed based on Place, like ones Place, tens Place and so on.
65.     Place = 1
66.     WHILE MaxArrayValue \ Place > 0
67.         CALL COUNT_SORT(Array(), Place)
68.         Place = Place * 10
69.
70.
71. '_______________________________________________________________________________
72. SUB COUNT_SORT (Array() AS LONG, Place)
73.
74.     DIM OwtPut(ArrayLength) AS LONG
75.
76.     'Range of the number is 0-9 for each Place considered.
77.     DIM Count(10) AS LONG
78.
79.     'Enumerate Place member occurrences in Count()
80.     DIM Index AS LONG
81.
82.     FOR i& = 0 TO ArrayLength - 1
83.         Index = Array(i&) \ Place
84.         Count(Index MOD 10) = Count(Index MOD 10) + 1
85.
86.     'Change Count() so that Count() now contains actual Place position of this
87.     'each digit in OwtPut()
88.     FOR i& = 1 TO 10
89.         Count(i&) = Count(i&) + Count(i& - 1)
90.
91.     'Build the OwtPut() array
92.     i& = ArrayLength - 1
93.     WHILE i& >= 0
94.         Index& = Array&(i&) \ Place
95.         OwtPut(Count(Index& MOD 10) - 1) = Array(i&)
96.         Count(Index& MOD 10) = Count(Index& MOD 10) - 1
97.         i& = i& - 1
98.
99.     i& = 0
100.     FOR i& = 0 TO ArrayLength - 1
101.         Array(i&) = OwtPut(i&)
102.
103.
104.
105. '______________________________________________________________________________
106.
107. 'Find the largest member of an array set.
108. FUNCTION ARRAY_MAX_VALUE (Array() AS LONG, ArrayLength)
109.     FOR i& = 0 TO ArrayLength
110.         IF Array&(i&) > tmx& THEN tmx& = Array&(i&)
111.     ARRAY_MAX_VALUE = tmx&
112.
113. '______________________________________________________________________________
114.
115. 'Calculate the size of an array.
116. FUNCTION ARRAY_LENGTH (Array() AS LONG)
117.     ARRAY_LENGTH = UBOUND(Array&) - LBOUND(Array&)
118.

#### SMcNeill

• QB64 Developer
• Forum Resident
• Posts: 3972
« Reply #6 on: February 02, 2022, 04:54:09 pm »
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]
2.
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.
27. i& = 0
28. For x& = 0 To WDTH - 1
29.     For y& = 0 To HGHT - 1
30.         PSet (x&, y&), _RGB(DemoArray(i&), DemoArray(i&), DemoArray(i&))
31.         i& = i& + 1
32. Input "Press ENTER to Sort Array", a\$
33.
34. '==============================================================================
35.
36.
37. 'Used in procedures____________________________________________________________
38. Dim Shared ArrayLength As Long
39. ArrayLength = ARRAY_LENGTH(DemoArray())
40. ts = Timer
42.
43. tf = Timer
44. Delta = tf - ts
45. '______________________________________________________________________________
46.
47.
48. '==============================================================================
49. i& = 0
50. For x& = 0 To WDTH - 1
51.     For y& = 0 To HGHT - 1
52.         PSet (x&, y&), _RGB(DemoArray(i&), DemoArray(i&), DemoArray(i&))
53.         i& = i& + 1
54.
55. Print "Set of 1000000 members sorted in"; Delta; "seconds."
56.
57. '==============================================================================
58.
59. 'Restore the background to the original state
60. i& = 0
61. For x& = 0 To WDTH - 1
62.     For y& = 0 To HGHT - 1
63.         PSet (x&, y&), _RGB(DemoArrayCopy(i&), DemoArrayCopy(i&), DemoArrayCopy(i&))
64.         i& = i& + 1
65.
66.
67. ts = Timer
68. Sort m
69.
70. tf = Timer
71. Delta = tf - ts
72. '______________________________________________________________________________
73.
74.
75. '==============================================================================
76. i& = 0
77. For x& = 0 To WDTH - 1
78.     For y& = 0 To HGHT - 1
79.         PSet (x&, y&), _RGB(DemoArray(i&), DemoArray(i&), DemoArray(i&))
80.         i& = i& + 1
81.
82. Print "Set of 1000000 members sorted in"; Delta; "seconds."
83.
84.
85.
86.
87.
88.
89.
90. '______________________________________________________________________________
91. Sub Sort (m As _MEM)
92.     \$If 64BIT Then
93.         DIM ES AS LONG, EC AS LONG
94.
95.     If Not m.TYPE And 65536 Then Exit Sub 'We won't work without an array
96.     If m.TYPE And 1024 Then DataType = 10
97.     If m.TYPE And 1 Then DataType = DataType + 1
98.     If m.TYPE And 2 Then DataType = DataType + 2
99.     If m.TYPE And 4 Then If m.TYPE And 128 Then DataType = DataType + 4 Else DataType = 3
100.     If m.TYPE And 8 Then If m.TYPE And 128 Then DataType = DataType + 8 Else DataType = 5
101.     If m.TYPE And 32 Then DataType = 6
102.     If m.TYPE And 512 Then DataType = 7
103.
104.     'Convert our offset data over to something we can work with
105.     Dim m1 As _MEM: m1 = _MemNew(Len(ES))
106.     _MemPut m1, m1.OFFSET, m.ELEMENTSIZE: _MemGet m1, m1.OFFSET, ES 'Element Size
107.     _MemPut m1, m1.OFFSET, m.SIZE: _MemGet m1, m1.OFFSET, EC 'Element Count will temporily hold the WHOLE array size
108.     _MemFree m1
109.
110.     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.
111.     'And work with it!
112.     Dim o As _Offset, o1 As _Offset, counter As _Unsigned Long
113.
114.     Select Case DataType
115.         Case 1 'BYTE
116.             Dim temp1(-128 To 127) As _Unsigned Long
117.             i = 0
118.                 _MemGet m, m.OFFSET + i, t1
119.                 temp1(t1) = temp1(t1) + 1
120.                 i = i + 1
121.             Loop Until i > EC
122.             i1 = -128
123.                 Do Until temp1(i1) = 0
124.                     _MemPut m, m.OFFSET + counter, i1 As _BYTE
125.                     counter = counter + 1
126.                     temp1(i1) = temp1(i1) - 1
127.                     If counter > EC Then Exit Sub
128.                 i1 = i1 + 1
129.             Loop Until i1 > 127
130.         Case 2: 'INTEGER
131.             Dim temp2(-32768 To 32767) As _Unsigned Long
132.             i = 0
133.                 _MemGet m, m.OFFSET + i * 2, t2
134.                 temp2(t2) = temp2(t2) + 1
135.                 i = i + 1
136.             Loop Until i > EC
137.             i1 = -32768
138.                 Do Until temp2(i1) = 0
139.                     _MemPut m, m.OFFSET + counter * 2, i1 As INTEGER
140.                     counter = counter + 1
141.                     temp2(i1) = temp2(i1) - 1
142.                     If counter > EC Then Exit Sub
143.                 i1 = i1 + 1
144.             Loop Until i1 > 32767
145.         Case 3 'SINGLE
146.             Dim T3a As Single, T3b As Single
147.             gap = EC
148.                 gap = 10 * gap \ 13
149.                 If gap < 1 Then gap = 1
150.                 i = 0
151.                 swapped = 0
152.                     o = m.OFFSET + i * 4
153.                     o1 = m.OFFSET + (i + gap) * 4
154.                     If _MemGet(m, o, Single) > _MemGet(m, o1, Single) Then
155.                         _MemGet m, o1, T3a
156.                         _MemGet m, o, T3b
157.                         _MemPut m, o1, T3b
158.                         _MemPut m, o, T3a
159.                         swapped = -1
160.                     i = i + 1
161.                 Loop Until i + gap > EC
162.             Loop Until gap = 1 And swapped = 0
163.         Case 4 'LONG
164.             Dim T4a As Long, T4b As Long
165.             gap = EC
166.                 gap = 10 * gap \ 13
167.                 If gap < 1 Then gap = 1
168.                 i = 0
169.                 swapped = 0
170.                     o = m.OFFSET + i * 4
171.                     o1 = m.OFFSET + (i + gap) * 4
172.                     If _MemGet(m, o, Long) > _MemGet(m, o1, Long) Then
173.                         _MemGet m, o1, T4a
174.                         _MemGet m, o, T4b
175.                         _MemPut m, o1, T4b
176.                         _MemPut m, o, T4a
177.                         swapped = -1
178.                     i = i + 1
179.                 Loop Until i + gap > EC
180.             Loop Until gap = 1 And swapped = 0
181.         Case 5 'DOUBLE
182.             Dim T5a As Double, T5b As Double
183.             gap = EC
184.                 gap = 10 * gap \ 13
185.                 If gap < 1 Then gap = 1
186.                 i = 0
187.                 swapped = 0
188.                     o = m.OFFSET + i * 8
189.                     o1 = m.OFFSET + (i + gap) * 8
190.                     If _MemGet(m, o, Double) > _MemGet(m, o1, Double) Then
191.                         _MemGet m, o1, T5a
192.                         _MemGet m, o, T5b
193.                         _MemPut m, o1, T5b
194.                         _MemPut m, o, T5a
195.                         swapped = -1
196.                     i = i + 1
197.                 Loop Until i + gap > EC
198.             Loop Until gap = 1 And swapped = 0
199.         Case 6 ' _FLOAT
200.             Dim T6a As _Float, T6b As _Float
201.             gap = EC
202.                 gap = 10 * gap \ 13
203.                 If gap < 1 Then gap = 1
204.                 i = 0
205.                 swapped = 0
206.                     o = m.OFFSET + i * 32
207.                     o1 = m.OFFSET + (i + gap) * 32
208.                     If _MemGet(m, o, _Float) > _MemGet(m, o1, _Float) Then
209.                         _MemGet m, o1, T6a
210.                         _MemGet m, o, T6b
211.                         _MemPut m, o1, T6b
212.                         _MemPut m, o, T6a
213.                         swapped = -1
214.                     i = i + 1
215.                 Loop Until i + gap > EC
216.             Loop Until gap = 1 And swapped = 0
217.         Case 7 'String
218.             Dim T7a As String, T7b As String, T7c As String
219.             T7a = Space\$(ES): T7b = Space\$(ES): T7c = Space\$(ES)
220.             gap = EC
221.                 gap = Int(gap / 1.247330950103979)
222.                 If gap < 1 Then gap = 1
223.                 i = 0
224.                 swapped = 0
225.                     o = m.OFFSET + i * ES
226.                     o1 = m.OFFSET + (i + gap) * ES
227.                     _MemGet m, o, T7a
228.                     _MemGet m, o1, T7b
229.                     If T7a > T7b Then
230.                         T7c = T7b
231.                         _MemPut m, o1, T7a
232.                         _MemPut m, o, T7c
233.                         swapped = -1
234.                     i = i + 1
235.                 Loop Until i + gap > EC
236.             Loop Until gap = 1 And swapped = false
237.         Case 8 '_INTEGER64
238.             Dim T8a As _Integer64, T8b As _Integer64
239.             gap = EC
240.                 gap = 10 * gap \ 13
241.                 If gap < 1 Then gap = 1
242.                 i = 0
243.                 swapped = 0
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.                     i = i + 1
253.                 Loop Until i + gap > EC
254.             Loop Until gap = 1 And swapped = 0
255.         Case 11: '_UNSIGNED _BYTE
256.             Dim temp11(0 To 255) As _Unsigned Long
257.             i = 0
258.                 _MemGet m, m.OFFSET + i, t11
259.                 temp11(t11) = temp11(t11) + 1
260.                 i = i + 1
261.             Loop Until i > EC
262.             i1 = 0
263.                 Do Until temp11(i1) = 0
264.                     _MemPut m, m.OFFSET + counter, i1 As _UNSIGNED _BYTE
265.                     counter = counter + 1
266.                     temp11(i1) = temp11(i1) - 1
267.                     If counter > EC Then Exit Sub
268.                 i1 = i1 + 1
269.             Loop Until i1 > 255
270.         Case 12 '_UNSIGNED INTEGER
271.             Dim temp12(0 To 65535) As _Unsigned Long
272.             i = 0
273.                 _MemGet m, m.OFFSET + i * 2, t12
274.                 temp12(t12) = temp12(t12) + 1
275.                 i = i + 1
276.             Loop Until i > EC
277.             i1 = 0
278.                 Do Until temp12(i1) = 0
279.                     _MemPut m, m.OFFSET + counter * 2, i1 As _UNSIGNED INTEGER
280.                     counter = counter + 1
281.                     temp12(i1) = temp12(i1) - 1
282.                     If counter > EC Then Exit Sub
283.                 i1 = i1 + 1
284.             Loop Until i1 > 65535
285.         Case 14 '_UNSIGNED LONG
286.             Dim T14a As _Unsigned Long, T14b As _Unsigned Long
287.             gap = EC
288.                 gap = 10 * gap \ 13
289.                 If gap < 1 Then gap = 1
290.                 i = 0
291.                 swapped = 0
292.                     o = m.OFFSET + i * 4
293.                     o1 = m.OFFSET + (i + gap) * 4
294.                     If _MemGet(m, o, _Unsigned Long) > _MemGet(m, o1, _Unsigned Long) Then
295.                         _MemGet m, o1, T14a
296.                         _MemGet m, o, T14b
297.                         _MemPut m, o1, T14b
298.                         _MemPut m, o, T14a
299.                         swapped = -1
300.                     i = i + 1
301.                 Loop Until i + gap > EC
302.             Loop Until gap = 1 And swapped = 0
303.         Case 18: '_UNSIGNED _INTEGER64
304.             gap = EC
305.                 gap = 10 * gap \ 13
306.                 If gap < 1 Then gap = 1
307.                 i = 0
308.                 swapped = 0
309.                     o = m.OFFSET + i * 8
310.                     o1 = m.OFFSET + (i + gap) * 8
311.                         _MemGet m, o1, T18a
312.                         _MemGet m, o, T18b
313.                         _MemPut m, o1, T18b
314.                         _MemPut m, o, T18a
315.                         swapped = -1
316.                     i = i + 1
317.                 Loop Until i + gap > EC
318.             Loop Until gap = 1 And swapped = 0
319.
320.
322. Sub RADIX_SORT (Array() As Long)
323.
324.     'Find largest element in the Array
325.     Dim MaxArrayValue As Long
326.     MaxArrayValue = ARRAY_MAX_VALUE(Array(), ArrayLength)
327.
328.     'Counting sort is performed based on Place, like ones Place, tens Place and so on.
329.     Place = 1
330.     While MaxArrayValue \ Place > 0
331.         Call COUNT_SORT(Array(), Place)
332.         Place = Place * 10
333.
334.
335. '_______________________________________________________________________________
336. Sub COUNT_SORT (Array() As Long, Place)
337.
338.     Dim OwtPut(ArrayLength) As Long
339.
340.     'Range of the number is 0-9 for each Place considered.
341.     Dim Count(10) As Long
342.
343.     'Enumerate Place member occurrences in Count()
344.     Dim Index As Long
345.
346.     For i& = 0 To ArrayLength - 1
347.         Index = Array(i&) \ Place
348.         Count(Index Mod 10) = Count(Index Mod 10) + 1
349.
350.     'Change Count() so that Count() now contains actual Place position of this
351.     'each digit in OwtPut()
352.     For i& = 1 To 10
353.         Count(i&) = Count(i&) + Count(i& - 1)
354.
355.     'Build the OwtPut() array
356.     i& = ArrayLength - 1
357.     While i& >= 0
358.         Index& = Array&(i&) \ Place
359.         OwtPut(Count(Index& Mod 10) - 1) = Array(i&)
360.         Count(Index& Mod 10) = Count(Index& Mod 10) - 1
361.         i& = i& - 1
362.
363.     i& = 0
364.     For i& = 0 To ArrayLength - 1
365.         Array(i&) = OwtPut(i&)
366.
367.
368.
369. '______________________________________________________________________________
370.
371. 'Find the largest member of an array set.
372. Function ARRAY_MAX_VALUE (Array() As Long, ArrayLength)
373.     For i& = 0 To ArrayLength
374.         If Array&(i&) > tmx& Then tmx& = Array&(i&)
375.     ARRAY_MAX_VALUE = tmx&
376.
377. '______________________________________________________________________________
378.
379. 'Calculate the size of an array.
380. Function ARRAY_LENGTH (Array() As Long)
381.     ARRAY_LENGTH = UBound(Array&) - LBound(Array&)
382.
383.

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.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

#### Phlashlite

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

Marked as best answer by Phlashlite on February 02, 2022, 02:46:24 pm

#### SMcNeill

• QB64 Developer
• Forum Resident
• Posts: 3972
« Reply #8 on: February 02, 2022, 05:55:02 pm »
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.  😁
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

#### bplus

• Global Moderator
• Forum Resident
• Posts: 8053
• b = b + ...
« Reply #9 on: February 02, 2022, 07:21:22 pm »
I think a count sort not only clever but it should count as a sort.

#### Phlashlite

• Newbie
• Posts: 50
« Reply #10 on: February 02, 2022, 07:29:50 pm »
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.
15.     'Change Count() so that Count() now contains actual Place position of this
16.     'each digit in OwtPut()
17.     FOR i& = 1 TO 10
18.         Count(i&) = Count(i&) + Count(i& - 1)
19.
20.     'Build the OwtPut() array
21.     i& = ArrayLength - 1
22.     WHILE i& >= 0
23.         Index& = Array&(i&) \ Place
24.         OwtPut(Count(Index& MOD 10) - 1) = Array(i&)
25.         Count(Index& MOD 10) = Count(Index& MOD 10) - 1
26.         i& = i& - 1
27.
28.     i& = 0
29.     FOR i& = 0 TO ArrayLength - 1
30.         Array(i&) = OwtPut(i&)
31.
32.

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!
« Last Edit: February 02, 2022, 07:45:50 pm by Phlashlite »

#### SMcNeill

• QB64 Developer
• Forum Resident
• Posts: 3972
« Reply #11 on: February 02, 2022, 07:33:53 pm »
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!
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

#### Phlashlite

• Newbie
• Posts: 50
« Reply #12 on: February 02, 2022, 07:48:12 pm »
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]
« Last Edit: February 02, 2022, 07:56:34 pm by Phlashlite »

#### DANILIN

• Forum Regular
• Posts: 128