Changeset 903

Timestamp:

Feb 23, 2008 8:16:38 PM (16 years ago)

Author:

mmc

Message:

Final tweaks on the optimization package. The demo now works properly.
Just run "wish simple.tcl" to see it work.

Fixed the Tool class to work better with the optimizer. The "run"
method now returns the result directly as a Rappture::Library object,
and the Analyzer merely loads the object.

Location:

trunk

Files:

• gui/scripts/analyzer.tcl (modified) (5 diffs)
• gui/scripts/tool.tcl (modified) (3 diffs)
• optimizer/examples/simple.tcl (modified) (4 diffs)
• optimizer/src/plugin_pgapack.c (modified) (1 diff)
• optimizer/src/rp_optimizer_tcl.c (modified) (8 diffs)
• optimizer/tests/aaa.test (modified) (3 diffs)

trunk/gui/scripts/analyzer.tcl

@@ -52 +52 @@
     public method simulate {args}
     public method reset {{when -eventually}}
-    public method load {file}
+    public method load {xmlobj}
     public method clear {}
     public method download {option args}
@@ -77 +77 @@
 
     private common job                 ;# array var used for blt::bgexec jobs
-
-    # resources file tells us the results directory
-    public common _resultdir ""
-    public proc setResultDir {path} { set _resultdir $path }
-}
-
-# must use this name -- plugs into Rappture::resources::load
-proc analyzer_init_resources {} {
-    Rappture::resources::register \
-        results_directory Rappture::Analyzer::setResultDir
-}
-                                                                                
+}
+
 itk::usual Analyzer {
     keep -background -cursor foreground -font
@@ -354 +344 @@
     }
 
-    # read back the results from run.xml
+    # load results from run.xml into analyzer
     if {$status == 0 && $result != "ABORT"} {
-        if {[regexp {=RAPPTURE-RUN=>([^\n]+)} $result match file]} {
-            set status [catch {load $file} msg]
-            if {$status != 0} {
-                global errorInfo
-                set result "$msg\n$errorInfo"
-            }
-
-            # if there's a results_directory defined in the resources
-            # file, then move the run.xml file there for storage
-            if {"" != $_resultdir} {
-                catch {
-                    if {![file exists $_resultdir]} {
-                        _mkdir $_resultdir
-                    }
-                    file rename -force -- $file $_resultdir
-                }
-            }
-        } else {
-            set status 1
-            set result "Can't find result file in output.\nDid you call Rappture::result in your simulator?"
-        }
+        set status [catch {load $result} result]
     }
 
@@ -441 +411 @@
 
 # ----------------------------------------------------------------------
-# USAGE: load <file>
-#
-# Loads the data from the given <file> into the appropriate results
+# USAGE: load <xmlobj>
+#
+# Loads the data from the given <xmlobj> into the appropriate results
 # sets.  If necessary, new results sets are created to store the data.
 # ----------------------------------------------------------------------
