Author Topic: Radix Sorting  (Read 5168 times)

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.

Offline Phlashlite

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

Offline Phlashlite

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

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Radix Sorting
« 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 »

Offline Phlashlite

  • Newbie
  • Posts: 50
    • View Profile
Re: Radix Sorting
« 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.

Offline bplus

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

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 »

Offline Phlashlite

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

Offline SMcNeill

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

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!

Offline Phlashlite

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

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

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Radix Sorting
« 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!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Radix Sorting
« 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.

Offline Phlashlite

  • Newbie
  • Posts: 50
    • View Profile
Re: Radix Sorting
« 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.     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.  

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 »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Radix Sorting
« 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!

Offline Phlashlite

  • Newbie
  • Posts: 50
    • View Profile
Re: Radix Sorting
« 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 »

Offline DANILIN

  • Forum Regular
  • Posts: 128
    • View Profile
    • Danilin youtube
Re: Radix Sorting
« Reply #13 on: February 04, 2022, 04:56:25 pm »
Russia looks world from future. big data is peace data.
https://youtube.com/playlist?list=PLBBTP9oVY7IagpH0g9FNUQ8JqmHwxDDDB
i never recommend anything to anyone and always write only about myself