# "More Programming Pearls - Confessions of a Coder" by Jon Bentley
# Addison-Wesley, 1988. ISBN 0-201-11889-0, pp. 176-182.
# Appendix 2 - "A Subroutine Library"
#
# Transcribed manually by Arnold Robbins (skeeve!arnold). Therefore this
# should be redistributable...

# UTILITY ROUTINES AND SET ALGORITHMS


function swap(i, j,	t) {	# x[i] :=: x[j]
	t = x[i]; x[i] = x[j]; x[j] = t
}


function randint(l, u) {	# rand int in l..u
	return l + int((u-l+1)*rand())
}


function select(k,	l, u, i , t, m) {
		# post: x[1..k-1] <= x[k] <= x[k+1..n]
		# bugs: n**2 time if x[1]=...=x[n]
	l = 1; u = n
	while (l < u) {
		# x[1..l-1] <= x[l..u] <= x[u+1..n]
		swap(l, randint(l, u))
		t = x[l]
		m = l
		for (i = l+1; i <= u; i++) {
			# x[l+1..m] < t and x[m+1..i-1] >= t
			if (x[i] < t) swap(i, ++m)
		}
		swap(l, m)
		# x[l..m-1] <= x[m] <= x[m+1..u]
		if (m <= k) l = m+1
		if (m >= k) u = m-1
	}
}


function qsort(l, u,	i, t, m) {
		# post: sorted(l,u)
		# bugs: n**2 time if x[1]=...=x[n]
	if (l < u) {
		swap(l, randint(l, u))
		t = x[l]
		m = l
		for (i = l+1; i <= u; i++) {
			# x[l+1..m] < t and x[m+1..i-1] >= t
			if (x[i] < t) swap(i, ++m)
		}
		swap(l, m)
		# x[l..m-1] <= x[m] <= x[m+1..u]
		qsort(l, m-1)
		qsort(m+1, u)
	}
}


function isort(		i, j) {
		# post: sorted(1,n)
	for (i = 2; i <= n; i++) {
		# sorted(1, i-1)
		j = i
		while (j > 1 && x[j-1] > x[j]) {
			swap(j-1, j)
			j--
		}
	}
}

function siftup(l, u,	i, p) {
		# pre  maxheap(l,u-1)
		# post maxheap(l,u)
	i = u
	while (1) {
		# maxheap(l,u) except between
		#  i and its parent
		if (i <= l) break
		p = int(i/2)
		if (x[p] >= x[i]) break
		swap(p, i)
		i = p
	}
}


function siftdown(l, u,		i, c) {
		# pre  maxheap(l+1,u)
		# post maxheap(l,u)
	i = l
	while (1) {
		# maxheap(l,u) except between
		#  i and its parents
		c = 2*i
		if (c > u) break
		if (c+1 <= u && x[c+1] > x[c]) c++
		if (x[i] >= x[c]) break
		swap(c, i)
		i = c
	}
}


function hsort(		i) {
		# post sorted(1,n)
	for (i = int(n/2); i >= 1; i--)
		siftdown(i, n)
	for (i = n; i >= 2; i--) {
		swap(1, i); siftdown(1, i-1)
	}
}

function pqinit(i) {
	pqmax = i
	n = 0
}


function pqinsert(t) {
		# post t is added to set
	assert(n < pqmax)
	x[++n] = t
	siftup(1, n)
}

function pqextractmax(	t) {
		# pre  set isn't empty
		# post max is deleted and returned
	assert(n >= 1)
	t = x[1]; x[1] = x[n--]
	siftdown(1, n)
	return t
}


function ssearch(t,	i) {
		# post result=0     => x[1..n]  != t
		#      1<=result<=n => x[result] = t
	i = 1
	while (i <= n && x[i] != t) i++
	if (i <= n) return i; else return 0
}


function bsearch(t,	l, u, m) {
		# pre  x[1] <= x[2] <= ... <= x[n]
		# post result=0     => x[1..n]  != t
		#      1<=result<=n => x[result] = t
	l = 1; u = n
	while (l <= u) {
		# t is in x[1..n] => t is in x[l..u]
		m = int((l+u)/2)
		if	(x[m] < t) l = m+1
		else if (x[m] > t) u = m-1
		else return m
	}
	return 0
}


# TESTING ROUTINES


function genequal(	i) {	# fill x
	for (i = 1; i <= n; i++) x[i] = 1
}


function geninorder(	i) {	# fill x
	for (i = 1; i <= n; i++) x[i] = i
}


