//		R o u t i n g   A l g o r i t h m s

//	Part 1 - Combinatorics and auxiliary functions

//	E. McCreight
//	last edited November 16, 1978  10:40 PM  by emm

external
	[ 
	MoveBlock		// Defined by OS
	Zero
	CallSwat
	DefaultArgs

	HeuristicNet	// Defined by other modules
	bestTotalNetLength
	Route		// Locally defined
	InitRandom
	Random
	GetOrderedRandomSet
	ArcLength
	ManhattanDistFn
	EuclideanDistFn

	n
	exhaustThresh
	Perm
	forceFirstNodeToEnd
	]


manifest
[
	memoTableEntries = 229	// prime
	empty = 0
	infinity = #77777
]

static
	[ n
	Perm
	X
	Y
	clusterBaseVec
	forceFirstNodeToEnd

	randomTable
	randomIndex
	randomTrailer

	exhaustThresh = 7

	TrialPerm
	bestTotalNetLength

	randomInitialized = false

	DistFn
	memoTable
	]


structure MEMO:
	[ key word
	value word
	]


let Route(nNodes, localX, localY, ResultPerm, fFNTE, distanceMetricFn, cbv;
		numargs na) be

	[ DefaultArgs(lv na, -4, false, ManhattanDistFn, empty)

	unless randomInitialized do InitRandom()

	n = nNodes
	X = localX
	Y = localY
	clusterBaseVec = cbv
	DistFn = distanceMetricFn

	Perm = ResultPerm
	forceFirstNodeToEnd = fFNTE

	let mt = vec memoTableEntries*(size MEMO/16)
	memoTable = mt
	Zero(memoTable, memoTableEntries*(size MEMO/16))

	test nNodes le exhaustThresh % clusterBaseVec ne empty

	ifso
	[
		bestTotalNetLength = infinity
		let tP = vec 200
		TrialPerm = tP

		for i=1 to nNodes do TrialPerm!i = i

		let clusterBase, clusterTop, clusterNumber = 1,nNodes,1
		if clusterBaseVec ne empty then
		[
			clusterNumber = clusterBaseVec!0
			clusterBase = clusterBaseVec!clusterNumber
		]

		for i=clusterBase to clusterTop do
		[
			TrialPerm!i = clusterTop
			TrialPerm!clusterTop = i

			TryAllPermsRecursively(0, clusterNumber, clusterBase, clusterTop-1)

			if fFNTE & (clusterBaseVec eq empty) then break // first node in last place

			TrialPerm!i = i
		]
	]

	ifnot HeuristicNet()

	if fFNTE & cbv eq empty & ResultPerm!nNodes ne 1 do
		CallSwat("Wrong node at end")
	]




//	Inter-node distance calculating functions.

and ArcLength(i, j) = valof

	[ if i eq j then resultis 0

	if i gr j then
		[ let t = i; i = j; j = t ]	// exchange i and j

	let memoKey = (i lshift 8)+j
	let memo = memoTable+
			((memoKey rem memoTableEntries) lshift 1)

	if memo>>MEMO.key eq memoKey then
		resultis memo>>MEMO.value

	memo>>MEMO.key = memoKey

	let value = DistFn(X!i, Y!i, X!j, Y!j)
	memo>>MEMO.value = value
	resultis value
	]


//	1. The combinatorial algorithm results in a true
//	optimum but is prohibitively expensive for large nets.
//	The idea is that there are two vectors X and Y holding the
//	X and Y co-ordinates of a set of nodes (1...n), and a vector
//	TrialPerm (1...n) containing a permutation of the integers 1...n.
//	These integers are arranged in "clusters", which intra-permute but
//	cannot inter-permute.

//	The outer program sets bestTotalNetLength to infinity
//	and then calls TryAllPerms(0, ...) with each node in the final
//	cluster in last place in TrialPerm.


and TryAllPermsRecursively(netLengthSoFar, clusterNumber,
	clusterBase, clusterTop) be

	[ if netLengthSoFar ge bestTotalNetLength then return

	while clusterTop ls clusterBase do
	[
		clusterNumber = clusterNumber-1
		if clusterNumber eq 0 then [ RecordBetterNet(netLengthSoFar); return ]
		clusterTop = clusterBase-1
		clusterBase = clusterBaseVec!clusterNumber
	]

	TryAllPermsRecursively(netLengthSoFar+
			ArcLength(TrialPerm!(clusterTop+1), TrialPerm!clusterTop),
			clusterNumber, clusterBase, clusterTop-1)

	let ct = TrialPerm!clusterTop

	for i=clusterTop-1 to clusterBase by -1 do
		[ 
		TrialPerm!clusterTop = TrialPerm!i
		TrialPerm!i = ct

		TryAllPermsRecursively(netLengthSoFar+
			ArcLength(TrialPerm!(clusterTop+1), TrialPerm!clusterTop),
			clusterNumber, clusterBase, clusterTop-1)

		TrialPerm!i = TrialPerm!clusterTop
		]

	TrialPerm!clusterTop = ct
	]


and RecordBetterNet(length) be

	[ bestTotalNetLength = length
	MoveBlock(lv (Perm!1), lv (TrialPerm!1), n)
	]



//	This random number generator derives from the answer to
//	exercise 3.2.2-11 in the first edition of the second volume
//	of Knuth's "Art of Computer Programming." From Appendix C
//	in Peterson & Weldon's "Error-Correcting Codes" we learn
//	that x^33+x^13+1 is a primitive polynomial over GF(2). Thus
//	the sequence X(n) = (X(n-33)+X(n-13)) mod 2^16 has a period
//	length greater than 2^33 if the first 33 elements are not all
//	even.

and InitRandom() be

	[ manifest
		[ degree = 33
		midPower = 13
		]

	let foo = table [ 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0; ]
	randomTable = foo
	randomTable!0 = #101011
	randomIndex = 0
	randomTrailer = degree-midPower

	for i=1 to 2000 do Random(1)
	randomInitialized = true
	]


and Random(max) = valof

	[ manifest
		[ degree = 33
		midPower = 13
		]

	let result = randomTable!randomIndex+
			randomTable!randomTrailer
	randomTable!randomIndex = result

	test randomIndex eq degree-1

	ifso	[ randomIndex = 0
		randomTrailer = degree-midPower
		]

	ifnot	[ randomIndex = randomIndex+1
		test randomTrailer eq degree-1
		ifso	randomTrailer = 0
		ifnot	randomTrailer = randomTrailer+1
		]

	resultis (result & #77777) rem (max+1)
			// This "rem" introduces a slight non-
			//	randomness.
	]


and GetOrderedRandomSet(n, vector, lowerLimit, upperLimit) be

	[ for i=1 to n do
		[ let newValue = Random(upperLimit+1-
				lowerLimit-i)+lowerLimit
		for j=1 to i-1 do
			test vector!j le newValue
			ifso newValue = newValue+1
			ifnot	[ let t = newValue
				newValue = vector!j
				vector!j = t
				]

		vector!i = newValue
		]
	]
(635)\f1