## The Mergesort algorithm.

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
D.J.Peters
Posts: 7667
Joined: May 28, 2005 3:28

### The Mergesort algorithm.

Only for fun I tested the "merge sort" algorithm. Wikipedia: Mergesort an comparison based sorting algorithm.

Joshy

Code: Select all

`#include once "crt/string.bi"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 subsub 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,rend subsub mergeSort(array as integer ptr,nItems as integer)  dim as integer ptr tmp = new integer [nItems]  merge(array,tmp,0,nItems-1)  delete[] tmpend subconst MAX_ITEMS = 10000dim as integer ptr array = new integer[MAX_ITEMS]for i as integer=0 to MAX_ITEMS-1  array[i]=inext' make it randomfor i as integer = 1 to MAX_ITEMS  dim as integer i1=rnd*MAX_ITEMS  dim as integer i2=rnd*MAX_ITEMS  while i1=i2 : i2=rnd*MAX_ITEMS : wend  swap array[i1],array[i2]nextdim as double tStart = timer()mergeSort array,MAX_ITEMSdim as double tAll = timer()-tStartprint "sorting " & MAX_ITEMS & " = " & tAll & " seconds"sleep`
Last edited by D.J.Peters on Nov 18, 2018 17:03, edited 1 time in total.
Munair
Posts: 834
Joined: Oct 19, 2017 15:00
Location: 't Zand, NL
Contact:

### Re: The Mergesort algorithm.

Thanks for sharing.
jj2007
Posts: 1135
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

### Re: The Mergesort algorithm.

Mergesort is an interesting algo indeed. I use an in-place variant for my string sort macros. For numbers instead, I use the radix sort - for integers below a certain range it's faster than quicksort.
Munair
Posts: 834
Joined: Oct 19, 2017 15:00
Location: 't Zand, NL
Contact:

### Re: The Mergesort algorithm.

In one of my old QuickBASIC books, several sorting algorithms are discussed, including QuickSort, BubbleSort and ShellSort. The section also includes a speed benchmark table. Some algorithms are faster when the data are not badly disordered while others show exactly the opposite. So depending on the data, a specific algorithm might be preferred. However, based on average speed (from least to most disordered) the ShellSort algorithm comes out best. I never checked that benchmark, but I have used ShellSort most of the time in my software, also because the code is small and easy to implement. It never let me down and never caused a real performance issue.
Last edited by Munair on Nov 18, 2018 16:30, edited 1 time in total.
jj2007
Posts: 1135
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

### Re: The Mergesort algorithm.

Shellsort can be very fast indeed, but mergesort is both fast and stable. If you are interested, see Sorting strings, a little snippet that generates a 2 Mio lines, 50MB file with random strings. Size is chosen so that the file doesn't fit in the cache and the timings are still in an acceptable range, a few seconds at most.
D.J.Peters
Posts: 7667
Joined: May 28, 2005 3:28

### Re: The Mergesort algorithm.

I changed delete tmp to delete[] tmp

Joshy
Munair
Posts: 834
Joined: Oct 19, 2017 15:00
Location: 't Zand, NL
Contact:

### Re: The Mergesort algorithm.

D.J.Peters wrote:I changed delete tmp to delete[] tmp

Joshy

Line 36
dodicat
Posts: 5703
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: The Mergesort algorithm.

Here are some timings for mergesort, shellsort (adapted from munair) and quicksort (C run time)

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 0End 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 subsub 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,rend subsub mergeSort(array as integer ptr,nItems as integer)  dim as integer ptr tmp = new integer [nItems]  merge(array,tmp,0,nItems-1)  delete[] tmpend sub #define sortup > #define sortdown <#macro Shellsort(arr,start,finish,direction)scopedim as long max = finish-start+1,jdim as boolean nswapwhile 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 nswapwendend scope#endmacrosub setup(arr2() as integer,n as long)reDim   arr2(1 to n)Randomize 1for i as long=1 to n    arr2 (i)= rnd*1000000Next end subsub printafew(a() as integer)    for i as Integer=1 to 10    print i, a (i)Next     end sub'=====================dim as double t1,t2redim as integer arr2()dim as long n=1000000setup(arr2(),n)t1=timerdim as integer ptr p=@arr2(1)mergesort(p,1000000)t2=timerprintafew(arr2())print t2-t1;"   seconds mergesort"setup(arr2(),n)t1=timershellsort(arr2,1,UBound(arr2),sortup)t2=timerprintafew(arr2())print t2-t1;"   seconds shellsort"SetSort(Integer,IntegerCallback,up,) 'set up the C qsortsetup(arr2(),n)t1=timerqsort(ArrayToSort(arr2),@IntegerCallback)t2=timerprintafew(arr2())print t2-t1;"   seconds C runtime sort"sleep   `
jj2007
Posts: 1135
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

