The Mergesort algorithm.

[Munair]

So why is the C runtime sort so slow? Normally, I would expect a quicksort there. My radix sort is still a tick faster, though:

See my citation above from Wikipedia regarding the C implementation. There may also be some overhead involved. A direct FB implementation without lib calls seems like the best choice.

[jj2007]

So why is the C runtime sort so slow? Normally, I would expect a quicksort there. My radix sort is still a tick faster, though:

See my citation above from Wikipedia regarding the C implementation. There may also be some overhead involved. A direct FB implementation without lib calls seems like the best choice.

Your post:

Shellsort performs more operations and has higher cache miss ratio than quicksort. However, since it can be implemented using little code and does not use the call stack, some implementations of the qsort function in the C standard library

Yes, but your timings for the C runtime sort are a factor 10 faster than those for the shellsort. Which means that either your FB implementation of shellsort is very inefficient, or the C runtime sort is not a shellsort.

Just for fun, what about other sizes? This is ArraySort, under the hood it's still radix sort:

Code: Select all

4999999 499933
5000000 499933
5000001 499934
1.09 secs for sorting 10 Million integer elements

4999999 499933
5000000 499933
5000001 499934
1.43 secs for sorting 10 Million QWORD elements

4999999 -6.624474e-05
5000000 -6.613415e-05
5000001 -6.591296e-05
1.45 secs for sorting 10 Million float elements

4999999 -6.62447419009783e-05
5000000 -6.61341473452427e-05
5000001 -6.59129582337715e-05
1.61 secs for sorting 10 Million double elements

Btw the forum is extremely slow today, is it only my line, or do others experience the same slow responses?

[Munair]

Btw the forum is extremely slow today, is it only my line, or do others experience the same slow responses?

Connection is a bit slow here too, but not all the time.

[dodicat]

Added my chuckle sort for fun.

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
'======================================================================
type chuck
    as long n(any)
    as long repeat(any)
end type

sub chucklesort(f() as integer)
    dim as long count=lbound(f)
    dim as long max= -2147483647,min=2147483647
    for n as long=lbound(f) to ubound(f)
        if max<f(n) then max=f(n)
        if min>f(n) then min=f(n)
    next
    dim as chuck d
    redim d.n(min to max),d.repeat(min to max)
   for n as long=lbound(f) to ubound(f)
        d.n(f(n))=f(n):d.repeat(f(n))+=1
    next 
    for n as long=lbound(d.n) to ubound(d.n)
   for z as long=1 to d.repeat(n)
     f(count)=d.n(n):count+=1
     next z
    next 
end sub

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 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"
print
setup(arr2(),n)
t1=timer
shellsort(arr2,1,UBound(arr2),sortup)
t2=timer
printafew(arr2())
print t2-t1;"   seconds shellsort"
print

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"
print
setup(arr2(),n)
t1=timer
chucklesort(arr2())
t2=timer
printafew(arr2())
print t2-t1;"   seconds Chuckle sort"
sleep




   

[Carlos Herrera]

Which means that either your FB implementation of shellsort is very inefficient, or the C runtime sort is not a shellsort.

Indeed. Here is an efficient implementation of ShellSort

Code: Select all

procedure SortShell(var A: TVector);

var
  ua, N: LongInt;
  j, k, h: LongInt;
  ta: double;
begin
  ua := High(A);
  N := ua;
  h := 1;
  repeat
    h := 3 * h + 1
  until h > N;
  repeat
    h := (h - 1) div 3;
    for j := h to N do
    begin
      ta := A[j];
      k := j;
      while (k >= h) and (A[k - h] > ta) do
      begin
        A[k] := A[k - h];
        k := k - h;
      end;
      A[k] := ta;
    end;
  until h = 0;
end;        

adopted from Harley Flanders book Scientific Pascal (sorry). For me it is almost as fast as quicksort. Sometimes it is even faster, it depends on a particular vector
realization. Carlos

[dodicat]

It is Zero based (Pascal array)
But easily fixed.

Code: Select all

 

Sub SortShell(A() As Integer)
    Dim As Long lb=Lbound(a),ub=Ubound(a)
    Redim Preserve A(0 To ub-lb) 'make zero based
    Dim As Longint j,k,h,N,ua
    Dim As Double ta
    ua = Ubound(a)
    N = ua
    h = 1
    Do
        h = 3 * h + 1
    Loop Until h > N
    Do
        h = (h - 1) \ 3
        For j = h To N 
            ta = A(j)
            k = j
            While (k >= h) Andalso (A(k - h) > ta)
                A(k) = A(k - h)
                k = k - h
            Wend
            A(k) = ta
        Next j
    Loop Until h = 0
    Redim Preserve A(lb To ub) 'back to original base
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=Lbound(a) To 10
        Print i, a (i)
    Next 
    Print "..."
    For i As Integer= Ubound(a)-10  To Ubound(a)
        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
