//	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
		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

\f1