A ternary, iterative merge sort

It’s also in-place, but that’s a given with my sorts. :slight_smile:

I posted a “conventional” (binary, recursive) merge sort here a few years ago.

But in fact there’s no reason why a merge sort has to be recursive. The algorithm’s perfectly amenable to iterative treatment. Instead of using binary recursion to divide and subdivide the sort range into variously-sized half-ranges and merging the contents of these later as the individual recursion branches return, you simply iterate through the range a few times, doubling the step size on each pass and merging the intervening blocks as you go.

Two significant characteristics of this approach are:
¢ The overheads associated with recursive handler calls don’t occur.
¢ All merges of a particular size occur in the same pass instead of at different times. And in fact all merges are of particular sizes except at the end of the range and have particular offsets from the beginning of the range. This means that things happen in the right order and in the right proportions to allow merging back and forth using just two lists. The number of throw-away auxiliary lists can thus be reduced from one per recursion step (as in my recursive merge sort ” although it was three in another implementation I saw) to just one per sort. This is far more satisfying. :slight_smile:

A ternary merge sort merges three sub-ranges at a time instead of two. This involves slightly more work during the comparisons, but the merge sizes go up in powers of three rather than powers of two, so fewer sweeps of the range are needed to complete the sort.

The handler here contains quite a lot of code, but that’s mainly because of the different actions taken in response to the comparisons and because it has four different “gears” which are optimised for different stages of the sort. It’s possibly not quite as fast as an ASObjC or OSAX sort ” which is one of the reasons I’ve not got round to posting it before now. But it’s certainly no slouch and outperforms even my Quicksort implementations in some situations. And being an in-place, vanilla sort, the sorted list at the end of the process is the original list and the items in it the original items, which somehow seems more in keeping with the spirit of a stable sort. :wink:

(* Iterative merge sort ” ternary version
Merge sort algorithm: John von Neumann, 1945.
AppleScript implementation: Nigel Garvey, 2007. Ternary iterative version 2012.

Parameters: (list, range index 1, range index 2)
*)

