From: marko <marko>
Date: Sat, 10 Sep 2005 01:03:36 +0000 (+0000)
Subject: Replace the probabilistic algorithm for node rearrangement with a fluid
X-Git-Url: https://git.entuzijast.net/?a=commitdiff_plain;h=8e0e0dd5be52ff7768a6534093171f61a6afddf7;p=imunes.git

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 ed16999..9a0e9c3 100755
--- 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 034a9ae..c25171c 100755
--- 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