function scramble(	i) {	# shuffle x
	for (i = 1; i <= n; i++)
		swap(i, randint(i, n))
}


function assert(cond) {
	if (! cond) {
		errcnt++
		print "   >> assert failed <<"
	}
}


function checkselect(k,		i) {
	for (i = 1;    i < k; i++) {
		assert(x[i] <= x[k])
	}
	for (i = k+1; i <= n; i++) {
		assert(x[i] >= x[k])
	}
}


function checksort(	i) {
	for (i = 1; i < n; i++)
		assert(x[i] <= x[i+1])
}


function clearsubs(	i) {	# clear array x
	for (i in x) delete x[i]
}


function checksubs(	i, c) { # alters x
		# error if subscripts not in 1..n
	for (i = 1; i <= n; i++) delete x[i]
	for (i in x) c++
	assert(c == 0)
}

function sort() {	# call proper sort
	if	(sortname == "qsort") qsort(1, n)
	else if (sortname == "hsort") hsort()
	else if (sortname == "isort") isort()
	else print "invalid sort name"
}


function testsort(name,		i, nfac) {
	sortname = name
	print "  pathological tests"
	for (n = 0; n <= bign; n++) {
		print "   n=", n
		clearsubs()
		geninorder(); sort(); checksort()
		for (i = 1; i <= n/2; i++) swap(i, n+1-i)
		sort(); checksort();
		genequal(); sort(); checksort();
		checksubs()
	}
	print "  random tests"
	nfac = 1
	for (n = 1; n <= smalln; n++) {
		print "   n=", n
		nfac = nfac*n
		clearsubs()
		geninorder();
		for (i = 1; i <= nfac; i++) {
			scramble(); sort(); checksort()
		}
		checksubs()
	}
}


function search(t) {	# call proper search
	if	(searchname == "bsearch")
		return bsearch(t)
	else if	(searchname == "ssearch")
		return ssearch(t)
	else print "invalid search name"
}


function testsearch(name,	i) {
	searchname = name
	for (n = 0; n <= bign; n++) {
		print "   n=", n
		clearsubs()
		geninorder()
		for (i = 1; i <= n; i++) {
			assert(search(i)    == i)
			assert(search(i-.5) == 0)
			assert(search(i+.5) == 0)
		}
		genequal()
		assert(search(0.5) == 0)
		if (n > 0) assert(search(1) >= 1)
		assert(search(1) <= n)
		assert(search(1.5) == 0)
		checksubs()
	}
}



BEGIN {	# MAIN PROGRAM
bign = 12
smalln = 5
print "testing assert -- should fail" > "/dev/stderr"
print "testing assert -- should fail"
	assert(1 == 0)

print "testing select" > "/dev/stderr"
print "testing select"
	for (n = 0; n <= bign; n++) {
		print "   n=", n
		clearsubs()
		for (i = 1; i <= n; i++) {
			geninorder()
			select(i)
			checkselect(i)
		}
		for (i = 1; i <= n; i++) {
			scramble()
			select(i)
			checkselect(i)
		}
		genequal()
		for (i = 1; i <= n; i++) {
			select(i)
			checkselect(i)
		}
		checksubs()
	}

print "testing quick sort" > "/dev/stderr"
print "testing quick sort"
	testsort("qsort")
print "testing insertion sort" > "/dev/stderr"
print "testing insertion sort"
	testsort("isort")
print "testing heap sort" > "/dev/stderr"
print "testing heap sort"
	testsort("hsort")


print "testing priority queues" > "/dev/stderr"
print "testing priority queues"
	for (m = 0; m <= bign; m++) {
		# m is max heap size
		print "   m=", m
		clearsubs()
		pqinit(m)
		for (i = 1; i <= m; i++)
			pqinsert(i)
		for (i = m; i >= 1; i--)
			assert(pqextractmax() == i)
		assert(n == 0)
		pqinit(m)
		for (i = m; i >= 1; i--)
			pqinsert(i)
		for (i = m; i >= 1; i--)
			assert(pqextractmax() == i)
		assert(n == 0)
		pqinit(m)
		for (i = 1; i <= m; i++)
			pqinsert(1)
		for (i = m; i >= 1; i--)
			assert(pqextractmax() == 1)
		assert(n == 0)
		n = m; checksubs()
	}


print "testing sequential search" > "/dev/stderr"
print "testing sequential search"
	testsearch("ssearch")
print "testing binary search" > "/dev/stderr"
print "testing binary search"
	testsearch("bsearch")
print "total errors (1 expected):", errcnt
if (errcnt > 1) print ">>>> TEST FAILED <<<<"
}