From: marko Date: Mon, 12 Sep 2005 00:04:03 +0000 (+0000) Subject: Improve alghoritmic efficiency / speed of automatic repositioning of X-Git-Url: https://git.entuzijast.net/?a=commitdiff_plain;h=52d8911bb281cad14bbd7289a6459afd72071d20;p=imunes.git 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 9a0e9c3..9a314d3 100755 --- 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" -}