-itcl::body Rappture::Analyzer::load {file} {
+itcl::body Rappture::Analyzer::load {xmlobj} {
     # only show the last result? then clear first
     if {[$_tool xml get tool.analyzer] == "last"} {
@@ -452 +422 @@
     }
 
-    # try to load new results from the given file
-    set xmlobj [Rappture::library $file]
     lappend _runs $xmlobj
 

trunk/gui/scripts/tool.tcl

@@ -40 +40 @@
 
     public common _resources
-    public proc setAppName {name} { set _resources(-appname) $name }
-    public proc setHubName {name} { set _resources(-hubname) $name }
-    public proc setHubURL {name}  { set _resources(-huburl) $name }
-    public proc setSession {name} { set _resources(-session) $name }
-    public proc setJobPrt {name}  { set _resources(-jobprotocol) $name }
+    public proc setAppName {name}   { set _resources(-appname) $name }
+    public proc setHubName {name}   { set _resources(-hubname) $name }
+    public proc setHubURL {name}    { set _resources(-huburl) $name }
+    public proc setSession {name}   { set _resources(-session) $name }
+    public proc setJobPrt {name}    { set _resources(-jobprotocol) $name }
+    public proc setResultDir {name} { set _resources(-resultdir) $name }
 }
 
@@ -50 +51 @@
 proc tool_init_resources {} {
     Rappture::resources::register \
-        application_name Rappture::Tool::setAppName \
-        application_id   Rappture::Tool::setAppId \
-        hub_name         Rappture::Tool::setHubName \
-        hub_url          Rappture::Tool::setHubURL \
-        session_token    Rappture::Tool::setSession \
-        job_protocol     Rappture::Tool::setJobPrt
+        application_name  Rappture::Tool::setAppName \
+        application_id    Rappture::Tool::setAppId \
+        hub_name          Rappture::Tool::setHubName \
+        hub_url           Rappture::Tool::setHubURL \
+        session_token     Rappture::Tool::setSession \
+        job_protocol      Rappture::Tool::setJobPrt \
+        results_directory Rappture::Tool::setResultDir
 }
                                                                                 
@@ -263 +265 @@
     #
     if {$status == 0} {
-        set file [string trim $job(output)]
-        return [list $status $file]
+        set result [string trim $job(output)]
+        if {[regexp {=RAPPTURE-RUN=>([^\n]+)} $result match file]} {
+            set status [catch {Rappture::library $file} result]
+            if {$status != 0} {
+                global errorInfo
+                set result "$result\n$errorInfo"
+            }
+
+            # if there's a results_directory defined in the resources
+            # file, then move the run.xml file there for storage
+            if {[info exists _resources(-resultdir)]
+                  && "" != $_resources(-resultdir)} {
+                catch {
+                    if {![file exists $_resources(-resultdir)]} {
+                        _mkdir $_resources(-resultdir)
+                    }
+                    file rename -force -- $file $_resources(-resultdir)
+                }
+            }
+        } else {
+            set status 1
+            set result "Can't find result file in output.\nDid you call Rappture
+::result in your simulator?"
+        }
+        return [list $status $result]
     } elseif {"" != $job(output) || "" != $job(error)} {
         return [list $status [string trim "$job(output)\n$job(error)"]]

trunk/optimizer/examples/simple.tcl

@@ -7 +7 @@
 #  to drive development and testing.
 #
-#  Run this as:  tclsh simple.tcl ?-tool path/to/tool.xml?
+#  Run this as:  wish simple.tcl ?-tool path/to/tool.xml?
 #
 # ======================================================================
@@ -16 +16 @@
 #  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # ======================================================================
+package require BLT
 package require Itcl
 package require Rappture
 package require RapptureGUI
 package require RapptureOptimizer
+
+set popsize 100  ;# size of each population for genetic algorithm
 
 # ----------------------------------------------------------------------
@@ -43 +46 @@
 
 # ----------------------------------------------------------------------
+#  Create some plotting stuff so we can watch the progress of the
+#  optimization as it runs.
+# ----------------------------------------------------------------------
+blt::graph .space
+.space xaxis configure -title "x1" -min -2 -max 2
+.space yaxis configure -title "x2" -min -2 -max 2
+.space legend configure -hide no
+pack .space -side left -expand yes -fill both
+
+blt::graph .value
+.value xaxis configure -title "job number" -min 0
+.value yaxis configure -title "f(x1,x2)" -logscale yes -max 1
+.value legend configure -hide yes
+pack .value -side left -expand yes -fill both
+
+set colors {magenta purple blue DeepSkyBlue cyan green yellow Gold orange tomato red FireBrick black}
+
+for {set pop [expr [llength $colors]-1]} {$pop >= 0} {incr pop -1} {
+    blt::vector x1vec$pop
+    blt::vector x2vec$pop
+    .space element create spots$pop -xdata x1vec$pop -ydata x2vec$pop \
+        -color [lindex $colors $pop] -linewidth 0 -label "Population #$pop"
+
+    blt::vector jobvec$pop
+    blt::vector fvec$pop
+    .value element create line$pop -xdata jobvec$pop -ydata fvec$pop \
+        -color [lindex $colors $pop] -symbol none
+}
+
+set jobnumber 0
+proc add_to_plot {xmlobj} {
+    global jobnumber popsize
+    set pop [expr {$jobnumber/$popsize}]
+    x1vec$pop append [$xmlobj get input.number(x1).current]
+    x2vec$pop append [$xmlobj get input.number(x2).current]
+    jobvec$pop append $jobnumber
+    fvec$pop append [$xmlobj get output.number(f).current]
+    incr jobnumber
+}
+
+# ----------------------------------------------------------------------
 #  Create an optimization context and configure the parameters used
 #  for optimization...
@@ -50 +94 @@
 optim add number input.number(x1) -min -2 -max 2
 optim add number input.number(x2) -min -2 -max 2
-optim configure -operation minimize -popsize 100 -maxruns 200
+optim configure -operation minimize -popsize $popsize -maxruns 1000
 
 set status [optim perform \
     -fitness output.number(f).current \
-    -updatecommand {puts "checking"}]
+    -updatecommand add_to_plot]
 
 puts "done: $status"

trunk/optimizer/src/plugin_pgapack.c

@@ -111 +111 @@
     PGASetPopReplaceType(ctx, dataPtr->popRepl);
     PGASetCrossoverType(ctx, PGA_CROSSOVER_UNIFORM);
+
+    /* stop if any of these are true */
+    PGASetStoppingRuleType(ctx, PGA_STOP_MAXITER);
+    PGASetStoppingRuleType(ctx, PGA_STOP_NOCHANGE);
+    PGASetStoppingRuleType(ctx, PGA_STOP_TOOSIMILAR);
 
     PGASetUserFunction(ctx, PGA_USERFUNCTION_CREATESTRING, PgapCreateString);

trunk/optimizer/src/rp_optimizer_tcl.c

@@ -416 +416 @@
                 case RP_OPTIMPARAM_NUMBER:
                     optSpecPtr = rpOptimNumberOpts;
+                    if (option == NULL) {
+                        /* no particular option value? then include type */
+                        if (Tcl_ListObjAppendElement(interp, rrval,
+                              Tcl_NewStringObj("number",-1)) != TCL_OK) {
+                            Tcl_DecrRefCount(rrval);
+                            Tcl_DecrRefCount(rval);
+                            return TCL_ERROR;
+                        }
+                    }
                     break;
                 case RP_OPTIMPARAM_STRING:
                     optSpecPtr = rpOptimStringOpts;
+                    if (option == NULL) {
+                        /* no particular option value? then include type */
+                        if (Tcl_ListObjAppendElement(interp, rrval,
+                              Tcl_NewStringObj("string",-1)) != TCL_OK) {
+                            Tcl_DecrRefCount(rrval);
+                            Tcl_DecrRefCount(rval);
+                            return TCL_ERROR;
+                        }
+                    }
                     break;
                 default:
@@ -638 +656 @@
         }
         Tcl_SetResult(interp, envPtr->pluginDefn->name, TCL_STATIC);
+
+        /* if the -tool was specified, then add it as a second element */
+        toolDataPtr = (RpOptimToolData*)envPtr->toolData;
+        if (toolDataPtr->toolPtr) {
+            Tcl_AppendElement(interp,
+                Tcl_GetStringFromObj(toolDataPtr->toolPtr, (int*)NULL));
+        }
         return TCL_OK;
     }
@@ -671 +696 @@
 {
     RpOptimStatus result = RP_OPTIM_SUCCESS;
+    Tcl_Obj *xmlObj = NULL;
     RpOptimToolData *toolDataPtr = (RpOptimToolData*)envPtr->toolData;
     Tcl_Interp *interp = toolDataPtr->interp;
+
     int n, status;
 #define MAXBUILTIN 10
@@ -678 +705 @@
     int rc; Tcl_Obj **rv;
     Tcl_Obj *dataPtr;
-    char *out;
+    Tcl_DString buffer;
 
     /*
@@ -730 +757 @@
             fprintf(stderr, "== JOB FAILED: malformed result: expected {status output}\n");
         } else {
-            out = Tcl_GetStringFromObj(rv[1], (int*)NULL);
             if (status != 0) {
                 result = RP_OPTIM_FAILURE;
                 fprintf(stderr, "== JOB FAILED with status code %d:\n%s\n",
-                    status, out);
+                    status, Tcl_GetStringFromObj(rv[1], (int*)NULL));
             } else {
                 /*
@@ -745 +771 @@
                  *    xmlobj get fitnessExpr
                  */
-                getcmd[0] = rv[1];
+                xmlObj = rv[1];
+                /* hang onto this for -updatecommand below */
+                Tcl_IncrRefCount(xmlObj);
+
+                getcmd[0] = xmlObj;
                 getcmd[1] = Tcl_NewStringObj("get",-1);
                 getcmd[2] = Tcl_NewStringObj(envPtr->fitnessExpr,-1);
@@ -786 +816 @@
      */
     if (toolDataPtr->updateCmdPtr) {
-        status = Tcl_GlobalEvalObj(toolDataPtr->interp,
-            toolDataPtr->updateCmdPtr);
+        Tcl_DStringInit(&buffer);
+        Tcl_DStringAppend(&buffer,
+            Tcl_GetStringFromObj(toolDataPtr->updateCmdPtr, (int*)NULL), -1);
+        Tcl_DStringAppendElement(&buffer,
+            (xmlObj != NULL) ? Tcl_GetStringFromObj(xmlObj, (int*)NULL): "");
+
+        status = Tcl_GlobalEval(toolDataPtr->interp,
+            Tcl_DStringValue(&buffer));
 
         if (status == TCL_ERROR) {
@@ -793 +829 @@
         }
         else if (status == TCL_BREAK || status == TCL_RETURN) {
-            return RP_OPTIM_ABORTED;
-        }
-    }
-    return RP_OPTIM_SUCCESS;
+            result = RP_OPTIM_ABORTED;
+        }
+        Tcl_DStringFree(&buffer);
+    }
+
+    if (xmlObj) {
+        Tcl_DecrRefCount(xmlObj);  /* done with this now */
+    }
+    return result;
 }

