Replace the probabilistic algorithm for node rearrangement with a fluid

model.

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

diff --git a/editor.tcl b/editor.tcl
index ed16999a6af68d2ded7b4df50e1e7bbc2871a03b..9a0e9c3419bea40341e0665545b10eec01cadb05 100755 (executable)
--- a/editor.tcl
+++ b/editor.tcl
@@ -768,8 +768,13 @@ proc button1-release { c x y } {
            set coords [$c coords $img]
            set x [lindex $coords 0]
            set y [lindex $coords 1]
-           set dx [expr int($x / $grid + 0.5) * $grid - $x]
-           set dy [expr int($y / $grid + 0.5) * $grid - $y]
+           if { $autorearrange_enabled } {
+               set dx 0
+               set dy 0
+           } else {
+               set dx [expr int($x / $grid + 0.5) * $grid - $x]
+               set dy [expr int($y / $grid + 0.5) * $grid - $y]
+           }
            $c move $img $dx $dy
            set coords [$c coords $img]
            set x [lindex $coords 0]
@@ -1580,7 +1585,7 @@ proc delete_object { c x y } {
 
 
 proc rearrange { mode } {
-    global nodes autorearrange_enabled
+    global nodes autorearrange_enabled sizex sizey
 
     set c .c
     set autorearrange_enabled 1
@@ -1592,26 +1597,83 @@ proc rearrange { mode } {
     } else {
        set tagmatch "node"
     }
+    set otime [clock clicks -milliseconds]
     while { $autorearrange_enabled } {
-       foreach obj [$c find withtag $tagmatch] {
+       set ntime [clock clicks -milliseconds]
+       if { $otime == $ntime } {
+           set dt 0.001
+       } else {
+           set dt [expr $ntime - $otime]
+           if { $dt > 200 } {
+               set dt 0.2
+           } else {
+               set dt [expr $dt * 0.001]
+           }
+           set otime $ntime
+       }
+       set objects [$c find withtag $tagmatch]
+       foreach obj $objects {
             set node [lindex [$c gettags $obj] 1]
            set coords [getNodeCoords $node]
            set x [lindex $coords 0]
            set y [lindex $coords 1]
-           if { [catch "set cachectable($node)" cached] } {
-               set weight0 [calcDistWeight $node $x $y]
-           } elseif { [lindex $cached 0] == $x && [lindex $cached 1] == $y } {
-               set weight0 [lindex $cached 2]
+
+           if { $x > 0 } {
+               set fx [expr 1000.0 / ($x * $x + 100)]
+           } else {
+               set fx 10
+           }
+           set dx [expr $sizex - $x]
+           if { $dx > 0 } {
+               set fx [expr $fx - 1000.0 / ($dx * $dx + 100)]
            } else {
-               set weight0 [calcDistWeight $node $x $y]
+               set fx [expr $fx - 10]
            }
-           set dx [expr (rand() - 0.5) * 16]
-           set dy [expr (rand() - 0.5) * 16]
+
+           if { $y > 0 } {
+               set fy [expr 1000.0 / ($y * $y + 100)]
+           } else {
+               set fy 10
+           }
+           set dy [expr $sizey - $y]
+           if { $dy > 0 } {
+               set fy [expr $fy - 1000.0 / ($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 x $x_t($node)
+           set y $y_t($node)
+           set fx $fx_t($node)
+           set fy $fy_t($node)
+           if { [catch "set v_t($node)" v] } {
+               set vx 0
+               set vy 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 dx [expr $vx * $dt]
+           set dy [expr $vy * $dt]
            set x [expr $x + $dx]
            set y [expr $y + $dy]
-           set weight1 [calcDistWeight $node $x $y]
-           set cachectable($node) "$x $y $weight1"
-           if { $weight0 > $weight1 } {
+           set v_t($node) "$vx $vy"
+           if { 1 } {
                setNodeCoords $node "$x $y"
                set img [$c find withtag "selectmark && $node"]
                $c move $img $dx $dy
@@ -1635,12 +1697,11 @@ proc rearrange { mode } {
 }
 
 
-proc calcDistWeight { node x y } {
+proc calcfxy { node x y } {
     global nodes links sizex sizey
 
-    set weight [expr .1 / ($x * $x) + .1 / ($y * $y)]
-    set weight [expr $weight + .1 / (($sizex - $x) * ($sizex - $x))]
-    set weight [expr $weight + .1 / (($sizey - $y) * ($sizey - $y))]
+    set fx 0
+    set fy 0
     foreach other $nodes {
        if { $other == $node } {
            continue
@@ -1648,29 +1709,29 @@ proc calcDistWeight { node x y } {
        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 d2 [expr $dx * $dx + $dy * $dy]
-       if { $d2 != 0 } {
-           set weight [expr $weight + 1 / $d2]
-       }
+       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 d2 [expr $dx * $dx + $dy * $dy]
-           set weight [expr $weight + $d2 * $d2 / 1000000000000000]
+           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]]
-       set o_y [expr [lindex $coords0 1] + [lindex $coords1 1]]
-       set dx [expr (2 * $x - $o_x)]
-       set dy [expr (2 * $y - $o_y)]
-       set d2 [expr $dx * $dx + $dy * $dy]
-       if { $d2 != 0 } {
-           set weight [expr $weight + .1 / $d2]
-       }
+       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 $weight
+    return "$fx $fy"
 }

diff --git a/imunes.tcl b/imunes.tcl
index 034a9ae9e97fd9342f6f19b8c34eedee631826e4..c25171c3d2ec815dca3ebebd14d6df55210a6a46 100755 (executable)
--- a/imunes.tcl
+++ b/imunes.tcl
@@ -102,6 +102,7 @@ set grid 24
 set sizex 1024
 set sizey 768
 set curcanvas [lindex $canvass 0]
+set autorearrange_enabled 0
 
 # Some default values
 set defLinkColor red