sortshell(arr2())
t2=Timer
printafew(arr2())
Print t2-t1;"   seconds shellsort-carlos"
sleep
  

[jj2007]

Results on a Core i5 (Intel(R) Core(TM) i5-2450M CPU @ 2.50GHz) using Dodicat's adaption of Carlos' Pascal version (32-bit with -gen gcc -Wc -Ofast):

Code: Select all

 4999999       500145
 5000000       500146
 5000001       500146
 1.72 seconds mergesort

 4999999       500145
 5000000       500146
 5000001       500146
 6.46 seconds shellsort-carlos

 4999999       500145
 5000000       500146
 5000001       500146
 2.05 seconds C runtime sort

Same as 64-bit FB (-arch x86_64 -gen gcc -Wc -O3):

Code: Select all

 4999999       500145
 5000000       500146
 5000001       500146
 1.51 seconds mergesort

 4999999       500145
 5000000       500146
 5000001       500146
 8.19 seconds shellsort-carlos

 4999999       500145
 5000000       500146
 5000001       500146
 1.78 seconds C runtime sort

Full source:

Code: Select all

#include once "crt.bi"
#define elements 10000000

'=========  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

Sub SortShell(A() As Integer)
    Dim As Long lb=Lbound(a),ub=Ubound(a)
    Redim Preserve A(0 To ub-lb) 'make zero based
    Dim As Longint j,k,h,N,ua
    Dim As Double ta
    ua = Ubound(a)
    N = ua
    h = 1
    Do
        h = 3 * h + 1
    Loop Until h > N
    Do
        h = (h - 1) \ 3
        For j = h To N 
            ta = A(j)
            k = j
            While (k >= h) Andalso (A(k - h) > ta)
                A(k) = A(k - h)
                k = k - h
            Wend
            A(k) = ta
        Next j
    Loop Until h = 0
    Redim Preserve A(lb To ub) 'back to original base
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 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)
  print
  for i as Integer=elements/2-1 to elements/2+1
	print i, a (i)
  Next
end sub
'=====================

dim as double t1,t2
redim as integer arr2()
dim as long n=elements


setup(arr2(),n)
t1=timer
dim as integer ptr p=@arr2(1)
mergesort(p,elements)
t2=timer
printafew(arr2())
print using "##.## seconds mergesort"; t2-t1

#if 1
  setup(arr2(),n)
  t1=Timer
  sortshell(arr2())
  t2=Timer
  printafew(arr2())
  print using "##.## seconds shellsort-carlos"; t2-t1
#else
  setup(arr2(),n)
  t1=timer
  shellsort(arr2,1,UBound(arr2),sortup)
  t2=timer
  printafew(arr2())
  print t2-t1;"   seconds shellsort"
#endif
SetSort(Integer,IntegerCallback,up,) 'set up the C qsort

setup(arr2(),n)
t1=timer
qsort(ArrayToSort(arr2),@IntegerCallback)
t2=timer
printafew(arr2())
print using "##.## seconds C runtime sort"; t2-t1
sleep

[Munair]

Which means that either your FB implementation of shellsort is very inefficient, or the C runtime sort is not a shellsort.

Indeed. Here is an efficient implementation of ShellSort

Strictly speaking,

Code: Select all

Do
        h = 3 * h + 1
    Loop Until h > N

is not part of the original ShellSort algorithm. There are several adaptations and even hybrid algorithms with different names but with more or less the same technique.

[Munair]

It is Zero based (Pascal array)
But easily fixed.

Best practice to keep arrays zero-based in FB too.

[Munair]

The algorithm Carlos provided is not really optimal in this test. the two redim preserves are bad. The variable ta of type double also slows things down and is not needed with an integer array.

[dodicat]

I generally don't like zero based arrays.
You are forever messing with that offset by one from the natural order of things.

I have changed the double in carlos's sort.
I have kept the redim preserves for non zero based arrays.
The overhead is tiny.
But I agree, the algorithm should be changed to accept non zero based arrays. I leave it as an exercise.

Anyway I have put together most the sorts so far including D.J.Peters quicksort pointer, in which I hope have applied the correct addresses.

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
'======================================================================
'dodicat
type chuck
    as long n(any)
    as long repeat(any)
end type