### Re: The Mergesort algorithm.

Same but with 10 Mio elements, and showing the sorted middle range:

Code: Select all

` 4999997       500145 4999998       500145 4999999       500145 5000000       500146 5000001       500146 5000002       500146 5000003       500146 1.564637490082532   seconds mergesort 4999997       500145 4999998       500145 4999999       500145 5000000       500146 5000001       500146 5000002       500146 5000003       500146 13.17791355890222   seconds shellsort 4999997       500145 4999998       500145 4999999       500145 5000000       500146 5000001       500146 5000002       500146 5000003       500146 2.06266761966981   seconds C runtime sort`

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 0End 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 subsub 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,rend subsub mergeSort(array as integer ptr,nItems as integer)  dim as integer ptr tmp = new integer [nItems]  merge(array,tmp,0,nItems-1)  delete[] tmpend sub #define sortup > #define sortdown <#macro Shellsort(arr,start,finish,direction)scopedim as long max = finish-start+1,jdim as boolean nswapwhile 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 nswapwendend scope#endmacrosub setup(arr2() as integer,n as long)reDim   arr2(1 to n)Randomize 1for i as long=1 to n    arr2 (i)= rnd*1000000Next end subsub printafew(a() as integer)    for i as Integer=elements/2-3 to elements/2+3    print i, a (i)Next     end sub'=====================dim as double t1,t2redim as integer arr2()dim as long n=elementssetup(arr2(),n)t1=timerdim as integer ptr p=@arr2(1)mergesort(p,elements)t2=timerprintafew(arr2())print t2-t1;"   seconds mergesort"setup(arr2(),n)t1=timershellsort(arr2,1,UBound(arr2),sortup)t2=timerprintafew(arr2())print t2-t1;"   seconds shellsort"SetSort(Integer,IntegerCallback,up,) 'set up the C qsortsetup(arr2(),n)t1=timerqsort(ArrayToSort(arr2),@IntegerCallback)t2=timerprintafew(arr2())print t2-t1;"   seconds C runtime sort"sleep`

Interesting that the MergeSort wins so clearly over the C runtime sort. For comparison, a radix sort (ArraySort, using a different PRNG):

Code: Select all

`4999997 4999334999998 4999334999999 4999335000000 4999335000001 4999345000002 4999345000003 4999340.945 secs for sorting 10000000 elements`
Munair
Posts: 834
Joined: Oct 19, 2017 15:00
Location: 't Zand, NL
Contact:

### Re: The Mergesort algorithm.

Interesting results. On Wikipedia we can read regarding Shellsort:
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 targeted at embedded systems use it instead of quicksort. Shellsort is, for example, used in the uClibc library. For similar reasons, an implementation of Shellsort is present in the Linux kernel.

Shellsort can also serve as a sub-algorithm of introspective sort, to sort short subarrays and to prevent a slowdown when the recursion depth exceeds a given limit. This principle is employed, for instance, in the bzip2 compressor.

I always liked the fact that Shellsort doesn't use recursion.
jj2007
Posts: 1135
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

### Re: The Mergesort algorithm.

Munair wrote:Interesting results. On Wikipedia we can read regarding Shellsort:
Shellsort performs more operations and has higher cache miss ratio than quicksort...
Reddit:
Sorting 100K int-sized elements most likely won't spill out of your processor's cache. Try something like 100M elements. Mergesort is exceptionally good when it comes to data caching since it preforms operations on sequences of elements that are packed close together.
Munair
Posts: 834
Joined: Oct 19, 2017 15:00
Location: 't Zand, NL
Contact:

### Re: The Mergesort algorithm.