on ternaryIterativeMergeSort(theList, l, r) -- Sort items l thru r of theList.
	script o -- Script object for the main list and its sort range indices.
		property l : missing value
		property r : missing value
		property lst : theList
	end script
	script aux -- Separate script object for an auxiliary list and its start and end indices.
		property l : missing value
		property r : missing value
		property lst : missing value
	end script
	
	-- Process the input parameters.
	set listLen to (count theList)
	if (listLen < 2) then return
	
	-- Negative and/or transposed range indices.
	if (l < 0) then set l to listLen + l + 1
	if (r < 0) then set r to listLen + r + 1
	if (l > r) then set {l, r} to {r, l}
	
	-- Do the sort.
	-- The first pass simply sorts trios of items in place.
	repeat with mergeL from l to (r - 2) by 3
		set mergeM to mergeL + 1
		set mergeR to mergeM + 1
		set lv to item mergeL of o's lst
		set mv to item mergeM of o's lst
		set rv to item mergeR of o's lst
		if (rv < lv) then
			if (rv < mv) then
				if (mv < lv) then -- (rv < mv < lv)
					set item mergeL of o's lst to rv
					set item mergeR of o's lst to lv
				else -- (rv < lv <= mv)
					set item mergeL of o's lst to rv
					set item mergeM of o's lst to lv
					set item mergeR of o's lst to mv
				end if
			else -- (mv <= rv < lv)
				set item mergeL of o's lst to mv
				set item mergeM of o's lst to rv
				set item mergeR of o's lst to lv
			end if
		else if (mv < lv) then -- (mv < lv <= rv)
			set item mergeL of o's lst to mv
			set item mergeM of o's lst to lv
		else if (rv < mv) then -- (lv <= rv < mv) 
			set item mergeM of o's lst to rv
			set item mergeR of o's lst to mv
		end if
	end repeat
	-- If there are two items left over at the end of the range, sort them too.
	if (r - mergeR is 2) then
		set mergeL to r - 1
		set lv to item mergeL of o's lst
		set rv to item r of o's lst
		if (rv < lv) then
			set item mergeL of o's lst to rv
			set item r of o's lst to lv
		end if
	end if
	
	set rangeLen to r - l + 1
	if (rangeLen < 4) then return -- Sort complete if three items or fewer in the range.
	
	-- Set the range indices in the script objects and create an auxiliary list from the partly sorted sort range. The items will be merged back and forth between the two lists on alternate passes.
	set o's l to l
	set o's r to r
	
	set aux's l to 1
	set aux's r to rangeLen
	set aux's lst to o's lst's items l thru r
	
	-- Work out how many more passes are needed and set the initial merge direction so that the last pass will merge back to the original list.
	set passesStillToDo to 0
	set trioLen to 3
	repeat while (trioLen < rangeLen)
		set passesStillToDo to passesStillToDo + 1
		set trioLen to trioLen * 3
	end repeat
	set {srce, dest} to item (passesStillToDo mod 2 + 1) of {{o, aux}, {aux, o}}
	
	-- Do the remaining passes, each merging trios of merged trios from the pass before. The last "trio" in the range will usually be truncated by the range boundary.
	set trioLen to 3
	repeat passesStillToDo times
		set previousTrioLen to trioLen
		set trioLen to previousTrioLen * 3
		
		-- Traverse the source range a "trio" section at a time, merging the already sorted thirds of each into the equivalent section of the destination list.
		set dx to (dest's l) - 1 -- Destination tracking index.
		repeat with leftL from srce's l to srce's r by trioLen
			set mergeR to dx + trioLen -- Destination section end index.
			if (mergeR > dest's r) then set mergeR to dest's r
			
			set lx to leftL -- Left third tracking index.
			set leftR to leftL + previousTrioLen - 1 -- Left third end index.
			if (leftR < srce's r) then
				-- Two or three "thirds" in this trio.
				set middleR to leftR + previousTrioLen -- Middle third end index.
				if (middleR < srce's r) then
					-- Three thirds, in fact. Merge them by repeatedly comparing the lowest remaining value from each and assigning the lowest of the three (or the leftmost co-lowest) to the next slot in the destination list.
					set mx to lx + previousTrioLen -- Middle third tracking index.
					set rx to mx + previousTrioLen -- Right third tracking index.
					set rightR to middleR + previousTrioLen -- Right third end index.
					if (rightR > srce's r) then set rightR to srce's r
					
					set lv to item lx of srce's lst -- First (lowest) value from left third.
					set mv to item mx of srce's lst -- Ditto middle third.
					set rv to item rx of srce's lst -- Ditto right third.
					repeat with dx from dx + 1 to mergeR
						if (rv < lv) then
							if (rv < mv) then
								-- The right value's the lowest. Assign it to the destination slot.
								set item dx of dest's lst to rv
								-- If no more right-third values, recast the middle third as the right and exit to the "two thirds" repeat below.
								if (rx is rightR) then
									set rx to mx
									set rv to mv
									set rightR to middleR
									exit repeat
								end if
								-- Otherwise get the next right-third value.
								set rx to rx + 1
								set rv to item rx of srce's lst
							else
								-- The middle value's the lowest or co-lowest with the right.
								set item dx of dest's lst to mv
								-- If no more middle-third values, exit to the "two thirds" repeat.
								if (mx is middleR) then exit repeat
								-- Otherwise get the next middle-third value.
								set mx to mx + 1
								set mv to item mx of srce's lst
							end if
						else if (mv < lv) then
							-- The middle value's the lowest. (This is on a different logic branch from the identical code immediately above!)
							set item dx of dest's lst to mv
							-- If no more middle-third values, exit to the "two thirds" repeat.
							if (mx is middleR) then exit repeat
							-- Otherwise get the next middle-third value.
							set mx to mx + 1
							set mv to item mx of srce's lst
						else
							-- The left value's the lowest or co-lowest.
							set item dx of dest's lst to lv
							-- If no more left-third values, recast the middle third as the left and exit to the "two thirds" repeat.
							if (lx is leftR) then
								set lx to mx
								set lv to mv
								set leftR to middleR
								exit repeat
							end if
							-- Otherwise get the next left-third value
							set lx to lx + 1
							set lv to item lx of srce's lst
						end if
					end repeat
				else
					-- Only two "thirds" in this trio. Set up to merge them as for three thirds, but with only left and right participants.
					set rx to lx + previousTrioLen
					set rightR to leftR + previousTrioLen
					if (rightR > srce's r) then set rightR to srce's r
					
					set lv to item lx of srce's lst
					set rv to item rx of srce's lst
				end if
				
				-- Merge the (remaining) two "thirds" to the destination list.
				repeat with dx from dx + 1 to mergeR
					if (rv < lv) then
						-- The right value's less than the left. Assign it to the destination slot.
						set item dx of dest's lst to rv
						-- If no more right values, exit to the "one third" repeat below.
						if (rx is rightR) then exit repeat
						-- Otherwise get the next right-third value.
						set rx to rx + 1
						set rv to item rx of srce's lst
					else
						-- The left value's less than or equal to the right.
						set item dx of dest's lst to lv
						-- If no more left-third values, recast the right third as the left and exit to the "one third" repeat.
						if (lx is leftR) then
							set lx to rx
							exit repeat
						end if
						-- Otherwise get the next left-third value.
						set lx to lx + 1
						set lv to item lx of srce's lst
					end if
				end repeat
			end if
			
			-- Copy over the (remaining) one "third" as is.
			repeat with dx from (dx + 1) to mergeR
				set item dx of dest's lst to item lx of srce's lst
				set lx to lx + 1
			end repeat
		end repeat
		
		-- Swap the source and destination roles for the next pass.
		tell srce
			set srce to dest
			set dest to it
		end tell
	end repeat
	
	return -- nothing
end ternaryIterativeMergeSort

property sort : ternaryIterativeMergeSort

-- (* Demo:
set l to {}
repeat 1000 times
	set end of my l to (random number 1000)
end repeat

sort(l, 1, -1)
l
-- *)

Hello.

I’ts sort of impressive. :cool:

I look forward to study how you removed the recursion. And, to learn a new sorting algorithm. :slight_smile: