1 (* From the SML
/NJ benchmark suite
. *)
4 * COPYRIGHT (c
) 1994 AT
&T Bell Laboratories
.
6 * Trees for the TSP program
.
15 left
: tree
, right
: tree
,
18 prev
: tree ref
, next
: tree ref
21 fun mkNode (l
, r
, x
, y
, sz
) = ND
{
22 left
= l
, right
= r
, x
= x
, y
= y
, sz
= sz
,
23 prev
= ref NULL
, next
= ref NULL
26 fun printTree (outS
, NULL
) = ()
27 |
printTree (outS
, ND
{x
, y
, left
, right
, ...}) = (
28 TextIO.output(outS
, String.concat
[
29 Real.toString x
, " ", Real.toString y
, "\n"]);
30 printTree (outS
, left
);
31 printTree (outS
, right
))
33 fun printList (outS
, NULL
) = ()
34 |
printList (outS
, start
as ND
{next
, ...}) = let
35 fun cycle (ND
{next
=next
', ...}) = (next
= next
')
38 |
prt (t
as ND
{x
, y
, next
, ...}) = (
39 TextIO.output(outS
, String.concat
[
40 Real.toString x
, " ", Real.toString y
, "\n"
53 * COPYRIGHT (c
) 1994 AT
&T Bell Laboratories
.
58 val tsp
: (Tree
.tree
* int) -> Tree
.tree
64 fun setPrev (T
.ND
{prev
, ...}, x
) = prev
:= x
65 fun setNext (T
.ND
{next
, ...}, x
) = next
:= x
66 fun link (a
as T
.ND
{next
, ...}, b
as T
.ND
{prev
, ...}) = (
69 fun sameNd (T
.ND
{next
, ...}, T
.ND
{next
=next
', ...}) = (next
= next
')
70 |
sameNd (T
.NULL
, T
.NULL
) = true
73 (* Find Euclidean distance from a to b
*)
74 fun distance (T
.ND
{x
=ax
, y
=ay
, ...}, T
.ND
{x
=bx
, y
=by
, ...}) =
75 Math
.sqrt(((ax
-bx
)*(ax
-bx
)+(ay
-by
)*(ay
-by
)))
76 | distance _
= raise Fail
"distance"
78 (* sling tree nodes into a list
-- requires root to be tail
of list
, and
79 * only fills
in next field
, not prev
.
81 fun makeList T
.NULL
= T
.NULL
82 |
makeList (t
as T
.ND
{left
, right
, next
= t_next
, ...}) = let
83 val retVal
= (case (makeList left
, makeList right
)
84 of (T
.NULL
, T
.NULL
) => t
85 |
(l
as T
.ND
{...}, T
.NULL
) => (setNext(left
, t
); l
)
86 |
(T
.NULL
, r
as T
.ND
{...}) => (setNext(right
, t
); r
)
87 |
(l
as T
.ND
{...}, r
as T
.ND
{...}) => (
88 setNext(right
, t
); setNext(left
, r
); l
)
95 (* reverse orientation
of list
*)
96 fun reverse T
.NULL
= ()
97 |
reverse (t
as T
.ND
{next
, prev
, ...}) = let
98 fun rev (_
, T
.NULL
) = ()
99 |
rev (back
, tmp
as T
.ND
{prev
, next
, ...}) = let
102 next
:= back
; setPrev(back
, tmp
);
106 setNext (!prev
, T
.NULL
);
111 (* Use closest
-point heuristic from Cormen Leiserson
and Rivest
*)
112 fun conquer (T
.NULL
) = T
.NULL
114 val (cycle
as T
.ND
{next
=cycle_next
, prev
=cycle_prev
, ...}) = makeList t
115 fun loop (T
.NULL
) = ()
116 |
loop (t
as T
.ND
{next
=ref doNext
, prev
, ...}) =
118 fun findMinDist (min
, minDist
, tmp
as T
.ND
{next
, ...}) =
119 if (sameNd(cycle
, tmp
))
122 val test
= distance(t
, tmp
)
125 then findMinDist (tmp
, test
, !next
)
126 else findMinDist (min
, minDist
, !next
)
128 val (min
as T
.ND
{next
=ref min_next
, prev
=ref min_prev
, ...}) =
129 findMinDist (cycle
, distance(t
, cycle
), !cycle_next
)
130 val minToNext
= distance(min
, min_next
)
131 val minToPrev
= distance(min
, min_prev
)
132 val tToNext
= distance(t
, min_next
)
133 val tToPrev
= distance(t
, min_prev
)
135 if ((tToPrev
- minToPrev
) < (tToNext
- minToNext
))
136 then ( (* insert between min
and min_prev
*)
146 (* Create initial cycle
*)
147 cycle_next
:= cycle
; cycle_prev
:= cycle
;
152 (* Merge two cycles
as per Karp
*)
153 fun merge (a
as T
.ND
{next
, ...}, b
, t
) = let
154 fun locateCycle (start
as T
.ND
{next
, ...}) = let
155 fun findMin (min
, minDist
, tmp
as T
.ND
{next
, ...}) =
156 if (sameNd(start
, tmp
))
158 else let val test
= distance(t
, tmp
)
161 then findMin (tmp
, test
, !next
)
162 else findMin (min
, minDist
, !next
)
164 val (min
as T
.ND
{next
=ref next
', prev
=ref prev
', ...}, minDist
) =
165 findMin (start
, distance(t
, start
), !next
)
166 val minToNext
= distance(min
, next
')
167 val minToPrev
= distance(min
, prev
')
168 val tToNext
= distance(t
, next
')
169 val tToPrev
= distance(t
, prev
')
171 if ((tToPrev
- minToPrev
) < (tToNext
- minToNext
))
172 (* would insert between min
and prev
*)
173 then (prev
', tToPrev
, min
, minDist
)
174 (* would insert between min
and next
*)
175 else (min
, minDist
, next
', tToNext
)
177 (* Compute location for first cycle
*)
178 val (p1
, tToP1
, n1
, tToN1
) = locateCycle a
179 (* compute location for second cycle
*)
180 val (p2
, tToP2
, n2
, tToN2
) = locateCycle b
181 (* Now we have
4 choices to complete
:
187 val n1ToN2
= distance(n1
, n2
)
188 val n1ToP2
= distance(n1
, p2
)
189 val p1ToN2
= distance(p1
, n2
)
190 val p1ToP2
= distance(p1
, p2
)
191 fun choose (testChoice
, test
, choice
, minDist
) =
192 if (test
< minDist
) then (testChoice
, test
) else (choice
, minDist
)
193 val (choice
, minDist
) = (1, tToP1
+tToP2
+n1ToN2
)
194 val (choice
, minDist
) = choose(2, tToP1
+tToN2
+n1ToP2
, choice
, minDist
)
195 val (choice
, minDist
) = choose(3, tToN1
+tToP2
+p1ToN2
, choice
, minDist
)
196 val (choice
, minDist
) = choose(4, tToN1
+tToN2
+p1ToP2
, choice
, minDist
)
199 of 1 => ( (* 1:p1
,t t
,p2 n2
,n1
-- reverse
2! *)
204 |
2 => ( (* 2:p1
,t t
,n2 p2
,n1
-- OK
*)
208 |
3 => ( (* 3:p2
,t t
,n1 p1
,n2
-- OK
*)
212 |
4 => ( (* 4:n1
,t t
,n2 p2
,p1
-- reverse
1! *)
221 (* Compute TSP for the tree t
-- use conquer for problems
<= sz
* *)
222 fun tsp (t
as T
.ND
{left
, right
, sz
=sz
', ...}, sz
) =
225 else merge (tsp(left
, sz
), tsp(right
, sz
), t
)
226 |
tsp (T
.NULL
, _
) = T
.NULL
232 * COPYRIGHT (c
) 1993 by AT
&T Bell Laboratories
. See COPYRIGHT file for details
.
233 * COPYRIGHT (c
) 1998 by AT
&T Laboratories
.
235 * Signature for a simple random number generator
.
242 type rand
= Word.word
247 val random
: rand
-> rand
248 (* Given seed
, return value randMin
<= v
<= randMax
249 * Iteratively using the value returned by random
as the
250 * next seed to random will produce a sequence
of pseudo
-random
254 val mkRandom
: rand
-> unit
-> rand
255 (* Given seed
, return function generating a sequence
of
256 * random numbers randMin
<= v
<= randMax
259 val norm
: rand
-> real
260 (* Map values
in the range
[randMin
,randMax
] to (0.0,1.0) *)
262 val range
: (int * int) -> rand
-> int
263 (* Map v
, randMin
<= v
<= randMax
, to integer range
[i
,j
]
272 * COPYRIGHT (c
) 1991 by AT
&T Bell Laboratories
. See COPYRIGHT file for details
273 * COPYRIGHT (c
) 1998 by AT
&T Laboratories
. See COPYRIGHT file for details
275 * Random number generator taken from Paulson
, pp
. 170-171.
276 * Recommended by Stephen K
. Park
and Keith W
. Miller
,
277 * Random number generators
: good ones are hard to find
,
278 * CACM
31 (1988), 1192-1201
279 * Updated to
include the new preferred multiplier
of 48271
280 * CACM
36 (1993), 105-110
281 * Updated to use on
Word.
283 * Note
: The Random
structure provides a better generator
.
286 structure Rand
: RAND
=
289 type rand
= Word.word
290 type rand
' = Int.int (* internal representation
*)
292 val a
: rand
' = 48271
293 val m
: rand
' = valOf
Int.maxInt (* 2^
31 - 1 *)
298 val extToInt
= Word.toInt
299 val intToExt
= Word.fromInt
301 val randMin
: rand
= 0w1
302 val randMax
: rand
= intToExt m_1
305 | chk
0wx7fffffff
= m_1
306 | chk seed
= extToInt seed
308 fun random
' seed
= let
311 val test
= a
* lo
- r
* hi
313 if test
> 0 then test
else test
+ m
316 val random
= intToExt
o random
' o chk
318 fun mkRandom seed
= let
319 val seed
= ref (chk seed
)
321 fn () => (seed
:= random
' (!seed
); intToExt (!seed
))
324 val real_m
= Real.fromInt m
325 fun norm s
= (Real.fromInt (Word.toInt s
)) / real_m
329 then raise Fail
"Random.range: hi < lo"
330 else if j
= i
then fn _
=> i
332 val R
= Int.fromInt j
- Int.fromInt i
333 val cvt
= Word.toIntX
o Word.fromInt
335 if R
= m
then Word.toIntX
336 else fn s
=> i
+ cvt ((extToInt s
) mod (R
+1))
343 * COPYRIGHT (c
) 1994 AT
&T Bell Laboratories
.
345 * Build a two
-dimensional tree for TSP
.
348 structure BuildTree
: sig
350 datatype axis
= X_AXIS | Y_AXIS
354 min_x
: real, min_y
: real, max_x
: real, max_y
: real
361 val m_e
= 2.7182818284590452354
362 val m_e2
= 7.3890560989306502274
363 val m_e3
= 20.08553692318766774179
364 val m_e6
= 403.42879349273512264299
365 val m_e12
= 162754.79141900392083592475
367 datatype axis
= X_AXIS | Y_AXIS
369 (* builds a
2D tree
of n nodes
in specified range
with dir
as primary axis
*)
370 fun buildTree arg
= let
371 val rand
= Rand
.mkRandom
0w314
372 fun drand48 () = Rand
.norm (rand ())
373 fun median
{min
, max
, n
} = let
374 val t
= drand48(); (* in [0.0..1.0) *)
375 val retval
= if (t
> 0.5)
376 then Math
.ln(1.0-(2.0*(m_e12
-1.0)*(t
-0.5)/m_e12
))/12.0
377 else ~
(Math
.ln(1.0-(2.0*(m_e12
-1.0)*t
/m_e12
))/12.0)
379 min
+ ((retval
+ 1.0) * (max
- min
)/2.0)
381 fun uniform
{min
, max
} = min
+ (drand48() * (max
- min
))
382 fun build
{n
= 0, ...} = T
.NULL
383 | build
{n
, dir
=X_AXIS
, min_x
, min_y
, max_x
, max_y
} = let
384 val med
= median
{min
=min_y
, max
=max_y
, n
=n
}
385 fun mkTree (min
, max
) = build
{
386 n
=n
div 2, dir
=Y_AXIS
, min_x
=min_x
, max_x
=max_x
,
391 mkTree(min_y
, med
), mkTree(med
, max_y
),
392 uniform
{min
=min_x
, max
=max_x
}, med
, n
)
394 | build
{n
, dir
=Y_AXIS
, min_x
, min_y
, max_x
, max_y
} = let
395 val med
= median
{min
=min_x
, max
=max_x
, n
=n
}
396 fun mkTree (min
, max
) = build
{
397 n
=n
div 2, dir
=X_AXIS
, min_x
=min
, max_x
=max
,
398 min_y
=min_y
, max_y
=max_y
402 mkTree(min_x
, med
), mkTree(med
, max_x
),
403 med
, uniform
{min
=min_y
, max
=max_y
}, n
)
413 val doit
: int -> unit
414 val testit
: TextIO.outstream
-> unit
418 * COPYRIGHT (c
) 1994 AT
&T Bell Laboratories
.
426 val dumpPS
: TextIO.outstream
-> unit
432 val problemSz
= ref
32767
433 val divideSz
= ref
150
435 fun printLength (outS
, Tree
.NULL
) = print
"(* 0 points *)\n"
436 |
printLength (outS
, start
as Tree
.ND
{next
, x
, y
, ...}) = let
437 fun cycle (Tree
.ND
{next
=next
', ...}) = (next
= next
')
439 fun distance (ax
, ay
, bx
, by
) = let
440 val dx
= ax
-bx
and dy
= ay
-by
442 Math
.sqrt (dx
*dx
+ dy
*dy
)
444 fun length (Tree
.NULL
, px
, py
, n
, len
) = (n
, len
+distance(px
, py
, x
, y
))
445 |
length (t
as Tree
.ND
{x
, y
, next
, ...}, px
, py
, n
, len
) =
447 then (n
, len
+distance(px
, py
, x
, y
))
448 else length(!next
, x
, y
, n
+1, len
+distance(px
, py
, x
, y
))
451 then TextIO.output (outS
, "(* 1 point *)\n")
453 val (n
, len
) = length(!next
, x
, y
, 1, 0.0)
455 TextIO.output (outS
, concat
[
456 "(* ", Int.toString n
, "points, cycle length = ",
457 Real.toString len
, " *)\n"
462 fun mkTree n
= BuildTree
.buildTree
{
463 n
=n
, dir
=BuildTree
.X_AXIS
,
464 min_x
=0.0, max_x
=1.0,
468 fun doit
' n
= TSP
.tsp (mkTree n
, !divideSz
)
471 TextIO.output (outS
, "newgraph\n");
472 TextIO.output (outS
, "newcurve pts\n");
473 Tree
.printList (outS
, doit
' (!problemSz
));
474 TextIO.output (outS
, "linetype solid\n"))
476 fun testit strm
= printLength (strm
, doit
' (!problemSz
))
478 val _
= problemSz
:= 2097151
479 fun doit () = doit
' (!problemSz
)