//routeHeuristic.bcpl

// Heuristic wire router

//last edited by McCreight, July 2, 1981 3:38 PM

get "route.defs"

static
[
arcLens
totalCircuitLength
longestArcLen
longestArc
heuristicImprovements
improvementBreak = -1
heuristicWork = 20
]

//This heuristic algorithm does not guarantee an
//optimum but is much more economical than the
//combinatorial one for large nets.

let HeuristicImprove() be

[ let OrigFirstNode = Perm!1

let aL = Allocate(swapZone, n+2)
arcLens = aL

let tempArcLen = nil
totalCircuitLength = 0

let triesSinceImprovement = 0
let criterion = heuristicWork*n
longestArcLen = -1

for i=1 to n do
[ tempArcLen = ArcLength(Perm!i, Perm!((i rem n)+1))
totalCircuitLength = totalCircuitLength+tempArcLen
arcLens!i = tempArcLen
if tempArcLen gr longestArcLen then
[ longestArc = Perm!i
longestArcLen = tempArcLen
]
]

if forceFirstNodeToEnd then
test arcLens!n gr arcLens!1
ifso[ longestArc = Perm!n
longestArcLen = arcLens!n
]
ifnot[ longestArc = Perm!1
longestArcLen = arcLens!1
]

bestTotalNetLength = totalCircuitLength-longestArcLen
heuristicImprovements = 0

while triesSinceImprovement ls criterion do
[ triesSinceImprovement = triesSinceImprovement+1

if forceFirstNodeToEnd & (longestArc ne Perm!1) &
(longestArc ne Perm!n) then
[ CallSwat("Heuristic bug 1")
]

let segmentLasts = vec 4
GetOrderedRandomSet(3, segmentLasts, 1, n)

let segmentFirsts = vec 4
segmentFirsts!1 = (segmentLasts!3 ge n)? 1,
segmentLasts!3+1
for i=2 to 3 do
segmentFirsts!i = (segmentLasts!(i-1))+1

if ThisArrangementBetter(segmentFirsts, segmentLasts,
1, 3, 2) %
ThisArrangementBetter(segmentFirsts, segmentLasts,
1, -3, -2) %
ThisArrangementBetter(segmentFirsts, segmentLasts,
1, -3, 2) %
ThisArrangementBetter(segmentFirsts, segmentLasts,
1, 3, -2)
then
[ heuristicImprovements =
heuristicImprovements+1
if heuristicImprovements eq improvementBreak
then
CallSwat("Improvement break")

triesSinceImprovement = 0
]
]

MoveLongestArcToEnd:

CycleToRemoveLongest(Perm)

if forceFirstNodeToEnd then
for i=1 to n/2 do
[ let T = Perm!(n+1-i)// reverse it to get first
Perm!(n+1-i) = Perm!i// node at end
Perm!i = T
]

if forceFirstNodeToEnd & (Perm!n ne OrigFirstNode) then
CallSwat("Heuristic bug 2")

Free(swapZone, aL)
]


and ThisArrangementBetter(origF, origL, seg1, seg2, seg3) = valof