sub chucklesort(f() as integer,lb as long,ub as long)
    dim as long count=lb
    dim as longint max= -2147483647,min=2147483647 'arbitrary limits
    for n as long=lb to ub
        if max<f(n) then max=f(n)
        if min>f(n) then min=f(n)
    next
    dim as chuck d
    redim d.n(min to max),d.repeat(min to max)
   for n as long=lb to ub
        d.n(f(n))=f(n):d.repeat(f(n))+=1
    next 
    for n as long=lbound(d.n) to ubound(d.n)
   for z as long=1 to d.repeat(n)
     f(count)=d.n(n):count+=1
     next z
    next 
end sub

'Carlos Herrera
Sub SortShell(A() As Integer)
    Dim As Long lb=Lbound(a),ub=Ubound(a)
    Redim Preserve A(0 To ub-lb) 'make zero based
    Dim As Longint j,k,h,N,ua
    Dim As Double ta
    ua = Ubound(a)
    N = ua
    h = 1
    Do
        h = 3 * h + 1
    Loop Until h > N
    Do
        h = (h - 1) \ 3
        For j = h To N 
            ta = A(j)
            k = j
            While (k >= h) Andalso (A(k - h) > ta)
                A(k) = A(k - h)
                k = k - h
            Wend
            A(k) = ta
        Next j
    Loop Until h = 0
    Redim Preserve A(lb To ub) 'back to original base
End Sub
'd.j.peters
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

'adapted from munair qb code
 #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
