Implement a simple genetic algorithm for automatic rearpositioining of

nodes.  The new function is activated from the "tools" menu, and remains
in effect until a cusor is clicked on blank space in the canvas, or
"execute" mode is engaged.  It is possible to reposition either all nodes
or only the currently selected ones.

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

diff --git a/editor.tcl b/editor.tcl
index 382e4489bcaae8b3919d1024936679ac3bd2131f..ed16999a6af68d2ded7b4df50e1e7bbc2871a03b 100755 (executable)
--- a/editor.tcl
+++ b/editor.tcl
@@ -606,11 +606,10 @@ proc button1-motion { c x y } {
            set lastY $y
     } else {
        foreach img [$c find withtag "selectmark"] {
-           $c move $img [expr $x-$lastX] [expr $y-$lastY]
            set node [lindex [$c gettags $img] 1]
+           $c move $img [expr $x-$lastX] [expr $y-$lastY]
             set img [$c find withtag "node && $node"]
            $c move $img [expr $x-$lastX] [expr $y-$lastY]
-           set node [lindex [$c gettags $img] 1]
            set img [$c find withtag "nodelabel && $node"]
            $c move $img [expr $x-$lastX] [expr $y-$lastY]
            $c addtag need_redraw withtag "link && $node"
@@ -634,6 +633,7 @@ proc button1-release { c x y } {
     global lastX lastY sizex sizey
     global defLinkColor defLinkWidth
     global defEthBandwidth defSerBandwidth defSerDelay
+    global autorearrange_enabled
 
     set x [$c canvasx $x]
     set y [$c canvasy $y]
@@ -806,6 +806,7 @@ proc button1-release { c x y } {
        if {$selectbox == ""} {
            set x1 $x
            set y1 $y
+           set autorearrange_enabled 0
        } else {
            set coords [$c coords $selectbox]
            set x [lindex $coords 0]
@@ -1577,3 +1578,99 @@ proc delete_object { c x y } {
     updateUndoLog
 }
 
+
+proc rearrange { mode } {
+    global nodes autorearrange_enabled
+
+    set c .c
+    set autorearrange_enabled 1
+    .menubar.tools entryconfigure "Rearrange all" -state disabled
+    .menubar.tools entryconfigure "Rearrange selected" -state disabled
+    .bottom.mbuf config -text "autorearrange"
+    if { $mode == "selected" } {
+       set tagmatch "node && selected"
+    } else {
+       set tagmatch "node"
+    }
+    while { $autorearrange_enabled } {
+       foreach obj [$c find withtag $tagmatch] {
+            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]
+           } else {
+               set weight0 [calcDistWeight $node $x $y]
+           }
+           set dx [expr (rand() - 0.5) * 16]
+           set dy [expr (rand() - 0.5) * 16]
+           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 } {
+               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"
+           }
+       }
+       foreach link [$c find withtag "link && need_redraw"] {
+           redrawLink [lindex [$c gettags $link] 1]
+       }
+       $c dtag link need_redraw
+       update
+    }
+    .menubar.tools entryconfigure "Rearrange all" -state normal
+    .menubar.tools entryconfigure "Rearrange selected" -state normal
+    .bottom.mbuf config -text ""
+}
+
+
+proc calcDistWeight { 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))]
+    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 d2 [expr $dx * $dx + $dy * $dy]
+       if { $d2 != 0 } {
+           set weight [expr $weight + 1 / $d2]
+       }
+       if {[linkByPeers $node $other] != ""} {
+           set d2 [expr $dx * $dx + $dy * $dy]
+           set weight [expr $weight + $d2 * $d2 / 1000000000000000]
+       }
+    }
+    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]
+       }
+    }
+    return $weight
+}

diff --git a/exec.tcl b/exec.tcl
index 0a47116156b02ca59185e50cb4642c8f17928508..4d2c0fb4be66095b0fb255c3411bffbc8b231e8a 100755 (executable)
--- a/exec.tcl
+++ b/exec.tcl
@@ -73,6 +73,10 @@ proc setOperMode { mode } {
     set activetool select
     .left.select configure -state active
     if { "$mode" == "exec" && [nexec id -u] == 0} {
+       global autorearrange_enabled
+       set autorearrange_enabled 0
+       .menubar.tools entryconfigure "Rearrange all" -state disabled
+       .menubar.tools entryconfigure "Rearrange selected" -state disabled
        .menubar.experiment entryconfigure "Execute" -state disabled
        .menubar.experiment entryconfigure "Terminate" -state normal
        .menubar.edit entryconfigure "Undo" -state disabled
@@ -85,6 +89,8 @@ proc setOperMode { mode } {
     } else {
        if {$oper_mode != "edit"} {
            vimageCleanup
+           .menubar.tools entryconfigure "Rearrange all" -state normal
+           .menubar.tools entryconfigure "Rearrange selected" -state normal
        }
        if {[nexec id -u] == 0} {
            .menubar.experiment entryconfigure "Execute" -state normal

diff --git a/initgui.tcl b/initgui.tcl
index e93eb369db209e16f0a34ce12c09b3d27afa62df..637bde3795de20aca46044613f26e18b12e0783f 100755 (executable)
--- a/initgui.tcl
+++ b/initgui.tcl
@@ -48,6 +48,7 @@ menu .menubar
 .menubar add cascade -label File -underline 0 -menu .menubar.file
 .menubar add cascade -label Edit -underline 0 -menu .menubar.edit
 #.menubar add cascade -label Canvas -underline 0 -menu .menubar.canvas
+.menubar add cascade -label Tools -underline 0 -menu .menubar.tools
 .menubar add cascade -label View -underline 0 -menu .menubar.view
 .menubar add cascade -label Experiment -underline 1 -menu .menubar.experiment
 .menubar add cascade -label Help -underline 0 -menu .menubar.help
@@ -117,6 +118,16 @@ bind . <Control-y> redo
 menu .menubar.canvas -tearoff 0
 
 
+#
+# Tools
+#
+menu .menubar.tools -tearoff 0
+.menubar.tools add command -label "Rearrange all" -underline 0 \
+    -command { rearrange all }
+.menubar.tools add command -label "Rearrange selected" -underline 0 \
+    -command { rearrange selected }
+
+
 #
 # View
 #
@@ -174,12 +185,6 @@ menu .menubar.experiment -tearoff 0
        -command "setOperMode edit" -state disabled
 
 
-#
-# Tools
-#
-menu .menubar.tools -tearoff 0
-
-
 #
 # Help
 #