*title snobol test program #5 -- demonstration	version	of treesort4
-stitl driver
	define('treesort4(data,numbertosort)')
	define('printer(quqquq)')
	data =	array(24)
	input(.input,,72)
reader	j = j + 1
	data<j> = trim(input)				:s(reader)
	output	= 'unsorted data'
	output	=
	printer()
	treesort4(data,24)
	output	=
	output	= 'sorted data'
	output	=
	printer()					:(end)
*
printer	j = 0
printl	j = j + 1
	output	= data<j>			:s(printl)f(return)
-eject
*
*	      treesort4
*	      ---------
*
*	      sorting algorithm	derived	from floyd's treesort3 published
*	      in cacm dec. 1967	-- the modifications devised by	r. dewar
*	      and l.fisher reduce the number of	compares from 2nlogn
*	      to nlogn -- this version coded in	snobol4	by r. dewar
*
treesort4
.	      numberintree = numbertosort
	      nodetosift = numbertosort	/ 2
	      returnfromsift = .siftreturn1
siftcall1
.	      holdlocation = data<nodetosift>		:(siftnode)
siftreturn1
.	      nodetosift = gt(nodetosift,1)
.			       nodetosift - 1		:s(siftcall1)
secondphase
.	      returnfromsift = .siftreturn2
siftreturn2
.	      holdlocation = data<numberintree>
	      data<numberintree> = data<1>
	      numberintree = gt(numberintree,1)
.				numberintree - 1
.						 :s(siftnode)f(return)
-eject
siftnode
.	      father = nodetosift
pulluplargerson
.	      leftson =	father * 2
	      lt(leftson,numberintree)	      :s(comparesons)
	      eq(leftson,numberintree)	      :s(leftsonhigh)
						 :(checkfathers)
comparesons
.	      rightson = leftson + 1
	      lgt(data<leftson>,data<rightson>)
.						 :s(leftsonhigh)
rightsonhigh
.	      data<father> = data<rightson>
	      father = rightson			:(pulluplargerson)
leftsonhigh
.	      data<father> = data<leftson>
	      father = leftson			:(pulluplargerson)
checkfathers
.	      holeintree = father
testnextfather
.	      fatherofhole = holeintree	/ 2
	      lt(fatherofhole,nodetosift)    :s(fillhole)
	      lgt(data<fatherofhole>,holdlocation)
.						 :s(fillhole)
	      data<holeintree> = data<fatherofhole>
	      holeintree = fatherofhole	     :(testnextfather)
fillhole
.	      data<holeintree> = holdlocation
.						 :($returnfromsift)
end
shall
i
compare
thee
to
a
summers
day
thou
art
more
lovely
and
more
temporate
rough
winds
do
shake
the
darling
buds
of
may