Same test code, but includes QuickSort. Its name is well deserved:
Code: Select all
#include once "crt.bi"
'========= set up c sort =========
#define up <,>
#define down >,<
#define ArrayToSort(x) @X(Lbound(X)),(Ubound(X)-Lbound(X)+1),Sizeof(X)
#macro SetSort(Datatype,FnName,b1,b2,dot)
Function FnName Cdecl(n1 As Any Ptr,n2 As Any Ptr) As long
If *Cptr(Datatype Ptr,n1)dot b1 *Cptr(Datatype Ptr,n2)dot Then Return -1
If *Cptr(DataType Ptr,n1)dot b2 *Cptr(DataType Ptr,n2)dot Then Return 1
return 0
End Function
#endmacro
'======================================================================
sub sort(array as integer ptr,tmp as integer ptr,lS as integer,rEnd as integer)
dim as integer lEnd = (rEnd+lS)\2, rS = lEnd+1, s = rEnd - lS + 1
dim as integer l = lS, r = rS, i = lS,sC=any
while l<=lEnd andalso r<=rEnd
if array[l] <= array[r] then
tmp[i] = array[l] : l+=1
else
tmp[i] = array[r] : r+=1
end if
i+=1
wend
sC=lEnd - l + 1
if sC then
' copy left part
memcpy @tmp[i],@array[l],sC*SizeOf(integer)
else ' copy right part
sC = rEnd - r + 1
memcpy @tmp[i],@array[r],sC*SizeOf(integer)
end if
memcpy @array[lS],@tmp[lS],s*SizeOf(integer)
end sub
sub merge(array as integer ptr,tmp as integer ptr,l as integer,r as integer)
dim as integer middle = (l+r)\2
if l>=r then return
merge array,tmp,l,middle ' left part
merge array,tmp,middle+1,r ' right part
sort array,tmp,l,r
end sub
sub mergeSort(array as integer ptr,nItems as integer)
dim as integer ptr tmp = new integer [nItems]
merge(array,tmp,0,nItems-1)
delete[] tmp
end sub
#define sortup >
#define sortdown <
#macro Shellsort(arr,start,finish,direction)
scope
dim as long max = finish-start+1,j
dim as boolean nswap
while max > 1
max \= 2
do
nswap = false
for i as long = start to finish - max
j = i + max
if arr(i) direction arr(j) then
swap arr(i), arr(j)
nswap = true
end if
next
loop while nswap
wend
end scope
#endmacro
sub MergeSort2(arr() as integer, first as long, last as long)
'from https://www.quora.com/How-do-I-do-merge-sort-on-QBasic
' Adapted by Munair
if first < last then
dim length as long = last - first + 1
dim middle as long = first + (last - first) \ 2
MergeSort2(arr(), first, middle)
MergeSort2(arr(), middle+1, last)
redim temp(0 to length - 1) as integer
for i as long = 0 to length - 1
temp(i) = arr(first + i)
next
dim mptr as long = 0
dim sptr as long = middle - first + 1
for i as long = 0 to length - 1
if sptr > last - first then
arr(i + first) = temp(mptr)
mptr += 1
elseif mptr > middle - first then
arr(i + first) = temp(sptr)
sptr += 1
elseif temp(mptr) > temp(sptr) then
arr(i + first) = temp(sptr)
sptr += 1
else
arr(i + first) = temp(mptr)
mptr += 1
end if
next
end if
end sub
Sub QuickSort(qs() As integer, l As Long, r As Long)
Dim As ULong size = r - l +1
If size < 2 Then Exit Sub
Dim As Long i = l, j = r
Dim As Long pivot = qs(l + size \ 2)
Do
While qs(i) < pivot
i += 1
Wend
While pivot < qs(j)
j -= 1
Wend
If i <= j Then
Swap qs(i), qs(j)
i += 1
j -= 1
End If
Loop Until i > j
If l < j Then quicksort(qs(), l, j)
If i < r Then quicksort(qs(), i, r)
End Sub
sub setup(arr2() as integer,n as long)
reDim arr2(1 to n)
Randomize 1
for i as long=1 to n
arr2 (i)= rnd*1000000
Next
end sub
sub printafew(a() as integer)
for i as Integer=1 to 10
print i, a (i)
Next
end sub
'=====================
dim as double t1,t2
redim as integer arr2()
dim as long n=1000000
setup(arr2(),n)
t1=timer
dim as integer ptr p=@arr2(1)
mergesort(p,1000000)
t2=timer
printafew(arr2())
print t2-t1;" seconds mergesort"
setup(arr2(),n)
t1=timer
shellsort(arr2, 1, ubound(arr2), sortup) ',1,UBound(arr2),sortup)
t2=timer
printafew(arr2())
print t2-t1;" seconds shellsort"
setup(arr2(),n)
t1=timer
MergeSort2(arr2(), 1, ubound(arr2))
t2=timer
printafew(arr2())
print t2-t1;" seconds mergesort2"
setup(arr2(),n)
t1=timer
QuickSort(arr2(), lbound(arr2), ubound(arr2))
t2=timer
printafew(arr2())
print t2-t1;" seconds quicksort"
SetSort(Integer,IntegerCallback,up,) 'set up the C qsort
setup(arr2(),n)
t1=timer
qsort(ArrayToSort(arr2),@IntegerCallback)
t2=timer
printafew(arr2())
print t2-t1;" seconds C runtime sort"
sleep