A MergeSort from a QBasic program, adapted but not optimized (taken as is). Slower than the other, but still much faster than Shellsort.

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 0End 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 subsub 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,rend subsub mergeSort(array as integer ptr,nItems as integer)  dim as integer ptr tmp = new integer [nItems]  merge(array,tmp,0,nItems-1)  delete[] tmpend sub #define sortup > #define sortdown <#macro Shellsort(arr,start,finish,direction)scopedim as long max = finish-start+1,jdim as boolean nswapwhile 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 nswapwendend scope#endmacrosub 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 subsub setup(arr2() as integer,n as long)reDim   arr2(1 to n)Randomize 1for i as long=1 to n    arr2 (i)= rnd*1000000Nextend subsub printafew(a() as integer)    for i as Integer=1 to 10    print i, a (i)Next    end sub'=====================dim as double t1,t2redim as integer arr2()dim as long n=1000000setup(arr2(),n)t1=timerdim as integer ptr p=@arr2(1)mergesort(p,1000000)t2=timerprintafew(arr2())print t2-t1;"   seconds mergesort"setup(arr2(),n)t1=timershellsort(arr2, 1, ubound(arr2), sortup) ',1,UBound(arr2),sortup)t2=timerprintafew(arr2())print t2-t1;"   seconds shellsort"setup(arr2(),n)t1=timerMergeSort2(arr2(), 1, ubound(arr2))t2=timerprintafew(arr2())print t2-t1;"   seconds mergesort2"SetSort(Integer,IntegerCallback,up,) 'set up the C qsortsetup(arr2(),n)t1=timerqsort(ArrayToSort(arr2),@IntegerCallback)t2=timerprintafew(arr2())print t2-t1;"   seconds C runtime sort"sleep   `
dafhi
Posts: 1238
Joined: Jun 04, 2005 9:51

### Re: The Mergesort algorithm.

cool to finally see a mergesort here
Last edited by dafhi on Nov 19, 2018 1:18, edited 1 time in total.
Munair
Posts: 834
Joined: Oct 19, 2017 15:00
Location: 't Zand, NL
Contact:

### Re: The Mergesort algorithm.

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 0End 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 subsub 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,rend subsub mergeSort(array as integer ptr,nItems as integer)  dim as integer ptr tmp = new integer [nItems]  merge(array,tmp,0,nItems-1)  delete[] tmpend sub #define sortup > #define sortdown <#macro Shellsort(arr,start,finish,direction)scopedim as long max = finish-start+1,jdim as boolean nswapwhile 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 nswapwendend scope#endmacrosub 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 subSub 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 Subsub setup(arr2() as integer,n as long)reDim   arr2(1 to n)Randomize 1for i as long=1 to n    arr2 (i)= rnd*1000000Nextend subsub printafew(a() as integer)    for i as Integer=1 to 10    print i, a (i)Next    end sub'=====================dim as double t1,t2redim as integer arr2()dim as long n=1000000setup(arr2(),n)t1=timerdim as integer ptr p=@arr2(1)mergesort(p,1000000)t2=timerprintafew(arr2())print t2-t1;"   seconds mergesort"setup(arr2(),n)t1=timershellsort(arr2, 1, ubound(arr2), sortup) ',1,UBound(arr2),sortup)t2=timerprintafew(arr2())print t2-t1;"   seconds shellsort"setup(arr2(),n)t1=timerMergeSort2(arr2(), 1, ubound(arr2))t2=timerprintafew(arr2())print t2-t1;"   seconds mergesort2"setup(arr2(),n)t1=timerQuickSort(arr2(), lbound(arr2), ubound(arr2))t2=timerprintafew(arr2())print t2-t1;"   seconds quicksort"SetSort(Integer,IntegerCallback,up,) 'set up the C qsortsetup(arr2(),n)t1=timerqsort(ArrayToSort(arr2),@IntegerCallback)t2=timerprintafew(arr2())print t2-t1;"   seconds C runtime sort"sleep`
jj2007
Posts: 1135
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

### Re: The Mergesort algorithm.

Munair wrote:Same test code, but includes QuickSort. Its name is well deserved
100 Million elements:

Code: Select all

` 49999999      500004 50000000      500004 50000001      500004 16.80204577522818   seconds mergesort 49999999      500004 50000000      500004 50000001      500004 229.7400005008094   seconds shellsort 49999999      500004 50000000      500004 50000001      500004 55.47414085781202   seconds mergesort2 49999999      500004 50000000      500004 50000001      500004 11.06132317334414   seconds quicksort 49999999      500004 50000000      500004 50000001      500004 19.99825488810893   seconds C runtime sort`
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:

Code: Select all

`49999998        49992949999999        49992950000000        49992950000001        49992950000002        4999299.57 secs for sorting 100000000 elements`
Last edited by jj2007 on Nov 19, 2018 8:51, edited 1 time in total.

Return to “Tips and Tricks”

### Who is online

Users browsing this forum: No registered users and 3 guests