//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
ifsorandomTrailer = 0
ifnotrandomTrailer = 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
]
]