source: trunk/packages/optimizer/src/rp_optimizer_tcl.c @ 1067

Last change on this file since 1067 was 1062, checked in by liveletlive, 14 years ago

Committing changes related to command <name> samples ?number?

File size: 30.9 KB
Line 
1/*
2 * ----------------------------------------------------------------------
3 *  rp_optimizer_tcl
4 *
5 *  This is the Tcl API for the functions in rp_optimizer.  This code
6 *  allows you to call all of the core optimization functions from Tcl.
7 *
8 * ======================================================================
9 *  AUTHOR:  Michael McLennan, Purdue University
10 *  Copyright (c) 2008  Purdue Research Foundation
11 *
12 *  See the file "license.terms" for information on usage and
13 *  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14 * ======================================================================
15 */
16#include "rp_optimizer.h"
17
18extern int pgapack_abort;
19
20/*
21 * ----------------------------------------------------------------------
22 * KNOWN OPTIMIZATION PACKAGES
23 * Add an entry below for each new optimization package that is
24 * plugged in and available via the -using option.  End with all
25 * NULL values.
26 * ----------------------------------------------------------------------
27 */
28RpOptimInit PgapackInit;
29RpOptimHandler PgapackRun;
30RpOptimCleanup PgapackCleanup;
31extern RpTclOption PgapackOptions;
32
33static RpOptimPlugin rpOptimPlugins[] = {
34    {"pgapack", PgapackInit, PgapackRun, PgapackCleanup, &PgapackOptions},
35    {NULL, NULL, NULL},
36};
37
38typedef struct RpOptimToolData {
39    Tcl_Interp *interp;             /* interp handling this tool */
40    Tcl_Obj *toolPtr;               /* command for tool object */
41    Tcl_Obj *updateCmdPtr;          /* command used to look for abort */
42} RpOptimToolData;
43
44/*
45 * ----------------------------------------------------------------------
46 *  Options for the various parameter types
47 * ----------------------------------------------------------------------
48 */
49RpTclOption rpOptimNumberOpts[] = {
50  {"-min", RP_OPTION_DOUBLE, Rp_Offset(RpOptimParamNumber,min)},
51  {"-max", RP_OPTION_DOUBLE, Rp_Offset(RpOptimParamNumber,max)},
52  {NULL, NULL, 0}
53};
54
55RpTclOption rpOptimStringOpts[] = {
56  {"-values", RP_OPTION_LIST, Rp_Offset(RpOptimParamString,values)},
57  {NULL, NULL, 0}
58};
59
60static int RpOptimizerCmd _ANSI_ARGS_((ClientData clientData,
61    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
62static void RpOptimCmdDelete _ANSI_ARGS_((ClientData cdata));
63static int RpOptimInstanceCmd _ANSI_ARGS_((ClientData clientData,
64    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
65static RpOptimStatus RpOptimizerPerformInTcl _ANSI_ARGS_((RpOptimEnv *envPtr,
66    RpOptimParam *values, int numValues, double *fitnessPtr));
67
68#ifdef BUILD_Rappture
69__declspec( dllexport )
70#endif
71
72extern int pgapack_abort;
73extern void PGARuntimeDataTableInit();
74extern void PGARuntimeDataTableDeInit();
75extern void GetSampleInformation();
76
77int
78Rapptureoptimizer_Init(Tcl_Interp *interp)   /* interpreter being initialized */
79{
80    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
81        return TCL_ERROR;
82    }
83    if (Tcl_PkgProvide(interp, "RapptureOptimizer", PACKAGE_VERSION)
84          != TCL_OK) {
85        return TCL_ERROR;
86    }
87
88    Tcl_CreateObjCommand(interp, "::Rappture::optimizer", RpOptimizerCmd,
89        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
90
91    return TCL_OK;
92}
93
94/*
95 * ------------------------------------------------------------------------
96 *  RpOptimizerCmd()
97 *
98 *  Invoked whenever someone uses the "optimizer" command to create a
99 *  new optimizer context.  Handles the following syntax:
100 *
101 *      optimizer ?<name>? ?-using <pluginName>?
102 *
103 *  Creates a command called <name> that can be used to manipulate
104 *  the optimizer context.  Returns TCL_OK on success, and TCL_ERROR
105 *  (along with an error message in the interpreter) if anything goes
106 *  wrong.
107 * ------------------------------------------------------------------------
108 */
109static int
110RpOptimizerCmd(cdata, interp, objc, objv)
111    ClientData cdata;         /* not used */
112    Tcl_Interp *interp;       /* interpreter handling this request */
113    int objc;                 /* number of command line args */
114    Tcl_Obj *CONST objv[];    /* command line args */
115{
116    /* use this for auto-generated names */
117    static int autocounter = 0;
118
119    /* use this plugin by default for -using */
120    RpOptimPlugin *usingPluginPtr = &rpOptimPlugins[0];
121
122    /* no good default for the tool being optimized */
123    Tcl_Obj *toolPtr = NULL;
124
125    /* no name for this object by default */
126    char *name = NULL;
127
128    RpOptimEnv* envPtr;
129    RpOptimPlugin* pluginPtr;
130    RpOptimToolData* toolDataPtr;
131
132    int n;
133    char *option, autoname[32], *sep;
134    Tcl_CmdInfo cmdInfo;
135
136    /*
137     * Make sure that a command with this name doesn't already exist.
138     */
139    n = 1;
140    if (objc >= 2) {
141        name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
142        if (*name != '-') {
143            if (Tcl_GetCommandInfo(interp, name, &cmdInfo)) {
144                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
145                    "command \"", name, "\" already exists",
146                    (char*)NULL);
147                return TCL_ERROR;
148            }
149            n++;
150        }
151    }
152
153    /*
154     * Parse the rest of the arguments.
155     */
156    while (n < objc) {
157        option = Tcl_GetStringFromObj(objv[n], (int*)NULL);
158        if (strcmp(option,"-using") == 0) {
159            if (n+1 >= objc) {
160                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
161                    "missing value for option \"", option, "\"",
162                    (char*)NULL);
163                return TCL_ERROR;
164            }
165
166            /* search for a plugin with the given name */
167            option = Tcl_GetStringFromObj(objv[n+1], (int*)NULL);
168            for (pluginPtr=rpOptimPlugins; pluginPtr->name; pluginPtr++) {
169                if (strcmp(pluginPtr->name,option) == 0) {
170                    break;
171                }
172            }
173            if (pluginPtr->name == NULL) {
174                /* oops! name not recognized */
175                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
176                    "bad plugin name \"", option, "\": should be ",
177                    (char*)NULL);
178
179                sep = "";
180                for (pluginPtr=rpOptimPlugins; pluginPtr->name; pluginPtr++) {
181                    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
182                        sep, pluginPtr->name, (char*)NULL);
183                    sep = ", ";
184                }
185                return TCL_ERROR;
186            }
187            usingPluginPtr = pluginPtr;
188            n += 2;
189        }
190        else if (strcmp(option,"-tool") == 0) {
191            if (n+1 >= objc) {
192                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
193                    "missing value for option \"", option, "\"",
194                    (char*)NULL);
195                return TCL_ERROR;
196            }
197            toolPtr = objv[n+1];
198            Tcl_IncrRefCount(toolPtr);
199            n += 2;
200        }
201        else {
202            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
203                "bad option \"", option, "\": should be ",
204                "-tool, -using", (char*)NULL);
205            return TCL_ERROR;
206        }
207    }
208
209    /*
210     * If a name wasn't specified, then auto-generate one.
211     */
212    while (name == NULL) {
213        sprintf(autoname, "optimizer%d", autocounter++);
214        if (!Tcl_GetCommandInfo(interp, autoname, &cmdInfo)) {
215            name = autoname;
216        }
217    }
218
219    /*
220     * Create an optimizer and install a Tcl command to access it.
221     */
222    envPtr = RpOptimCreate(usingPluginPtr);
223
224    toolDataPtr = (RpOptimToolData*)malloc(sizeof(RpOptimToolData));
225    toolDataPtr->interp = interp;
226    toolDataPtr->toolPtr = toolPtr;
227    toolDataPtr->updateCmdPtr = NULL;
228    envPtr->toolData = (ClientData)toolDataPtr;
229    Tcl_CreateObjCommand(interp, name, RpOptimInstanceCmd,
230        (ClientData)envPtr, (Tcl_CmdDeleteProc*)RpOptimCmdDelete);
231    Tcl_SetResult(interp, name, TCL_VOLATILE);
232    return TCL_OK;
233}
234
235/*
236 * ----------------------------------------------------------------------
237 * RpOptimDelete()
238 *
239 * Called whenever a optimizer object is deleted to clean up after
240 * the command.  If the optimizer is running, it is aborted, and
241 * the optimizer is deleted.
242 * ----------------------------------------------------------------------
243 */
244static void
245RpOptimCmdDelete(cdata)
246    ClientData cdata;   /* optimizer being deleted */
247{
248    RpOptimEnv *envPtr = (RpOptimEnv*)cdata;
249    RpOptimToolData *toolDataPtr;
250    int n;
251    ClientData paramdata;
252
253    PGARuntimeDataTableDeInit();/*Free space allocated to data table here*/
254    if (envPtr->toolData) {
255        toolDataPtr = (RpOptimToolData*)envPtr->toolData;
256        if (toolDataPtr->toolPtr) {
257            Tcl_DecrRefCount(toolDataPtr->toolPtr);
258        }
259        if (toolDataPtr->updateCmdPtr) {
260            Tcl_DecrRefCount(toolDataPtr->updateCmdPtr);
261        }
262        free(toolDataPtr);
263        envPtr->toolData = NULL;
264    }
265
266    for (n=0; n < envPtr->numParams; n++) {
267        paramdata = (ClientData)envPtr->paramList[n];
268        switch (envPtr->paramList[n]->type) {
269        case RP_OPTIMPARAM_NUMBER:
270            RpTclOptionsCleanup(rpOptimNumberOpts, paramdata);
271            break;
272        case RP_OPTIMPARAM_STRING:
273            RpTclOptionsCleanup(rpOptimStringOpts, paramdata);
274            break;
275        }
276    }
277    RpOptimDelete(envPtr);
278}
279
280/*
281 * ------------------------------------------------------------------------
282 *  RpOptimInstanceCmd()
283 *
284 *  Invoked to handle the actions of an optimizer object.  Handles the
285 *  following syntax:
286 *
287 *      <name> add number <path> ?-min <number>? ?-max <number>?
288 *      <name> add string <path> ?-values <valueList>?
289 *      <name> get ?<glob>? ?-option?
290 *      <name> configure ?-option? ?value -option value ...?
291 *      <name> perform ?-tool <tool>? ?-fitness <expr>? \
292 *                     ?-updatecommand <varName>?
293 *      <name> using
294 *      <name> samples ?number?
295 *
296 *  The "add" command is used to add various parameter types to the
297 *  optimizer context.  The "perform" command kicks off an optimization
298 *  run. The "samples" command displays sample info during an optimization run.
299 * ------------------------------------------------------------------------
300 */
301static int
302RpOptimInstanceCmd(cdata, interp, objc, objv)
303    ClientData cdata;         /* optimizer context */
304    Tcl_Interp *interp;       /* interpreter handling this request */
305    int objc;                 /* number of command line args */
306    Tcl_Obj *CONST objv[];    /* command line args */
307{
308    RpOptimEnv* envPtr = (RpOptimEnv*)cdata;
309    RpOptimToolData* toolDataPtr = (RpOptimToolData*)envPtr->toolData;
310
311    int n, j, nvals, nmatches;
312    char *option, *type, *path, *fitnessExpr;
313    RpOptimParam *paramPtr;
314    RpOptimParamString *strPtr;
315    RpOptimStatus status;
316    RpTclOption *optSpecPtr;
317    Tcl_Obj *rval, *rrval, *toolPtr, *updateCmdPtr;
318   
319    if (objc < 2) {
320        Tcl_WrongNumArgs(interp, 1, objv, "option ?args...?");
321        return TCL_ERROR;
322    }
323    option = Tcl_GetStringFromObj(objv[1], (int*)NULL);
324
325    /*
326     * OPTION:  add type ?args...?
327     */
328    if (*option == 'a' && strcmp(option,"add") == 0) {
329        if (objc < 4) {
330            Tcl_WrongNumArgs(interp, 1, objv, "add type path ?args...?");
331            return TCL_ERROR;
332        }
333        type = Tcl_GetStringFromObj(objv[2], (int*)NULL);
334        path = Tcl_GetStringFromObj(objv[3], (int*)NULL);
335
336        /*
337         * OPTION:  add number name ?-min num? ?-max num?
338         */
339        if (*type == 'n' && strcmp(type,"number") == 0) {
340            paramPtr = RpOptimAddParamNumber(envPtr, path);
341            if (RpTclOptionsProcess(interp, objc-4, objv+4,
342                  rpOptimNumberOpts, (ClientData)paramPtr) != TCL_OK) {
343                RpOptimDeleteParam(envPtr, path);
344                return TCL_ERROR;
345            }
346        }
347
348        /*
349         * OPTION:  add string name ?-values list?
350         */
351        else if (*type == 's' && strcmp(type,"string") == 0) {
352            paramPtr = RpOptimAddParamString(envPtr, path);
353            if (RpTclOptionsProcess(interp, objc-4, objv+4,
354                  rpOptimStringOpts, (ClientData)paramPtr) != TCL_OK) {
355                RpOptimDeleteParam(envPtr, path);
356                return TCL_ERROR;
357            }
358
359            /* list of values just changed -- patch up the count */
360            strPtr = (RpOptimParamString*)paramPtr;
361            for (nvals=0; strPtr->values[nvals]; nvals++)
362                ; /* count the values */
363            strPtr->numValues = nvals;
364        }
365        else {
366            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
367                "bad parameter type \"", type, "\": should be number, string",
368                (char*)NULL);
369            return TCL_ERROR;
370        }
371    } else if (*option == 'a' && strcmp(option,"abort") == 0) {
372        int value;
373
374        if (objc < 3) {
375            Tcl_WrongNumArgs(interp, 1, objv, "abort bool");
376            return TCL_ERROR;
377        }
378        if (Tcl_GetBooleanFromObj(interp, objv[2], &value) != TCL_OK) {
379            return TCL_ERROR;
380        }
381        pgapack_abort = value;
382        return TCL_OK;
383    } else if (*option == 'g' && strcmp(option,"get") == 0) {
384        /*
385         * OPTION:  get ?globPattern? ?-option?
386         */
387        if (objc > 2) {
388            path = Tcl_GetStringFromObj(objv[2], (int*)NULL);
389        } else {
390            path = NULL;
391        }
392        if (objc > 3) {
393            option = Tcl_GetStringFromObj(objv[3], (int*)NULL);
394        } else {
395            option = NULL;
396        }
397        if (objc > 4) {
398            Tcl_WrongNumArgs(interp, 1, objv, "get ?pattern? ?-option?");
399            return TCL_ERROR;
400        }
401
402        /* count the number of matches */
403        nmatches = 0;
404        for (n=0; n < envPtr->numParams; n++) {
405            if (path == NULL
406                  || Tcl_StringMatch(envPtr->paramList[n]->name,path)) {
407                nmatches++;
408            }
409        }
410
411        rval = Tcl_NewListObj(0,NULL);
412        Tcl_IncrRefCount(rval);
413        for (n=0; n < envPtr->numParams; n++) {
414            if (path == NULL
415                  || Tcl_StringMatch(envPtr->paramList[n]->name,path)) {
416
417                rrval = Tcl_NewListObj(0,NULL);
418                Tcl_IncrRefCount(rrval);
419
420                /* add the parameter name as the first element */
421                if (nmatches > 1 || path == NULL) {
422                    if (Tcl_ListObjAppendElement(interp, rrval,
423                          Tcl_NewStringObj(envPtr->paramList[n]->name,-1))
424                          != TCL_OK) {
425                        Tcl_DecrRefCount(rrval);
426                        Tcl_DecrRefCount(rval);
427                        return TCL_ERROR;
428                    }
429                }
430
431                /* get the option specifications for this parameter */
432                switch (envPtr->paramList[n]->type) {
433                case RP_OPTIMPARAM_NUMBER:
434                    optSpecPtr = rpOptimNumberOpts;
435                    if (option == NULL) {
436                        /* no particular option value? then include type */
437                        if (Tcl_ListObjAppendElement(interp, rrval,
438                              Tcl_NewStringObj("number",-1)) != TCL_OK) {
439                            Tcl_DecrRefCount(rrval);
440                            Tcl_DecrRefCount(rval);
441                            return TCL_ERROR;
442                        }
443                    }
444                    break;
445                case RP_OPTIMPARAM_STRING:
446                    optSpecPtr = rpOptimStringOpts;
447                    if (option == NULL) {
448                        /* no particular option value? then include type */
449                        if (Tcl_ListObjAppendElement(interp, rrval,
450                              Tcl_NewStringObj("string",-1)) != TCL_OK) {
451                            Tcl_DecrRefCount(rrval);
452                            Tcl_DecrRefCount(rval);
453                            return TCL_ERROR;
454                        }
455                    }
456                    break;
457                default:
458                    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
459                        "internal error: unrecognized parameter type",
460                        " for \"", envPtr->paramList[n]->name,"\"",
461                        (char*)NULL);
462                    Tcl_DecrRefCount(rrval);
463                    Tcl_DecrRefCount(rval);
464                    return TCL_ERROR;
465                }
466
467                if (option == NULL) {
468                    /* no particular option value */
469                    for (j=0; optSpecPtr[j].optname; j++) {
470                        char *curOpt = optSpecPtr[j].optname;
471                        /* append -option name */
472                        if (Tcl_ListObjAppendElement(interp, rrval,
473                              Tcl_NewStringObj(curOpt,-1)) != TCL_OK) {
474                            Tcl_DecrRefCount(rrval);
475                            Tcl_DecrRefCount(rval);
476                            return TCL_ERROR;
477                        }
478                        /* append option value */
479                        if (RpTclOptionGet(interp, optSpecPtr,
480                            (ClientData)envPtr->paramList[n],
481                            optSpecPtr[j].optname) != TCL_OK) {
482                            Tcl_DecrRefCount(rrval);
483                            Tcl_DecrRefCount(rval);
484                            return TCL_ERROR;
485                        }
486                        if (Tcl_ListObjAppendElement(interp, rrval,
487                              Tcl_GetObjResult(interp)) != TCL_OK) {
488                            Tcl_DecrRefCount(rrval);
489                            Tcl_DecrRefCount(rval);
490                            return TCL_ERROR;
491                        }
492                    }
493                } else {
494                    if (RpTclOptionGet(interp, optSpecPtr,
495                        (ClientData)envPtr->paramList[n], option) != TCL_OK) {
496                        Tcl_DecrRefCount(rrval);
497                        Tcl_DecrRefCount(rval);
498                        return TCL_ERROR;
499                    }
500                    if (Tcl_ListObjAppendElement(interp, rrval,
501                          Tcl_GetObjResult(interp)) != TCL_OK) {
502                        Tcl_DecrRefCount(rrval);
503                        Tcl_DecrRefCount(rval);
504                        return TCL_ERROR;
505                    }
506                }
507                if (Tcl_ListObjAppendElement(interp, rval, rrval) != TCL_OK) {
508                    Tcl_DecrRefCount(rrval);
509                    Tcl_DecrRefCount(rval);
510                    return TCL_ERROR;
511                }
512                Tcl_DecrRefCount(rrval);
513            }
514        }
515
516        if (nmatches == 1) {
517            /* only one result? then return it directly */
518            Tcl_ListObjIndex(interp, rval, 0, &rrval);
519            Tcl_SetObjResult(interp, rrval);
520        } else {
521            /* return a whole list */
522            Tcl_SetObjResult(interp, rval);
523        }
524        Tcl_DecrRefCount(rval);
525        return TCL_OK;
526    }
527
528    /*
529     * OPTION:  configure ?-option? ?value -option value ...?
530     */
531    else if (*option == 'c' && strcmp(option,"configure") == 0) {
532        optSpecPtr = envPtr->pluginDefn->optionSpec;
533        if (objc == 2) {
534            /* report all values: -option val -option val ... */
535
536            rval = Tcl_NewListObj(0,NULL);
537            Tcl_IncrRefCount(rval);
538
539            for (n=0; optSpecPtr[n].optname; n++) {
540                if (RpTclOptionGet(interp, optSpecPtr,
541                    (ClientData)envPtr->pluginData,
542                    optSpecPtr[n].optname) != TCL_OK) {
543                    Tcl_DecrRefCount(rval);
544                    return TCL_ERROR;
545                }
546                if (Tcl_ListObjAppendElement(interp, rval,
547                      Tcl_NewStringObj(optSpecPtr[n].optname,-1)) != TCL_OK) {
548                    Tcl_DecrRefCount(rval);
549                    return TCL_ERROR;
550                }
551                if (Tcl_ListObjAppendElement(interp, rval,
552                      Tcl_GetObjResult(interp)) != TCL_OK) {
553                    Tcl_DecrRefCount(rval);
554                    return TCL_ERROR;
555                }
556            }
557            Tcl_SetObjResult(interp, rval);
558            Tcl_DecrRefCount(rval);
559            return TCL_OK;
560        }
561        else if (objc == 3) {
562            /* report the value for just one option */
563            option = Tcl_GetStringFromObj(objv[2], (int*)NULL);
564            return RpTclOptionGet(interp, optSpecPtr,
565                (ClientData)envPtr->pluginData, option);
566        }
567        else {
568            return RpTclOptionsProcess(interp, objc-2, objv+2,
569                optSpecPtr, envPtr->pluginData);
570        }
571    }
572
573    /*
574     * OPTION:  perform ?-tool name? ?-fitness expr? ?-updatecommand name?
575     */
576    else if (*option == 'p' && strcmp(option,"perform") == 0) {
577        /* use this tool by default */
578        toolPtr = toolDataPtr->toolPtr;
579
580        /* no -fitness function by default */
581        fitnessExpr = NULL;
582
583        /* no -updatecommand by default */
584        updateCmdPtr = NULL;
585               
586                PGARuntimeDataTableInit(envPtr);/*Initialize Data table here....*/
587               
588        n = 2;
589        while (n < objc) {
590            option = Tcl_GetStringFromObj(objv[n], (int*)NULL);
591            if (n+1 >= objc) {
592                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
593                    "missing value for option \"", option, "\"",
594                    (char*)NULL);
595                return TCL_ERROR;
596            }
597            if (strcmp(option,"-tool") == 0) {
598                toolPtr = objv[n+1];
599                n += 2;
600            }
601            else if (strcmp(option,"-fitness") == 0) {
602                fitnessExpr = Tcl_GetStringFromObj(objv[n+1], (int*)NULL);
603                n += 2;
604            }
605            else if (strcmp(option,"-updatecommand") == 0) {
606                updateCmdPtr = objv[n+1];
607                n += 2;
608            }
609            else {
610                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
611                    "bad option \"", option, "\": should be -fitness, -tool,"
612                    " -updatecommand", (char*)NULL);
613                return TCL_ERROR;
614            }
615        }
616
617        /*
618         * Must have a tool object and a fitness function at this point,
619         * or else we don't know what to optimize.
620         */
621        if (toolPtr == NULL) {
622            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
623                "tool being optimized not specified via -tool option",
624                (char*)NULL);
625            return TCL_ERROR;
626        }
627        if (fitnessExpr == NULL) {
628            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
629                "missing -fitness function for optimization",
630                (char*)NULL);
631            return TCL_ERROR;
632        }
633
634        Tcl_IncrRefCount(toolPtr);
635        if (updateCmdPtr) {
636            Tcl_IncrRefCount(updateCmdPtr);
637            toolDataPtr->updateCmdPtr = updateCmdPtr;
638        }
639               
640        /* call the main optimization routine here */
641        status = (*envPtr->pluginDefn->runProc)(envPtr,
642            RpOptimizerPerformInTcl, fitnessExpr);
643               
644                fprintf(stderr, ">>>status=%d\n", status);
645
646        Tcl_DecrRefCount(toolPtr);
647        if (updateCmdPtr) {
648            Tcl_DecrRefCount(updateCmdPtr);
649            toolDataPtr->updateCmdPtr = NULL;
650        }
651
652        switch (status) {
653        case RP_OPTIM_SUCCESS:
654            Tcl_SetResult(interp, "success", TCL_STATIC);
655            break;
656        case RP_OPTIM_FAILURE:
657            Tcl_SetResult(interp, "failure", TCL_STATIC);
658            break;
659        case RP_OPTIM_ABORTED:
660            fprintf(stderr, "Got abort status=%d\n", status);
661            Tcl_SetResult(interp, "aborted", TCL_STATIC);
662            break;
663        case RP_OPTIM_UNKNOWN:
664        default:
665            Tcl_SetResult(interp, "???", TCL_STATIC);
666            break;
667        }
668        return TCL_OK;
669    }
670
671    /*
672     * OPTION:  using
673     */
674    else if (*option == 'u' && strcmp(option,"using") == 0) {
675        if (objc > 2) {
676            Tcl_WrongNumArgs(interp, 1, objv, "using");
677            return TCL_ERROR;
678        }
679        Tcl_SetResult(interp, envPtr->pluginDefn->name, TCL_STATIC);
680
681        /* if the -tool was specified, then add it as a second element */
682        toolDataPtr = (RpOptimToolData*)envPtr->toolData;
683        if (toolDataPtr->toolPtr) {
684            Tcl_AppendElement(interp,
685                Tcl_GetStringFromObj(toolDataPtr->toolPtr, (int*)NULL));
686        }
687        return TCL_OK;
688    }
689   
690    else if(*option == 's' && strcmp(option,"samples") == 0){
691        int sampleNumber = -1; /*initing sampnum to -1, use it when no sample number is specified*/
692        char *sampleDataBuffer;
693        if(objc>3){
694                Tcl_WrongNumArgs(interp, 2, objv, "?sampleNumber?");
695            return TCL_ERROR;
696        }
697       
698        if(objc == 3){
699                if(Tcl_GetIntFromObj(interp,objv[2],&sampleNumber) != TCL_OK){
700                        return TCL_ERROR;
701                }
702                sampleDataBuffer = malloc(sizeof(char)*SINGLE_SAMPLE_DATA_BUFFER_DEFAULT_SIZE);
703        }else{
704                sampleDataBuffer = malloc(sizeof(char)*50);
705        }
706       
707        if(sampleDataBuffer == NULL){
708                panic("Error: Could not allocate memory for sample data buffer.");
709        }
710        GetSampleInformation(sampleDataBuffer,sampleNumber);
711                fprintf(stdout,sampleDataBuffer);/**TODO GTG check if this should be fprintf or something else*/
712                free(sampleDataBuffer);
713        return TCL_OK;
714       
715    }
716
717    else {
718        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
719            "bad option \"", option, "\": should be add, configure, "
720            "get, perform, using, samples", (char*)NULL);
721        return TCL_ERROR;
722    }
723    return TCL_OK;
724}
725
726/*
727 * ------------------------------------------------------------------------
728 *  RpOptimizerPerformInTcl()
729 *
730 *  Invoked as a call-back within RpOptimPerform() to handle each
731 *  optimization run.  Launches a run of a Rappture-based tool using
732 *  the given values and computes the value for the fitness function.
733 *
734 *  Returns RP_OPTIM_SUCCESS if the run was successful, along with
735 *  the value in the fitness function in fitnessPtr.  If something
736 *  goes wrong with the run, it returns RP_OPTIM_FAILURE.
737 * ------------------------------------------------------------------------
738 */
739static RpOptimStatus
740RpOptimizerPerformInTcl(envPtr, values, numValues, fitnessPtr)
741    RpOptimEnv *envPtr;       /* optimization environment */
742    RpOptimParam *values;     /* incoming values for the simulation */
743    int numValues;            /* number of incoming values */
744    double *fitnessPtr;       /* returns: computed value of fitness func */
745{
746    RpOptimStatus result = RP_OPTIM_SUCCESS;
747    Tcl_Obj *xmlObj = NULL;
748    RpOptimToolData *toolDataPtr = (RpOptimToolData*)envPtr->toolData;
749    Tcl_Interp *interp = toolDataPtr->interp;
750
751    int n, status;
752#define MAXBUILTIN 10
753    int objc; Tcl_Obj **objv, *storage[MAXBUILTIN], *getcmd[3];
754    int rc; Tcl_Obj **rv;
755    Tcl_Obj *dataPtr;
756    Tcl_DString buffer;
757
758    /*
759     * Set up the arguments for a Tcl evaluation.
760     */
761    objc = 2*numValues + 2;  /* "tool run" + (name value)*numValues */
762    if (objc > MAXBUILTIN) {
763        objv = (Tcl_Obj**)malloc(objc*sizeof(Tcl_Obj));
764    } else {
765        objv = storage;
766    }
767    objv[0] = toolDataPtr->toolPtr;
768    objv[1] = Tcl_NewStringObj("run",-1); Tcl_IncrRefCount(objv[1]);
769    for (n=0; n < numValues; n++) {
770        objv[2*n+2] = Tcl_NewStringObj(values[n].name, -1);
771        Tcl_IncrRefCount(objv[2*n+2]);
772
773        switch (values[n].type) {
774        case RP_OPTIMPARAM_NUMBER:
775            objv[2*n+3] = Tcl_NewDoubleObj(values[n].value.dval);
776            Tcl_IncrRefCount(objv[2*n+3]);
777            break;
778        case RP_OPTIMPARAM_STRING:
779            objv[2*n+3] = Tcl_NewStringObj(values[n].value.sval.str,-1);
780            Tcl_IncrRefCount(objv[2*n+3]);
781            break;
782        default:
783            panic("bad parameter type in RpOptimizerPerformInTcl()");
784        }
785    }
786
787    /*
788     *  Invoke the tool and pick apart its results.
789     */
790    status = Tcl_EvalObjv(interp, objc, objv, TCL_EVAL_GLOBAL);
791
792    if (status != TCL_OK) {
793        result = RP_OPTIM_FAILURE;
794        fprintf(stderr, "== JOB FAILED: %s\n", Tcl_GetStringResult(interp));
795    } else {
796        dataPtr = Tcl_GetObjResult(interp);
797        /* hang on to this while we pick it apart into rv[] */
798        Tcl_IncrRefCount(dataPtr);
799
800        if (Tcl_ListObjGetElements(interp, dataPtr, &rc, &rv) != TCL_OK) {
801            result = RP_OPTIM_FAILURE;
802            fprintf(stderr, "== JOB FAILED: %s\n", Tcl_GetStringResult(interp));
803        } else if (rc != 2
804                    || Tcl_GetIntFromObj(interp, rv[0], &status) != TCL_OK) {
805            result = RP_OPTIM_FAILURE;
806            fprintf(stderr, "== JOB FAILED: malformed result: expected {status output}\n");
807        } else {
808            if (status != 0) {
809                result = RP_OPTIM_FAILURE;
810                fprintf(stderr, "== JOB FAILED with status code %d:\n%s\n",
811                    status, Tcl_GetStringFromObj(rv[1], (int*)NULL));
812            } else {
813                /*
814                 *  Get the output value from the tool output in the
815                 *  result we just parsed above:  {status xmlobj}
816                 *
817                 *  Eventually, we should write a whole parser to
818                 *  handle arbitrary fitness functions.  For now,
819                 *  just query a single output value by calling:
820                 *    xmlobj get fitnessExpr
821                 */
822                xmlObj = rv[1];
823                /* hang onto this for -updatecommand below */
824                Tcl_IncrRefCount(xmlObj);
825
826                getcmd[0] = xmlObj;
827                getcmd[1] = Tcl_NewStringObj("get",-1);
828                getcmd[2] = Tcl_NewStringObj(envPtr->fitnessExpr,-1);
829                for (n=0; n < 3; n++) {
830                    Tcl_IncrRefCount(getcmd[n]);
831                }
832
833                status = Tcl_EvalObjv(interp, 3, getcmd, TCL_EVAL_GLOBAL);
834
835                if (status != TCL_OK) {
836                    result = RP_OPTIM_FAILURE;
837                    fprintf(stderr, "== UNEXPECTED ERROR while extracting output value:%s\n", Tcl_GetStringResult(interp));
838                } else if (Tcl_GetDoubleFromObj(interp,
839                      Tcl_GetObjResult(interp), fitnessPtr) != TCL_OK) {
840                    result = RP_OPTIM_FAILURE;
841                    fprintf(stderr, "== ERROR while extracting output value:%s\n", Tcl_GetStringResult(interp));
842                }
843                for (n=0; n < 3; n++) {
844                    Tcl_DecrRefCount(getcmd[n]);
845                }
846            }
847        }
848        Tcl_DecrRefCount(dataPtr);
849    }
850
851    /*
852     * Clean up objects created for command invocation.
853     */
854    for (n=1; n < objc; n++) {
855        Tcl_DecrRefCount(objv[n]);
856    }
857    if (objv != storage) {
858        free(objv);
859    }
860
861    /*
862     * If there's the -updatecommand was specified, execute it here
863     * to bring the application up-to-date and see if the user wants
864     * to abort.
865     */
866    if (toolDataPtr->updateCmdPtr) {
867        Tcl_DStringInit(&buffer);
868        Tcl_DStringAppend(&buffer,
869            Tcl_GetStringFromObj(toolDataPtr->updateCmdPtr, (int*)NULL), -1);
870        Tcl_DStringAppendElement(&buffer,
871            (xmlObj != NULL) ? Tcl_GetStringFromObj(xmlObj, (int*)NULL): "");
872
873        status = Tcl_GlobalEval(toolDataPtr->interp,
874            Tcl_DStringValue(&buffer));
875        if (status == TCL_ERROR) {
876            Tcl_BackgroundError(toolDataPtr->interp);
877        }
878        Tcl_DStringFree(&buffer);
879    }
880
881    if (xmlObj) {
882        Tcl_DecrRefCount(xmlObj);  /* done with this now */
883    }
884    return result;
885}
Note: See TracBrowser for help on using the repository browser.