siegel@booga.Eng.Sun.COM (Josh Siegel) (04/29/91)
[Who says you can't do "real" work in PostScript?!? ]
This is a PostScript implementation of one of the better "Minimum
Spanning Tree" solving algorithm.
--josh siegel
P.S. If you don't know what a "Minimum Spanning Tree" is, star this up
and just start clicking on the window.
===
% Written by Josh Siegel (siegel@sun.com)
/MyCanvas ClassCanvas []
classbegin
/Trackable? true def
/DispList [] def
/Points [] def
/Reset_Picture {
gsave
/Points [] def
/DispList [] def
can setcanvas
/Paint self send
null null /setfooter main_win send
grestore
} def
/refresh_picture {
gsave
self setcanvas
/DispList Points to_do store
/Paint self send
(Points ) Points length 255 string cvs append
(dist: ) /TotalDist self send 255 string cvs append
/setfooter main_win send
grestore
} def
/TotalDist {
0 DispList {
2 get sqrt add
} forall
} def
/TrackStart {
gsave
self setcanvas
begin
/Points [XLocation YLocation null null] Points aload
length 1 add array astore store
/refresh_picture self send
end
grestore
[] true
} def
/preferredsize {
300 300
} def
/Paint {
1 1 1 rgbcolor setcolor
clippath fill
0 0 0 rgbcolor setcolor
DispList {
aload pop pop
0 2 getinterval aload pop moveto
0 2 getinterval aload pop lineto
} forall
stroke
} def
classend def
/can framebuffer /new MyCanvas send def
/the_panel /Calculated framebuffer /new ClassPanel send def
/main_win can framebuffer /new ClassBaseWindow send def
/place main_win send
(Spanning Tree) /setlabel main_win send
/new ClassEventMgr send /activate main_win send
/the_menu /Grid framebuffer /new ClassMenu send def
[
[(Clear Tree) {pop pop /Reset_Picture can send}]
[(Algorithms) {pop pop
/pin oper_win send
/totop oper_win send
/map oper_win send
}]
[(Random) {
pop pop
MyCanvas /Points
[
20 {
[ random 300 mul random 300 mul null null ]
} repeat
] put
/refresh_picture can send
}]
] /setitemlist the_menu send
(span) /setlabel the_menu send
the_menu /setmenu can send
true /setmenuable can send
/Operations /Grid framebuffer /new ClassSettings send def
[
(Minimum Spanning Tree)
(Traveling Salesman #1)
(Traveling Salesman #2)
] /setitemlist Operations send
[true 3 1] /setlayoutparameters Operations send
/Operations Operations [ /SouthWest { /SouthWest PARENT POSITION } ]
/addclient the_panel send
/Exclusive /setchoicemode Operations send
/oper_win the_panel framebuffer /new ClassPopupWindow send def
/pin oper_win send
/place oper_win send
0 true /setchoice Operations send
{
pop 0 get {
0 {
/to_do /do_span load store
/span_flag 0 store
/refresh_picture can send
}
1 {
/to_do /do_span load store
/span_flag 1 store
/refresh_picture can send
}
2 {
/to_do /do_trav2 load store
/refresh_picture can send
}
} case
} /setnotifier Operations send
oper_win /addsubwindow main_win send
/map main_win send
main_win /Colormap get /Installed true put
% Lets do a min spanning tree...
%
% This is sure a lot shorter then the C version I wrote was!
%
% This is a lot faster when packed
%
/span_flag 0 def
% span_flag:
% 0 - normal spanning tree
% 1 - This was the first quick solution to the traveling salesman problem.
% I did this originally because we needed it for wirewrapping. It ended
% up not being good enough (even through it was very fast). People
% used it to give them a first draft and then edited the result.
%
% Pritty much it is the same as the min spanning tree accept it
% doesn't let more then two wires be tied to the same pin.
%
/do_span { % array => -
10 dict begin
/obj exch def
/nobj obj length 1 sub def
/suba obj def
obj { % Clear out previous entries
dup 2 null put
3 0 put
} forall
[
obj {
/suba suba dup 1 exch length 1 sub getinterval def
suba { % obj1 obj2
[ 3 copy pop 2 copy do_dist] 3 1 roll
pop
} forall
pop
} forall
] { 2 get exch 2 get lt } quicksort
[
exch {do_insert_objs} forall
]
end
} def
% (x2-x1)^2 + (y2-y1)^2
/do_dist { % obj1 obj2
2 copy
0 get exch 0 get sub dup mul
3 1 roll
1 get exch 1 get sub dup mul
add
} def
/get_family { % obj => obj
dup 2 get null ne {
dup dup 2 get get_family 2 exch put 2 get
} if
} def
/join_family { % obj1 obj2
get_family exch get_family 2 exch put
} def
/to_do /do_span load def
% This is a different solution to the trav salesman problem. This
% time, we will make a minimum spanning tree, and then try to insert
% the sides in reverse order using the same 2 connections to one
% pin rule that was in the other traveling salesman solution. Then,
% I will go foward inserting sides again. This way, the
% optimum long connections will be in place from the minimum spanning
% tree.
%
% In the end, this is worse then my previous attempt.
%
/do_trav2 {
10 dict begin
/obj exch def
/nobj obj length 1 sub def
/suba obj def
% First pass... normal spanning tree
/span_flag 0 def
/flinks obj do_span def
% Lets try to insert them using a different set of rules.
obj { % Clear out previous entries
dup 2 null put
3 0 put
} forall
/span_flag 1 def
[
flinks length 1 sub -1 0 {
flinks exch get
mark exch do_insert_objs
dup mark eq { pop exit } { exch pop } ifelse
} for
]
[
obj {
/suba suba dup 1 exch length 1 sub getinterval def
suba { % obj1 obj2
[ 3 copy pop 2 copy do_dist] 3 1 roll
pop
} forall
pop
} forall
] { 2 get exch 2 get lt } quicksort
[
exch {do_insert_objs} forall
]
append
end
} def
/do_insert_objs
{
dup aload pop pop 2 copy get_family exch get_family eq {
pop pop pop
} {
span_flag 1 eq {
dup 3 get 2 lt 2 index 3 get 2 lt and {
dup dup 3 get 1 add 3 exch put
exch dup dup 3 get 1 add 3 exch put
join_family
counttomark nobj eq { exit } if
} {
pop pop pop
} ifelse
} {
join_family
counttomark nobj eq { exit } if
} ifelse
} ifelse
} defks@cs.tut.fi (Syst{ Kari) (04/30/91)
Unfortunately I don't have TNT 2.0. So I modified the program
for TNT 1.0 (which is part of OpenWindindows).
At the same time I changed some classvariables to instance-variables.
I also added the possibility to change the speed of display-update (sort
of animation).
I hope Josh does not mind, if the the modified code is included below:
% Written by Josh Siegel (siegel@sun.com)
%?(ks)/ClassPanel OpenLookPane def
%?(ks)/ClassBaseWindow OpenLookBaseFrame def
/MyCanvas ClassCanvas
dictbegin
/Trackable? true def
/DispList [] def
/Points [] def
/SleepTime 0 def
dictend
classbegin
/Reset_Picture {
gsave
/Points [] def
/DispList [] def
can setcanvas
/Paint self send
null null /setfooter main_win send
grestore
} def
/refresh_picture {
gsave
self setcanvas
/DispList Points to_do store
/Paint self send
(Points ) Points length 255 string cvs append
(dist: ) /TotalDist self send 255 string cvs append
/setfooter main_win send
grestore
} def
/TotalDist {
0 DispList {
2 get sqrt add
} forall
} def
/TrackStart {
gsave
self setcanvas
begin
/Points [XLocation YLocation null null] Points aload
length 1 add array astore store
/refresh_picture self send
end
grestore
[] true
} def
/preferredsize {
300 300
} def
/PaintPoint {
2 copy moveto
3 0 360 arc fill
} def
/Paint {
1 1 1 rgbcolor setcolor
clippath fill
1 0 0 setrgbcolor
Points {
dup 0 get
exch 1 get
PaintPoint
} forall
0 0 0 rgbcolor setcolor
DispList {
aload pop pop
0 2 getinterval aload pop moveto
0 2 getinterval aload pop lineto
stroke SleepTime sleep
} forall
stroke
} def
classend def
/can framebuffer /new MyCanvas send def
/the_panel framebuffer /new FlexBag send def
/main_win can [] framebuffer /new OpenLookBaseFrame send def
/reshapefromuser main_win send
(Spanning Tree) /setlabel main_win send
%/new ClassEventMgr send
/activate main_win send
/the_menu
[
(Clear Tree) null {pop pop /Reset_Picture can send}
(Algorithms) null {pop pop
/pin oper_win send
/totop oper_win send
/map oper_win send
}
(Random) null {
pop pop
can /Points
[
20 {
[ random 300 mul random 300 mul null null ]
} repeat
] put
/refresh_picture can send
}
] framebuffer /new OpenLookMenu send def
(span) /setlabel the_menu send
the_menu /setmenu can send
%true /setmenuable can send
/Operations
[
(Minimum Spanning Tree)
(Traveling Salesman #1)
(Traveling Salesman #2)
]
{
/value exch send {
0 {
/to_do /do_span load store
/span_flag 0 store
/refresh_picture can send
}
1 {
/to_do /do_span load store
/span_flag 1 store
/refresh_picture can send
}
2 {
/to_do /do_trav2 load store
/refresh_picture can send
}
} case
}
framebuffer /new OpenLookXSetting send def
/Speed { /value exch send
0.1 mul
can /SleepTime 3 -1 roll put } framebuffer
/new OpenLookHorizontalSlider send def
/Line 1 /setdelta Speed def
0 0 /minsize Operations send /reshape Operations send
0 0 100 20 /reshape Speed send
true 3 1 /setlayoutstyle Operations send
/Operations [ /sw { /sw self POSITION 20 20 XYADD } Operations]
/addclient the_panel send
/Speed [ /nw { /nw self POSITION 20 -20 XYADD } Speed]
/addclient the_panel send
%/Exclusive /setchoicemode Operations send
/oper_win the_panel {} framebuffer /new OpenLookHelpFrame send def
%/pin oper_win send
400 400 200 200 /reshape oper_win send
%0 true /setchoice Operations send
%oper_win /addsubwindow main_win send
%/map oper_win send
/activate oper_win send
/map main_win send
main_win /Colormap get /Installed true put
% Lets do a min spanning tree...
%
% This is sure a lot shorter then the C version I wrote was!
%
% This is a lot faster when packed
%
/span_flag 0 def
% span_flag:
% 0 - normal spanning tree
% 1 - This was the first quick solution to the traveling salesman problem.
% I did this originally because we needed it for wirewrapping. It ended
% up not being good enough (even through it was very fast). People
% used it to give them a first draft and then edited the result.
%
% Pritty much it is the same as the min spanning tree accept it
% doesn't let more then two wires be tied to the same pin.
%
/do_span { % array => -
10 dict begin
/obj exch def
/nobj obj length 1 sub def
/suba obj def
obj { % Clear out previous entries
dup 2 null put
3 0 put
} forall
[
obj {
/suba suba dup 1 exch length 1 sub getinterval def
suba { % obj1 obj2
[ 3 copy pop 2 copy do_dist] 3 1 roll
pop
} forall
pop
% dup ==
} forall
] { 2 get exch 2 get lt } quicksort
[
exch {do_insert_objs} forall
]
end
% dup { == } forall
} def
% (x2-x1)^2 + (y2-y1)^2
/do_dist { % obj1 obj2
2 copy
0 get exch 0 get sub dup mul
3 1 roll
1 get exch 1 get sub dup mul
add
} def
/get_family { % obj => obj
dup 2 get null ne {
dup dup 2 get get_family 2 exch put 2 get
} if
} def
/join_family { % obj1 obj2
get_family exch get_family 2 exch put
} def
/to_do /do_span load def
% This is a different solution to the trav salesman problem. This
% time, we will make a minimum spanning tree, and then try to insert
% the sides in reverse order using the same 2 connections to one
% pin rule that was in the other traveling salesman solution. Then,
% I will go foward inserting sides again. This way, the
% optimum long connections will be in place from the minimum spanning
% tree.
%
% In the end, this is worse then my previous attempt.
%
/do_trav2 {
10 dict begin
/obj exch def
/nobj obj length 1 sub def
/suba obj def
% First pass... normal spanning tree
/span_flag 0 def
/flinks obj do_span def
% Lets try to insert them using a different set of rules.
obj { % Clear out previous entries
dup 2 null put
3 0 put
} forall
/span_flag 1 def
[
flinks length 1 sub -1 0 {
flinks exch get
mark exch do_insert_objs
dup mark eq { pop exit } { exch pop } ifelse
} for
]
[
obj {
/suba suba dup 1 exch length 1 sub getinterval def
suba { % obj1 obj2
[ 3 copy pop 2 copy do_dist] 3 1 roll
pop
} forall
pop
} forall
] { 2 get exch 2 get lt } quicksort
[
exch {do_insert_objs} forall
]
append
end
} def
/do_insert_objs
{
dup aload pop pop 2 copy get_family exch get_family eq {
pop pop pop
} {
span_flag 1 eq {
dup 3 get 2 lt 2 index 3 get 2 lt and {
dup dup 3 get 1 add 3 exch put
exch dup dup 3 get 1 add 3 exch put
join_family
counttomark nobj eq { exit } if
} {
pop pop pop
} ifelse
} {
join_family
counttomark nobj eq { exit } if
} ifelse
} ifelse
} def
--
% This article represents my personal views.
% NeWS flash: "X is the Fortran of windowing systems."
% Kari Systa, Tampere Univ. Technology, Box 527, 33101 Tampere, Finland
% work: +358 31 162585 fax: +358 31 162913 home: +358 31 177412