Sorting algorithms/Merge sort: Difference between revisions
Capra Hircus (talk | contribs) (adding maxima) |
m (→{{header|REXX}}: indeded DO loops, added comments, changed comments, changed the fence, added whitespace. -- ~~~~) |
||
Line 2,661: | Line 2,661: | ||
=={{header|REXX}}== |
=={{header|REXX}}== |
||
Note: the array elements can be anything, integers, floating point, characters ... |
Note: the array elements can be anything, integers, floating point (exponentiated), characters ... |
||
<lang rexx>/*REXX program sorts |
<lang rexx>/*REXX program sorts a (stemmed) array using the merge-sort method. */ |
||
call gen@ /*generate array elements. */ |
call gen@ /*generate the array elements. */ |
||
call show@ 'before sort' /*show before array elements*/ |
call show@ 'before sort' /*show the before array elements.*/ |
||
call mergeSort highItem /*invoke the merge sort |
call mergeSort highItem /*invoke the merge sort for array*/ |
||
call show@ ' after sort' /*show after array elements*/ |
call show@ ' after sort' /*show the after array elements.*/ |
||
exit /* |
exit /*stick a fork in it, we're done.*/ |
||
/*──────────────────────────────────GEN@ subroutine─────────────────────*/ |
|||
/*─────────────────────────────────────MERGESORT subroutine────────*/ |
|||
⚫ | |||
mergeSort: procedure expose @. |
|||
⚫ | |||
call mergeTo@ 1,arg(1) |
|||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
return |
return |
||
/*──────────────────────────────────MERGETO@ subroutine─────────────────*/ |
|||
/*─────────────────────────────────────MERGETO@ subroutine─────────*/ |
|||
mergeTo@: procedure expose @. !.; parse arg L,n; if n==1 then return |
mergeTo@: procedure expose @. !.; parse arg L,n; if n==1 then return |
||
if n==2 then do |
if n==2 then do; h=L+1 |
||
h=L |
if @.L>@.h then do; _=@.h; @.h=@.L; @.L=_; end |
||
if @.L>@.h then do; _=@.h; @.h=@.L; @.L=_; end |
|||
return |
return |
||
end |
end |
||
Line 2,682: | Line 2,692: | ||
call mergeTo@ L+m,n-m |
call mergeTo@ L+m,n-m |
||
call mergeTo! L,m,1 |
call mergeTo! L,m,1 |
||
i=1; j=L+m |
i=1; j=L+m; do k=L while k<j |
||
if j==L+n | !.i<=@.j then do; @.k=!.i; i=i+1; end |
|||
else do; @.k=@.j; j=j+1; end |
|||
end /*k*/ |
|||
end /*k*/ |
|||
return |
return |
||
/*──────────────────────────────────MERGESORT subroutine────────────────*/ |
|||
/*─────────────────────────────────────MERGETO! subroutine─────────*/ |
|||
mergeSort: procedure expose @.; call mergeTo@ 1,arg(1) |
|||
⚫ | |||
/*──────────────────────────────────MERGETO! subroutine─────────────────*/ |
|||
mergeTo!: procedure expose @. !.; parse arg L,n,_ |
|||
if n==1 then do; !._=@.L; return; end |
if n==1 then do; !._=@.L; return; end |
||
if n==2 then do |
if n==2 then do |
||
h=L+1; q=1+_ |
h=L+1; q=1+_ |
||
if @.L>@.h then do; q=_; _=q+1; end |
if @.L>@.h then do; q=_; _=q+1; end |
||
!._=@.L; !.q=@.h |
!._=@.L; !.q=@.h |
||
return |
return |
||
end |
end |
||
Line 2,701: | Line 2,713: | ||
call mergeTo! L+m,n-m,m+_ |
call mergeTo! L+m,n-m,m+_ |
||
i=L; j=m+_ |
i=L; j=m+_ |
||
do k=_ while k<j |
do k=_ while k<j |
||
if j==n+_ | @.i<=!.j then do; !.k=@.i; i=i+1; end |
if j==n+_ | @.i<=!.j then do; !.k=@.i; i=i+1; end |
||
else do; !.k=!.j; j=j+1; end |
else do; !.k=!.j; j=j+1; end |
||
end /*k*/ |
end /*k*/ |
||
⚫ | |||
/*─────────────────────────────────────GEN@ subroutine─────────────*/ |
|||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
return |
return |
||
/*──────────────────────────────────SHOW@ subroutine────────────────────*/ |
|||
/*─────────────────────────────────────SHOW@ subroutine────────────*/ |
|||
show@: widthH=length(highItem) /*maximum width of any line.*/ |
show@: widthH=length(highItem) /*maximum the width of any line. */ |
||
do j=1 for highItem |
do j=1 for highItem |
||
say 'element' right(j,widthH) arg(1)':' @.j |
say 'element' right(j,widthH) arg(1)':' @.j |
||
end /*j*/ |
end /*j*/ |
||
say copies('─', |
say copies('─',60) /*show a seperator line (fence). */ |
||
return</lang> |
return</lang> |
||
'''output''' |
'''output''' |
||
Line 2,739: | Line 2,736: | ||
element 8 before sort: sloth |
element 8 before sort: sloth |
||
element 9 before sort: lust |
element 9 before sort: lust |
||
──────────────────────────────────────────────────────────── |
|||
──────────────────────────────────────────────────────────────────────────────── |
|||
element 1 after sort: ---The seven deadly sins--- |
element 1 after sort: ---The seven deadly sins--- |
||
element 2 after sort: =========================== |
element 2 after sort: =========================== |
||
Line 2,749: | Line 2,746: | ||
element 8 after sort: sloth |
element 8 after sort: sloth |
||
element 9 after sort: wrath |
element 9 after sort: wrath |
||
──────────────────────────────────────────────────────────── |
|||
──────────────────────────────────────────────────────────────────────────────── |
|||
</pre> |
</pre> |
||
Revision as of 20:54, 6 September 2012
You are encouraged to solve this task according to the task description, using any language you may know.
Sorting Algorithm
This is a sorting algorithm. It may be applied to a set of data in order to sort it.
For comparing various sorts, see compare sorts.
For other sorting algorithms, see sorting algorithms, or:
Heap sort | Merge sort | Patience sort | Quick sort
O(n log2n) sorts
Shell Sort
O(n2) sorts
Bubble sort |
Cocktail sort |
Cocktail sort with shifting bounds |
Comb sort |
Cycle sort |
Gnome sort |
Insertion sort |
Selection sort |
Strand sort
other sorts
Bead sort |
Bogo sort |
Common sorted list |
Composite structures sort |
Custom comparator sort |
Counting sort |
Disjoint sublist sort |
External sort |
Jort sort |
Lexicographical sort |
Natural sorting |
Order by pair comparisons |
Order disjoint list items |
Order two numerical lists |
Object identifier (OID) sort |
Pancake sort |
Quickselect |
Permutation sort |
Radix sort |
Ranking methods |
Remove duplicate elements |
Sleep sort |
Stooge sort |
[Sort letters of a string] |
Three variable sort |
Topological sort |
Tree sort
The merge sort is a recursive sort of order n*log(n). It is notable for having a worst case and average complexity of O(n*log(n)), and a best case complexity of O(n) (for pre-sorted input). The basic idea is to split the collection into smaller groups by halving it until the groups only have one element or no elements (which are both entirely sorted groups). Then merge the groups back together so that their elements are in order. This is how the algorithm gets its "divide and conquer" description.
Write a function to sort a collection of integers using the merge sort. The merge sort algorithm comes in two parts: a sort function and a merge function. The functions in pseudocode look like this:
function mergesort(m) var list left, right, result if length(m) ≤ 1 return m else var middle = length(m) / 2 for each x in m up to middle - 1 add x to left for each x in m at and after middle add x to right left = mergesort(left) right = mergesort(right) if last(left) ≤ first(right) append right to left return left result = merge(left, right) return result function merge(left,right) var list result while length(left) > 0 and length(right) > 0 if first(left) ≤ first(right) append first(left) to result left = rest(left) else append first(right) to result right = rest(right) if length(left) > 0 append rest(left) to result if length(right) > 0 append rest(right) to result return result
For more information see Wikipedia
ACL2
<lang Lisp>(defun split (xys)
(if (endp (rest xys)) (mv xys nil) (mv-let (xs ys) (split (rest (rest xys))) (mv (cons (first xys) xs) (cons (second xys) ys)))))
(defun mrg (xs ys)
(declare (xargs :measure (+ (len xs) (len ys)))) (cond ((endp xs) ys) ((endp ys) xs) ((< (first xs) (first ys)) (cons (first xs) (mrg (rest xs) ys))) (t (cons (first ys) (mrg xs (rest ys))))))
(defthm split-shortens
(implies (consp (rest xs)) (mv-let (ys zs) (split xs) (and (< (len ys) (len xs)) (< (len zs) (len xs))))))
(defun msort (xs)
(declare (xargs :measure (len xs) :hints (("Goal" :use ((:instance split-shortens)))))) (if (endp (rest xs)) xs (mv-let (ys zs) (split xs) (mrg (msort ys) (msort zs)))))</lang>
ActionScript
<lang ActionScript>function mergesort(a:Array) { //Arrays of length 1 and 0 are always sorted if(a.length <= 1) return a; else { var middle:uint = a.length/2; //split the array into two var left:Array = new Array(middle); var right:Array = new Array(a.length-middle); var j:uint = 0, k:uint = 0; //fill the left array for(var i:uint = 0; i < middle; i++) left[j++]=a[i]; //fill the right array for(i = middle; i< a.length; i++) right[k++]=a[i]; //sort the arrays left = mergesort(left); right = mergesort(right); //If the last element of the left array is less than or equal to the first //element of the right array, they are in order and don't need to be merged if(left[left.length-1] <= right[0]) return left.concat(right); a = merge(left, right); return a; } }
function merge(left:Array, right:Array) { var result:Array = new Array(left.length + right.length); var j:uint = 0, k:uint = 0, m:uint = 0; //merge the arrays in order while(j < left.length && k < right.length) { if(left[j] <= right[k]) result[m++] = left[j++]; else result[m++] = right[k++]; } //If one of the arrays has remaining entries that haven't been merged, they //will be greater than the rest of the numbers merged so far, so put them on the //end of the array. for(; j < left.length; j++) result[m++] = left[j]; for(; k < right.length; k++) result[m++] = right[k]; return result; }</lang>
Ada
This example creates a generic package for sorting arrays of any type. Ada allows array indices to be any discrete type, including enumerated types which are non-numeric. Furthermore, numeric array indices can start at any value, positive, negative, or zero. The following code handles all the possible variations in index types. <lang ada>generic
type Element_Type is private; type Index_Type is (<>); type Collection_Type is array(Index_Type range <>) of Element_Type; with function "<"(Left, Right : Element_Type) return Boolean is <>;
package Mergesort is
function Sort(Item : Collection_Type) return Collection_Type;
end MergeSort;</lang>
<lang ada>package body Mergesort is
----------- -- Merge -- ----------- function Merge(Left, Right : Collection_Type) return Collection_Type is Result : Collection_Type(Left'First..Right'Last); Left_Index : Index_Type := Left'First; Right_Index : Index_Type := Right'First; Result_Index : Index_Type := Result'First; begin while Left_Index <= Left'Last and Right_Index <= Right'Last loop if Left(Left_Index) <= Right(Right_Index) then Result(Result_Index) := Left(Left_Index); Left_Index := Index_Type'Succ(Left_Index); -- increment Left_Index else Result(Result_Index) := Right(Right_Index); Right_Index := Index_Type'Succ(Right_Index); -- increment Right_Index end if; Result_Index := Index_Type'Succ(Result_Index); -- increment Result_Index end loop; if Left_Index <= Left'Last then Result(Result_Index..Result'Last) := Left(Left_Index..Left'Last); end if; if Right_Index <= Right'Last then Result(Result_Index..Result'Last) := Right(Right_Index..Right'Last); end if; return Result; end Merge; ---------- -- Sort -- ----------
function Sort (Item : Collection_Type) return Collection_Type is Result : Collection_Type(Item'range); Middle : Index_Type; begin if Item'Length <= 1 then return Item; else Middle := Index_Type'Val((Item'Length / 2) + Index_Type'Pos(Item'First)); declare Left : Collection_Type(Item'First..Index_Type'Pred(Middle)); Right : Collection_Type(Middle..Item'Last); begin for I in Left'range loop Left(I) := Item(I); end loop; for I in Right'range loop Right(I) := Item(I); end loop; Left := Sort(Left); Right := Sort(Right); Result := Merge(Left, Right); end; return Result; end if; end Sort;
end Mergesort;</lang> The following code provides an usage example for the generic package defined above. <lang ada>with Ada.Text_Io; use Ada.Text_Io; with Mergesort;
procedure Mergesort_Test is
type List_Type is array(Positive range <>) of Integer; package List_Sort is new Mergesort(Integer, Positive, List_Type); procedure Print(Item : List_Type) is begin for I in Item'range loop Put(Integer'Image(Item(I))); end loop; New_Line; end Print; List : List_Type := (1, 5, 2, 7, 3, 9, 4, 6);
begin
Print(List); Print(List_Sort.Sort(List));
end Mergesort_Test;</lang> The output of this example is:
1 5 2 7 3 9 4 6 1 2 3 4 5 6 7 9
ALGOL 68
Below are two variants of the same routine. If copying the DATA type to a different memory location is expensive, then the optimised version should be used as the DATA elements are handled indirectly. <lang algol68>MODE DATA = CHAR;
PROC merge sort = ([]DATA m)[]DATA: (
IF LWB m >= UPB m THEN m ELSE INT middle = ( UPB m + LWB m ) OVER 2; []DATA left = merge sort(m[:middle]); []DATA right = merge sort(m[middle+1:]); flex merge(left, right)[AT LWB m] FI
);
- FLEX version: A demonstration of FLEX for manipulating arrays #
PROC flex merge = ([]DATA in left, in right)[]DATA:(
[UPB in left + UPB in right]DATA result; FLEX[0]DATA left := in left; FLEX[0]DATA right := in right;
FOR index TO UPB result DO # change the direction of this comparison to change the direction of the sort # IF LWB right > UPB right THEN result[index:] := left; stop iteration ELIF LWB left > UPB left THEN result[index:] := right; stop iteration ELIF left[1] <= right[1] THEN result[index] := left[1]; left := left[2:] ELSE result[index] := right[1]; right := right[2:] FI OD;
stop iteration:
result
);
[32]CHAR char array data := "big fjords vex quick waltz nymph"; print((merge sort(char array data), new line));</lang> Output:
abcdefghiijklmnopqrstuvwxyz
Optimised version:
- avoids FLEX array copies and manipulations
- avoids type DATA memory copies, useful in cases where DATA is a large STRUCT
<lang algol68>PROC opt merge sort = ([]REF DATA m)[]REF DATA: (
IF LWB m >= UPB m THEN m ELSE INT middle = ( UPB m + LWB m ) OVER 2; []REF DATA left = opt merge sort(m[:middle]); []REF DATA right = opt merge sort(m[middle+1:]); opt merge(left, right)[AT LWB m] FI
);
PROC opt merge = ([]REF DATA left, right)[]REF DATA:(
[UPB left - LWB left + 1 + UPB right - LWB right + 1]REF DATA result; INT index left:=LWB left, index right:=LWB right;
FOR index TO UPB result DO # change the direction of this comparison to change the direction of the sort # IF index right > UPB right THEN result[index:] := left[index left:]; stop iteration ELIF index left > UPB left THEN result[index:] := right[index right:]; stop iteration ELIF left[index left] <= right[index right] THEN result[index] := left[index left]; index left +:= 1 ELSE result[index] := right[index right]; index right +:= 1 FI OD;
stop iteration:
result
);
- create an array of pointers to the data being sorted #
[UPB char array data]REF DATA data; FOR i TO UPB char array data DO data[i] := char array data[i] OD;
[]REF CHAR result = opt merge sort(data); FOR i TO UPB result DO print((result[i])) OD; print(new line)</lang> Output:
abcdefghiijklmnopqrstuvwxyz
AutoHotkey_L
AutoHotkey_L has true array support and can dynamically grow and shrink its arrays at run time. This version of Merge Sort only needs n locations to sort. AHK forum post <lang AutoHotkey>#NoEnv
Test := [] Loop 100 {
Random n, 0, 999 Test.Insert(n)
} Result := MergeSort(Test) Loop % Result.MaxIndex() {
MsgBox, 1, , % Result[A_Index] IfMsgBox Cancel Break
} Return
/*
Function MergeSort Sorts an array by first recursively splitting it down to its individual elements and then merging those elements in their correct order. Parameters Array The array to be sorted Returns The sorted array
- /
MergeSort(Array)
{ ; Return single element arrays If (! Array.HasKey(2)) Return Array
; Split array into Left and Right halfs Left := [], Right := [], Middle := Array.MaxIndex() // 2 Loop % Middle Right.Insert(Array.Remove(Middle-- + 1)), Left.Insert(Array.Remove(1)) If (Array.MaxIndex()) Right.Insert(Array.Remove(1)) Left := MergeSort(Left), Right := MergeSort(Right)
; If all the Right values are greater than all the ; Left values, just append Right at the end of Left. If (Left[Left.MaxIndex()] <= Right[1]) { Loop % Right.MaxIndex() Left.Insert(Right.Remove(1)) Return Left } ; Loop until one of the arrays is empty While(Left.MaxIndex() and Right.MaxIndex()) Left[1] <= Right[1] ? Array.Insert(Left.Remove(1)) : Array.Insert(Right.Remove(1))
Loop % Left.MaxIndex() Array.Insert(Left.Remove(1))
Loop % Right.MaxIndex() Array.Insert(Right.Remove(1)) Return Array }</lang>
AutoHotkey
Contributed by Laszlo on the ahk forum <lang AutoHotkey>MsgBox % MSort("") MsgBox % MSort("xxx") MsgBox % MSort("3,2,1") MsgBox % MSort("dog,000000,cat,pile,abcde,1,zz,xx,z")
MSort(x) { ; Merge-sort of a comma separated list
If (2 > L:=Len(x)) Return x ; empty or single item lists are sorted StringGetPos p, x, `,, % "L" L//2 ; Find middle comma Return Merge(MSort(SubStr(x,1,p)), MSort(SubStr(x,p+2))) ; Split, Sort, Merge
}
Len(list) {
StringReplace t, list,`,,,UseErrorLevel ; #commas -> ErrorLevel Return list="" ? 0 : ErrorLevel+1
}
Item(list,ByRef p) { ; item at position p, p <- next position
Return (p := InStr(list,",",0,i:=p+1)) ? SubStr(list,i,p-i) : SubStr(list,i)
}
Merge(list0,list1) { ; Merge 2 sorted lists
IfEqual list0,, Return list1 IfEqual list1,, Return list0 i0 := Item(list0,p0:=0) i1 := Item(list1,p1:=0) Loop { i := i0>i1 list .= "," i%i% ; output smaller If (p%i%) i%i% := Item(list%i%,p%i%) ; get next item from processed list Else { i ^= 1 ; list is exhausted: attach rest of other Return SubStr(list "," i%i% (p%i% ? "," SubStr(list%i%,p%i%+1) : ""), 2) } }
}</lang>
BBC BASIC
<lang BBCBASIC>DEFPROC_MergeSort(Start%,End%) REM ***************************************************************** REM This procedure Merge Sorts the chunk of data% bounded by REM Start% & End%. REM *****************************************************************
LOCAL Middle% IF End%=Start% ENDPROC
IF End%-Start%=1 THEN
IF data%(End%)<data%(Start%) THEN SWAP data%(Start%),data%(End%) ENDIF ENDPROC
ENDIF
Middle%=Start%+(End%-Start%)/2
PROC_MergeSort(Start%,Middle%) PROC_MergeSort(Middle%+1,End%) PROC_Merge(Start%,Middle%,End%)
ENDPROC
DEF PROC_Merge(Start%,Middle%,End%)
LOCAL fh_size% fh_size% = Middle%-Start%+1
FOR I%=0 TO fh_size%-1
fh%(I%)=data%(Start%+I%)
NEXT I%
I%=0 J%=Middle%+1 K%=Start%
REPEAT
IF fh%(I%) <= data%(J%) THEN data%(K%)=fh%(I%) I%+=1 K%+=1 ELSE data%(K%)=data%(J%) J%+=1 K%+=1 ENDIF
UNTIL I%=fh_size% OR J%>End%
WHILE I% < fh_size%
data%(K%)=fh%(I%) I%+=1 K%+=1
ENDWHILE
ENDPROC</lang> Usage would look something like this example which sorts a series of 1000 random integers: <lang BBCBASIC>REM Example of merge sort usage. Size%=1000
S1%=Size%/2
DIM data%(Size%) DIM fh%(S1%)
FOR I%=1 TO Size%
data%(I%)=RND(100000)
NEXT
PROC_MergeSort(1,Size%)
END</lang>
C
<lang c>#include <stdio.h>
- include <stdlib.h>
- include <string.h>
inline void merge(int *left, int l_len, int *right, int r_len, int *out) { int i, j, k; for (i = j = k = 0; i < l_len && j < r_len; ) out[k++] = left[i] < right[j] ? left[i++] : right[j++];
while (i < l_len) out[k++] = left[i++]; while (j < r_len) out[k++] = right[j++]; }
/* inner recursion of merge sort */ void recur(int *buf, int *tmp, int len) { int l = len / 2; if (len <= 1) return;
/* note that buf and tmp are swapped */ recur(tmp, buf, l); recur(tmp + l, buf + l, len - l);
merge(tmp, l, tmp + l, len - l, buf); }
/* preparation work before recursion */ void merge_sort(int *buf, int len) { /* call alloc, copy and free only once */ int *tmp = malloc(sizeof(int) * len); memcpy(tmp, buf, sizeof(int) * len);
recur(buf, tmp, len);
free(tmp); }
int main() {
- define LEN 20
int i, x[LEN];
for (i = 0; i < LEN; i++) x[i] = rand() % LEN;
puts("before sort:"); for (i = 0; i < LEN; i++) printf("%d ", x[i]); putchar('\n');
merge_sort(x, LEN);
puts("after sort:"); for (i = 0; i < LEN; i++) printf("%d ", x[i]); putchar('\n');
return 0; }</lang>
C++
<lang cpp>#include <iterator>
- include <algorithm> // for std::inplace_merge
- include <functional> // for std::less
template<typename RandomAccessIterator, typename Order>
void mergesort(RandomAccessIterator first, RandomAccessIterator last, Order order)
{
if (last - first > 1) { RandomAccessIterator middle = first + (last - first) / 2; mergesort(first, middle, order); mergesort(middle, last, order); std::inplace_merge(first, middle, last, order); }
}
template<typename RandomAccessIterator>
void mergesort(RandomAccessIterator first, RandomAccessIterator last)
{
mergesort(first, last, std::less<typename std::iterator_traits<RandomAccessIterator>::value_type>());
}</lang>
C#
<lang csharp>using System; using System.Collections.Generic;
namespace RosettaCode.MergeSort {
public static class MergeSorter { public static List<T> Sort<T>(List<T> list) where T : IComparable { if (list.Count <= 1) return list;
List<T> left = list.GetRange(0, list.Count / 2); List<T> right = list.GetRange(left.Count, list.Count - left.Count); return Merge(Sort(left), Sort(right)); }
public static List<T> Merge<T>(List<T> left, List<T> right) where T : IComparable { List<T> result = new List<T>(); while (left.Count > 0 && right.Count > 0) { if (left[0].CompareTo(right[0]) <= 0) { result.Add(left[0]); left.RemoveAt(0); } else { result.Add(right[0]); right.RemoveAt(0); } } result.AddRange(left); result.AddRange(right); return result; } }
}</lang> As in the Ada example above, the following code provides a usage example: <lang csharp>using System; using System.Collections.Generic;
namespace RosettaCode.MergeSort {
class Program { static void Main(string[] args) { List<int> testList = new List<int> { 1, 5, 2, 7, 3, 9, 4, 6 }; printList(testList); printList(MergeSorter.Sort(testList)); }
private static void printList<T>(List<T> list) { foreach (var t in list) { Console.Write(t + " "); } Console.WriteLine(); } }
}</lang> Again, as in the Ada example the output is:
1 5 2 7 3 9 4 6 1 2 3 4 5 6 7 9
Clojure
<lang lisp>(defn merge* [left right]
(cond (nil? left) right (nil? right) left true (let [[l & *left] left [r & *right] right] (if (<= l r) (cons l (merge* *left right)) (cons r (merge* left *right))))))
(defn merge-sort [L]
(let [[l & *L] L] (if (nil? *L) L (let [[left right] (split-at (/ (count L) 2) L)] (merge* (merge-sort left) (merge-sort right))))))</lang>
COBOL
Cobol cannot do recursion, so this version simulates recursion. The working storage is therefore pretty complex, so I have shown the whole program, not just the working procedure division parts. <lang COBOL> IDENTIFICATION DIVISION.
PROGRAM-ID. MERGESORT. AUTHOR. DAVE STRATFORD. DATE-WRITTEN. APRIL 2010. INSTALLATION. HEXAGON SYSTEMS LIMITED. ****************************************************************** * MERGE SORT * * The Merge sort uses a completely different paradigm, one of * * divide and conquer, to many of the other sorts. The data set * * is split into smaller sub sets upon which are sorted and then * * merged together to form the final sorted data set. * * This version uses the recursive method. Split the data set in * * half and perform a merge sort on each half. This in turn splits* * each half again and again until each set is just one or 2 items* * long. A set of one item is already sorted so is ignored, a set * * of two is compared and swapped as necessary. The smaller data * * sets are then repeatedly merged together to eventually form the* * full, sorted, set. * * Since cobol cannot do recursion this module only simulates it * * so is not as fast as a normal recursive version would be. * * Scales very well to larger data sets, its relative complexity * * means it is not suited to sorting smaller data sets: use an * * Insertion sort instead as the Merge sort is a stable sort. * ******************************************************************
ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. ICL VME. OBJECT-COMPUTER. ICL VME.
INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT FA-INPUT-FILE ASSIGN FL01. SELECT FB-OUTPUT-FILE ASSIGN FL02.
DATA DIVISION. FILE SECTION. FD FA-INPUT-FILE. 01 FA-INPUT-REC. 03 FA-DATA PIC 9(6).
FD FB-OUTPUT-FILE. 01 FB-OUTPUT-REC PIC 9(6).
WORKING-STORAGE SECTION. 01 WA-IDENTITY. 03 WA-PROGNAME PIC X(10) VALUE "MERGESORT". 03 WA-VERSION PIC X(6) VALUE "000001".
01 WB-TABLE. 03 WB-ENTRY PIC 9(8) COMP SYNC OCCURS 100000 INDEXED BY WB-IX-1 WB-IX-2.
01 WC-VARS. 03 WC-SIZE PIC S9(8) COMP SYNC. 03 WC-TEMP PIC S9(8) COMP SYNC. 03 WC-START PIC S9(8) COMP SYNC. 03 WC-MIDDLE PIC S9(8) COMP SYNC. 03 WC-END PIC S9(8) COMP SYNC.
01 WD-FIRST-HALF. 03 WD-FH-MAX PIC S9(8) COMP SYNC. 03 WD-ENTRY PIC 9(8) COMP SYNC OCCURS 50000 INDEXED BY WD-IX.
01 WF-CONDITION-FLAGS. 03 WF-EOF-FLAG PIC X. 88 END-OF-FILE VALUE "Y". 03 WF-EMPTY-FILE-FLAG PIC X. 88 EMPTY-FILE VALUE "Y".
01 WS-STACK. * This stack is big enough to sort a list of 1million items. 03 WS-STACK-ENTRY OCCURS 20 INDEXED BY WS-STACK-TOP. 05 WS-START PIC S9(8) COMP SYNC. 05 WS-MIDDLE PIC S9(8) COMP SYNC. 05 WS-END PIC S9(8) COMP SYNC. 05 WS-FS-FLAG PIC X. 88 FIRST-HALF VALUE "F". 88 SECOND-HALF VALUE "S". 88 WS-ALL VALUE "A". 05 WS-IO-FLAG PIC X. 88 WS-IN VALUE "I". 88 WS-OUT VALUE "O".
PROCEDURE DIVISION. A-MAIN SECTION. A-000. PERFORM B-INITIALISE.
IF NOT EMPTY-FILE PERFORM C-PROCESS.
PERFORM D-FINISH.
A-999. STOP RUN.
B-INITIALISE SECTION. B-000. DISPLAY "*** " WA-PROGNAME " VERSION " WA-VERSION " STARTING ***".
MOVE ALL "N" TO WF-CONDITION-FLAGS. OPEN INPUT FA-INPUT-FILE. SET WB-IX-1 TO 0.
READ FA-INPUT-FILE AT END MOVE "Y" TO WF-EOF-FLAG WF-EMPTY-FILE-FLAG.
PERFORM BA-READ-INPUT UNTIL END-OF-FILE.
CLOSE FA-INPUT-FILE.
SET WC-SIZE TO WB-IX-1.
B-999. EXIT.
BA-READ-INPUT SECTION. BA-000. SET WB-IX-1 UP BY 1. MOVE FA-DATA TO WB-ENTRY(WB-IX-1).
READ FA-INPUT-FILE AT END MOVE "Y" TO WF-EOF-FLAG.
BA-999. EXIT.
C-PROCESS SECTION. C-000. DISPLAY "SORT STARTING".
MOVE 1 TO WS-START(1). MOVE WC-SIZE TO WS-END(1). MOVE "F" TO WS-FS-FLAG(1). MOVE "I" TO WS-IO-FLAG(1). SET WS-STACK-TOP TO 2.
PERFORM E-MERGE-SORT UNTIL WS-OUT(1).
DISPLAY "SORT FINISHED".
C-999. EXIT.
D-FINISH SECTION. D-000. OPEN OUTPUT FB-OUTPUT-FILE. SET WB-IX-1 TO 1.
PERFORM DA-WRITE-OUTPUT UNTIL WB-IX-1 > WC-SIZE.
CLOSE FB-OUTPUT-FILE.
DISPLAY "*** " WA-PROGNAME " FINISHED ***".
D-999. EXIT.
DA-WRITE-OUTPUT SECTION. DA-000. WRITE FB-OUTPUT-REC FROM WB-ENTRY(WB-IX-1). SET WB-IX-1 UP BY 1.
DA-999. EXIT.
****************************************************************** E-MERGE-SORT SECTION. *===================== * * This section controls the simulated recursion. * ****************************************************************** E-000. IF WS-OUT(WS-STACK-TOP - 1) GO TO E-010.
MOVE WS-START(WS-STACK-TOP - 1) TO WC-START. MOVE WS-END(WS-STACK-TOP - 1) TO WC-END.
* First check size of part we are dealing with. IF WC-END - WC-START = 0 * Only 1 number in range, so simply set for output, and move on MOVE "O" TO WS-IO-FLAG(WS-STACK-TOP - 1) GO TO E-010.
IF WC-END - WC-START = 1 * 2 numbers, so compare and swap as necessary. Set for output MOVE "O" TO WS-IO-FLAG(WS-STACK-TOP - 1) IF WB-ENTRY(WC-START) > WB-ENTRY(WC-END) MOVE WB-ENTRY(WC-START) TO WC-TEMP MOVE WB-ENTRY(WC-END) TO WB-ENTRY(WC-START) MOVE WC-TEMP TO WB-ENTRY(WC-END) GO TO E-010 ELSE GO TO E-010.
* More than 2, so split and carry on down COMPUTE WC-MIDDLE = ( WC-START + WC-END ) / 2.
MOVE WC-START TO WS-START(WS-STACK-TOP). MOVE WC-MIDDLE TO WS-END(WS-STACK-TOP). MOVE "F" TO WS-FS-FLAG(WS-STACK-TOP). MOVE "I" TO WS-IO-FLAG(WS-STACK-TOP). SET WS-STACK-TOP UP BY 1.
GO TO E-999.
E-010. SET WS-STACK-TOP DOWN BY 1.
IF SECOND-HALF(WS-STACK-TOP) GO TO E-020.
MOVE WS-START(WS-STACK-TOP - 1) TO WC-START. MOVE WS-END(WS-STACK-TOP - 1) TO WC-END. COMPUTE WC-MIDDLE = ( WC-START + WC-END ) / 2 + 1.
MOVE WC-MIDDLE TO WS-START(WS-STACK-TOP). MOVE WC-END TO WS-END(WS-STACK-TOP). MOVE "S" TO WS-FS-FLAG(WS-STACK-TOP). MOVE "I" TO WS-IO-FLAG(WS-STACK-TOP). SET WS-STACK-TOP UP BY 1.
GO TO E-999.
E-020. MOVE WS-START(WS-STACK-TOP - 1) TO WC-START. MOVE WS-END(WS-STACK-TOP - 1) TO WC-END. COMPUTE WC-MIDDLE = ( WC-START + WC-END ) / 2. PERFORM H-PROCESS-MERGE. MOVE "O" TO WS-IO-FLAG(WS-STACK-TOP - 1).
E-999. EXIT.
****************************************************************** H-PROCESS-MERGE SECTION. *======================== * * This section identifies which data is to be merged, and then * * merges the two data streams into a single larger data stream. * ****************************************************************** H-000. INITIALISE WD-FIRST-HALF. COMPUTE WD-FH-MAX = WC-MIDDLE - WC-START + 1. SET WD-IX TO 1.
PERFORM HA-COPY-OUT VARYING WB-IX-1 FROM WC-START BY 1 UNTIL WB-IX-1 > WC-MIDDLE.
SET WB-IX-1 TO WC-START. SET WB-IX-2 TO WC-MIDDLE. SET WB-IX-2 UP BY 1. SET WD-IX TO 1. PERFORM HB-MERGE UNTIL WD-IX > WD-FH-MAX OR WB-IX-2 > WC-END.
PERFORM HC-COPY-BACK UNTIL WD-IX > WD-FH-MAX.
H-999. EXIT.
HA-COPY-OUT SECTION. HA-000. MOVE WB-ENTRY(WB-IX-1) TO WD-ENTRY(WD-IX). SET WD-IX UP BY 1.
HA-999. EXIT.
HB-MERGE SECTION. HB-000. IF WB-ENTRY(WB-IX-2) < WD-ENTRY(WD-IX) MOVE WB-ENTRY(WB-IX-2) TO WB-ENTRY(WB-IX-1) SET WB-IX-2 UP BY 1 ELSE MOVE WD-ENTRY(WD-IX) TO WB-ENTRY(WB-IX-1) SET WD-IX UP BY 1.
SET WB-IX-1 UP BY 1.
HB-999. EXIT.
HC-COPY-BACK SECTION. HC-000. MOVE WD-ENTRY(WD-IX) TO WB-ENTRY(WB-IX-1). SET WD-IX UP BY 1. SET WB-IX-1 UP BY 1.
HC-999. EXIT.</lang>
CoffeeScript
<lang coffeescript># This is a simple version of mergesort that returns brand-new arrays.
- A more sophisticated version would do more in-place optimizations.
merge_sort = (arr) ->
if arr.length <= 1 return (elem for elem in arr) m = Math.floor(arr.length / 2) arr1 = merge_sort(arr.slice 0, m) arr2 = merge_sort(arr.slice m) result = [] p1 = p2 = 0 while true if p1 >= arr1.length if p2 >= arr2.length return result result.push arr2[p2] p2 += 1 else if p2 >= arr2.length or arr1[p1] < arr2[p2] result.push arr1[p1] p1 += 1 else result.push arr2[p2] p2 += 1
do ->
console.log merge_sort [2,4,6,8,1,3,5,7,9,10,11,0,13,12]</lang>
- Output:
> coffee mergesort.coffee [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 ]
Common Lisp
<lang lisp>(defun merge-sort (result-type sequence predicate)
(let ((split (floor (length sequence) 2))) (if (zerop split) (copy-seq sequence) (merge result-type (merge-sort result-type (subseq sequence 0 split) predicate) (merge-sort result-type (subseq sequence split) predicate) predicate))))</lang>
merge is a standard Common Lisp function.
> (merge-sort 'list (list 1 3 5 7 9 8 6 4 2) #'<) (1 2 3 4 5 6 7 8 9)
Curry
Copied from Curry: Example Programs <lang curry>-- merge sort: sorting two lists by merging the sorted first -- and second half of the list
sort :: ([a] -> [a] -> [a] -> Success) -> [a] -> [a] -> Success
sort merge xs ys =
if length xs < 2 then ys =:= xs else sort merge (firsthalf xs) us & sort merge (secondhalf xs) vs & merge us vs ys where us,vs free
intMerge :: [Int] -> [Int] -> [Int] -> Success
intMerge [] ys zs = zs =:= ys intMerge (x:xs) [] zs = zs =:= x:xs intMerge (x:xs) (y:ys) zs =
if (x > y) then intMerge (x:xs) ys us & zs =:= y:us else intMerge xs (y:ys) vs & zs =:= x:vs where us,vs free
firsthalf xs = take (length xs `div` 2) xs secondhalf xs = drop (length xs `div` 2) xs
goal1 xs = sort intMerge [3,1,2] xs goal2 xs = sort intMerge [3,1,2,5,4,8] xs goal3 xs = sort intMerge [3,1,2,5,4,8,6,7,2,9,1,4,3] xs</lang>
D
Arrays only, not in-place. <lang d>import std.stdio, std.algorithm, std.array, std.range;
T[] mergeSorted(T)(in T[] D) /*pure nothrow*/ {
if (D.length < 2) return D.dup; return [D[0 .. $ / 2].mergeSorted(), D[$ / 2 .. $].mergeSorted()] .nWayUnion().array();
}
void main() {
auto a = [3, 4, 2, 5, 1, 6]; writeln(a.mergeSorted());
}</lang>
Alternative Version
This in-place version allocates the auxiliary memory on the stack, making life easier for the garbage collector, but with risk of stack overflow (same output): <lang d>import std.stdio, std.algorithm, core.stdc.stdlib, std.exception,
std.range;
void mergeSort(T)(T[] data) if (hasSwappableElements!(typeof(data))) {
immutable L = data.length; if (L < 2) return; T* ptr = cast(T*)alloca(L * T.sizeof); enforce(ptr != null); ptr[0 .. L] = data[]; mergeSort(ptr[0 .. L/2]); mergeSort(ptr[L/2 .. L]); [ptr[0 .. L/2], ptr[L/2 .. L]].nWayUnion().copy(data);
}
void main() {
auto a = [3, 4, 2, 5, 1, 6]; a.mergeSort(); writeln(a);
}</lang>
Dart
<lang dart>merge(left, right, items) {
var a = 0; var t; while (left.length != 0 && right.length != 0) { if (right[0] < left[0]) { t = right[0]; right.removeRange(0,1); } else { t = left[0]; left.removeRange(0,1); } items[a++] = t; } while(left.length != 0) { t = left[0]; left.removeRange(0,1); items[a++] = t; } while(right.length != 0) { t = right[0]; right.removeRange(0,1); items[a++] = t; }
}
mSort(items, tmp, l) {
if (l == 1) { return; } var m = (l/2).floor().toInt(); var tmp_l = tmp.getRange(0, m); var tmp_r = tmp.getRange(m, tmp.length-m); mSort(tmp_l, items.getRange(0,m), m); mSort(tmp_r, items.getRange(m, items.length-m), l-m); merge(tmp_l, tmp_r, items);
}
merge_sort(items) {
mSort(items,items.getRange(0, items.length),items.length);
}
void main() {
var arr=[1,5,2,7,3,9,4,6,8]; print("Before sort"); arr.forEach((var i)=>print("$i")); merge_sort(arr); print("After sort"); arr.forEach((var i)=>print("$i"));
}</lang>
E
<lang e>def merge(var xs :List, var ys :List) {
var result := [] while (xs =~ [x] + xr && ys =~ [y] + yr) { if (x <= y) { result with= x xs := xr } else { result with= y ys := yr } } return result + xs + ys
}
def sort(list :List) {
if (list.size() <= 1) { return list } def split := list.size() // 2 return merge(sort(list.run(0, split)), sort(list.run(split)))
}</lang>
Erlang
Below are two versions. Both take advantage of built-in Erlang functions, lists:split and list:merge. The multi-process version spawns a new process each time it splits. This was slightly faster on a test system with only two cores, so it may not be the best implementation, however it does illustrate how easy it can be to add multi-threaded/process capabilities to a program.
Single-threaded version: <lang erlang>mergeSort(L) when length(L) == 1 -> L; mergeSort(L) when length(L) > 1 ->
{L1, L2} = lists:split(length(L) div 2, L), lists:merge(mergeSort(L1), mergeSort(L2)).</lang>
Multi-process version: <lang erlang>pMergeSort(L) when length(L) == 1 -> L; pMergeSort(L) when length(L) > 1 ->
{L1, L2} = lists:split(length(L) div 2, L), spawn(mergesort, pMergeSort2, [L1, self()]), spawn(mergesort, pMergeSort2, [L2, self()]), mergeResults([]).
pMergeSort2(L, Parent) when length(L) == 1 -> Parent ! L; pMergeSort2(L, Parent) when length(L) > 1 ->
{L1, L2} = lists:split(length(L) div 2, L), spawn(mergesort, pMergeSort2, [L1, self()]), spawn(mergesort, pMergeSort2, [L2, self()]), Parent ! mergeResults([]).</lang>
Euphoria
<lang euphoria>function merge(sequence left, sequence right)
sequence result result = {} while length(left) > 0 and length(right) > 0 do if compare(left[1], right[1]) <= 0 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 else middle = floor(length(m)/2) left = mergesort(m[1..middle]) right = mergesort(m[middle+1..$]) if compare(left[$], right[1]) <= 0 then return left & right elsif compare(right[$], left[1]) <= 0 then return right & left else return merge(left, right) end if end if
end function
constant s = rand(repeat(1000,10)) ? s ? mergesort(s)</lang>
- Output:
{385,599,284,650,457,804,724,300,434,722} {284,300,385,434,457,599,650,722,724,804}
F#
<lang fsharp>let split list =
let rec aux l acc1 acc2 = match l with | [] -> (acc1,acc2) | [x] -> (x::acc1,acc2) | x::y::tail -> aux tail (x::acc1) (y::acc2) in aux list [] []
let rec merge l1 l2 =
match (l1,l2) with | (x,[]) -> x | ([],y) -> y | (x::tx,y::ty) -> if x <= y then x::merge tx l2 else y::merge l1 ty
let rec mergesort list =
match list with | [] -> [] | [x] -> [x] | _ -> let (l1,l2) = split list in merge (mergesort l1) (mergesort l2)</lang>
Factor
<lang factor>: mergestep ( accum seq1 seq2 -- accum seq1 seq2 ) 2dup [ first ] bi@ < [ [ [ first ] [ rest-slice ] bi [ suffix ] dip ] dip ] [ [ first ] [ rest-slice ] bi [ swap [ suffix ] dip ] dip ] if ;
- merge ( seq1 seq2 -- merged )
[ { } ] 2dip [ 2dup [ length 0 > ] bi@ and ] [ mergestep ] while append append ;
- mergesort ( seq -- sorted )
dup length 1 > [ dup length 2 / floor [ head ] [ tail ] 2bi [ mergesort ] bi@ merge ] [ ] if ;</lang>
<lang factor>( scratchpad ) { 4 2 6 5 7 1 3 } mergesort . { 1 2 3 4 5 6 7 }</lang>
Forth
This is an in-place mergesort which works on arrays of integers. <lang forth>: merge-step ( right mid left -- right mid+ left+ )
over @ over @ < if over @ >r 2dup - over dup cell+ rot move r> over ! >r cell+ 2dup = if rdrop dup else r> then then cell+ ;
- merge ( right mid left -- right left )
dup >r begin 2dup > while merge-step repeat 2drop r> ;
- mid ( l r -- mid ) over - 2/ cell negate and + ;
- mergesort ( right left -- right left )
2dup cell+ <= if exit then swap 2dup mid recurse rot recurse merge ;
- sort ( addr len -- ) cells over + swap mergesort 2drop ;
create test 8 , 1 , 5 , 3 , 9 , 0 , 2 , 7 , 6 , 4 ,
- .array ( addr len -- ) 0 do dup i cells + @ . loop drop ;
test 10 2dup sort .array \ 0 1 2 3 4 5 6 7 8 9</lang>
Fortran
<lang fortran>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</lang>
Go
<lang go>package main
import "fmt"
var a = []int{170, 45, 75, -90, -802, 24, 2, 66} var s = make([]int, len(a)/2+1) // scratch space for merge step
func main() {
fmt.Println("before:", a) mergeSort(a) fmt.Println("after: ", a)
}
func mergeSort(a []int) {
if len(a) < 2 { return } mid := len(a) / 2 mergeSort(a[:mid]) mergeSort(a[mid:]) if a[mid-1] <= a[mid] { return } // merge step, with the copy-half optimization copy(s, a[:mid]) l, r := 0, mid for i := 0; ; i++ { if s[l] <= a[r] { a[i] = s[l] l++ if l == mid { break } } else { a[i] = a[r] r++ if r == len(a) { copy(a[i+1:], s[l:mid]) break } } } return
}</lang>
Groovy
This is the standard algorithm, except that in the looping phase of the merge we work backwards through the left and right lists to construct the merged list, to take advantage of the Groovy List.pop() method. However, this results in a partially merged list in reverse sort order; so we then reverse it to put in back into correct order. This could play havoc with the sort stability, but we compensate by picking aggressively from the right list (ties go to the right), rather than aggressively from the left as is done in the standard algorithm. <lang groovy>def merge = { List left, List right ->
List mergeList = [] while (left && right) { print "." mergeList << ((left[-1] > right[-1]) ? left.pop() : right.pop()) } mergeList = mergeList.reverse() mergeList = left + right + mergeList
}
def mergeSort; mergeSort = { List list ->
def n = list.size() if (n < 2) return list def middle = n.intdiv(2) def left = [] + list[0..<middle] def right = [] + list[middle..<n] left = mergeSort(left) right = mergeSort(right) if (left[-1] <= right[0]) return left + right merge(left, right)
}</lang> Test: <lang groovy>println (mergeSort([23,76,99,58,97,57,35,89,51,38,95,92,24,46,31,24,14,12,57,78,4])) println (mergeSort([88,18,31,44,4,0,8,81,14,78,20,76,84,33,73,75,82,5,62,70,12,7,1])) println () println (mergeSort([10, 10.0, 10.00, 1])) println (mergeSort([10, 10.00, 10.0, 1])) println (mergeSort([10.0, 10, 10.00, 1])) println (mergeSort([10.0, 10.00, 10, 1])) println (mergeSort([10.00, 10, 10.0, 1])) println (mergeSort([10.00, 10.0, 10, 1]))</lang> The presence of decimal and integer versions of the same numbers, demonstrates, but of course does not prove, that the sort remains stable.
- Output:
.............................................................[4, 12, 14, 23, 24, 24, 31, 35, 38, 46, 51, 57, 57, 58, 76, 78, 89, 92, 95, 97, 99] ....................................................................[0, 1, 4, 5, 7, 8, 12, 14, 18, 20, 31, 33, 44, 62, 70, 73, 75, 76, 78, 81, 82, 84, 88] ....[1, 10, 10.0, 10.00] ....[1, 10, 10.00, 10.0] ....[1, 10.0, 10, 10.00] ....[1, 10.0, 10.00, 10] ....[1, 10.00, 10, 10.0] ....[1, 10.00, 10.0, 10]
Haskell
Splitting in half in the middle like the normal merge sort does would be inefficient on the singly-linked lists used in Haskell (since you would have to do one pass just to determine the length, and then another half-pass to do the splitting). Instead, the algorithm here splits the list in half in a different way -- by alternately assigning elements to one list and the other. That way we (lazily) construct both sublists in parallel as we traverse the original list. Unfortunately, under this way of splitting we cannot do a stable sort. <lang haskell>merge [] ys = ys merge xs [] = xs merge xs@(x:xs') ys@(y:ys') | x <= y = x : merge xs' ys
| otherwise = y : merge xs ys'
split (x:y:zs) = let (xs,ys) = split zs in (x:xs,y:ys) split [x] = ([x],[]) split [] = ([],[])
mergeSort [] = [] mergeSort [x] = [x] mergeSort xs = let (as,bs) = split xs
in merge (mergeSort as) (mergeSort bs)</lang>
Io
<lang io>List do (
merge := method(lst1, lst2, result := list() while(lst1 isNotEmpty or lst2 isNotEmpty, if(lst1 first <= lst2 first) then( result append(lst1 removeFirst) ) else ( result append(lst2 removeFirst) ) ) result)
mergeSort := method( if (size > 1) then( half_size := (size / 2) ceil return merge(slice(0, half_size) mergeSort, slice(half_size, size) mergeSort) ) else (return self) )
mergeSortInPlace := method( copy(mergeSort) )
)
lst := list(9, 5, 3, -1, 15, -2) lst mergeSort println # ==> list(-2, -1, 3, 5, 9, 15) lst mergeSortInPlace println # ==> list(-2, -1, 3, 5, 9, 15)</lang>
Icon and Unicon
<lang Icon>procedure main() #: demonstrate various ways to sort a list and string
demosort(mergesort,[3, 14, 1, 5, 9, 2, 6, 3],"qwerty")
end
procedure mergesort(X,op,lower,upper) #: return sorted list ascending(or descending) local middle
if /lower := 1 then { # top level call setup upper := *X op := sortop(op,X) # select how and what we sort }
if upper ~= lower then { # sort all sections with 2 or more elements X := mergesort(X,op,lower,middle := lower + (upper - lower) / 2) X := mergesort(X,op,middle+1,upper) if op(X[middle+1],X[middle]) then # @middle+1 < @middle merge if halves reversed X := merge(X,op,lower,middle,upper) } return X
end
procedure merge(X,op,lower,middle,upper) # merge two list sections within a larger list local p1,p2,add
p1 := lower p2 := middle + 1 add := if type(X) ~== "string" then put else "||" # extend X, strings require X := add (until ||:= is invocable) while p1 <= middle & p2 <= upper do if op(X[p1],X[p2]) then { # @p1 < @p2 X := add(X,X[p1]) # extend X temporarily (rather than use a separate temporary list) p1 +:= 1 } else { X := add(X,X[p2]) # extend X temporarily p2 +:= 1 }
while X := add(X,X[middle >= p1]) do p1 +:= 1 # and rest of lower or ... while X := add(X,X[upper >= p2]) do p2 +:= 1 # ... upper trailers if any if type(X) ~== "string" then # pull section's sorted elements from extension every X[upper to lower by -1] := pull(X) else (X[lower+:(upper-lower+1)] := X[0-:(upper-lower+1)])[0-:(upper-lower+1)] := "" return X
end</lang>
Note: This example relies on the supporting procedures 'sortop', and 'demosort' in Bubble Sort. The full demosort exercises the named sort of a list with op = "numeric", "string", ">>" (lexically gt, descending),">" (numerically gt, descending), a custom comparator, and also a string.
Abbreviated sample output:
Sorting Demo using procedure mergesort on list : [ 3 14 1 5 9 2 6 3 ] with op = &null: [ 1 2 3 3 5 6 9 14 ] (0 ms) ... on string : "qwerty" with op = &null: "eqrtwy" (0 ms)
J
Solution <lang j>merge =: ,`(({.@] , ($: }.))~` ({.@] , ($: }.)) @.(>&{.))@.(*@*&#) split =: </.~ 0 1$~# mergeSort =: merge & $: &>/ @ split ` ] @. (1>:#)</lang> This version is usable for relative small arrays due to stack limitations for the recursive verb 'merge'. For larger arrays replace 'merge' with the following explicit non-recursive version: <lang j>merge=: 4 : 0
if. 0= x *@*&# y do. x,y return. end. la=.x ra=.y z=.i.0 while. la *@*&# ra do. if. la >&{. ra do. z=.z,{.ra ra=.}.ra else. z=.z,{.la la=.}.la end. end. z,la,ra
)</lang> But don't forget to use J's primitives /: or \: if you really need a sort-function.
Java
<lang java>import java.util.List; import java.util.ArrayList; import java.util.Iterator;
public class Merge {
public static <E extends Comparable<? super E>> List<E> mergeSort(List<E> m) { if (m.size() <= 1) return m;
int middle = m.size() / 2; List<E> left = m.subList(0, middle); List<E> right = m.subList(middle, m.size());
right = mergeSort(right); left = mergeSort(left); List<E> result = merge(left, right);
return result; }
public static <E extends Comparable<? super E>> List<E> merge(List<E> left, List<E> right) { List<E> result = new ArrayList<E>(); Iterator<E> it1 = left.iterator(); Iterator<E> it2 = right.iterator();
E x = it1.next(); E y = it2.next();
while (true) { //change the direction of this comparison to change the direction of the sort if (x.compareTo(y) <= 0) {
result.add(x); if (it1.hasNext()) x = it1.next(); else { result.add(y); while (it2.hasNext()) result.add(it2.next()); break; } } else { result.add(y); if (it2.hasNext()) y = it2.next(); else { result.add(x); while (it1.hasNext()) result.add(it1.next()); break; } }
} return result; }
}</lang>
JavaScript
<lang javascript>function merge(left,right,arr){ var a=0; while(left.length&&right.length) arr[a++]=right[0]<left[0]?right.shift():left.shift(); while(left.length)arr[a++]=left.shift(); while(right.length)arr[a++]=right.shift(); } function mSort(arr,tmp,l){ if(l==1)return; var m=Math.floor(l/2), tmp_l=tmp.slice(0,m), tmp_r=tmp.slice(m); mSort(tmp_l,arr.slice(0,m),m); mSort(tmp_r,arr.slice(m),l-m); merge(tmp_l,tmp_r,arr); } function merge_sort(arr){ mSort(arr,arr.slice(),arr.length); }
var arr=[1,5,2,7,3,9,4,6,8]; merge_sort(arr); // arr will now: 1,2,3,4,5,6,7,8,9</lang>
Liberty BASIC
<lang lb> itemCount = 20
dim A(itemCount) dim tmp(itemCount) 'merge sort needs additionally same amount of storage
for i = 1 to itemCount A(i) = int(rnd(1) * 100) next i
print "Before Sort" call printArray itemCount
call mergeSort 1,itemCount
print "After Sort" call printArray itemCount
end
'------------------------------------------ sub mergeSort start, theEnd
if theEnd-start < 1 then exit sub if theEnd-start = 1 then if A(start)>A(theEnd) then tmp=A(start) A(start)=A(theEnd) A(theEnd)=tmp end if exit sub end if middle = int((start+theEnd)/2) call mergeSort start, middle call mergeSort middle+1, theEnd call merge start, middle, theEnd
end sub
sub merge start, middle, theEnd
i = start: j = middle+1: k = start while i<=middle OR j<=theEnd select case case i<=middle AND j<=theEnd if A(i)<=A(j) then tmp(k)=A(i) i=i+1 else tmp(k)=A(j) j=j+1 end if k=k+1 case i<=middle tmp(k)=A(i) i=i+1 k=k+1 case else 'j<=theEnd tmp(k)=A(j) j=j+1 k=k+1 end select wend
for i = start to theEnd A(i)=tmp(i) next
end sub
'=========================================== sub printArray itemCount
for i = 1 to itemCount print using("###", A(i)); next i print
end sub</lang>
Logo
<lang logo>to split :size :front :list
if :size < 1 [output list :front :list] output split :size-1 (lput first :list :front) (butfirst :list)
end
to merge :small :large
if empty? :small [output :large] ifelse lessequal? first :small first :large ~ [output fput first :small merge butfirst :small :large] ~ [output fput first :large merge butfirst :large :small]
end
to mergesort :list
localmake "half split (count :list) / 2 [] :list if empty? first :half [output :list] output merge mergesort first :half mergesort last :half
end</lang>
Logtalk
<lang logtalk>msort([], []) :- !. msort([X], [X]) :- !. msort([X, Y| Xs], Ys) :-
split([X, Y| Xs], X1s, X2s), msort(X1s, Y1s), msort(X2s, Y2s), merge(Y1s, Y2s, Ys).
split([], [], []). split([X| Xs], [X| Ys], Zs) :-
split(Xs, Zs, Ys).
merge([X| Xs], [Y| Ys], [X| Zs]) :-
X @=< Y, !, merge(Xs, [Y| Ys], Zs).
merge([X| Xs], [Y| Ys], [Y| Zs]) :-
X @> Y, !, merge([X | Xs], Ys, Zs).
merge([], Xs, Xs) :- !. merge(Xs, [], Xs).</lang>
Lucid
[1] <lang lucid>msort(a) = if iseod(first next a) then a else merge(msort(b0),msort(b1)) fi
where p = false fby not p; b0 = a whenever p; b1 = a whenever not p; just(a) = ja where ja = a fby if iseod ja then eod else next a fi; end; merge(x,y) = if takexx then xx else yy fi where xx = (x) upon takexx; yy = (y) upon not takexx; takexx = if iseod(yy) then true elseif iseod(xx) then false else xx <= yy fi; end; end;</lang>
Mathematica
<lang Mathematica>MergeSort[m_List] := Module[{middle},
If[Length[m] >= 2, middle = Ceiling[Length[m]/2]; Apply[Merge, Map[MergeSort, Partition[m, middle, middle, {1, 1}, {}]]], m ] ]
Merge[left_List, right_List] := Module[
{leftIndex = 1, rightIndex = 1}, Table[ Which[ leftIndex > Length[left], rightrightIndex++, rightIndex > Length[right], leftleftIndex++, leftleftIndex <= rightrightIndex, leftleftIndex++, True, rightrightIndex++], {Length[left] + Length[right]}] ]</lang>
MATLAB
<lang MATLAB>function list = mergeSort(list)
if numel(list) <= 1 return else middle = ceil(numel(list) / 2); left = list(1:middle); right = list(middle+1:end); left = mergeSort(left); right = mergeSort(right); if left(end) <= right(1) list = [left right]; return end %merge(left,right) counter = 1; while (numel(left) > 0) && (numel(right) > 0) if(left(1) <= right(1)) list(counter) = left(1); left(1) = []; else list(counter) = right(1); right(1) = []; end counter = counter + 1; end
if numel(left) > 0 list(counter:end) = left; elseif numel(right) > 0 list(counter:end) = right; end %end merge end %if
end %mergeSort</lang> Sample Usage: <lang MATLAB>>> mergeSort([4 3 1 5 6 2])
ans =
1 2 3 4 5 6</lang>
Maxima
<lang maxima>merge(a, b) := block(
[c: [ ], i: 1, j: 1, p: length(a), q: length(b)], while i <= p and j <= q do ( if a[i] < b[j] then ( c: endcons(a[i], c), i: i + 1 ) else ( c: endcons(b[j], c), j: j + 1 ) ), if i > p then append(c, rest(b, j - 1)) else append(c, rest(a, i - 1))
)$
mergesort(u) := block(
[n: length(u), k, a, b], if n <= 1 then u else ( a: rest(u, k: quotient(n, 2)), b: rest(u, k - n), merge(mergesort(a), mergesort(b)) )
)$</lang>
OCaml
<lang ocaml>let rec split_at n xs =
match n, xs with 0, xs -> [], xs | _, [] -> failwith "index too large" | n, x::xs when n > 0 -> let xs', xs = split_at (pred n) xs in x::xs', xs | _, _ -> invalid_arg "negative argument"
let rec merge_sort cmp = function
[] -> [] | [x] -> [x] | xs -> let xs, ys = split_at (List.length xs / 2) xs in List.merge cmp (merge_sort cmp xs) (merge_sort cmp ys)
let _ =
merge_sort compare [8;6;4;2;1;3;5;7;9]</lang>
Oz
<lang oz>declare
fun {MergeSort Xs} case Xs of nil then nil [] [X] then [X] else Middle = {Length Xs} div 2 Left Right {List.takeDrop Xs Middle ?Left ?Right} in {List.merge {MergeSort Left} {MergeSort Right} Value.'<'} end end
in
{Show {MergeSort [3 1 4 1 5 9 2 6 5]}}</lang>
NetRexx
<lang NetRexx>/* NetRexx */ options replace format comments java crossref savelog symbols binary
import java.util.List
placesList = [String -
"UK London", "US New York", "US Boston", "US Washington" - , "UK Washington", "US Birmingham", "UK Birmingham", "UK Boston" -
]
lists = [ -
placesList - , mergeSort(String[] Arrays.copyOf(placesList, placesList.length)) -
]
loop ln = 0 to lists.length - 1
cl = lists[ln] loop ct = 0 to cl.length - 1 say cl[ct] end ct say end ln
return
method mergeSort(m = String[]) public constant binary returns String[]
rl = String[m.length] al = List mergeSort(Arrays.asList(m)) al.toArray(rl)
return rl
method mergeSort(m = List) public constant binary returns ArrayList
result = ArrayList(m.size) left = ArrayList() right = ArrayList() if m.size > 1 then do middle = m.size % 2 loop x_ = 0 to middle - 1 left.add(m.get(x_)) end x_ loop x_ = middle to m.size - 1 right.add(m.get(x_)) end x_ left = mergeSort(left) right = mergeSort(right) if (Comparable left.get(left.size - 1)).compareTo(Comparable right.get(0)) <= 0 then do left.addAll(right) result.addAll(m) end else do result = merge(left, right) end end else do result.addAll(m) end
return result
method merge(left = List, right = List) public constant binary returns ArrayList
result = ArrayList() loop label mx while left.size > 0 & right.size > 0 if (Comparable left.get(0)).compareTo(Comparable right.get(0)) <= 0 then do result.add(left.get(0)) left.remove(0) end else do result.add(right.get(0)) right.remove(0) end end mx if left.size > 0 then do result.addAll(left) end if right.size > 0 then do result.addAll(right) end
return result
</lang>
- Output:
UK London US New York US Boston US Washington UK Washington US Birmingham UK Birmingham UK Boston UK Birmingham UK Boston UK London UK Washington US Birmingham US Boston US New York US Washington
PARI/GP
Note also that the built-in vecsort
and listsort
use a merge sort internally.
<lang parigp>mergeSort(v)={
if(#v<2, return(v)); my(m=#v\2,left=vector(m,i,v[i]),right=vector(#v-m,i,v[m+i])); left=mergeSort(left); right=mergeSort(right); merge(left, right)
}; merge(u,v)={ my(ret=vector(#u+#v),i=1,j=1); for(k=1,#ret, if(i<=#u & (j>#v | u[i]<v[j]), ret[k]=u[i]; i++ , ret[k]=v[j]; j++ ) ); ret };</lang>
Pascal
<lang pascal>program MergeSortDemo;
type
TIntArray = array of integer;
function merge(left, right: TIntArray): TIntArray;
var i, j: integer; begin j := 0; setlength(merge, length(left) + length(right)); while (length(left) > 0) and (length(right) > 0) do begin if left[0] <= right[0] then begin
merge[j] := left[0]; inc(j); for i := low(left) to high(left) - 1 do left[i] := left[i+1]; setlength(left, length(left) - 1);
end else begin
merge[j] := right[0]; inc(j); for i := low(right) to high(right) - 1 do right[i] := right[i+1]; setlength(right, length(right) - 1);
end; end; if length(left) > 0 then for i := low(left) to high(left) do
merge[j + i] := left[i];
j := j + length(left); if length(right) > 0 then for i := low(right) to high(right) do
merge[j + i] := right[i];
end;
function mergeSort(m: TIntArray): TIntArray;
var left, right: TIntArray; i, middle: integer; begin setlength(mergeSort, length(m)); if length(m) = 1 then mergeSort[0] := m[0] else if length(m) > 1 then begin middle := length(m) div 2; setlength(left, middle); setlength(right, length(m)-middle); for i := low(left) to high(left) do left[i] := m[i]; for i := low(right) to high(right) do right[i] := m[middle+i]; left := mergeSort(left); right := mergeSort(right); mergeSort := merge(left, right); end; end;
var
data: TIntArray; i: integer;
begin
setlength(data, 8); Randomize; writeln('The data before sorting:'); for i := low(data) to high(data) do begin data[i] := Random(high(data)); write(data[i]:4); end; writeln; data := mergeSort(data); writeln('The data after sorting:'); for i := low(data) to high(data) do begin write(data[i]:4); end; writeln;
end.</lang>
- Output:
./MergeSort The data before sorting: 6 1 2 1 5 2 1 5 The data after sorting: 1 1 1 2 2 5 5 6
PL/I
<lang pli>MERGE: PROCEDURE (A,LA,B,LB,C);
/* Merge A(1:LA) with B(1:LB), putting the result in C
B and C may share the same memory, but not with A.
- /
DECLARE (A(*),B(*),C(*)) BYADDR POINTER; DECLARE (LA,LB) BYVALUE NONASGN FIXED BIN(31); DECLARE (I,J,K) FIXED BIN(31); DECLARE (SX) CHAR(58) VAR BASED (PX); DECLARE (SY) CHAR(58) VAR BASED (PY); DECLARE (PX,PY) POINTER;
I=1; J=1; K=1; DO WHILE ((I <= LA) & (J <= LB)); PX=A(I); PY=B(J); IF(SX <= SY) THEN DO; C(K)=A(I); K=K+1; I=I+1; END; ELSE DO; C(K)=B(J); K=K+1; J=J+1; END; END; DO WHILE (I <= LA); C(K)=A(I); I=I+1; K=K+1; END; RETURN;
END MERGE;
MERGESORT: PROCEDURE (AP,N) RECURSIVE ;
/* Sort the array AP containing N pointers to strings */
DECLARE (AP(*)) BYADDR POINTER; DECLARE (N) BYVALUE NONASGN FIXED BINARY(31); DECLARE (M,I) FIXED BINARY; DECLARE AMP1(1) POINTER BASED(PAM); DECLARE (pX,pY,PAM) POINTER; DECLARE SX CHAR(58) VAR BASED(pX); DECLARE SY CHAR(58) VAR BASED(pY);
IF (N=1) THEN RETURN; M = trunc((N+1)/2); IF (M>1) THEN CALL MERGESORT(AP,M); PAM=ADDR(AP(M+1)); IF (N-M > 1) THEN CALL MERGESORT(AMP1,N-M); pX=AP(M); pY=AP(M+1); IF SX <= SY then return; /* Skip Merge */ DO I=1 to M; TP(I)=AP(I); END; CALL MERGE(TP,M,AMP1,N-M,AP); RETURN;
END MERGESORT;</lang>
Prolog
<lang prolog>% msort( L, S ) % True if S is a sorted copy of L, using merge sort msort( [], [] ). msort( [X], [X] ). msort( U, S ) :- split(U, L, R), msort(L, SL), msort(R, SR), merge(SL, SR, S).
% split( LIST, L, R ) % Alternate elements of LIST in L and R split( [], [], [] ). split( [X], [X], [] ). split( [L,R|T], [L|LT], [R|RT] ) :- split( T, LT, RT ).
% merge( LS, RS, M ) % Assuming LS and RS are sorted, True if M is the sorted merge of the two merge( [], RS, RS ). merge( LS, [], LS ). merge( [L|LS], [R|RS], [L|T] ) :- L =< R, merge( LS, [R|RS], T). merge( [L|LS], [R|RS], [R|T] ) :- L > R, merge( [L|LS], RS, T).</lang>
Perl
<lang perl>sub merge_sort {
my @x = @_; return @x if @x < 2; my $m = int @x / 2; my @a = merge_sort(@x[0 .. $m - 1]); my @b = merge_sort(@x[$m .. $#x]); for (@x) { $_ = !@a ? shift @b : !@b ? shift @a : $a[0] <= $b[0] ? shift @a : shift @b; } @x;
}
my @a = (4, 65, 2, -31, 0, 99, 83, 782, 1); @a = merge_sort @a; print "@a\n";</lang> Also note, the built-in function sort uses mergesort.
Perl 6
<lang perl6>sub merge_sort ( @a ) {
return @a if @a <= 1;
my $m = @a.elems div 2; my @l = merge_sort @a[ 0 ..^ $m ]; my @r = merge_sort @a[ $m ..^ @a ];
return @l, @r if @l[*-1] !after @r[0]; return gather { take @l[0] before @r[0] ?? @l.shift !! @r.shift while @l and @r; take @l, @r; }
} my @data = 6, 7, 2, 1, 8, 9, 5, 3, 4; say 'input = ' ~ @data; say 'output = ' ~ @data.&merge_sort;</lang>
- Output:
input = 6 7 2 1 8 9 5 3 4 output = 1 2 3 4 5 6 7 8 9
PHP
<lang php>function mergesort($arr){ if(count($arr) == 1 ) return $arr; $mid = count($arr) / 2;
$left = array_slice($arr, 0, $mid); $right = array_slice($arr, $mid);
$left = mergesort($left); $right = mergesort($right); return merge($left, $right); }
function merge($left, $right){ $res = array(); while (count($left) > 0 && count($right) > 0){ if($left[0] > $right[0]){ $res[] = $right[0]; $right = array_slice($right , 1); }else{ $res[] = $left[0]; $left = array_slice($left, 1); } } while (count($left) > 0){ $res[] = $left[0]; $left = array_slice($left, 1); } while (count($right) > 0){ $res[] = $right[0]; $right = array_slice($right, 1); } return $res; }
$arr = array( 1, 5, 2, 7, 3, 9, 4, 6, 8); $arr = mergesort($arr); echo implode(',',$arr);</lang>
- Output:
1,2,3,4,5,6,7,8,9
PicoLisp
PicoLisp's built-in sort routine uses merge sort. This is a high level implementation. <lang lisp>(de alt (List)
(if List (cons (car List) (alt (cddr List))) ()) )
(de merge (L1 L2)
(cond ((not L2) L1) ((< (car L1) (car L2)) (cons (car L1) (merge L2 (cdr L1)))) (T (cons (car L2) (merge L1 (cdr L2)))) ) )
(de mergesort (List)
(if (cdr List) (merge (mergesort (alt List)) (mergesort (alt (cdr List)))) List) )
(mergesort (8 1 5 3 9 0 2 7 6 4))</lang>
PowerShell
<lang PowerShell>Function Merge-Array( [Object[]] $lhs, [Object[]] $rhs ) { $result = @() $lhsl = $lhs.length $rhsl = $rhs.length if( $lhsl -gt 0 ) { if( $rhsl -gt 0 ) { $i = 0 for( $j = 0; ( $i -lt $lhsl ) -and ( $j -lt $rhsl ); ) { if( $lhs[ $i ] -le $rhs[ $j ] ) { $result += $lhs[ $i ] [void] ( $i++ ) } else { $result += $rhs[ $j ] [void] ( $j++ ) } } if( $i -lt $lhsl ) { $result += $lhs[ $i..( $lhsl - 1 ) ] } if( $j -lt $rhsl ) { $result += $rhs[ $j..( $rhsl - 1 ) ] } } else { for( $i = 0; $i -lt $lhsl; $i++ ) { if( $rhs -le $lhs[ $i ] ) { $result += $rhs break } $result += $lhs[ $i ] } if( $i -lt $lhsl ) { $result += $lhs[ $i..( $lhsl - 1 ) ] } } } else { if( $rhsl -gt 0 ) { for( $i = 0; $i -lt $rhsl; $i++ ) { if( $lhs -le $rhs[ $i ] ) { $result += $lhs break } $result += $rhs[ $i ] } if( $i -lt $rhsl ) { $result += $rhs[ $i..( $rhsl - 1 ) ] } } else { if( $lhs -lt $rhs ) { $result += $lhs $result += $rhs } else { $result += $rhs $result += $lhs } } } $result }
Function MergeSort( [Object[]] $data ) { $datal = $data.length - 1 if( $datal -gt 0 ) { $middle = [Math]::Floor( $datal / 2 ) $left = @() $left += MergeSort $data[ 0..$middle ] $right = @() $right += MergeSort $data[ ( $middle + 1 )..$datal ] if( $left[ -1 ] -le $right[ 0 ] ) { $result = @() $result += $left $result += $right $result } elseif( $right[ -1 ] -le $left[ 0 ] ) { $result = @() $result += $right $result += $left $result } else { Merge-Array $left $right } } else { $data } }
$l = 100; MergeSort ( 1..$l | ForEach-Object { $Rand = New-Object Random }{ $Rand.Next( 0, $l - 1 ) } )</lang>
PureBasic
A non-optimized version with lists. <lang PureBasic>Procedure display(List m())
ForEach m() Print(LSet(Str(m()), 3," ")) Next PrintN("")
EndProcedure
- overwrites list m() with the merger of lists ma() and mb()
Procedure merge(List m(), List ma(), List mb())
FirstElement(m()) Protected ma_elementExists = FirstElement(ma()) Protected mb_elementExists = FirstElement(mb()) Repeat If ma() <= mb() m() = ma(): NextElement(m()) ma_elementExists = NextElement(ma()) Else m() = mb(): NextElement(m()) mb_elementExists = NextElement(mb()) EndIf Until Not (ma_elementExists And mb_elementExists)
If ma_elementExists Repeat m() = ma(): NextElement(m()) Until Not NextElement(ma()) ElseIf mb_elementExists Repeat m() = mb(): NextElement(m()) Until Not NextElement(mb()) EndIf
EndProcedure
Procedure mergesort(List m())
Protected NewList ma() Protected NewList mb() If ListSize(m()) > 1 Protected current, middle = (ListSize(m()) / 2 ) - 1 FirstElement(m()) While current <= middle AddElement(ma()) ma() = m() NextElement(m()): current + 1 Wend PreviousElement(m()) While NextElement(m()) AddElement(mb()) mb() = m() Wend mergesort(ma()) mergesort(mb()) LastElement(ma()): FirstElement(mb()) If ma() <= mb() FirstElement(m()) FirstElement(ma()) Repeat m() = ma(): NextElement(m()) Until Not NextElement(ma()) Repeat m() = mb(): NextElement(m()) Until Not NextElement(mb()) Else merge(m(), ma(), mb()) EndIf EndIf
EndProcedure
If OpenConsole()
Define i NewList x() For i = 1 To 21: AddElement(x()): x() = Random(60): Next display(x()) mergesort(x()) display(x()) Print(#CRLF$ + #CRLF$ + "Press ENTER to exit") Input() CloseConsole()
EndIf</lang>
- Sample output:
22 51 31 59 58 45 11 2 16 56 38 42 2 10 23 41 42 25 45 28 42 2 2 10 11 16 22 23 25 28 31 38 41 42 42 42 45 45 51 56 58 59
Python
<lang python>from heapq import merge
def merge_sort(m):
if len(m) <= 1: return m
middle = len(m) / 2 left = m[:middle] right = m[middle:]
left = merge_sort(left) right = merge_sort(right) return list(merge(left, right))</lang>
Pre-2.6, merge() could be implemented like this: <lang python>def merge(left, right):
result = [] left_idx, right_idx = 0, 0 while left_idx < len(left) and right_idx < len(right): # change the direction of this comparison to change the direction of the sort if left[left_idx] <= right[right_idx]: result.append(left[left_idx]) left_idx += 1 else: result.append(right[right_idx]) right_idx += 1
if left: result.extend(left[left_idx:]) if right: result.extend(right[right_idx:]) return result</lang>
R
<lang r>mergesort <- function(m) {
merge_ <- function(left, right) { result <- c() while(length(left) > 0 && length(right) > 0) { if(left[1] <= right[1]) { result <- c(result, left[1]) left <- left[-1] } else { result <- c(result, right[1]) right <- right[-1] } } if(length(left) > 0) result <- c(result, left) if(length(right) > 0) result <- c(result, right) result } len <- length(m) if(len <= 1) m else { middle <- length(m) / 2 left <- m[1:floor(middle)] right <- m[floor(middle+1):len] left <- mergesort(left) right <- mergesort(right) if(left[length(left)] <= right[1]) { c(left, right) } else { merge_(left, right) } }
} mergesort(c(4, 65, 2, -31, 0, 99, 83, 782, 1)) # -31 0 1 2 4 65 83 99 782</lang>
REBOL
msort: function [a compare] [msort-do merge] [ if (length? a) < 2 [return a] ; define a recursive Msort-do function msort-do: function [a b l] [mid] [ either l < 4 [ if l = 3 [msort-do next b next a 2] merge a b 1 next b l - 1 ] [ mid: make integer! l / 2 msort-do b a mid msort-do skip b mid skip a mid l - mid merge a b mid skip b mid l - mid ] ] ; function Merge is the key part of the algorithm merge: func [a b lb c lc] [ until [ either (compare first b first c) [ change/only a first b b: next b a: next a zero? lb: lb - 1 ] [ change/only a first c c: next c a: next a zero? lc: lc - 1 ] ] loop lb [ change/only a first b b: next b a: next a ] loop lc [ change/only a first c c: next c a: next a ] ] msort-do a copy a length? a a ]
REXX
Note: the array elements can be anything, integers, floating point (exponentiated), characters ... <lang rexx>/*REXX program sorts a (stemmed) array using the merge-sort method. */ call gen@ /*generate the array elements. */ call show@ 'before sort' /*show the before array elements.*/ call mergeSort highItem /*invoke the merge sort for array*/ call show@ ' after sort' /*show the after array elements.*/ exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────GEN@ subroutine─────────────────────*/ gen@: @.= /*assign default value for @ stem*/ @.1='---The seven deadly sins---' /*everybody: pick your favorite.*/ @.2='===========================' @.3='pride' @.4='avarice' @.5='wrath' @.6='envy' @.7='gluttony' @.8='sloth' @.9='lust'
do highItem=1 while @.highItem\== /*find number of entries*/ end
highItem=highItem-1 /*adjust highItem by -1.*/ return /*──────────────────────────────────MERGETO@ subroutine─────────────────*/ mergeTo@: procedure expose @. !.; parse arg L,n; if n==1 then return if n==2 then do; h=L+1
if @.L>@.h then do; _=@.h; @.h=@.L; @.L=_; end return end
m=n%2 call mergeTo@ L+m,n-m call mergeTo! L,m,1 i=1; j=L+m; do k=L while k<j
if j==L+n | !.i<=@.j then do; @.k=!.i; i=i+1; end else do; @.k=@.j; j=j+1; end end /*k*/
return /*──────────────────────────────────MERGESORT subroutine────────────────*/ mergeSort: procedure expose @.; call mergeTo@ 1,arg(1) return /*──────────────────────────────────MERGETO! subroutine─────────────────*/ mergeTo!: procedure expose @. !.; parse arg L,n,_ if n==1 then do; !._=@.L; return; end if n==2 then do
h=L+1; q=1+_ if @.L>@.h then do; q=_; _=q+1; end !._=@.L; !.q=@.h return end
m=n%2 call mergeTo@ L,m call mergeTo! L+m,n-m,m+_ i=L; j=m+_
do k=_ while k<j if j==n+_ | @.i<=!.j then do; !.k=@.i; i=i+1; end else do; !.k=!.j; j=j+1; end end /*k*/
return /*──────────────────────────────────SHOW@ subroutine────────────────────*/ show@: widthH=length(highItem) /*maximum the width of any line. */
do j=1 for highItem say 'element' right(j,widthH) arg(1)':' @.j end /*j*/
say copies('─',60) /*show a seperator line (fence). */ return</lang> output
element 1 before sort: ---The seven deadly sins--- element 2 before sort: =========================== element 3 before sort: pride element 4 before sort: avarice element 5 before sort: wrath element 6 before sort: envy element 7 before sort: gluttony element 8 before sort: sloth element 9 before sort: lust ──────────────────────────────────────────────────────────── element 1 after sort: ---The seven deadly sins--- element 2 after sort: =========================== element 3 after sort: avarice element 4 after sort: envy element 5 after sort: gluttony element 6 after sort: lust element 7 after sort: pride element 8 after sort: sloth element 9 after sort: wrath ────────────────────────────────────────────────────────────
Ruby
<lang ruby>def merge_sort(m)
if m.length <= 1 return m end
middle = m.length / 2 left = m[0,middle] right = m[middle..-1]
left = merge_sort(left) right = merge_sort(right) merge(left, right)
end
def merge(left, right)
result = []
until left.empty? || right.empty? # change the direction of this comparison to change the direction of the sort if left.first <= right.first result << left.shift else result << right.shift end end
unless left.empty? result += left end unless right.empty? result += right end result
end</lang> Here's a version that monkey patches the Array class, with an example that demonstrates it's a stable sort <lang ruby>class Array
def mergesort(&comparitor) if length <= 1 self else unless comparitor comparitor = lambda {|a, b| a <=> b} end middle = length / 2 left = self[0, middle].mergesort(&comparitor) right = self[middle..-1].mergesort(&comparitor) merge(left, right, comparitor) end end protected def merge(left, right, comparitor) if left.empty? right elsif right.empty? left elsif comparitor.call(left.first, right.first) <= 0 [left.first] + merge(left[1..-1], right, comparitor) else [right.first] + merge(left, right[1..-1], comparitor) end end
end
ary = [7,6,5,9,8,4,3,1,2,0] ary.mergesort # => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] ary.mergesort {|a, b| b <=> a} # => [9, 8, 7, 6, 5, 4, 3, 2, 1, 0]
ary = [["UK", "London"], ["US", "New York"], ["US", "Birmingham"], ["UK", "Birmingham"]] ary.mergesort {|a, b| a[1] <=> b[1]}
- => [["US", "Birmingham"], ["UK", "Birmingham"], ["UK", "London"], ["US", "New York"]]</lang>
Scala
The use of Stream as the merge result avoids stack overflows without resorting to tail recursion, which would typically require reversing the result, as well as being a bit more convoluted.
<lang scala>def mergeSort(input: List[Int]) = {
def merge(left: List[Int], right: List[Int]): Stream[Int] = (left, right) match { case (x :: xs, y :: ys) if x <= y => x #:: merge(xs, right) case (x :: xs, y :: ys) => y #:: merge(left, ys) case _ => if (left.isEmpty) right.toStream else left.toStream } def sort(input: List[Int], length: Int): List[Int] = input match { case Nil | List(_) => input case _ => val middle = length / 2 val (left, right) = input splitAt middle merge(sort(left, middle), sort(right, middle + length % 2)).toList } sort(input, input.length)
}</lang>
Replace the first two lines of merge
by the following:
<lang scala> case (x :: xs, y :: ys) if x < y => Stream.cons(x, merge(xs, right))
case (x :: xs, y :: ys) => Stream.cons(y, merge(left, ys))</lang>
I suppose I should have written this version to begin with, but I think the 2.8 version is more clear.
Scheme
<lang scheme>(define (merge-sort l gt?)
(define (merge left right) (cond ((null? left) right) ((null? right) left) ((gt? (car left) (car right)) (cons (car right) (merge left (cdr right)))) (else (cons (car left) (merge (cdr left) right))))) (define (take l n) (if (zero? n) (list) (cons (car l) (take (cdr l) (- n 1))))) (let ((half (quotient (length l) 2))) (if (zero? half) l (merge (merge-sort (take l half) gt?) (merge-sort (list-tail l half) gt?)))))</lang>
(merge-sort '(1 3 5 7 9 8 6 4 2) >)
Seed7
<lang seed7>const proc: mergeSort2 (inout array elemType: arr, in integer: lo, in integer: hi, inout array elemType: scratch) is func
local var integer: mid is 0; var integer: k is 0; var integer: t_lo is 0; var integer: t_hi is 0; begin if lo < hi then mid := (lo + hi) div 2; mergeSort2(arr, lo, mid, scratch); mergeSort2(arr, succ(mid), hi, scratch); t_lo := lo; t_hi := succ(mid); for k range lo to hi do if t_lo <= mid and (t_hi > hi or arr[t_lo] <= arr[t_hi]) then scratch[k] := arr[t_lo]; incr(t_lo); else scratch[k] := arr[t_hi]; incr(t_hi); end if; end for; for k range lo to hi do arr[k] := scratch[k]; end for; end if; end func;
const proc: mergeSort2 (inout array elemType: arr) is func
local var array elemType: scratch is 0 times elemType.value; begin scratch := length(arr) times elemType.value; mergeSort2(arr, 1, length(arr), scratch); end func;</lang>
Original source: [2]
Standard ML
<lang sml>fun merge cmp ([], ys) = ys
| merge cmp (xs, []) = xs | merge cmp (xs as x::xs', ys as y::ys') = case cmp (x, y) of GREATER => y :: merge cmp (xs, ys') | _ => x :: merge cmp (xs', ys)
fun merge_sort cmp [] = []
| merge_sort cmp [x] = [x] | merge_sort cmp xs = let val ys = List.take (xs, length xs div 2) val zs = List.drop (xs, length xs div 2) in merge cmp (merge_sort cmp ys, merge_sort cmp zs) end
merge_sort Int.compare [8,6,4,2,1,3,5,7,9]</lang>
Tcl
<lang tcl>package require Tcl 8.5
proc mergesort m {
set len [llength $m] if {$len <= 1} { return $m } set middle [expr {$len / 2}] set left [lrange $m 0 [expr {$middle - 1}]] set right [lrange $m $middle end] return [merge [mergesort $left] [mergesort $right]]
}
proc merge {left right} {
set result [list] while {[set lleft [llength $left]] > 0 && [set lright [llength $right]] > 0} { if {[lindex $left 0] <= [lindex $right 0]} { set left [lassign $left value] } else { set right [lassign $right value] } lappend result $value } if {$lleft > 0} { lappend result {*}$left } if {$lright > 0} { set result [concat $result $right] ;# another way append elements } return $result
}
puts [mergesort {8 6 4 2 1 3 5 7 9}] ;# => 1 2 3 4 5 6 7 8 9</lang> Also note that Tcl's built-in lsort command uses the mergesort algorithm.
UnixPipes
<lang bash>split() {
(while read a b ; do echo $a > $1 ; echo $b > $2 done)
}
mergesort() {
xargs -n 2 | (read a b; test -n "$b" && ( lc="1.$1" ; gc="2.$1" (echo $a $b;cat)|split >(mergesort $lc >$lc) >( mergesort $gc >$gc) sort -m $lc $gc rm -f $lc $gc; ) || echo $a)
}
cat to.sort | mergesort</lang>
Ursala
<lang Ursala>#import std
mergesort "p" = @iNCS :-0 ~&B^?a\~&YaO "p"?abh/~&alh2faltPrXPRC ~&arh2falrtPXPRC
- show+
example = mergesort(lleq) <'zoh','zpb','hhh','egi','bff','cii','yid'></lang>
- Output:
bff cii egi hhh yid zoh zpb
The mergesort function could also have been defined using the built in sorting operator, -<, because the same algorithm is used. <lang Ursala>mergesort "p" = "p"-<</lang>
V
merge uses the helper mergei to merge two lists. The mergei takes a stack of the form [mergedlist] [list1] [list2] it then extracts one element from list2, splits the list1 with it, joins the older merged list, first part of list1 and the element that was used for splitting (taken from list2) into the new merged list. the new list1 is the second part of the split on older list1. new list2 is the list remaining after the element e2 was extracted from it. <lang v>[merge
[mergei uncons [swap [>] split] dip [[*m] e2 [*a1] b1 a2 : [*m *a1 e2] b1 a2] view]. [a b : [] a b] view [size zero?] [pop concat] [mergei] tailrec].
[msort
[splitat [arr a : [arr a take arr a drop]] view i]. [splitarr dup size 2 / >int splitat].
[small?] [] [splitarr] [merge] binrec].</lang>
[8 7 6 5 4 2 1 3 9] msort puts
- Programming Tasks
- Sorting Algorithms
- Recursion
- ACL2
- ActionScript
- Ada
- ALGOL 68
- AutoHotkey
- BBC BASIC
- C
- C++
- C sharp
- Clojure
- COBOL
- CoffeeScript
- Common Lisp
- Curry
- D
- Dart
- E
- Erlang
- Euphoria
- F Sharp
- Factor
- Forth
- Fortran
- Go
- Groovy
- Haskell
- Io
- Icon
- Unicon
- J
- Java
- JavaScript
- Liberty BASIC
- Logo
- Logtalk
- Lucid
- Mathematica
- MATLAB
- Maxima
- OCaml
- Oz
- NetRexx
- PARI/GP
- Pascal
- PL/I
- Prolog
- Perl
- Perl 6
- PHP
- PicoLisp
- PowerShell
- PureBasic
- Python
- R
- REBOL
- REXX
- Ruby
- Scala
- Scheme
- Seed7
- Standard ML
- Tcl
- UnixPipes
- Ursala
- V
- GUISS/Omit