Algorithm Implementation/Sorting/Merge sort

Merge Sort

edit

You start with an unordered sequence. You create N empty queues. You loop over every item to be sorted. On each loop iteration, you look at the last element in the key. You move that item into the end of the queue which corresponds to that element. When you are finished looping you concatenate all the queues together into another sequence. You then reapply the procedure described but look at the second last element in the key. You keep doing this until you have looped over every key. When you complete this process the resulting sequence will be sorted as described above.

Key Comparing

edit

Keys are compared in the following way: Let ka be the key of the one item, called item A, let kb be the key of the other item, called item B. Let ka(i) be the ith entry in the key ka, where the first entry is at index 0. Let i = 0. If the keys are less than i elements long then the keys are equal. If ka(i) < kb(i), then item A is ordered before item B. If ka(i) > kb(i), then item B is ordered before item A. If ka(i) = kb(i), then add one to i, and return the line under "Let i = 0."

Time Cost

edit

Let ni be the number of items in the sequence to be sorted. N is number of integers that each key element can take. Let nk be the number of keys in each item.

The total time to sort the sequence is thus O(nk(ni + N)).

Naive implementation, translation of pseudocode found at Wikipedia.

(defmacro
  apenda-primeiro (ret1 left1)
  "Appends first element of left1 to right1, and removes first element from left1."
  `(progn
    (setf ,ret1 (if (eq ,ret1 nil) (cons (car ,left1) nil) (append ,ret1 (cons (car ,left1) nil))))
    (setf ,left1 (cdr ,left1))))

(defun
    merge-func (left right)
  "Our very own merge function, takes two lists, left and right, as arguments, and returns a new merged list."
  (let (ret)
    (loop
      (if (or (not (null left)) (not (null right)))
          (progn
           (if (and (not (null left)) (not (null right)))
               (if (<= (car left) (car right))
                   (apenda-primeiro ret left)
                 (apenda-primeiro ret right))
             (if (not (null left))
                 (apenda-primeiro ret left)
               (if (not (null right))
                   (apenda-primeiro ret right)))))
        (return)))
    ret))
(defun
    merge-sort (m)
  "Merge-sort proper. Takes a list m as input and returns a new, sorted list; doesn't touch the input."
  (let* ((tam (length m))
         (mid (ceiling (/ tam 2)))
         (left)
         (right))
    (if (<= tam 1)
        m
      (progn
       (loop for n from 0 to (- mid 1) do
         (apenda-primeiro left m))
       (loop for n from mid to (- tam 1) do
         (apenda-primeiro right m))
       (setf left (merge-sort left))
       (setf right (merge-sort right))
       (merge-func left right)))))

Simpler Implementation in a somewhat more functional style.

(defun sort-func (frst scond &optional (sorted nil))
  "Sorts the elements from the first and second list in ascending order and puts them in `sorted`"
  (cond ((and (null frst) (null scond)) sorted)
        ((null frst) (append (reverse sorted) scond))
        ((null scond) (append (reverse sorted) frst))
        (t (let ((x (first frst))
                 (y (first scond)))
             (if (< x y)
                 (sort-func (rest frst) scond (push x sorted))
                 (sort-func frst (rest scond) (push y sorted)))))))

(defun merge-sort (lst)
  "Divides the elements in `lst` into individual elements and sorts them"
  (when (not (null lst))
    (let ((divided (mapcar #'(lambda (x) (list x)) lst)))
      (labels ((merge-func (div-list &optional (combined '())) ; merges the elements in ascending order
                 (if div-list
                     (merge-func (rest (rest div-list)) (push (sort-func (first div-list) (second div-list)) combined))
                     combined))
               (final-merge (div-list) ; runs merge-func until all elements have been reconciled
                 (if (> (length div-list) 1)
                     (final-merge (merge-func div-list))
                     div-list)))
        (final-merge divided)))))
///function:
mergeSort(name_array);

 //tipo Data used:
typedef struct data{
      char*some;
      int data;
} DATA;
typedef struct _nodo{
       int key;
       DATA data;
}nodo;

///n is kept as global
int n;

void merge(nodo*a,nodo*aux,int left,int right,int rightEnd){
  int i,num,temp,leftEnd=right-1;
  temp=left;
  num=rightEnd-left+1;
  while((left<=leftEnd)&&(right<=rightEnd)){
    if(a[left].key<=a[right].key){
       aux[temp++]=a[left++];
    }
    else{
        aux[temp++]=a[right++];
    }
  }
  while(left<=leftEnd){
        aux[temp++]=a[left++];
  }
  while(right<=rightEnd){
        aux[temp++]=a[right++];
  }
  for (i=1;i<=num;i++,rightEnd--){
    a[rightEnd]=aux[rightEnd];
  }
}
void mSort(nodo*a,nodo*aux,int left,int right){
  int center;
  if (left<right){
    center=(left+right)/2;
    mSort(a,aux,left,center);
    mSort(a,aux,center+1,right);
    merge(a,aux,left,center+1,right);
  }
}
void mergeSort(nodo*p){
    nodo*temp=(nodo*)malloc(sizeof(nodo)*n);
    mSort(p,temp,0,n-1);
    free(temp);
}

A recursive implementation using the C++14 standard library.

#include <iterator>
#include <algorithm>
#include <functional>

template <typename BidirIt, typename Compare = std::less<>>
void merge_sort(BidirIt first, BidirIt last, Compare cmp = Compare {})
{
    const auto n = std::distance(first, last);
    
    if (n > 1) {
        const auto middle = std::next(first, n / 2);
        
        merge_sort(first, middle, cmp);
        merge_sort(middle, last, cmp);
        
        std::inplace_merge(first, middle, last, cmp);
    }
}

#include <vector>

int main()
{
    std::vector<int> v {3, -2, 1, 5, -9, 10, 3, -3, 2};
    
    merge_sort(std::begin(v), std::end(v)); // sort increasing
    merge_sort(std::begin(v), std::end(v), std::greater<> {}); // sort decreasing
}
subroutine Merge(A,NA,B,NB,C,NC)
 
   integer, intent(in) :: NA,NB,NC         ! Normal usage: NA+NB = NC
   integer, intent(in out) :: A(NA)        ! B overlays C(NA+1:NC)
   integer, intent(in)     :: B(NB)
   integer, intent(in out) :: C(NC)
 
   integer :: I,J,K
 
   I = 1; J = 1; K = 1;
   do while(I <= NA .and. J <= NB)
      if (A(I) <= B(J)) then
         C(K) = A(I)
         I = I+1
      else
         C(K) = B(J)
         J = J+1
      endif
      K = K + 1
   enddo
   do while (I <= NA)
      C(K) = A(I)
      I = I + 1
      K = K + 1
   enddo
   return
 
end subroutine merge
 
recursive subroutine MergeSort(A,N,T)
 
   integer, intent(in) :: N
   integer, dimension(N), intent(in out) :: A
   integer, dimension((N+1)/2), intent (out) :: T
 
   integer :: NA,NB,V
 
   if (N < 2) return
   if (N == 2) then
      if (A(1) > A(2)) then
         V = A(1)
         A(1) = A(2)
         A(2) = V
      endif
      return
   endif      
   NA=(N+1)/2
   NB=N-NA
 
   call MergeSort(A,NA,T)
   call MergeSort(A(NA+1),NB,T)
 
   if (A(NA) > A(NA+1)) then
      T(1:NA)=A(1:NA)
      call Merge(T,NA,A(NA+1),NB,A,N)
   endif
   return
 
end subroutine MergeSort
 
program TestMergeSort
 
   integer, parameter :: N = 8
   integer, dimension(N) :: A = (/ 1, 5, 2, 7, 3, 9, 4, 6 /)
   integer, dimension ((N+1)/2) :: T
   call MergeSort(A,N,T)
   write(*,'(A,/,10I3)')'Sorted array :',A
 
end program TestMergeSort


function merge_sort(arr)
    if length(arr) <= 1
        return arr
    end

    middle = trunc(Int, length(arr) / 2)
    L = arr[1:middle]
    R = arr[middle+1:end]

    merge_sort(L)
    merge_sort(R)

    i = j = k = 1
    while i <= length(L) && j <= length(R)
        if L[i] < R[j]
            arr[k] = L[i]
            i+=1
        else
            arr[k] = R[j]
            j+=1
         end
         k+=1
     end

     while i <= length(L)
          arr[k] = L[i]
          i+=1
          k+=1
      end
      
      while j <= length(R)
          arr[k] = R[j]
          j+=1
          k+=1
      end
      arr
end
(define (mergesort x)
  (if (= 0 (length x))
      '()
      ;else
      (if (= (length x) 1)
          x
          ;else
          (combine (mergesort (firstHalf x (/ (length x) 2))) (mergesort (lastHalf x (/ (length x) 2)))
                   )
          )
      )
)
(define (combine list1 list2)
  (if (null? list1) list2
      ;else
      (if (null? list2) list1
          ;else
          (if (<= (car list1) (car list2))
              ;car of list 1 is second element of list 2
              (cons (car list1) (combine (cdr list1) list2))
              ;else
              (cons (car list2) (combine list1 (cdr list2)))
      )
          )
      )
        )

(define (firstHalf L N)
  (if (= N 0)
      null
   )
  (if (or (= N 1) (< N 2)) 
      (list (car L))
      ;else
      (cons (car L) (firstHalf (cdr L) (- N 1)))))

(define (lastHalf L N)
  (if (= N 0) L); Base Case
  (if (or (= N 1) (< N 2))
      (cdr L)
      ;else
      (lastHalf (cdr L) (- N 1)))
      )
sort :: Ord a => [a] -> [a]
sort []         =  []
sort [x]        =  [x]
sort xs         =  merge (sort ys) (sort zs)
  where
    (ys,zs) =  splitAt (length xs `div` 2) xs
    merge [] y=y
    merge x []=x
    merge (x:xs) (y:ys)
      | x<=y = x:merge xs (y:ys)
      | otherwise = y:merge (x:xs) ys

A slightly more efficient version only traverses the input list once to split (note that length takes linear time in Haskell):

sort :: Ord a => [a] -> [a]
sort []         =  []
sort [x]        =  [x]
sort xs         =  merge (sort ys) (sort zs)
  where (ys,zs) = split xs

merge [] ys = ys
merge xs [] = xs
merge (x:xs) (y:ys)
      | x<=y      = x : merge xs (y:ys)
      | otherwise = y : merge (x:xs) ys

split []        =  ([], [])
split [x]       =  ([x], [])
split (x:y:xs)  =  (x:l, y:r)
  where (l, r)  =  split xs
function merge(sequence left, sequence right)
sequence result = {}
    while length(left)>0 and length(right)>0 do
        if left[1]<=right[1] then
            result = append(result, left[1])
            left = left[2..$]
        else
            result = append(result, right[1])
            right = right[2..$]
        end if
    end while
    return result & left & right
end function
 
function mergesort(sequence m)
sequence left, right
integer middle
    if length(m)<=1 then
        return m
    end if
    middle = floor(length(m)/2)
    left = mergesort(m[1..middle])
    right = mergesort(m[middle+1..$])
    if left[$]<=right[1] then
        return left & right
    elsif right[$]<=left[1] then
        return right & left
    end if
    return merge(left, right)
end function

This is an ISO-Prolog compatible implementation of merge sort.

mergesort(L, Sorted) :-
    once(mergesort_r(L, Sorted)).

mergesort_r([], []).
mergesort_r([X], [X]).
mergesort_r(L, Sorted) :-
    split(L, Left, Right),
    mergesort_r(Left, SortedL),
    mergesort_r(Right, SortedR),
    merge(SortedL, SortedR, Sorted).

% Split list into two roughly equal-sized lists.
split([], [], []).
split([X], [X], []).
split([X,Y|Xs], [X|Left], [Y|Right]) :-
    split(Xs, Left, Right).

% Merge two sorted lists into one.
merge(Left, [], Left).
merge([], Right, Right).
merge([X|Left], [Y|Right], [Z|Merged]) :-
    (X @< Y ->
        Z = X,
        merge(Left, [Y|Right], Merged)
    ;
        Z = Y,
        merge([X|Left], Right, Merged)
    ).

A "standard" mergesort:

from heapq import merge

def mergesort(w):
    """Sort list w and return it."""
    if len(w)<2:
        return w
    else:
        # sort the two halves of list w recursively with mergesort and merge them
        return merge(mergesort(w[:len(w)//2]), mergesort(w[len(w)//2:]))

An alternative method, using a recursive algorithm to perform the merging in place (except for the O(log n) overhead to trace the recursion) in O(n log n) time:

def merge(lst, frm, pivot, to, len1, len2):
    if len1==0 or len2==0: return
    if len1+len2 == 2:
        if lst([pivot])<lst[frm]: lst[pivot], lst[frm] = lst[frm], lst[pivot]
        return
    if len1 > len2:
        len11 = len1/2
        firstcut, secondcut, length = frm+len11, pivot, to-pivot
        while length > 0:
            half = length/2
            mid = secondcut+half
            if lst[mid]<lst[firstcut]: secondcut, length = mid+1, length-half-1
            else: length = half
        len22 = secondcut - pivot
    else:
        len22 = len2/2
        firstcut, secondcut, length = frm, pivot+len22, pivot-frm
        while length > 0:
            half = length/2
            mid = firstcut+half
            if lst[secondcut]<lst[mid]: length = half
            else: firstcut, length = mid+1, length-half-1
        len11 = firstcut-frm
    if firstcut!=pivot and pivot!=secondcut:
        n, m = secondcut-firstcut, pivot-firstcut
        while m != 0: n, m = m, n%m
        while n != 0:
            n -= 1
            p1, p2 = firstcut+n, n+pivot
            val, shift = lst[p1], p2-p1
            while p2 != firstcut+n:
                lst[p1], p1 = lst[p2], p2
                if secondcut-p2>shift: p2 += shift
                else: p2 = pivot-secondcut+p2
            lst[p1] = val
    newmid = firstcut+len22
    merge(lst, frm, firstcut, newmid, len11, len22)
    merge(lst, newmid, secondcut, to, len1-len11, len2-len22)

def sort(lst, frm=0, to=None):
    if to is None: to = len(lst)
    if to-frm<2: return
    middle = (frm+to)/2
    sort(lst, frm, middle)
    sort(lst, middle, to)
    merge(lst, frm, middle, to, middle-frm, to-middle)
def merge_sort(array)
  return array if array.size <= 1
  mid = array.size / 2
  merge(merge_sort(array[0...mid]), merge_sort(array[mid...array.size]))
end

def merge(left, right)
  result = []

  until left.empty? || right.empty?
    result << (left[0] <= right[0] ? left : right).shift
  end

  result.concat(left).concat(right)
end
sort []    = []
sort [x]   = [x]
sort array = merge (sort left) (sort right)
             where
               left  = [array!y | y <- [0..mid]]
               right = [array!y | y <- [(mid+1)..max]]
               max   = #array - 1
               mid   = max div 2
fun mergesort [] = []
|   mergesort [x] = [x]
|   mergesort lst = 
    let fun merge ([],ys) = ys (*merges two sorted lists to form a sorted list *)
        |   merge (xs,[]) = xs
        |   merge (x::xs,y::ys) = 
              if x<y then
                x::merge (xs,y::ys)
              else
                y::merge (x::xs,ys)
        ; 
        val half = length(lst) div 2;
     in
        merge (mergesort (List.take (lst, half)),mergesort (List.drop (lst, half)))
     end
;
public int[] mergeSort(int array[])
// pre: array is full, all elements are valid integers (not null)
// post: array is sorted in ascending order (lowest to highest)
{
	// if the array has more than 1 element, we need to split it and merge the sorted halves
	if(array.length > 1)
	{
		// number of elements in sub-array 1
		// if odd, sub-array 1 has the smaller half of the elements
		// e.g. if 7 elements total, sub-array 1 will have 3, and sub-array 2 will have 4
		int elementsInA1 = array.length / 2;
		// we initialize the length of sub-array 2 to
		// equal the total length minus the length of sub-array 1
		int elementsInA2 = array.length - elementsInA1;
                // declare and initialize the two arrays once we've determined their sizes
		int arr1[] = new int[elementsInA1];
		int arr2[] = new int[elementsInA2];
		// copy the first part of 'array' into 'arr1', causing arr1 to become full
		for(int i = 0; i < elementsInA1; i++)
			arr1[i] = array[i];
		// copy the remaining elements of 'array' into 'arr2', causing arr2 to become full
		for(int i = elementsInA1; i < elementsInA1 + elementsInA2; i++)
			arr2[i - elementsInA1] = array[i];
		// recursively call mergeSort on each of the two sub-arrays that we've just created
		// note: when mergeSort returns, arr1 and arr2 will both be sorted!
		// it's not magic, the merging is done below, that's how mergesort works :)
		arr1 = mergeSort(arr1);
		arr2 = mergeSort(arr2);
		
		// the three variables below are indexes that we'll need for merging
		// [i] stores the index of the main array. it will be used to let us
		// know where to place the smallest element from the two sub-arrays.
		// [j] stores the index of which element from arr1 is currently being compared
		// [k] stores the index of which element from arr2 is currently being compared
		int i = 0, j = 0, k = 0;
		// the below loop will run until one of the sub-arrays becomes empty
		// in my implementation, it means until the index equals the length of the sub-array
		while(arr1.length != j && arr2.length != k)
		{
			// if the current element of arr1 is less than current element of arr2
			if(arr1[j] < arr2[k])
			{
				// copy the current element of arr1 into the final array
				array[i] = arr1[j];
				// increase the index of the final array to avoid replacing the element
				// which we've just added
				i++;
				// increase the index of arr1 to avoid comparing the element
				// which we've just added
				j++;
			}
			// if the current element of arr2 is less than current element of arr1
			else
			{
				// copy the current element of arr2 into the final array
				array[i] = arr2[k];
				// increase the index of the final array to avoid replacing the element
				// which we've just added
				i++;
				// increase the index of arr2 to avoid comparing the element
				// which we've just added
				k++;
			}
		}
		// at this point, one of the sub-arrays has been exhausted and there are no more
		// elements in it to compare. this means that all the elements in the remaining
		// array are the highest (and sorted), so it's safe to copy them all into the
		// final array.
		while(arr1.length != j)
		{
			array[i] = arr1[j];
			i++;
			j++;
		}
		while(arr2.length != k)
		{
			array[i] = arr2[k];
			i++;
			k++;
		}
	}
	// return the sorted array to the caller of the function
	return array;
}
;(function() {

  var defaultComparator = function (a, b) {
    if (a < b) {
      return -1;
    }
    if (a > b) {
      return 1;
    }
    return 0;
  }

  Array.prototype.mergeSort = function( comparator ) {
    var i, j, k,
        firstHalf,
        secondHalf,
        arr1,
        arr2;

    if (typeof comparator != "function") { comparator = defaultComparator; }

    if (this.length > 1) {
      firstHalf = Math.floor(this.length / 2);
      secondHalf = this.length - firstHalf;
      arr1 = [];
      arr2 = [];

      for (i = 0; i < firstHalf; i++) {
        arr1[i] = this[i];
      }

      for(i = firstHalf; i < firstHalf + secondHalf; i++) {
        arr2[i - firstHalf] = this[i];
      }

      arr1.mergeSort( comparator );
      arr2.mergeSort( comparator );

      i=j=k=0;

      while(arr1.length != j && arr2.length != k) {
        if ( comparator( arr1[j], arr2[k] ) <= 0 ) {
          this[i] = arr1[j];
          i++;
          j++;
        } 
        else {
          this[i] = arr2[k];
          i++;
          k++;
        }
      }

      while (arr1.length != j) {
        this[i] = arr1[j];
        i++;
        j++;
      }

      while (arr2.length != k) {
        this[i] = arr2[k];
        i++;
        k++;
      }
    }
  }
})();

Separate into two functions:

function mergesort(list){
    return (list.length < 2) ? list : merge(mergesort(list.splice(0, list.length >> 1)), mergesort(list));
}

function merge(left, right){
    var sorted = [];
    while (left.length && right.length)
        sorted.push(left[0] <= right[0]? left.shift() : right.shift());
    while(left.length)
        sorted.push(left.shift());
    while(right.length)
        sorted.push(right.shift());
return sorted;
}
use sort '_mergesort';
sort @array;
function merge_sort(array $left, array $right) {
    $result = [];
    while (count($left) && count($right)) 
        ($left[0] < $right[0]) ? $result[] = array_shift($left) : $result[] = array_shift($right);
    return array_merge($result, $left, $right);
}

function merge(array $arrayToSort) {
    if (count($arrayToSort) == 1)
        return $arrayToSort;

    $left = merge(array_slice($arrayToSort, 0, count($arrayToSort) / 2));
    $right = merge(array_slice($arrayToSort, count($arrayToSort) / 2, count($arrayToSort)));

    return merge_sort($left, $right);
}
def mergeSort(def list){
 if (list.size() <= 1) { return list }
 else {
     center = list.size() / 2
     left  = list[0..center]
     right = list[center..list.size() - 1]
     merge(mergeSort(left), mergeSort(right))
 }
}

def merge(def left, def right){
  def sorted = []
  while(left.size() > 0 && right.size() > 0)
    if(left.get(0) <= right.get(0)){
      sorted << left.remove(0)
    }else{
      sorted << right.remove(0)
    }
  sorted = sorted + left + right
  return sorted
}
class
	APPLICATION

feature -- Algorithm

	mergesort (a: ARRAY [INTEGER]; l, r: INTEGER)
			-- Recursive mergesort
		local
			m: INTEGER
		do
			if l < r then
				m := (l + r) // 2
				mergesort(a, l, m)
				mergesort(a, m + 1, r)
				merge(a, l, m, r)
			end
		end

feature -- Utility feature

	merge (a: ARRAY [INTEGER]; l, m, r: INTEGER)
			-- The merge feature of all mergesort variants
		local
			b: ARRAY [INTEGER]
			h, i, j, k: INTEGER
		do
			i := l
			j := m + 1
			k := l
			create b.make (l, r)
			from
			until
				i > m or j > r
			loop
				-- Begins the merge and copies it into an array `b'
				if a.item (i) <= a.item (j) then
					b.item (k) := a.item (i)
					i := i + 1

				elseif a.item (i) > a.item (j) then
					b.item (k) := a.item (j)
					j := j + 1
				end
				k := k + 1
			end
				-- Finishes the copy of the uncopied part of the array
			if i > m then
				from
					h := j
				until
					h > r
				loop
					b.item (k + h - j) := a.item (h)
					h := h + 1
				end
			elseif j > m then
				from
					h := i
				until
					h > m
				loop
					b.item (k + h - i) := a.item (h)
					h := h + 1
				end
			end
			-- Begins the copy to the real array
			from
				h := l
			until
				h > r
			loop
				a.item (h) := b.item (h)
				h := h + 1
			end

		end

feature -- Attributes

	array: ARRAY [INTEGER]

end
public class MergeSort<T> where T : IComparable
{
    public T[] Sort(T[] source)
    {
        T[] sorted = this.Split(source);
        return sorted;
    }

    private T[] Split(T[] from)
    {
        if (from.Length == 1)
        {
            // size <= 1 considered sorted
            return from;
        }
        else
        {
            int iMiddle = from.Length / 2;
            T[] left = new T[iMiddle];
            for (int i = 0; i < iMiddle; i++)
            {
                left[i] = from[i];
            }
            T[] right = new T[from.Length - iMiddle];
            for (int i = iMiddle; i < from.Length; i++)
            {
                right[i - iMiddle] = from[i];
            }

            // Single threaded version
            T[] sLeft = this.Split(left);
            T[] sRight = this.Split(right);

            T[] sorted = this.Merge(sLeft, sRight);

            return sorted;
        }
    }

    private T[] Merge(T[] left, T[] right)
    {
        // each array will individually be sorted.
        // Do a sort of card merge to merge them in a sorted sequence
        int leftLen = left.Length;
        int rightLen = right.Length;
        T[] sorted = new T[leftLen + rightLen];

        int lIndex = 0;
        int rIndex = 0;
        int currentIndex = 0;

        while (lIndex < leftLen || rIndex < rightLen)
        {
            // If either has had all elements taken, just take remaining from the other.
            // If not, compare the two current and take the lower.
            if (lIndex >= leftLen)
            {
                sorted[currentIndex] = right[rIndex];
                rIndex++;
                currentIndex++;
            }
            else if (rIndex >= rightLen)
            {
                sorted[currentIndex] = left[lIndex];
                lIndex++;
                currentIndex++;
            }
            else if (left[lIndex].CompareTo(right[rIndex]) >= 0)
            {
                // l > r, so r goes into dest
                sorted[currentIndex] = right[rIndex];
                rIndex++;
                currentIndex++;
            }
            else
            {
                sorted[currentIndex] = left[lIndex];
                lIndex++;
                currentIndex++;
            }
        }

        return sorted;
    }
}
 const maxA = 1000;
 type TElem = integer;
      TArray = array[1..maxA]of TElem;

procedure merge(var A:TArray;p,q,r:integer);
var i,j,k,n1,n2:integer;
     B:TArray;
begin
  n1 := q - p + 1;
  n2 := r - q;
  for k := p to r do 
    B[k - p + 1] := A[k];
  i := 1;
  j :=n1 + 1;
  k := p;
  while(i <= n1)and(j <= n1 + n2)do
  begin
    if B[i] <= B[j] then 
    begin
      A[k] := B[i];
      i := i + 1;
    end
    else
    begin
      A[k] := B[j];
      j := j + 1;
    end;
    k := k + 1; 
  end;
  while i <= n1 do
  begin
    A[k] := B[i];
    i := i + 1;
    k := k + 1;
  end;
  while j <= n1 + n2 do
  begin
    A[k] := B[j];
    j := j + 1;
    k := k + 1;
  end;  
end;

(* Recursive version of merge sort *)

procedure mergeSort(var A:TArray;p,r:integer);
var q:integer;
begin
  if p < r then
  begin
    q := (p + r) div 2;
    mergeSort(A,p,q);
    mergeSort(A,q + 1,r);  
    merge(A,p,q,r);
  end;
end;

(* Iterative version of merge sort *)

procedure mergeSort(var A:TArray;n:integer);
var p,q,r,k:integer;
begin
  k := 1;
  while k <= n do
  begin
    p := 1;
    while p + k <= n do
    begin
      q := p + k - 1;
      if p + 2 * k - 1 < n then 
        r := p + 2 * k - 1
      else
        r := n;
      merge(A,p,q,r);
      p := p + 2 * k;
    end;
    k := k * 2;
  end;
end;

Using a functor to create modules that specialize sorting lists of a given type with a particular comparison function:

module type Comparable = sig
  type t
  val compare: t -> t -> int
end

module MakeSorter(M : Comparable) = struct
  (** Split list into two roughly equal halves *)
  let partition (lst: M.t list) =
    let rec helper lst left right =
      match lst with
      | [ ] -> left, right
      | x :: [ ] -> x :: left, right
      | x :: y :: xs ->  helper xs (x :: left) (y :: right) in
    helper lst [] []

  (** Merge two sorted lists *)
  let rec merge left right =
    match left, right with
    | _, [ ] -> left (* Emmpty right list *)
    | [ ], _ -> right (* Empty left list *)
    | x :: xs, y :: _ when (M.compare x y) < 0 -> x :: merge xs right (* First element of left is less than first element of right *)
    | _,  y :: ys  -> y :: merge left ys (* First element of right is greater than or equal to first element of left *)

  let rec sort lst =
    match lst with
    | [ ] | _ :: [ ] -> lst (* Empty and single element lists are always sorted *)
    | lst ->
       let left, right = partition lst in
       merge (sort left) (sort right)
end

module StringSort = MakeSorter(String)

let () =
  let animals = [ "dog"; "cow"; "ant"; "zebra"; "parrot" ] in
  let sorted_animals = StringSort.sort animals in
  List.iter print_endline sorted_animals