[ // This whole piece of code will fall apart on
// the floor unless seg1 eq 1. OK?

let seg = (lv seg1)-1
let f = vec 4
let l = vec 4
for i=1 to 3 do
[ f!i = (seg!i ls 0)? origL!(-(seg!i)), origF!(seg!i)
l!i = (seg!i ls 0)? origF!(-(seg!i)), origL!(seg!i)
]

let newArcLens = vec 4

for i=1 to 2 do
newArcLens!i = ArcLength(Perm!(l!i), Perm!(f!(i+1)))
newArcLens!3 = ArcLength(Perm!(l!3), Perm!(f!1))

let tempLongestArc = longestArc
let tempLongestArcLen = longestArcLen

if valof
[ for j=1 to 3 do
if Perm!(origL!j) eq longestArc then
resultis true
resultis false
]
then

[ tempLongestArcLen = 0
for i=1 to n do
if (arcLens!i gr tempLongestArcLen) &
valof
[ for j=1 to 3 do
if origL!j eq i then
resultis false
resultis true
]
then
[ tempLongestArc = Perm!i
tempLongestArcLen = arcLens!i
]
]

for j=1 to 3 do
if newArcLens!j gr tempLongestArcLen then
[ tempLongestArc = -(Perm!(l!j))
tempLongestArcLen = newArcLens!j
]

if forceFirstNodeToEnd then
[ let firstArc = Perm!1
let firstArcLen = arcLens!1
if origL!1 eq 1 then
firstArcLen = newArcLens!1

let lastArc = Perm!n
let lastArcLen = arcLens!n

if origL!3 eq n
then[ lastArc = Perm!(l!3)
lastArcLen = newArcLens!3
]

test firstArcLen ge lastArcLen

ifso[ tempLongestArc = -firstArc
tempLongestArcLen = firstArcLen
]

ifnot[ tempLongestArc = -lastArc
tempLongestArcLen = lastArcLen
]
]

let newNetLen = totalCircuitLength+valof
[ let sum=0
for j=1 to 3 do
sum = sum+newArcLens!j-
arcLens!(origL!j)
resultis sum
]-
tempLongestArcLen

unless newNetLen ls bestTotalNetLength do resultis false

HBetterNet:
bestTotalNetLength = newNetLen

totalCircuitLength = newNetLen+tempLongestArcLen

let tempVec = Allocate(swapZone, n+2)
let tempLens = Allocate(swapZone, n+2)

let nextWord = 1
for j=2 to 3 do
[ test seg!j ge 0
ifso[ MoveBlock(tempVec+nextWord,
lv (Perm!(f!j)),
(l!j-f!j+1))
MoveBlock(tempLens+nextWord,
lv (arcLens!(f!j)),
(l!j-f!j+1))
nextWord = nextWord+(l!j-f!j+1)
]

ifnot[ let cur = f!j
while cur ge l!j do
[ tempVec!nextWord = Perm!cur
tempLens!nextWord = arcLens!(cur-1)
if cur gr l!j &
tempLongestArc eq
Perm!(cur-1)
then
tempLongestArc = Perm!cur
cur = cur-1
nextWord = nextWord+1
]
]
tempLens!(nextWord-1) = newArcLens!j
]

arcLens!(origL!1) = newArcLens!1

longestArc = (tempLongestArc ge 0)? tempLongestArc,
-tempLongestArc
longestArcLen = tempLongestArcLen

MoveBlock(lv (Perm!(origF!2)), lv (tempVec!1), nextWord-1)
MoveBlock(lv (arcLens!(origF!2)), lv (tempLens!1),
nextWord-1)
Free(swapZone, tempVec)
Free(swapZone, tempLens)
resultis true
]

and CycleToRemoveLongest(Perm) be

[ let NewPerm = Allocate(swapZone, n+2)
let LongestArcPos = nil
let LongestArcLen = -1

test forceFirstNodeToEnd

ifnot[ for i=1 to n do
[ let ThisArcLen = ArcLength(Perm!i,
Perm!((i rem n)+1))
if ThisArcLen gr LongestArcLen then
[ LongestArcLen = ThisArcLen
LongestArcPos = i
]
]

MoveBlock(lv (NewPerm!1), lv (Perm!(LongestArcPos+1)),
n-LongestArcPos)
MoveBlock(lv (NewPerm!((n-LongestArcPos)+1)), lv (Perm!1),
LongestArcPos)
MoveBlock(lv (Perm!1), lv (NewPerm!1), n)
]

ifso if ArcLength(Perm!1, Perm!2) gr
ArcLength(Perm!n, Perm!1) then // reverse Perm!2..Perm!n
for i=1 to (n-1)/2 do
[ let T = Perm!(i+1)
Perm!(i+1) = Perm!(n+1-i)
Perm!(n+1-i) = T
]
Free(swapZone, NewPerm)
]


and Random(max) = valof

[ 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
]
]