trunk/optimizer/tests/aaa.test

@@ -67 +67 @@
   ctxt add number input.temperature -min 0 -max 1
   ctxt get
-} {input.temperature -min 0.0 -max 1.0}
+} {input.temperature number -min 0.0 -max 1.0}
 
 test aaa-2.2 {add a parameter with a bad type} {
@@ -87 +87 @@
 test aaa-2.6 {add doesn't add parameter when there's an error} {
   ctxt get
-} {input.temperature -min 0.0 -max 1.0}
+} {input.temperature number -min 0.0 -max 1.0}
 
 test aaa-2.7 {add a string parameter} {
   ctxt add string input.choice -values {a b c}
   ctxt get input.choice
-} {-values {a b c}}
+} {string -values {a b c}}
 
 test aaa-2.8 {add a string parameter with a missing option} {
@@ -104 +104 @@
 test aaa-2.10 {add doesn't add parameter when there's an error} {
   ctxt get
-} {{input.temperature -min 0.0 -max 1.0} {input.choice -values {a b c}}}
+} {{input.temperature number -min 0.0 -max 1.0} {input.choice string -values {a b c}}}
+
+test aaa-2.11 {add another number and return } {
+  ctxt add number input.temporary -min -5 -max 5
+  lsort [ctxt get input.temp*]
+} {{input.temperature number -min 0.0 -max 1.0} {input.temporary number -min -5.0 -max 5.0}}
+
+test aaa-2.12 {query -min values for multiple parameters} {
+  lsort [ctxt get input.temp* -min]
+} {{input.temperature 0.0} {input.temporary -5.0}}
 
 # cleanup