type SORT_TYPE as integer
' d.J.peters version of qsort in FreeBASIC
sub quicksortPointer(l as SORT_TYPE ptr, r as SORT_TYPE ptr)
  if (r - l <= 1) then return
  dim as SORT_TYPE ptr  p=l+1,i=p
  dim as SORT_TYPE t=any
  while (p <= r)
     if (*p < *l) then t=*p:*p=*i:*i=t:i+=1
    p+=1
  wend
  p=i-1:t=*l:*l=*p:*p=t
  quicksortPointer(l, p)
  quicksortPointer(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'-rnd*1000000
Next 
end sub

sub printafew(a() as integer)
    for i as Integer=1 to 6
    print i, a (i)
Next 
 print "..."
   for i as Integer= ubound(a)-6  to ubound(a)
    print i, a (i)
   Next 
    end sub
'=====================
color 15
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(lbound(arr2))
mergesort(p,1000000)
t2=timer
printafew(arr2())
color 11:print t2-t1;"   seconds. mergesort original --- D.j.Peters":color 15
print

setup(arr2(),n)
t1=timer
mergesort2(arr2(),lbound(arr2),ubound(arr2))
t2=timer
printafew(arr2())
color 11:print t2-t1;"   seconds. mergesort2 --- Munair":color 15
print

setup(arr2(),n)
t1=timer
shellsort(arr2,1,UBound(arr2),sortup)
t2=timer
printafew(arr2())
color 11:print t2-t1;"   seconds. shellsort --- adapted from Munair":color 15
print

SetSort(Integer,IntegerCallback,up,) 'set up the C qsort

setup(arr2(),n)
t1=timer
qsort(ArrayToSort(arr2),@IntegerCallback)
t2=timer
printafew(arr2())

color 11:print t2-t1;"   seconds. C runtime sort":color 15
print

setup(arr2(),n)
t1=timer
chucklesort(arr2(),lbound(arr2),ubound(arr2))
t2=timer
printafew(arr2())
color 11:print t2-t1;"   seconds. Chuckle sort --- dodicat":color 15
print

setup(arr2(),n)
t1=timer
sortshell(arr2())
t2=timer
printafew(arr2())
color 11:print t2-t1;"   seconds. sortshell --- Carlos Herrera":color 15
print

setup(arr2(),n)
t1=timer
 p=@arr2(lbound(arr2))
quicksortpointer(p,@arr2(n))
t2=timer
printafew(arr2())
color 11:print t2-t1;"   seconds. quicksortpointer ---  D.J.Peters":color 15
print
print "DONE"
sleep

  

[Munair]

Here's a modified version of the test. I put the redim preserves outside of the timing. I also included the QuickSort that I provided yesterday. There is hardly any difference between the "normal" and the pointer version.

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
'======================================================================
'dodicat
type chuck
    as long n(any)
    as long repeat(any)
end type

sub chucklesort(f() as integer,lb as long,ub as long)
    dim as long count=lb
    dim as longint max= -2147483647,min=2147483647 'arbitrary limits
    for n as long=lb to ub
        if max<f(n) then max=f(n)
        if min>f(n) then min=f(n)
    next
    dim as chuck d
    redim d.n(min to max),d.repeat(min to max)
   for n as long=lb to ub
        d.n(f(n))=f(n):d.repeat(f(n))+=1
    next
    for n as long=lbound(d.n) to ubound(d.n)
   for z as long=1 to d.repeat(n)
     f(count)=d.n(n):count+=1
     next z
    next
end sub

'Carlos Herrera
Sub SortShell(A() As Integer)
    Dim As Long lb=Lbound(a),ub=Ubound(a)
    Dim As Longint j,k,h,N,ua
    Dim As Double ta
    ua = Ubound(a)
    N = ua
    h = 1
    Do
        h = 3 * h + 1
    Loop Until h > N
    Do
        h = (h - 1) \ 3
        For j = h To N
            ta = A(j)
            k = j
            While (k >= h) Andalso (A(k - h) > ta)
                A(k) = A(k - h)
                k = k - h
            Wend
            A(k) = ta
        Next j
    Loop Until h = 0
End Sub

'd.j.peters
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

'adapted from munair qb code
 #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

type SORT_TYPE as integer

' d.J.peters version of qsort in FreeBASIC
sub quicksortPointer(l as SORT_TYPE ptr, r as SORT_TYPE ptr)
  if (r - l <= 1) then return
  dim as SORT_TYPE ptr  p=l+1,i=p
  dim as SORT_TYPE t=any
  while (p <= r)
     if (*p < *l) then t=*p:*p=*i:*i=t:i+=1
    p+=1
  wend
  p=i-1:t=*l:*l=*p:*p=t
  quicksortPointer(l, p)
  quicksortPointer(i, r)
end sub

' standard quicksort by Munair
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'-rnd*1000000
Next
end sub

sub printafew(a() as integer)
  for i as Integer=1 to 6
    print i, a (i)
	Next
	print "..."
  for i as Integer= ubound(a)-6  to ubound(a)
    print i, a (i)
  Next
end sub
    
'=====================

color 15
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(lbound(arr2))
mergesort(p,1000000)
t2=timer
printafew(arr2())
color 11:print t2-t1;"   seconds. mergesort original --- D.j.Peters":color 15
print

setup(arr2(),n)
t1=timer
mergesort2(arr2(),lbound(arr2),ubound(arr2))
t2=timer
printafew(arr2())
color 11:print t2-t1;"   seconds. mergesort2 --- Munair":color 15
print

setup(arr2(),n)
t1=timer
shellsort(arr2,1,UBound(arr2),sortup)
t2=timer
printafew(arr2())
color 11:print t2-t1;"   seconds. shellsort --- adapted from Munair":color 15
print

SetSort(Integer,IntegerCallback,up,) 'set up the C qsort

setup(arr2(),n)
t1=timer
qsort(ArrayToSort(arr2),@IntegerCallback)
t2=timer
printafew(arr2())

color 11:print t2-t1;"   seconds. C runtime sort":color 15
print

setup(arr2(),n)
t1=timer
chucklesort(arr2(),lbound(arr2),ubound(arr2))
t2=timer
printafew(arr2())
color 11:print t2-t1;"   seconds. Chuckle sort --- dodicat":color 15
print

setup(arr2(),n)
scope
	dim as long lb, ub
	lb = lbound(arr2)
	ub = ubound(arr2)
	redim preserve arr2(0 To ub - lb) 'make zero based
	t1=timer
	sortshell(arr2())
	t2=timer
	redim preserve arr2(lb To ub) 'back to original base
end scope
printafew(arr2())
color 11:print t2-t1;"   seconds. sortshell --- Carlos Herrera":color 15
print

setup(arr2(),n)
t1=timer
 p=@arr2(lbound(arr2))
quicksortpointer(p,@arr2(n))
t2=timer
printafew(arr2())
color 11:print t2-t1;"   seconds. quicksortpointer ---  D.J.Peters":color 15
print

setup(arr2(),n)
t1=timer
QuickSort(arr2(), lbound(arr2), ubound(arr2))
t2=timer
printafew(arr2())
print t2-t1;"   seconds quicksort --- Munair"

print "DONE"
sleep

  

[Munair]

I remember QuickBASIC's option base 1 and at the time I always used it, despite the habit of advanced C/C++ programmers to use zero based arrays. But when I started programming in RealBasic and Pascal, I began to see the advantage and quickly grew accustomed to it. Today I can't imagine using anything else. It also makes it easier to use libraries from other languages.

[jj2007]

I generally don't like zero based arrays.
You are forever messing with that offset by one from the natural order of things.

I fully understand your aversion but my experience is the same as Munair's - maybe 0-based is the "natural" order of an assembler programmer ;-)

[srvaldez]

also if dealing with polynomials which normally start with index 0, it's a pain when using a programming language that insists that index must start at 1