Improve alghoritmic efficiency / speed of automatic repositioning of

nodes by a factor of 2.

Improve the stability / decrease the possibility for oscillations.

Bug found by:
Submitted by:
Requested by:
Reviewed by:
Approved by:
Obtained from:

diff --git a/editor.tcl b/editor.tcl
index 9a0e9c3419bea40341e0665545b10eec01cadb05..9a314d385eabffb248400ecba88c26a832deefea 100755 (executable)
--- a/editor.tcl
+++ b/editor.tcl
@@ -1585,7 +1585,7 @@ proc delete_object { c x y } {
 
 
 proc rearrange { mode } {
-    global nodes autorearrange_enabled sizex sizey
+    global nodes links autorearrange_enabled sizex sizey
 
     set c .c
     set autorearrange_enabled 1
@@ -1603,87 +1603,121 @@ proc rearrange { mode } {
        if { $otime == $ntime } {
            set dt 0.001
        } else {
-           set dt [expr $ntime - $otime]
-           if { $dt > 200 } {
+           set dt [expr ($ntime - $otime) * 0.001]
+           if { $dt > 0.2 } {
                set dt 0.2
-           } else {
-               set dt [expr $dt * 0.001]
            }
            set otime $ntime
        }
+
        set objects [$c find withtag $tagmatch]
-       foreach obj $objects {
+       set peer_objects [$c find withtag node]
+       foreach obj $peer_objects {
             set node [lindex [$c gettags $obj] 1]
-           set coords [getNodeCoords $node]
+           set coords [$c coords $obj]
            set x [lindex $coords 0]
            set y [lindex $coords 1]
+           set x_t($node) $x
+           set y_t($node) $y
 
            if { $x > 0 } {
-               set fx [expr 1000.0 / ($x * $x + 100)]
+               set fx [expr 1000 / ($x * $x + 100)]
            } else {
                set fx 10
            }
            set dx [expr $sizex - $x]
            if { $dx > 0 } {
-               set fx [expr $fx - 1000.0 / ($dx * $dx + 100)]
+               set fx [expr $fx - 1000 / ($dx * $dx + 100)]
            } else {
                set fx [expr $fx - 10]
            }
 
            if { $y > 0 } {
-               set fy [expr 1000.0 / ($y * $y + 100)]
+               set fy [expr 1000 / ($y * $y + 100)]
            } else {
                set fy 10
            }
            set dy [expr $sizey - $y]
            if { $dy > 0 } {
-               set fy [expr $fy - 1000.0 / ($dy * $dy + 100)]
+               set fy [expr $fy - 1000 / ($dy * $dy + 100)]
            } else {
                set fy [expr $fy - 10]
            }
-
-           set fxy [calcfxy $node $x $y]
-           set fx [expr $fx + [lindex $fxy 0]]
-           set fy [expr $fy + [lindex $fxy 1]]
-           set x_t($node) $x
-           set y_t($node) $y
            set fx_t($node) $fx
            set fy_t($node) $fy
        }
+
        foreach obj $objects {
             set node [lindex [$c gettags $obj] 1]
+           set i [lsearch -exact $peer_objects $obj]
+           set peer_objects [lreplace $peer_objects $i $i]
            set x $x_t($node)
            set y $y_t($node)
-           set fx $fx_t($node)
-           set fy $fy_t($node)
+           foreach other_obj $peer_objects {
+               set other [lindex [$c gettags $other_obj] 1]
+               set o_x $x_t($other)
+               set o_y $y_t($other)
+               set dx [expr $x - $o_x]
+               set dy [expr $y - $o_y]
+               set d [expr hypot($dx, $dy)]
+               set d2 [expr $d * $d]
+               set p_fx [expr 1000.0 * $dx / ($d2 * $d + 100)]
+               set p_fy [expr 1000.0 * $dy / ($d2 * $d + 100)]
+               if {[linkByPeers $node $other] != ""} {
+                   set p_fx [expr $p_fx - $dx * $d2 / 2000000000.0]
+                   set p_fy [expr $p_fy - $dy * $d2 / 2000000000.0]
+               }
+               set fx_t($node) [expr $fx_t($node) + $p_fx]
+               set fy_t($node) [expr $fy_t($node) + $p_fy]
+               set fx_t($other) [expr $fx_t($other) - $p_fx]
+               set fy_t($other) [expr $fy_t($other) - $p_fy]
+           }
+
+           foreach link $links {
+               set peers [linkPeers $link]
+               set coords0 [getNodeCoords [lindex $peers 0]]
+               set coords1 [getNodeCoords [lindex $peers 1]]
+               set o_x [expr ([lindex $coords0 0] + [lindex $coords1 0]) * .5]
+               set o_y [expr ([lindex $coords0 1] + [lindex $coords1 1]) * .5]
+               set dx [expr $x - $o_x]
+               set dy [expr $y - $o_y]
+               set d [expr hypot($dx, $dy)]
+               set d2 [expr $d * $d]
+               set fx_t($node) \
+                   [expr $fx_t($node) + 500.0 * $dx / ($d2 * $d + 100)]
+               set fy_t($node) \
+                   [expr $fy_t($node) + 500.0 * $dy / ($d2 * $d + 100)]
+           }
+       }
+
+       foreach obj $objects {
+            set node [lindex [$c gettags $obj] 1]
            if { [catch "set v_t($node)" v] } {
-               set vx 0
-               set vy 0
+               set vx 0.0
+               set vy 0.0
            } else {
                set vx [lindex $v_t($node) 0]
                set vy [lindex $v_t($node) 1]
            }
-           set vx [expr $vx + 1000 * $fx * $dt]
-           set vy [expr $vy + 1000 * $fy * $dt]
-           set dampf [expr 6000 / (10000 + $vx * $vx + $vy * $vy)]
-           set vx [expr $vx * pow($dampf, $dt)]
-           set vy [expr $vy * pow($dampf, $dt)]
+           set vx [expr $vx + 1000.0 * $fx_t($node) * $dt]
+           set vy [expr $vy + 1000.0 * $fy_t($node) * $dt]
+           set dampk [expr 0.5 + ($vx * $vx + $vy * $vy) * 0.00001]
+           set vx [expr $vx * exp( - $dampk * $dt)]
+           set vy [expr $vy * exp( - $dampk * $dt)]
            set dx [expr $vx * $dt]
            set dy [expr $vy * $dt]
-           set x [expr $x + $dx]
-           set y [expr $y + $dy]
+           set x [expr $x_t($node) + $dx]
+           set y [expr $y_t($node) + $dy]
            set v_t($node) "$vx $vy"
-           if { 1 } {
-               setNodeCoords $node "$x $y"
-               set img [$c find withtag "selectmark && $node"]
-               $c move $img $dx $dy
-               set img [$c find withtag "node && $node"]
-               $c move $img $dx $dy
-               set img [$c find withtag "nodelabel && $node"]
-               $c move $img $dx $dy
-               setNodeLabelCoords $node [$c coords $img]
-               $c addtag need_redraw withtag "link && $node"
-           }
+
+           setNodeCoords $node "$x $y"
+           $c move $obj $dx $dy
+           set img [$c find withtag "selectmark && $node"]
+           $c move $img $dx $dy
+           set img [$c find withtag "nodelabel && $node"]
+           $c move $img $dx $dy
+           setNodeLabelCoords $node [$c coords $img]
+           $c addtag need_redraw withtag "link && $node"
        }
        foreach link [$c find withtag "link && need_redraw"] {
            redrawLink [lindex [$c gettags $link] 1]
@@ -1696,42 +1730,3 @@ proc rearrange { mode } {
     .bottom.mbuf config -text ""
 }
 
-
-proc calcfxy { node x y } {
-    global nodes links sizex sizey
-
-    set fx 0
-    set fy 0
-    foreach other $nodes {
-       if { $other == $node } {
-           continue
-       }
-       set coords [getNodeCoords $other]
-       set o_x [lindex $coords 0]
-       set o_y [lindex $coords 1]
-       set dx [expr $x - $o_x]
-       set dy [expr $y - $o_y]
-       set d [expr hypot($dx, $dy)]
-       set d2 [expr $d * $d]
-       set fx [expr $fx + 1000.0 * $dx / ($d2 * $d + 100)]
-       set fy [expr $fy + 1000.0 * $dy / ($d2 * $d + 100)]
-       if {[linkByPeers $node $other] != ""} {
-           set fx [expr $fx - $dx * $d2 / 2000000000.0]
-           set fy [expr $fy - $dy * $d2 / 2000000000.0]
-       }
-    }
-    foreach link $links {
-       set peers [linkPeers $link]
-       set coords0 [getNodeCoords [lindex $peers 0]]
-       set coords1 [getNodeCoords [lindex $peers 1]]
-       set o_x [expr ([lindex $coords0 0] + [lindex $coords1 0]) * .5]
-       set o_y [expr ([lindex $coords0 1] + [lindex $coords1 1]) * .5]
-       set dx [expr $x - $o_x]
-       set dy [expr $y - $o_y]
-       set d [expr hypot($dx, $dy)]
-       set d2 [expr $d * $d]
-       set fx [expr $fx + 500.0 * $dx / ($d2 * $d + 100)]
-       set fy [expr $fy + 500.0 * $dy / ($d2 * $d + 100)]
-    }
-    return "$fx $fy"
-}