Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
Rosetta code didn't have a QB64 version of a Gnome Sort so I made one.
Code: (Select All)
'GnomeSort.bas
'a sorting algorithm that will sort a one dimensional array of any size from lowest to greatest value
'https://en.wikipedia.org/wiki/Gnome_sort
'initialize two different one dimensional arrays to demonstrate the subroutine
Randomize Timer
Dim A(1 To 6)
Dim B(-5 To 5)
For I = LBound(A) To UBound(A)
A(I) = (Rnd(1) * 100)
Next I
For I = LBound(B) To UBound(B)
B(I) = Int(Rnd(1) * 100) + 1
Next I
'display the arrays before and after the gnomesort
Print "unsorted array: ";: printarray A(): Print
gnomesort A()
Print " sorted array: ";: printarray A(): Print
Print "unsorted array: ";: printarray B(): Print
gnomesort B()
Print " sorted array: ";: printarray B(): Print
End
Sub printarray (array())
'print all the elements in a 1 dimensional array of any range
For I = LBound(array) To UBound(array)
Print array(I);
Next I
End Sub
Sub gnomesort (array())
'sort a one dimensional array of any size using gnomesort
'https://en.wikipedia.org/wiki/Gnome_sort
I = LBound(array) + 1 'find the lowest element in the array and add 1 for the sorting routine
J = I + 1
While I <= UBound(array)
If array(I - 1) <= array(I) Then
I = J
J = J + 1
Else If array(I - 1) > array(I) Then
Swap array(I - 1), array(I)
I = I - 1
If I = LBound(array) Then
I = J
J = J + 1
End If
End If
End If
Wend
End Sub
Posts: 3,978
Threads: 177
Joined: Apr 2022
Reputation:
220
04-27-2024, 01:09 AM
(This post was last modified: 04-27-2024, 01:13 AM by bplus.)
so sorry
Code: (Select All) Option _Explicit
_Title "Gnome Sort vrs Quick Sort" ' b+ 2024-04-26
Randomize Timer ' so we have a different array each time we compare
DefLng A-Z
Const nItems = 25000
Dim sa$(1 To nItems) ' setup a string array sa$() to sort
Dim copy$(1 To nItems) ' make a copy of sa$() to compare another sort to
Dim As Long i, j ' indexes to array for building and displaying the arrays
Dim As Long r ' a random posw integer = 2 to 6
Dim t##, qtime##, ctime##
Dim b$ ' building string
For i = 1 To nItems ' make a random list to sort
b$ = ""
r = (Rnd * 5) \ 1 + 2
For j = 0 To r
b$ = b$ + Mid$("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789.?", (Rnd * 64) \ 1 + 1, 1)
Next
sa$(i) = b$
copy$(i) = b$
Print b$,
Next
Print
Print "Press any to Quick Sort"
Sleep
Cls
t## = Timer(.001)
QuickSort 1, nItems, sa$()
qtime## = Timer(.001) - t##
For i = 1 To 10
Print sa$(i),
Next
Print: Print
For i = nItems - 9 To nItems
Print sa$(i),
Next
Print: Print
Print " Quick Sort time:"; qtime##
Print
Print " Press any to Gnome Sort with array copy, zzz..."
Print
Print
Sleep
t## = Timer(.001)
gnomesort copy$()
ctime## = Timer(.001) - t##
For i = 1 To 10
Print copy$(i),
Next
Print: Print
For i = nItems - 9 To nItems
Print copy$(i),
Next
Print: Print
Print " Gnome Sort time:"; ctime##
Print
If ctime## < qtime## Then Print " Gnome wins!" Else Print " Quick Sort wins again!"
Sub QuickSort (start As Long, finish As Long, arr$())
Dim Hi As Long, Lo As Long, Middle$
Hi = finish: Lo = start
Middle$ = arr$((Lo + Hi) / 2) 'find middle of arr$
Do
Do While arr$(Lo) < Middle$: Lo = Lo + 1: Loop
Do While arr$(Hi) > Middle$: Hi = Hi - 1: Loop
If Lo <= Hi Then
Swap arr$(Lo), arr$(Hi)
Lo = Lo + 1: Hi = Hi - 1
End If
Loop Until Lo > Hi
If Hi > start Then Call QuickSort(start, Hi, arr$())
If Lo < finish Then Call QuickSort(Lo, finish, arr$())
End Sub
' trans from johnno ref: https://rcbasic.freeforums.net/thread/779/sort-algorithms
Sub CombSort (arr$())
Dim As Long itemCount, start, fini, swaps, gap, i
start = LBound(arr$)
itemCount = UBound(arr$) - start + 1
fini = start + itemCount - 1
gap = itemCount
While gap > 1 Or swaps <> 0
gap = Int(gap / 1.25)
If gap < 1 Then gap = 1
swaps = 0
For i = start To itemCount - gap
If arr$(i) > arr$(i + gap) Then
Swap arr$(i), arr$(i + gap)
swaps = 1
End If
Next
Wend
End Sub
Sub gnomesort (array$())
'sort a one dimensional array of any size using gnomesort
'https://en.wikipedia.org/wiki/Gnome_sort
Dim As Long i, j
i = LBound(array$) + 1 'find the lowest element in the array and add 1 for the sorting routine
j = i + 1
While i <= UBound(array$)
If array$(i - 1) <= array$(i) Then
i = j
j = j + 1
Else If array$(i - 1) > array$(i) Then
Swap array$(i - 1), array$(i)
i = i - 1
If i = LBound(array$) Then
i = j
j = j + 1
End If
End If
End If
Wend
End Sub
sanmayce can blow quick sort out of the water but i don't know what the heck he is using?!
https://qb64phoenix.com/forum/showthread...ight=qsort
b = b + ...
Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
04-27-2024, 12:49 PM
(This post was last modified: 04-27-2024, 01:02 PM by James D Jarvis.)
What are you sorry for? I'm well aware of what Gnome Sort is, that's why there's a link to the Wikipedia entry it in the comments for other folks. The Rossetta code examples for GW Basic and QuickBasic weren't as versatile and didn't take advantage of QB64 features. Yes NOT Gnome Sort is going to have different performance from Gnome Sort. I'm sure I could skim a tiny bit of time off gnome sort as well (pulling ubound and lbound out of the loop shaves some off when sorting large arrays) but that wasn't the goal.
Posts: 3,978
Threads: 177
Joined: Apr 2022
Reputation:
220
sorry we spent so much time on such a slow sort. unless you want to collect the whole set ;-))
any advantage to this sort? it starts bogging down at such a low amount of elements in array.
me wants only the faster without resorting to C or dll, api even mem (unless a really huge difference in speed with mem) guess i am bit of qb64 purest.
b = b + ...
Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
Collecting the whole set, without a doubt. Advantage? It's simple and I do like not having to pass anything but the array itself into the sub.
Posts: 2,698
Threads: 327
Joined: Apr 2022
Reputation:
217
The whole set was already collected ages ago, over at the old QBASIC forums (Pete's tapatalk forums now). You can find them all there -- something like 100 different sort algorythms all coded up, timed, and explained for as to when one might choose to use one over another, if you're interested in that stuff.
Posts: 3,978
Threads: 177
Joined: Apr 2022
Reputation:
220
ok @James D Jarvis, do you have Load Sort in your collection?
i'd be surprised because i made this up myself back in 2020.
it is handy for sorting an array while you load it with items, it actually does better than gnome!
Code: (Select All) Option _Explicit
_Title "Gnome Sort vrs Load Sort" ' b+ 2024-04-28
Randomize Timer ' so we have a different array each time we compare
DefLng A-Z
Const nItems = 25000
Dim sa$(1 To nItems) ' setup a string array sa$() to sort
Dim copy$(1 To nItems) ' make a copy of sa$() to compare another sort to
Dim As Long i, j ' indexes to array for building and displaying the arrays
Dim As Long r ' a random posw integer = 2 to 6
Dim t##, qtime##, ctime##
Dim b$ ' building string
For i = 1 To nItems ' make a random list to sort
b$ = ""
r = (Rnd * 5) \ 1 + 2
For j = 0 To r
b$ = b$ + Mid$("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789.?", (Rnd * 64) \ 1 + 1, 1)
Next
sa$(i) = b$
copy$(i) = b$
Print b$,
Next
Print
Print "Press any to Load Sort"
Sleep
Cls
t## = Timer(.001)
ReDim loadMe$(0)
For i = 1 To UBound(sa$)
loadSort sa$(i), loadMe$()
Next
qtime## = Timer(.001) - t##
For i = 1 To 10
Print loadMe$(i),
Next
Print: Print
For i = nItems - 9 To nItems
Print loadMe$(i),
Next
Print: Print
Print " Load Sort time:"; qtime##
Print
Print " Press any to Gnome Sort with array copy, zzz..."
Print
Print
Sleep
t## = Timer(.001)
gnomesort copy$()
ctime## = Timer(.001) - t##
For i = 1 To 10
Print copy$(i),
Next
Print: Print
For i = nItems - 9 To nItems
Print copy$(i),
Next
Print: Print
Print " Gnome Sort time:"; ctime##
Print
If ctime## < qtime## Then Print " Gnome wins!" Else Print " Load Sort wins!"
Sub QuickSort (start As Long, finish As Long, arr$())
Dim Hi As Long, Lo As Long, Middle$
Hi = finish: Lo = start
Middle$ = arr$((Lo + Hi) / 2) 'find middle of arr$
Do
Do While arr$(Lo) < Middle$: Lo = Lo + 1: Loop
Do While arr$(Hi) > Middle$: Hi = Hi - 1: Loop
If Lo <= Hi Then
Swap arr$(Lo), arr$(Hi)
Lo = Lo + 1: Hi = Hi - 1
End If
Loop Until Lo > Hi
If Hi > start Then Call QuickSort(start, Hi, arr$())
If Lo < finish Then Call QuickSort(Lo, finish, arr$())
End Sub
' trans from johnno ref: https://rcbasic.freeforums.net/thread/779/sort-algorithms
Sub CombSort (arr$())
Dim As Long itemCount, start, fini, swaps, gap, i
start = LBound(arr$)
itemCount = UBound(arr$) - start + 1
fini = start + itemCount - 1
gap = itemCount
While gap > 1 Or swaps <> 0
gap = Int(gap / 1.25)
If gap < 1 Then gap = 1
swaps = 0
For i = start To itemCount - gap
If arr$(i) > arr$(i + gap) Then
Swap arr$(i), arr$(i + gap)
swaps = 1
End If
Next
Wend
End Sub
Sub gnomesort (array$())
'sort a one dimensional array of any size using gnomesort
'https://en.wikipedia.org/wiki/Gnome_sort
Dim As Long i, j
i = LBound(array$) + 1 'find the lowest element in the array and add 1 for the sorting routine
j = i + 1
While i <= UBound(array$)
If array$(i - 1) <= array$(i) Then
i = j
j = j + 1
Else If array$(i - 1) > array$(i) Then
Swap array$(i - 1), array$(i)
i = i - 1
If i = LBound(array$) Then
i = j
j = j + 1
End If
End If
End If
Wend
End Sub
'this requires a separate dynamic array (used redim instead of dim) to load and sort array
Sub loadSort (insertN As String, dynArr() As String) ' version 2020-06-07
'note this leaves dynArr(0) empty! so ubound of array is also number of items in list
Dim ub, j, k
ub = UBound(dynArr) + 1
ReDim _Preserve dynArr(LBound(dynArr) To ub) As String
For j = 1 To ub - 1
If insertN < dynArr(j) Then ' GT to LT according to descending or ascending sort
For k = ub To j + 1 Step -1
dynArr(k) = dynArr(k - 1)
Next
Exit For
End If
Next
dynArr(j) = insertN
End Sub
b = b + ...
Posts: 2,698
Threads: 327
Joined: Apr 2022
Reputation:
217
Isn't this LoadSort just a standard Insertion Sort? https://en.wikipedia.org/wiki/Insertion_sort
Posts: 3,978
Threads: 177
Joined: Apr 2022
Reputation:
220
looks similar, great minds think alike
btw mine has a little flaw i am going to fix
b = b + ...
|
