+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Help Me! (https://qb64phoenix.com/forum/forumdisplay.php?fid=10)
+---- Thread: Alphabetizing Anyone? (/showthread.php?tid=2266)
Pages:
1
2
RE: Alphabetizing Anyone? - bplus - 12-21-2023
(12-21-2023, 05:32 PM)mnrvovrfc Wrote:Code: (Select All)ReDim Shared sa$(1 To nItems) 'setup with string array sa$() shared so dont have to pass as parameter
What if the user requires two string arrays to sort, and cannot copy or tamper with the only "sa$()" one?
I'd rather take the example in QB64 Wiki, as slow and clunky as it might look.
https://qb64phoenix.com/qb64wiki/index.php/SWAP
(Example #3 but change array type to string.)
Took me 15 secs to convert to most efficient little bit of sorting code there is:
Code: (Select All)
Sub QSort (Start, Finish, Arr$())
Dim i As Long, j As Long, x$
i = Start
j = Finish
x$ = Arr$(Int((i + j) / 2))
While i <= j
While Arr$(i) < x$
i = i + 1
Wend
While Arr$(j) > x$
j = j - 1
Wend
If i <= j Then
Swap Arr$(i), Arr$(j)
i = i + 1
j = j - 1
End If
Wend
If j > Start Then QSort Start, j, Arr$()
If i < Finish Then QSort i, Finish, Arr$()
End SubFor Start and Finish use LBound(Arr$) and UBound(Arr$).
RE: Alphabetizing Anyone? - SMcNeill - 02-25-2024
(12-21-2023, 09:42 PM)bplus Wrote: Took me 15 secs to convert to most efficient little bit of sorting code there is:
One thing to note -- QSort isn't *always* the most efficient sorting code, as highlighted below. Certain sorts just work better for certain data types than others. If you're already dealing with sorted data, and adding new data to it, an Insertion Sort can be the fastest method , in many cases.
Code: (Select All)
CONST Limit = 10000000
DIM AS _UNSIGNED _BYTE MyData(Limit), MyData2(Limit)
DIM m AS _MEM: m = _MEM(MyData())
FOR i = 0 TO Limit
MyData(i) = INT(RND * 256)
MyData2(i) = MyData(i)
NEXT
'print some prelimanry data:
FOR i = 0 TO 9: PRINT MyData(i),: NEXT
PRINT
t# = TIMER
Sort m
t1# = TIMER
QSort 0, Limit, MyData2()
t2# = TIMER
PRINT USING "###.#### seconds to memsort"; t1# - t#
PRINT USING "###.#### seconds to qsort"; t2# - t1#
'and some data verification
FOR i = 0 TO Limit
IF MyData(i) <> MyData2(i) THEN PRINT "Data Mismatch: "; i, MyData(i), MyData2(i)
NEXT
IF i > Limit THEN PRINT "All data matches in both arrays after sorting."
'print some example data, just to show it's in order now:
FOR i = 0 TO Limit STEP Limit / 9: PRINT MyData(i),: NEXT
PRINT
$CHECKING:OFF
SUB Sort (m AS _MEM)
DIM i AS _UNSIGNED LONG
$IF 64BIT THEN
DIM ES AS _INTEGER64, EC AS _INTEGER64
$ELSE
DIM ES AS LONG, EC AS LONG
$END IF
IF NOT m.TYPE AND 65536 THEN EXIT SUB 'We won't work without an array
IF m.TYPE AND 1024 THEN DataType = 10
IF m.TYPE AND 1 THEN DataType = DataType + 1
IF m.TYPE AND 2 THEN DataType = DataType + 2
IF m.TYPE AND 4 THEN IF m.TYPE AND 128 THEN DataType = DataType + 4 ELSE DataType = 3
IF m.TYPE AND 8 THEN IF m.TYPE AND 128 THEN DataType = DataType + 8 ELSE DataType = 5
IF m.TYPE AND 32 THEN DataType = 6
IF m.TYPE AND 512 THEN DataType = 7
'Convert our offset data over to something we can work with
DIM m1 AS _MEM: m1 = _MEMNEW(LEN(ES))
_MEMPUT m1, m1.OFFSET, m.ELEMENTSIZE: _MEMGET m1, m1.OFFSET, ES 'Element Size
_MEMPUT m1, m1.OFFSET, m.SIZE: _MEMGET m1, m1.OFFSET, EC 'Element Count will temporily hold the WHOLE array size
_MEMFREE m1
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.
'And work with it!
DIM o AS _OFFSET, o1 AS _OFFSET, counter AS _UNSIGNED LONG
SELECT CASE DataType
CASE 1 'BYTE
DIM temp1(-128 TO 127) AS _UNSIGNED LONG
DIM t1 AS _BYTE
i = 0
DO
_MEMGET m, m.OFFSET + i, t1
temp1(t1) = temp1(t1) + 1
i = i + 1
LOOP UNTIL i > EC
i1 = -128
DO
DO UNTIL temp1(i1) = 0
_MEMPUT m, m.OFFSET + counter, i1 AS _BYTE
counter = counter + 1
temp1(i1) = temp1(i1) - 1
IF counter > EC THEN EXIT SUB
LOOP
i1 = i1 + 1
LOOP UNTIL i1 > 127
CASE 2: 'INTEGER
DIM temp2(-32768 TO 32767) AS _UNSIGNED LONG
DIM t2 AS INTEGER
i = 0
DO
_MEMGET m, m.OFFSET + i * 2, t2
temp2(t2) = temp2(t2) + 1
i = i + 1
LOOP UNTIL i > EC
i1 = -32768
DO
DO UNTIL temp2(i1) = 0
_MEMPUT m, m.OFFSET + counter * 2, i1 AS INTEGER
counter = counter + 1
temp2(i1) = temp2(i1) - 1
IF counter > EC THEN EXIT SUB
LOOP
i1 = i1 + 1
LOOP UNTIL i1 > 32767
CASE 3 'SINGLE
DIM T3a AS SINGLE, T3b AS SINGLE
gap = EC
DO
gap = 10 * gap \ 13
IF gap < 1 THEN gap = 1
i = 0
swapped = 0
DO
o = m.OFFSET + i * 4
o1 = m.OFFSET + (i + gap) * 4
IF _MEMGET(m, o, SINGLE) > _MEMGET(m, o1, SINGLE) THEN
_MEMGET m, o1, T3a
_MEMGET m, o, T3b
_MEMPUT m, o1, T3b
_MEMPUT m, o, T3a
swapped = -1
END IF
i = i + 1
LOOP UNTIL i + gap > EC
LOOP UNTIL gap = 1 AND swapped = 0
CASE 4 'LONG
DIM T4a AS LONG, T4b AS LONG
gap = EC
DO
gap = 10 * gap \ 13
IF gap < 1 THEN gap = 1
i = 0
swapped = 0
DO
o = m.OFFSET + i * 4
o1 = m.OFFSET + (i + gap) * 4
IF _MEMGET(m, o, LONG) > _MEMGET(m, o1, LONG) THEN
_MEMGET m, o1, T4a
_MEMGET m, o, T4b
_MEMPUT m, o1, T4b
_MEMPUT m, o, T4a
swapped = -1
END IF
i = i + 1
LOOP UNTIL i + gap > EC
LOOP UNTIL gap = 1 AND swapped = 0
CASE 5 'DOUBLE
DIM T5a AS DOUBLE, T5b AS DOUBLE
gap = EC
DO
gap = 10 * gap \ 13
IF gap < 1 THEN gap = 1
i = 0
swapped = 0
DO
o = m.OFFSET + i * 8
o1 = m.OFFSET + (i + gap) * 8
IF _MEMGET(m, o, DOUBLE) > _MEMGET(m, o1, DOUBLE) THEN
_MEMGET m, o1, T5a
_MEMGET m, o, T5b
_MEMPUT m, o1, T5b
_MEMPUT m, o, T5a
swapped = -1
END IF
i = i + 1
LOOP UNTIL i + gap > EC
LOOP UNTIL gap = 1 AND swapped = 0
CASE 6 ' _FLOAT
DIM T6a AS _FLOAT, T6b AS _FLOAT
gap = EC
DO
gap = 10 * gap \ 13
IF gap < 1 THEN gap = 1
i = 0
swapped = 0
DO
o = m.OFFSET + i * 32
o1 = m.OFFSET + (i + gap) * 32
IF _MEMGET(m, o, _FLOAT) > _MEMGET(m, o1, _FLOAT) THEN
_MEMGET m, o1, T6a
_MEMGET m, o, T6b
_MEMPUT m, o1, T6b
_MEMPUT m, o, T6a
swapped = -1
END IF
i = i + 1
LOOP UNTIL i + gap > EC
LOOP UNTIL gap = 1 AND swapped = 0
CASE 7 'String
DIM T7a AS STRING, T7b AS STRING, T7c AS STRING
T7a = SPACE$(ES): T7b = SPACE$(ES): T7c = SPACE$(ES)
gap = EC
DO
gap = INT(gap / 1.247330950103979)
IF gap < 1 THEN gap = 1
i = 0
swapped = 0
DO
o = m.OFFSET + i * ES
o1 = m.OFFSET + (i + gap) * ES
_MEMGET m, o, T7a
_MEMGET m, o1, T7b
IF T7a > T7b THEN
T7c = T7b
_MEMPUT m, o1, T7a
_MEMPUT m, o, T7c
swapped = -1
END IF
i = i + 1
LOOP UNTIL i + gap > EC
LOOP UNTIL gap = 1 AND swapped = false
CASE 8 '_INTEGER64
DIM T8a AS _INTEGER64, T8b AS _INTEGER64
gap = EC
DO
gap = 10 * gap \ 13
IF gap < 1 THEN gap = 1
i = 0
swapped = 0
DO
o = m.OFFSET + i * 8
o1 = m.OFFSET + (i + gap) * 8
IF _MEMGET(m, o, _INTEGER64) > _MEMGET(m, o1, _INTEGER64) THEN
_MEMGET m, o1, T8a
_MEMGET m, o, T8b
_MEMPUT m, o1, T8b
_MEMPUT m, o, T8a
swapped = -1
END IF
i = i + 1
LOOP UNTIL i + gap > EC
LOOP UNTIL gap = 1 AND swapped = 0
CASE 11: '_UNSIGNED _BYTE
DIM temp11(0 TO 255) AS _UNSIGNED LONG
DIM t11 AS _UNSIGNED _BYTE
i = 0
DO
_MEMGET m, m.OFFSET + i, t11
temp11(t11) = temp11(t11) + 1
i = i + 1
LOOP UNTIL i > EC
i1 = 0
DO
DO UNTIL temp11(i1) = 0
_MEMPUT m, m.OFFSET + counter, i1 AS _UNSIGNED _BYTE
counter = counter + 1
temp11(i1) = temp11(i1) - 1
IF counter > EC THEN EXIT SUB
LOOP
i1 = i1 + 1
LOOP UNTIL i1 > 255
CASE 12 '_UNSIGNED INTEGER
DIM temp12(0 TO 65535) AS _UNSIGNED LONG
DIM t12 AS _UNSIGNED INTEGER
i = 0
DO
_MEMGET m, m.OFFSET + i * 2, t12
temp12(t12) = temp12(t12) + 1
i = i + 1
LOOP UNTIL i > EC
i1 = 0
DO
DO UNTIL temp12(i1) = 0
_MEMPUT m, m.OFFSET + counter * 2, i1 AS _UNSIGNED INTEGER
counter = counter + 1
temp12(i1) = temp12(i1) - 1
IF counter > EC THEN EXIT SUB
LOOP
i1 = i1 + 1
LOOP UNTIL i1 > 65535
CASE 14 '_UNSIGNED LONG
DIM T14a AS _UNSIGNED LONG, T14b AS _UNSIGNED LONG
gap = EC
DO
gap = 10 * gap \ 13
IF gap < 1 THEN gap = 1
i = 0
swapped = 0
DO
o = m.OFFSET + i * 4
o1 = m.OFFSET + (i + gap) * 4
IF _MEMGET(m, o, _UNSIGNED LONG) > _MEMGET(m, o1, _UNSIGNED LONG) THEN
_MEMGET m, o1, T14a
_MEMGET m, o, T14b
_MEMPUT m, o1, T14b
_MEMPUT m, o, T14a
swapped = -1
END IF
i = i + 1
LOOP UNTIL i + gap > EC
LOOP UNTIL gap = 1 AND swapped = 0
CASE 18: '_UNSIGNED _INTEGER64
DIM T18a AS _UNSIGNED _INTEGER64, T18b AS _UNSIGNED _INTEGER64
gap = EC
DO
gap = 10 * gap \ 13
IF gap < 1 THEN gap = 1
i = 0
swapped = 0
DO
o = m.OFFSET + i * 8
o1 = m.OFFSET + (i + gap) * 8
IF _MEMGET(m, o, _UNSIGNED _INTEGER64) > _MEMGET(m, o1, _UNSIGNED _INTEGER64) THEN
_MEMGET m, o1, T18a
_MEMGET m, o, T18b
_MEMPUT m, o1, T18b
_MEMPUT m, o, T18a
swapped = -1
END IF
i = i + 1
LOOP UNTIL i + gap > EC
LOOP UNTIL gap = 1 AND swapped = 0
END SELECT
END SUB
$CHECKING:ON
SUB QSort (Start, Finish, Arr() AS _UNSIGNED _BYTE)
DIM i AS LONG, j AS LONG, x AS _UNSIGNED _BYTE
i = Start
j = Finish
x = Arr(INT((i + j) / 2))
WHILE i <= j
WHILE Arr(i) < x
i = i + 1
WEND
WHILE Arr(j) > x
j = j - 1
WEND
IF i <= j THEN
SWAP Arr(i), Arr(j)
i = i + 1
j = j - 1
END IF
WEND
IF j > Start THEN QSort Start, j, Arr()
IF i < Finish THEN QSort i, Finish, Arr()
END SUB