Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!zaphod.mps.ohio-state.edu!swrinde!cs.utexas.edu!sun-barr!newstop!exodus!booga.Eng.Sun.COM!siegel From: siegel@booga.Eng.Sun.COM (Josh Siegel) Newsgroups: comp.windows.news Subject: Minimum Spanning Tree solver written in TNT 2.0 Message-ID: <12418@exodus.Eng.Sun.COM> Date: 29 Apr 91 16:45:10 GMT Sender: news@exodus.Eng.Sun.COM Lines: 288 [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 } def