This member has written at least
129 posts and created at least
9 threads on this forum
since joining in Jun 2015.
12142017, 10:27 PM
This post was last modified: 12142017, 10:44 PM by Adrian Huang. Edited 0 times
Dear all,
QB64 Category page has been created in Rosetta Code, and also added a page for "Anagrams". http://rosettacode.org/wiki/Category:QB64
Please feel free to add more pages of code!
List of programming tasks:
http://rosettacode.org/wiki/Category:Sol...mming_Task
bplus et al, take it away!
I like to program in BASIC
With code that is simple and slick
I learnt it in school
And it is still cool
So it is my number one pick
This member has written at least
1,268 posts and created at least
154 threads on this forum
since joining in Apr 2017.
12152017, 03:41 AM
This post was last modified: 12152017, 04:16 AM by bplus. Edited 0 times
Kudos for getting the ball rolling on this Adrian.
I do have some mixed feelings though. Had I known you were going to use my code for Anagrams I would have given you my latest greatest version (now posted in Anagrams http://www.thejoyfulprogrammer.com/qb64/...2537314363) not using Steve's super fast Memory techniques. I was of the opinion that Steve's code for Anagrams was the clear winner of the challenge. I wonder if he would have wanted to make some changes had he known his code would be submitted or did you check with him first? I think he just started playing along because he got interested in the problem and was curious what he could do with it, ha! the way it should be.
My hope for the future is community involvement specially those learning QB64 and community consensus as to which code best represents what QB64 has to offer.
B += x
This member has written at least
129 posts and created at least
9 threads on this forum
since joining in Jun 2015.
12152017, 04:24 AM
This post was last modified: 12152017, 04:35 AM by Adrian Huang. Edited 0 times
hi bplus,
sorry if i had "jumped the gun"! i have posted your latest greatest version on Rosetta Code, replacing the previous version.
Output from Steve's program added.
Cheers,
A.
I like to program in BASIC
With code that is simple and slick
I learnt it in school
And it is still cool
So it is my number one pick
This member has written at least
1,268 posts and created at least
154 threads on this forum
since joining in Apr 2017.
Thanks Adrian, That code gives Steve well deserved credit!
I am impressed on how fast you moved! I would have fiddled around and probably never gotten around to doing anything.
B += x
This member has written at least
129 posts and created at least
9 threads on this forum
since joining in Jun 2015.
My pleasure, bplus.
look forward to seeing more tasks being done in QB64!
I like to program in BASIC
With code that is simple and slick
I learnt it in school
And it is still cool
So it is my number one pick
This member has written at least
59 posts and created at least
25 threads on this forum
since joining in Jun 2014.
Quote:I think he just started playing along because he got interested in the problem and was curious what he could do with it, ha! the way it should be.
Aye. I was mainly just curious to see for myself how quickly I could find the anagrams without resorting on any SORT routine. Getting it down to about a second without sorting wasn't a bad run at all, I didn't think! But, once I'd gotten it as quick as I could without sorting, I wanted to compare and see how quickly I could get it to go WITH sorting...
The end result isn't the cleanest code which I could come up with, but it *is* the fastest. From my last test, most of the speed delay is actually in disk access speeds, moreso than in the sorting/match work needed for the program. 7000+ executions per second is nice, but that's on my 5200 RPM drive. If I run the program (unoptimized without Ofast, and in QB6432bit) in a ramdrive, it jumps up to almost 10k loops per second. Running it on a flash drive would probably be around 85009000 times per second.
It may not be the prettiest, but it is the fastest version I could come up with. Honestly, I don't think there's a single thing I know to do to make it any speedier than it is. I really wasn't trying to compete with anyone on the challenge (Heck, I didn't even know it was a challenge!); I was just trying to help a bit from where Bplus posted, "I am sure this code can be sped up:".
This member has written at least
59 posts and created at least
25 threads on this forum
since joining in Jun 2014.
Quote:look forward to seeing more tasks being done in QB64!
Here's the 2048 game for you: http://www.qb64.net/forum/index.php?topi...#msg105154
Honestly, I'd have to go look at the list of challenges again to know which links to share for you, but I think many of them have already been solved by the community over at QB64.net. Just do a search and you'll find almost all those topics covered at one time or another by the community there.
This member has written at least
129 posts and created at least
9 threads on this forum
since joining in Jun 2015.
12152017, 03:08 PM
This post was last modified: 12152017, 03:55 PM by Adrian Huang. Edited 0 times
Thanks Steve! Added!
http://rosettacode.org/wiki/2048#QB64
I have also added a link to TJP from QB64’s page.
I like to program in BASIC
With code that is simple and slick
I learnt it in school
And it is still cool
So it is my number one pick
This member has written at least
52 posts and created at least
3 threads on this forum
since joining in Jun 2014.
03152018, 02:24 PM
This post was last modified: 03152018, 02:59 PM by codeguy. Edited 0 times
Code: '* BucketSort Algorithm with single recursive step by CodeGuy, using QB64
'* approximately 3/4 GHzS to perform both verified sorts.
CONST TestN& = 131071
REDIM TestArray(0 TO TestN&) AS DOUBLE
TYPE MinMaxRec
min AS LONG
max AS LONG
END TYPE
acc! = 0
FOR sortdir& = 1 TO 1 STEP 2
FOR SetTestArray& = LBOUND(TestArray) TO UBOUND(TestArray)
TestArray(SetTestArray&) = (RND * 1023) AND 1023
NEXT
u! = TIMER(.001)
BucketSort TestArray(), LBOUND(TestArray), UBOUND(TestArray), sortdir&, 1
v! = TIMER(.001)
acc! = acc!  u! + v!
IF ArraySequenceCheck&(TestArray(), LBOUND(TestArray), UBOUND(TestArray), sortdir&) THEN
PRINT "sort:"; v!  u!; acc!
END IF
NEXT
SUB BucketSort (Array() AS DOUBLE, start AS LONG, finish AS LONG, order&, recurse%)
DIM BS_Local_NBuckets AS INTEGER
DIM BS_Local_ArrayRange AS DOUBLE
DIM BS_Local_N AS LONG
DIM BS_Local_S AS LONG
DIM BS_Local_Z AS LONG
DIM BS_Local_Remainder AS INTEGER
DIM BS_Local_Index AS INTEGER
DIM BS_Local_Last_Insert_Index AS LONG
DIM BS_Local_Current_Insert_Index AS LONG
DIM BS_Local_BucketIndex AS INTEGER
REDIM BSMMrec AS MinMaxRec
GetMinMaxArray Array(), start, finish, BSMMrec
BS_Local_ArrayRange = Array(BSMMrec.max)  Array(BSMMrec.min)
IF BS_Local_ArrayRange > 0 THEN
BS_Local_NBuckets = 2 * INT(LOG(finish  start + 1) / LOG(2)) + 1
BS_Local_N = (finish  start)
BS_Local_Remainder = BS_Local_N MOD BS_Local_NBuckets
BS_Local_NBuckets = BS_Local_NBuckets  1
REDIM BS_Buckets_Array(BS_Local_NBuckets, 0 TO (BS_Local_NBuckets * (1 + (BS_Local_N  BS_Local_Remainder) / BS_Local_NBuckets))) AS DOUBLE
REDIM BS_Count_Array(0 TO BS_Local_NBuckets) AS LONG
FOR BS_Local_S = start TO finish
BS_Local_BucketIndex = BS_Local_NBuckets * ((Array(BS_Local_S)  Array(BSMMrec.min)) / BS_Local_ArrayRange)
BS_Buckets_Array(BS_Local_BucketIndex, BS_Count_Array(BS_Local_BucketIndex)) = Array(BS_Local_S)
BS_Count_Array(BS_Local_BucketIndex) = BS_Count_Array(BS_Local_BucketIndex) + 1
NEXT
BS_Local_Last_Insert_Index = start
BS_Local_Current_Insert_Index = start
IF order& = 1 THEN
FOR BS_Local_S = 0 TO BS_Local_NBuckets
IF BS_Count_Array(BS_Local_S) > 0 THEN
BS_Local_Last_Insert_Index = BS_Local_Current_Insert_Index
FOR BS_Local_Z = 0 TO BS_Count_Array(BS_Local_S)  1
Array(BS_Local_Current_Insert_Index) = BS_Buckets_Array(BS_Local_S, BS_Local_Z)
BS_Local_Current_Insert_Index = BS_Local_Current_Insert_Index + 1
NEXT
IF recurse% THEN
BucketSort Array(), BS_Local_Last_Insert_Index, BS_Local_Current_Insert_Index  1, order&, 0
ELSE
InsertionSort Array(), BS_Local_Last_Insert_Index, BS_Local_Current_Insert_Index  1, order&
END IF
END IF
NEXT
ERASE BS_Buckets_Array, BS_Count_Array
EXIT SUB
ELSE
FOR BS_Local_S = BS_Local_NBuckets TO 0 STEP 1
IF BS_Count_Array(BS_Local_S) > 0 THEN
BS_Local_Last_Insert_Index = BS_Local_Current_Insert_Index
FOR BS_Local_Z = 0 TO BS_Count_Array(BS_Local_S)  1
Array(BS_Local_Current_Insert_Index) = BS_Buckets_Array(BS_Local_S, BS_Local_Z)
BS_Local_Current_Insert_Index = BS_Local_Current_Insert_Index + 1
NEXT
IF recurse% THEN
BucketSort Array(), BS_Local_Last_Insert_Index, BS_Local_Current_Insert_Index  1, order&, 0
ELSE
InsertionSort Array(), BS_Local_Last_Insert_Index, BS_Local_Current_Insert_Index  1, order&
END IF
END IF
NEXT
END IF
ERASE BS_Buckets_Array, BS_Count_Array
END IF
END SUB
FUNCTION ArraySequenceCheck& (array() AS DOUBLE, start&, finish&, order&)
oseq& = order&
h& = start&
i& = start&
DO
IF array(i&) < array(h&) THEN
IF oseq& = 1 THEN
'* this is a sequence error
oseq& = 0
EXIT DO
ELSE
oseq& = 1
h& = i&
END IF
ELSEIF array(i&) > array(h&) THEN
IF oseq& = 1 THEN
'* this is also a sequence error
oseq& = 0
EXIT DO
ELSE
oseq& = 1
h& = i&
END IF
END IF
i& = i& + 1
LOOP UNTIL i& > finish&
ArraySequenceCheck& = (oseq& = order&)
END SUB
Freely submit or steal this code.
This member has written at least
52 posts and created at least
3 threads on this forum
since joining in Jun 2014.
03152018, 02:30 PM
This post was last modified: 03152018, 02:33 PM by codeguy. Edited 0 times
On a side note, it's the single recursive step that makes ALL the difference in the world. From a shade over 10s for a SINGLE sort to around 350ms for BOTH. Cool, huh? That first sub is refactored to avoid variable name collisions when used as part of included code. I haven't yet dealt with the sequence check code.
This member has written at least
52 posts and created at least
3 threads on this forum
since joining in Jun 2014.
03242018, 11:30 PM
This post was last modified: 03252018, 04:52 AM by codeguy. Edited 0 times
Implements CountingSort(), even on noninteger numeric data.
Code: _TITLE "CGScaleArrayToInteger"
TYPE MinMaxRec
min AS LONG
max AS LONG
END TYPE
DIM T_minmax AS MinMaxRec
DIM SHARED DisplayRows AS INTEGER
DisplayRows = 40
WIDTH 140, DisplayRows
testn& = 16777215
REDIM T(0 TO testn&) AS DOUBLE
FOR s& = 0 TO UBOUND(T)
T(s&) = RND '((RND * 255) AND 255) / 256
NEXT
t! = TIMER(.001)
CGScaleArrayToInteger T(), LBOUND(t), UBOUND(t), order&, T_minmax, TScale#
CGFrequencyCounts T(), LBOUND(t), UBOUND(t), order&, T_minmax, TScale#
u! = TIMER(.001)
PRINT u!  t!;
'* very handy for scaling arrays to integer values so they can be ranked, accumulated in histograms
'* or anything else where ranks within an array are important. Beats sorting by a LOT, although it
'* is not 100% precise. Through a bit of clever engineering, this CAN be made that way.
SUB CGScaleArrayToInteger (CGSortLibArr() AS DOUBLE, start&, finish&, order&, CGSortLibArr_mmrec AS MinMaxRec, CGSortLibArr_ScaleMultiplier AS DOUBLE)
DIM CGScaleArray_Range AS DOUBLE
DIM CGScaleArray_ScaleTemp AS DOUBLE
DIM CGScaleArray_PowerOf2 AS LONG
DIM CGScaleArray_rank AS LONG
DIM CGScaleArray_Index AS LONG
GetMinMaxArray CGSortLibArr(), start&, finish&, CGSortLibArr_mmrec
CGScaleArray_Range = CGSortLibArr(CGSortLibArr_mmrec.max)  CGSortLibArr(CGSortLibArr_mmrec.min)
IF CGScaleArray_Range <> 0 THEN
CGScaleArray_ScaleTemp = CGScaleArray_Range
ELSE
CGScaleArray_ScaleTemp = CGSortLibArr(CGSortLibArr_mmrec.min)
CGScaleArray_Range = 1
END IF
CGScaleArray_PowerOf2 = 0
DO UNTIL CGScaleArray_ScaleTemp = INT(CGScaleArray_ScaleTemp)
CGScaleArray_ScaleTemp = CGScaleArray_ScaleTemp * 2
CGScaleArray_PowerOf2 = CGScaleArray_PowerOf2 + 1
LOOP
CGSortLibArr_ScaleMultiplier = 2 ^ CGScaleArray_PowerOf2
END SUB
SUB CGFrequencyCounts (CGSortLibArr() AS DOUBLE, Start&, Finish&, order&, CGSortLibArr_mmrec AS MinMaxRec, CGSortLibArr_ScaleMultiplier AS DOUBLE)
'* a short example of using this multiplier to convert the range respresented by
'* CGSortLibArr(start&) > CGSortLibArr(finish&)
'* to a scaled integer: the lowest valued element will appear as 0.
REDIM CGFrequencyCounts_Array(0 TO Finish&  Start&) AS LONG
DIM CGFrequencyCounts_IteratorU AS LONG
DIM CGFrequencyCounts_Index AS LONG
DIM CGFrequencyCounts_rank AS LONG
DIM CGFrequencyCounts_x AS DOUBLE
DIM CGFrequencyCounts_dx AS DOUBLE
CGFrequencyCounts_dx = CGSortLibArr(CGSortLibArr_mmrec.max)  CGSortLibArr(CGSortLibArr_mmrec.min)
FOR CGFrequencyCounts_IteratorU = Start& TO Finish&
CGFrequencyCounts_x = CGSortLibArr(CGFrequencyCounts_IteratorU)  CGSortLibArr(CGSortLibArr_mmrec.min)
CGFrequencyCounts_Index = INT(CGFrequencyCounts_x * (Finish&  Start&) / CGFrequencyCounts_dx)
IF order& = 1 THEN
CGFrequencyCounts_rank = Start& + CGFrequencyCounts_Index
ELSE
CGFrequencyCounts_rank = Finish&  CGFrequencyCounts_Index
END IF
CGFrequencyCounts_Array(CGFrequencyCounts_rank) = CGFrequencyCounts_Array(CGFrequencyCounts_rank) + 1
'IF CGFrequencyCounts_IteratorU MOD 37 = 0 THEN
' LOCATE (CGFrequencyCounts_IteratorU MOD DisplayRows) + 1, 1
' PRINT USING "i=#,###,###,###,###"; CGFrequencyCounts_Index;
' PRINT USING "r=#,###,###,###,###"; CGFrequencyCounts_rank;
' PRINT USING "s=#################"; CGFrequencyCounts_x * CGSortLibArr_ScaleMultiplier;
' PRINT USING "t(###,###,###,###)="; CGFrequencyCounts_IteratorU;
' PRINT USING "###################"; CGSortLibArr(CGFrequencyCounts_IteratorU) * CGSortLibArr_ScaleMultiplier;
' PRINT USING "c=#,###,####,###,###"; CGFrequencyCounts_Array(CGFrequencyCounts_rank);
'END IF
NEXT
FOR stx& = LBOUND(CGFrequencyCounts_Array) TO UBOUND(CGFrequencyCounts_Array)
IF CGFrequencyCounts_Array(stx&) > 0 THEN
b# = CGSortLibArr(CGSortLibArr_mmrec.min) + (CGSortLibArr(CGSortLibArr_mmrec.max)  CGSortLibArr(CGSortLibArr_mmrec.min)) * (stx& / UBOUND(CGFrequencyCounts_Array))
'PRINT "{"; b#; ","; CGFrequencyCounts_Array(stx&); "}";
END IF
NEXT
ERASE CGFrequencyCounts_Array
END SUB
SUB GetMinMaxArray (CGSortLibArr() AS DOUBLE, Start&, Finish&, GetMinMaxArray_minmax AS MinMaxRec)
DIM GetGetMinMaxArray_minmaxArray_i AS LONG
DIM GetMinMaxArray_n AS LONG
DIM GetMinMaxArray_TT AS LONG
DIM GetMinMaxArray_NMod2 AS INTEGER
'* this is a workaround for the irritating malfunction
'* of MOD using larger numbers and small divisors
GetMinMaxArray_n = Finish&  Start&
GetMinMaxArray_TT = GetMinMaxArray_n MOD 10000
GetMinMaxArray_NMod2 = GetMinMaxArray_n  10000 * ((GetMinMaxArray_n  GetMinMaxArray_TT) / 10000)
IF (GetMinMaxArray_NMod2 MOD 2) THEN
GetMinMaxArray_minmax.min = Start&
GetMinMaxArray_minmax.max = Start&
GetGetMinMaxArray_minmaxArray_i = Start& + 1
ELSE
IF CGSortLibArr(Start&) > CGSortLibArr(Finish&) THEN
GetMinMaxArray_minmax.max = Start&
GetMinMaxArray_minmax.min = Finish&
ELSE
GetMinMaxArray_minmax.min = Finish&
GetMinMaxArray_minmax.max = Start&
END IF
GetGetMinMaxArray_minmaxArray_i = Start& + 2
END IF
WHILE GetGetMinMaxArray_minmaxArray_i < Finish&
IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i) > CGSortLibArr(GetGetMinMaxArray_minmaxArray_i + 1) THEN
IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i) > CGSortLibArr(GetMinMaxArray_minmax.max) THEN
GetMinMaxArray_minmax.max = GetGetMinMaxArray_minmaxArray_i
END IF
IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i + 1) < CGSortLibArr(GetMinMaxArray_minmax.min) THEN
GetMinMaxArray_minmax.min = GetGetMinMaxArray_minmaxArray_i + 1
END IF
ELSE
IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i + 1) > CGSortLibArr(GetMinMaxArray_minmax.max) THEN
GetMinMaxArray_minmax.max = GetGetMinMaxArray_minmaxArray_i + 1
END IF
IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i) < CGSortLibArr(GetMinMaxArray_minmax.min) THEN
GetMinMaxArray_minmax.min = GetGetMinMaxArray_minmaxArray_i
END IF
END IF
GetGetMinMaxArray_minmaxArray_i = GetGetMinMaxArray_minmaxArray_i + 2
WEND
END SUB
This member has written at least
52 posts and created at least
3 threads on this forum
since joining in Jun 2014.
03252018, 05:37 PM
This post was last modified: 03252018, 05:52 PM by codeguy. Edited 0 times
Not yet submitted as BucketSort() code has been. As long as you leave the credits, (Coded 25 Mar 2018 By CodeGuy) you can use or post elsewhere.
Code: _TITLE "BFPRT Median of array by CodeGuy"
'* Demo of 48828125 doubleprecision elements takes a shade over 10s on 2.16GHz machine
'* Blum, M.; Floyd, R. W.; Pratt, V. R.; Rivest, R. L.; Tarjan, R. E. (August 1973). "Time bounds for selection" (PDF).
'* Journal of Computer and System Sciences. 7 (4): 448–461. doi:10.1016/S00220000(73)800339.
'* Coded 25 Mar 2018 By CodeGuy
REDIM anarray(0 TO 48828124) AS DOUBLE
FOR c& = 0 TO UBOUND(anarray)
anarray(c&) = RND
NEXT
t! = TIMER(.001)
BFPRT anarray(), LBOUND(anarray), UBOUND(anarray), anarrayMedian#
u! = TIMER(.001)
PRINT anarrayMedian#; u!  t!
SUB BFPRT (CGSortLibArr() AS DOUBLE, start AS LONG, finish AS LONG, BFPRTMedian AS DOUBLE)
bfprtn& = 5
IF finish  start < bfprtn&  1 THEN
SELECT CASE (finish  start) MOD bfprtn&
CASE 0, 2, 4
BFPRTMedian = CGSortLibArr(start + (finish  start) \ 2)
CASE 1
BFPRTMedian = (CGSortLibArr(start) + CGSortLibArr(finish)) / 2
CASE 3
BFPRTMedian = (CGSortLibArr(start + 1) + CGSortLibArr(finish  1)) / 2
END SELECT
ELSE
REDIM BfprtArray(0 TO (finish  start) / bfprtn& + bfprtn&) AS DOUBLE
s& = LBOUND(CGSortLibArr)
BfprtCount& = 0
DO
IF s&  1 > finish  bfprtn& THEN
InsertionSort CGSortLibArr(), s&, finish, 1
DO UNTIL s& > finish
BfprtArray(BfprtCount&) = CGSortLibArr(s&)
s& = s& + 1
LOOP
EXIT DO
ELSE
InsertionSort CGSortLibArr(), s&, s& + bfprtn&  1, 1
BfprtArray(BfprtCount&) = CGSortLibArr(s& + (bfprtn&  1) \ 2)
'* PRINT BfprtArray(BfprtCount&); BfprtCount&
BfprtCount& = BfprtCount& + 1
s& = s& + bfprtn&
END IF
LOOP
BFPRT BfprtArray(), 0, BfprtCount&  1, BFPRTMedian
END IF
END SUB
SUB InsertionSort (CGSortLibArr() AS DOUBLE, start AS LONG, finish AS LONG, order&)
DIM InSort_Local_ArrayTemp AS DOUBLE
DIM InSort_Local_i AS LONG
DIM InSort_Local_j AS LONG
SELECT CASE order&
CASE 1
FOR InSort_Local_i = start + 1 TO finish
InSort_Local_ArrayTemp = CGSortLibArr(InSort_Local_i)
InSort_Local_j = InSort_Local_i  1
DO UNTIL InSort_Local_j < start
IF (InSort_Local_ArrayTemp < CGSortLibArr(InSort_Local_j)) THEN
CGSortLibArr(InSort_Local_j + 1) = CGSortLibArr(InSort_Local_j)
InSort_Local_j = InSort_Local_j  1
ELSE
EXIT DO
END IF
LOOP
CGSortLibArr(InSort_Local_j + 1) = InSort_Local_ArrayTemp
NEXT
CASE ELSE
FOR InSort_Local_i = start + 1 TO finish
InSort_Local_ArrayTemp = CGSortLibArr(InSort_Local_i)
InSort_Local_j = InSort_Local_i  1
DO UNTIL InSort_Local_j < start
IF (InSort_Local_ArrayTemp > CGSortLibArr(InSort_Local_j)) THEN
CGSortLibArr(InSort_Local_j + 1) = CGSortLibArr(InSort_Local_j)
InSort_Local_j = InSort_Local_j  1
ELSE
EXIT DO
END IF
LOOP
CGSortLibArr(InSort_Local_j + 1) = InSort_Local_ArrayTemp
NEXT
END SELECT
END SUB
This member has written at least
52 posts and created at least
3 threads on this forum
since joining in Jun 2014.
03262018, 06:05 AM
This post was last modified: 03262018, 06:08 AM by codeguy. Edited 0 times
BFPRT is not deterministic except when array sizes are exact powers of 5. Using QuickSelect or another is Ok too,
http://www.qb64.net/forum/index.php?topi...#msg128402 the library containing this code, among others.
This member has written at least
239 posts and created at least
60 threads on this forum
since joining in Nov 2017.
In your BFPRT could you modify the call to InsertionSort to be replaced with a ShellSort??
Erik.
This member has written at least
52 posts and created at least
3 threads on this forum
since joining in Jun 2014.
Using InsertionSort produces better timings than any other sorting method for BFPRTN& = 5. Yes, you can use other ODD numbers for BFPRTN&, but then it won't be BFPRT. There has already been discussion on StackOverflow and other sites as to WHY 5 is the optimal number. And I'm sure the original authors of this algorithm tested other methods too. BTW, I had to modify a modification to use BubbleSortModified(), which produced a shabby timing of around 16, but for other applications, it's actually quite fast, especially compared to BubbleSort().
This member has written at least
52 posts and created at least
3 threads on this forum
since joining in Jun 2014.
03292018, 11:22 AM
This post was last modified: 03292018, 12:27 PM by codeguy. Edited 0 times
ICYW:
'InsertionSort CGSortLibArr(), s&, finish, 1 9.4s
'ShellSort CGSortLibArr(), s&, finish, 1  14.4s
'BubbleSort CGSortLibArr(), s&, finish, 1 '13.7s
BubbleSortModified CGSortLibArr(), s&, finish, 1 '16.7s
with either/any version of QuickSort, the time is around 30s. DEFINITELY not good.
This member has written at least
52 posts and created at least
3 threads on this forum
since joining in Jun 2014.
03292018, 11:37 AM
This post was last modified: 03292018, 11:42 AM by codeguy. Edited 0 times
If you want faster timings on nonsorted, nonmonotonic arrays AND deterministic, I already have a function coded to do this automatically. BFPRT is deterministic ONLY for (finishstart) = 5^k1. Otherwise, it's a good guess that doesn't require potentially VERY slow sorting speeds. deterministic = answer is the ACTUAL answer, not a guess.
This member has written at least
52 posts and created at least
3 threads on this forum
since joining in Jun 2014.
Use QuickSort on an alreadysorted or monotonic array and it becomes VERY slow.
This member has written at least
52 posts and created at least
3 threads on this forum
since joining in Jun 2014.
Did you know BST (Binary Search Trees) can be implemented in QB64? EASILY? That you DON'T need to know c/c++ to manipulate and use this wonderfully adept data structure? With CodeGuySortLib ®©™(etc), it is good as done, including correct traversal and even sortation for ascending/descending without the need to invert arrays? Anyone who claims you NEED c/c++ to implement this data structure quickly is a 100% liar. I'm NOT reposting code that isn't already available at qb64(org,net). The listing is FAR too long for the line limits of TJP, even stripped of comments.
This member has written at least
52 posts and created at least
3 threads on this forum
since joining in Jun 2014.
03292018, 05:44 PM
This post was last modified: 03292018, 07:16 PM by codeguy. Edited 0 times
Walking the branches and inserting stuff into an array in the desired order. Pretty much standard stuff.
Code: '* anyone claiming you need c/c++ to implement trees is telling you CRAP
'* This is a bit more complex than the standard noncopying version, but it is still
'* respectably fast. General complexity for TreeSort() is O(NLogN), EXCEPT when
'* presented with elements already sorted. One way to avoid this is to KnuthShuffle
'* the input first. Skipped in this implementation, but there is no reason you
'* can't do it prior to TreeSort(). Code modified/added from my repository. This
'* version allows multiple samevalue nodes
'* Modified/added 26 March 2018.
SUB TreeSortUsingBST (CGSortLibArr() AS DOUBLE, start&, finish&, order&)
DIM TSAmmrec AS MinMaxRec
GetMinMaxArray CGSortLibArr(), start&, finish&, TSAmmrec
delta# = CGSortLibArr(TSAmmrec.max)  CGSortLibArr(TSAmmrec.min)
IF delta# = 0 THEN 'already sorted because they're all equal
EXIT SUB
END IF
'*************************************
'* CGSortLibArr() COULD be KnuthShuffle CGSortLibArr(), start&, finish&
'* here. TreeSortUsingBST() performance on monotonic arrays seems to be fine anyway.
'*************************************
'* simple TreeNode struct, EXACTLY same as c/c++
TYPE TreeNode
value AS DOUBLE
left AS LONG
right AS LONG
END TYPE
DIM NextFreeNode AS LONG
DIM CurrentNodePtr AS LONG
DIM TreeScanX AS LONG
DIM NilValuePtr AS LONG
NilValuePtr = LBOUND(CGSortLibArr)  1
DIM TSUBST_tree(start& + 1 TO finish& + 1) AS TreeNode
FOR TreeScanX = start& + 1 TO finish& + 1
TSUBST_tree(TreeScanX).value = 0
TSUBST_tree(TreeScanX).left = NilValuePtr
TSUBST_tree(TreeScanX).right = NilValuePtr
NEXT
TSUBST_tree(LBOUND(TSUBST_tree)).value = CGSortLibArr(start&)
NextFreeNode = LBOUND(TSUBST_tree) + 1
IF order& = 1 THEN
FOR TreeScanX = LBOUND(TSUBST_tree) + 1 TO UBOUND(TSUBST_tree)
'* this is the primary root node  without starting HERE, nothing happens correctly
CurrentNodePtr = LBOUND(TSUBST_tree)
DO
IF CGSortLibArr(TreeScanX  1) < TSUBST_tree(CurrentNodePtr).value THEN
IF TSUBST_tree(CurrentNodePtr).left = NilValuePtr THEN
TSUBST_tree(CurrentNodePtr).left = NextFreeNode
TSUBST_tree(NextFreeNode).value = CGSortLibArr(TreeScanX  1)
NextFreeNode = NextFreeNode + 1
EXIT DO
ELSE
CurrentNodePtr = TSUBST_tree(CurrentNodePtr).left
END IF
ELSE
IF TSUBST_tree(CurrentNodePtr).right = NilValuePtr THEN
TSUBST_tree(CurrentNodePtr).right = NextFreeNode
TSUBST_tree(NextFreeNode).value = CGSortLibArr(TreeScanX  1)
NextFreeNode = NextFreeNode + 1
EXIT DO
ELSE
CurrentNodePtr = TSUBST_tree(CurrentNodePtr).right
END IF
END IF
LOOP
NEXT TreeScanX
ELSE
FOR TreeScanX = LBOUND(tree) + 1 TO UBOUND(tree)
'* this is the primary root node  without starting HERE, nothing happens correctly
CurrentNodePtr = LBOUND(tree)
DO
'* you notice this cool comparison sign change? THIS is important
'*************************** <\/> *****************************
IF CGSortLibArr(TreeScanX  1) > TSUBST_tree(CurrentNodePtr).value THEN
IF TSUBST_tree(CurrentNodePtr).left = NilValuePtr THEN
TSUBST_tree(CurrentNodePtr).left = NextFreeNode
TSUBST_tree(NextFreeNode).value = CGSortLibArr(TreeScanX  1)
NextFreeNode = NextFreeNode + 1
EXIT DO
ELSE
CurrentNodePtr = TSUBST_tree(CurrentNodePtr).left
END IF
ELSE
IF TSUBST_tree(CurrentNodePtr).right = NilValuePtr THEN
TSUBST_tree(CurrentNodePtr).right = NextFreeNode
TSUBST_tree(NextFreeNode).value = CGSortLibArr(TreeScanX  1)
NextFreeNode = NextFreeNode + 1
EXIT DO
ELSE
CurrentNodePtr = TSUBST_tree(CurrentNodePtr).right
END IF
END IF
LOOP
NEXT TreeScanX
END IF
depth& = start& + 1
TraverseBST CGSortLibArr(), start& + 1, depth&, TSUBST_tree(), NilValuePtr
ERASE TSUBST_tree
END SUB
SUB TraverseBST (CGSortLibArr() AS DOUBLE, NextPtr&, depth&, TBST_tree() AS TreeNode, NilValuePtr AS LONG)
IF TBST_tree(NextPtr&).left <> NilValuePtr THEN
TraverseBST CGSortLibArr(), TBST_tree(NextPtr&).left, depth&, TBST_tree(), NilValuePtr
END IF
CGSortLibArr(depth&  1) = TBST_tree(NextPtr&).value
depth& = depth& + 1
IF TBST_tree(NextPtr&).right <> NilValuePtr THEN TraverseBST CGSortLibArr(), TBST_tree(NextPtr&).right, depth&, TBST_tree(), NilValuePtr
END SUB
you're welcome.
