source: trunk/optimizer/src/plugin_pgapack.c @ 899

Last change on this file since 899 was 899, checked in by mmc, 15 years ago

Added a -fitness option to the "perform" operation. Right now, you can
specify just the name of an output quantity, and that quantity can be
minimized or maximized. In the future, there should be an expression
parser so you can enter any function of Rappture quantities.

Fixed up the example so that it runs the Rosenbrock function, which is
difficult to minimize. Added a visualize.tcl script, so you can visualize
the output from many different runXXXX.xml files.

File size: 23.2 KB
Line 
1/*
2 * ----------------------------------------------------------------------
3 *  OPTIMIZER PLUG-IN:  Pgapack
4 *
5 *  This code connects Pgapack into the Rappture Optimization
6 *  infrastructure.
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 "pgapack.h"
17#include "rp_optimizer.h"
18
19typedef struct PgapackData {
20    int operation;       /* operation <=> PGA_MINIMIZE/PGA_MAXIMIZE */
21    int maxRuns;         /* maximum runs <=> PGASetMaxGAIterValue() */
22    int popSize;         /* population size <=> PGASetPopSize() */
23    int popRepl;         /* replacement <=> PGASetPopReplacementType() */
24} PgapackData;
25
26RpCustomTclOptionParse RpOption_ParseOper;
27RpCustomTclOptionGet RpOption_GetOper;
28RpTclOptionType RpOption_Oper = {
29    "pga_operation", RpOption_ParseOper, RpOption_GetOper, NULL
30};
31
32RpCustomTclOptionParse RpOption_ParsePopRepl;
33RpCustomTclOptionGet RpOption_GetPopRepl;
34RpTclOptionType RpOption_PopRepl = {
35    "pga_poprepl", RpOption_ParsePopRepl, RpOption_GetPopRepl, NULL
36};
37
38RpTclOption PgapackOptions[] = {
39  {"-maxruns", RP_OPTION_INT, Rp_Offset(PgapackData,maxRuns)},
40  {"-operation", &RpOption_Oper, Rp_Offset(PgapackData,operation)},
41  {"-poprepl", &RpOption_PopRepl, Rp_Offset(PgapackData,popRepl)},
42  {"-popsize", RP_OPTION_INT, Rp_Offset(PgapackData,popSize)},
43  {NULL, NULL, 0}
44};
45
46static double PgapEvaluate _ANSI_ARGS_((PGAContext *ctx, int p, int pop));
47static void PgapCreateString _ANSI_ARGS_((PGAContext *ctx, int, int, int));
48static int PgapMutation _ANSI_ARGS_((PGAContext *ctx, int, int, double));
49static void PgapCrossover _ANSI_ARGS_((PGAContext *ctx, int, int, int,
50    int, int, int));
51static void PgapPrintString _ANSI_ARGS_((PGAContext *ctx, FILE*, int, int));
52static void PgapCopyString _ANSI_ARGS_((PGAContext *ctx, int, int, int, int));
53static int PgapDuplicateString _ANSI_ARGS_((PGAContext *ctx, int, int, int, int));
54static MPI_Datatype PgapBuildDT _ANSI_ARGS_((PGAContext *ctx, int, int));
55
56static void PgapLinkContext2Env _ANSI_ARGS_((PGAContext *ctx,
57    RpOptimEnv *envPtr));
58static RpOptimEnv* PgapGetEnvForContext _ANSI_ARGS_((PGAContext *ctx));
59static void PgapUnlinkContext2Env _ANSI_ARGS_((PGAContext *ctx));
60
61
62/*
63 * ----------------------------------------------------------------------
64 * PgapackInit()
65 *
66 * This routine is called whenever a new optimization object is created
67 * to initialize Pgapack.  Returns a pointer to PgapackData that is
68 * used in later routines.
69 * ----------------------------------------------------------------------
70 */
71ClientData
72PgapackInit()
73{
74    PgapackData *dataPtr;
75
76    dataPtr = (PgapackData*)malloc(sizeof(PgapackData));
77    dataPtr->operation = PGA_MINIMIZE;
78    dataPtr->maxRuns = 10000;
79    dataPtr->popRepl = PGA_POPREPL_BEST;
80    dataPtr->popSize = 200;
81
82    return (ClientData)dataPtr;
83}
84
85/*
86 * ----------------------------------------------------------------------
87 * PgapackRun()
88 *
89 * This routine is called to kick off an optimization run.  Sets up
90 * a PGApack context and starts invoking runs.
91 * ----------------------------------------------------------------------
92 */
93RpOptimStatus
94PgapackRun(envPtr, evalProc, fitnessExpr)
95    RpOptimEnv *envPtr;           /* optimization environment */
96    RpOptimEvaluator *evalProc;   /* call this proc to run tool */
97    char *fitnessExpr;            /* fitness function in string form */
98{
99    PgapackData *dataPtr =(PgapackData*)envPtr->pluginData;
100    PGAContext *ctx;
101
102    /* pgapack requires at least one arg -- the executable name */
103    /* fake it here by just saying something like "rappture" */
104    int argc = 1; char *argv[] = {"rappture"};
105
106    ctx = PGACreate(&argc, argv, PGA_DATATYPE_USER, envPtr->numParams,
107        dataPtr->operation);
108
109    PGASetMaxGAIterValue(ctx, dataPtr->maxRuns);
110    PGASetPopSize(ctx, dataPtr->popSize);
111    PGASetPopReplaceType(ctx, dataPtr->popRepl);
112    PGASetCrossoverType(ctx, PGA_CROSSOVER_UNIFORM);
113
114    PGASetUserFunction(ctx, PGA_USERFUNCTION_CREATESTRING, PgapCreateString);
115    PGASetUserFunction(ctx, PGA_USERFUNCTION_MUTATION, PgapMutation);
116    PGASetUserFunction(ctx, PGA_USERFUNCTION_CROSSOVER, PgapCrossover);
117    PGASetUserFunction(ctx, PGA_USERFUNCTION_PRINTSTRING, PgapPrintString);
118    PGASetUserFunction(ctx, PGA_USERFUNCTION_COPYSTRING, PgapCopyString);
119    PGASetUserFunction(ctx, PGA_USERFUNCTION_DUPLICATE, PgapDuplicateString);
120    PGASetUserFunction(ctx, PGA_USERFUNCTION_BUILDDATATYPE, PgapBuildDT);
121
122    envPtr->evalProc = evalProc;   /* plug these in for later during eval */
123    envPtr->fitnessExpr = fitnessExpr;
124
125    /*
126     * We need a way to convert from a PGAContext to our RpOptimEnv
127     * data.  This happens when Pgapack calls routines like
128     * PgapCreateString, passing in the PGAContext, but nothing else.
129     * Call PgapLinkContext2Env() here, so later on we can figure
130     * out how many parameters, names, types, etc.
131     */
132    PgapLinkContext2Env(ctx, envPtr);
133
134    PGASetUp(ctx);
135    PGARun(ctx, PgapEvaluate);
136    PGADestroy(ctx);
137
138    PgapUnlinkContext2Env(ctx);
139
140    return RP_OPTIM_SUCCESS;
141}
142
143/*
144 * ----------------------------------------------------------------------
145 * PgapackEvaluate()
146 *
147 * Called by PGApack whenever a set of input values needs to be
148 * evaluated.  Passes the values on to the underlying Rappture tool,
149 * launches a run, and computes the value of the fitness function.
150 * Returns the value for the fitness function.
151 * ----------------------------------------------------------------------
152 */
153double
154PgapEvaluate(ctx, p, pop)
155    PGAContext *ctx;  /* pgapack context for this optimization */
156    int p;            /* sample #p being run */
157    int pop;          /* identifier for this population */
158{
159    double fit = 0.0;
160    RpOptimEnv *envPtr;
161    RpOptimParam *paramPtr;
162    RpOptimStatus status;
163
164    envPtr = PgapGetEnvForContext(ctx);
165    paramPtr = (RpOptimParam*)PGAGetIndividual(ctx, p, pop)->chrom;
166
167    status = (*envPtr->evalProc)(envPtr, paramPtr, envPtr->numParams, &fit);
168
169    if (status != RP_OPTIM_SUCCESS) {
170        fprintf(stderr, "==WARNING: run failed!");
171        PgapPrintString(ctx, stderr, p, pop);
172    }
173
174    return fit;
175}
176
177/*
178 * ----------------------------------------------------------------------
179 * PgapackCleanup()
180 *
181 * This routine is called whenever an optimization object is deleted
182 * to clean up data associated with the object.  Frees the data
183 * allocated in PgapackInit.
184 * ----------------------------------------------------------------------
185 */
186void
187PgapackCleanup(cdata)
188    ClientData cdata;  /* data from to be cleaned up */
189{
190    PgapackData *dataPtr = (PgapackData*)cdata;
191    free(dataPtr);
192}
193
194/*
195 * ======================================================================
196 *  ROUTINES FOR MANAGING DATA STRINGS
197 * ======================================================================
198 * PgapCreateString()
199 *
200 * Called by pgapack to create the so-called "string" of data used for
201 * an evaluation.
202 * ----------------------------------------------------------------------
203 */
204void
205PgapCreateString(ctx, p, pop, initFlag)
206    PGAContext *ctx;  /* pgapack context for this optimization */
207    int p;            /* sample #p being run */
208    int pop;          /* identifier for this population */
209    int initFlag;     /* non-zero => fields should be initialized */
210{
211    int n, ival;
212    double dval;
213    RpOptimEnv *envPtr;
214    RpOptimParam *oldParamPtr, *newParamPtr;
215    PGAIndividual *newData;
216    RpOptimParamNumber *numPtr;
217    RpOptimParamString *strPtr;
218
219    envPtr = PgapGetEnvForContext(ctx);
220
221    newData = PGAGetIndividual(ctx, p, pop);
222    newData->chrom = malloc(envPtr->numParams*sizeof(RpOptimParam));
223    newParamPtr = (RpOptimParam*)newData->chrom;
224
225    for (n=0; n < envPtr->numParams; n++) {
226        oldParamPtr = envPtr->paramList[n];
227        newParamPtr[n].name = oldParamPtr->name;
228        newParamPtr[n].type = oldParamPtr->type;
229        switch (oldParamPtr->type) {
230        case RP_OPTIMPARAM_NUMBER:
231            newParamPtr[n].value.dval = 0.0;
232            break;
233        case RP_OPTIMPARAM_STRING:
234            newParamPtr[n].value.sval.num = -1;
235            newParamPtr[n].value.sval.str = NULL;
236            break;
237        default:
238            panic("bad parameter type in PgapCreateString()");
239        }
240    }
241
242    if (initFlag) {
243        for (n=0; n < envPtr->numParams; n++) {
244            switch (newParamPtr[n].type) {
245            case RP_OPTIMPARAM_NUMBER:
246                numPtr = (RpOptimParamNumber*)envPtr->paramList[n];
247                dval = PGARandom01(ctx,0);
248                newParamPtr[n].value.dval =
249                    (numPtr->max - numPtr->min)*dval + numPtr->min;
250                break;
251            case RP_OPTIMPARAM_STRING:
252                strPtr = (RpOptimParamString*)envPtr->paramList[n];
253                ival = (int)floor(PGARandom01(ctx,0) * strPtr->numValues);
254                envPtr->paramList[n]->value.sval.num = ival;
255                envPtr->paramList[n]->value.sval.str = strPtr->values[ival];
256                break;
257            default:
258                panic("bad parameter type in PgapCreateString()");
259            }
260        }
261    }
262}
263
264/*
265 * ----------------------------------------------------------------------
266 * PgapMutation()
267 *
268 * Called by pgapack to perform random mutations on the input data
269 * used for evaluation.
270 * ----------------------------------------------------------------------
271 */
272int
273PgapMutation(ctx, p, pop, mr)
274    PGAContext *ctx;  /* pgapack context for this optimization */
275    int p;            /* sample #p being run */
276    int pop;          /* identifier for this population */
277    double mr;        /* probability of mutation for each gene */
278{
279    int count = 0;    /* number of mutations */
280
281    int n, ival;
282    RpOptimEnv *envPtr;
283    RpOptimParam *paramPtr;
284    RpOptimParamNumber *numPtr;
285    RpOptimParamString *strPtr;
286
287    envPtr = PgapGetEnvForContext(ctx);
288    paramPtr = (RpOptimParam*)PGAGetIndividual(ctx, p, pop)->chrom;
289
290    for (n=0; n < envPtr->numParams; n++) {
291        if (PGARandomFlip(ctx, mr)) {
292            /* won the coin toss -- change this parameter */
293            count++;
294
295            switch (paramPtr[n].type) {
296            case RP_OPTIMPARAM_NUMBER:
297                /* bump the value up/down a little, randomly */
298                if (PGARandomFlip(ctx, 0.5)) {
299                    paramPtr[n].value.dval += 0.1*paramPtr[n].value.dval;
300                } else {
301                    paramPtr[n].value.dval -= 0.1*paramPtr[n].value.dval;
302                }
303                /* make sure the resulting value is still in bounds */
304                numPtr = (RpOptimParamNumber*)envPtr->paramList[n];
305                if (paramPtr[n].value.dval > numPtr->max) {
306                    paramPtr[n].value.dval = numPtr->max;
307                }
308                if (paramPtr[n].value.dval < numPtr->min) {
309                    paramPtr[n].value.dval = numPtr->min;
310                }
311                break;
312
313            case RP_OPTIMPARAM_STRING:
314                ival = paramPtr[n].value.sval.num;
315                if (PGARandomFlip(ctx, 0.5)) {
316                    ival += 1;
317                } else {
318                    ival -= 1;
319                }
320                strPtr = (RpOptimParamString*)envPtr->paramList[n];
321                if (ival < 0) ival = 0;
322                if (ival >= strPtr->numValues) ival = strPtr->numValues-1;
323                paramPtr[n].value.sval.num = ival;
324                paramPtr[n].value.sval.str = strPtr->values[ival];
325                break;
326
327            default:
328                panic("bad parameter type in PgapMutation()");
329            }
330        }
331    }
332    return count;
333}
334
335/*
336 * ----------------------------------------------------------------------
337 * PgapCrossover()
338 *
339 * Called by pgapack to perform cross-over mutations on the input data
340 * used for evaluation.
341 * ----------------------------------------------------------------------
342 */
343void
344PgapCrossover(ctx, p1, p2, pop1, c1, c2, pop2)
345    PGAContext *ctx;  /* pgapack context for this optimization */
346    int p1;           /* sample # for parent of input string1 */
347    int p2;           /* sample # for parent of input string2 */
348    int pop1;         /* population containing p1 and p2 */
349    int c1;           /* sample # for child of input string1 */
350    int c2;           /* sample # for child of input string2 */
351    int pop2;         /* population containing c1 and c2 */
352{
353    int n;
354    RpOptimEnv *envPtr;
355    RpOptimParam *parent1, *parent2, *child1, *child2;
356    double pu;
357
358    envPtr = PgapGetEnvForContext(ctx);
359    parent1 = (RpOptimParam*)PGAGetIndividual(ctx, p1, pop1)->chrom;
360    parent2 = (RpOptimParam*)PGAGetIndividual(ctx, p2, pop1)->chrom;
361    child1  = (RpOptimParam*)PGAGetIndividual(ctx, c1, pop2)->chrom;
362    child2  = (RpOptimParam*)PGAGetIndividual(ctx, c2, pop2)->chrom;
363
364    pu = PGAGetUniformCrossoverProb(ctx);
365
366    for (n=0; n < envPtr->numParams; n++) {
367        if (PGARandomFlip(ctx, pu)) {
368            /* child inherits from parent */
369            memcpy(&child1[n], &parent1[n], sizeof(RpOptimParam));
370            memcpy(&child2[n], &parent2[n], sizeof(RpOptimParam));
371        } else {
372            /* crossover */
373            memcpy(&child1[n], &parent2[n], sizeof(RpOptimParam));
374            memcpy(&child2[n], &parent1[n], sizeof(RpOptimParam));
375        }
376    }
377}
378
379/*
380 * ----------------------------------------------------------------------
381 * PgapPrintString()
382 *
383 * Called by pgapack to format the values for a particular string of
384 * input data.
385 * ----------------------------------------------------------------------
386 */
387void
388PgapPrintString(ctx, fp, p, pop)
389    PGAContext *ctx;  /* pgapack context for this optimization */
390    FILE *fp;         /* write to this file pointer */
391    int p;            /* sample #p being run */
392    int pop;          /* identifier for this population */
393{
394    int n;
395    RpOptimEnv *envPtr;
396    RpOptimParam *paramPtr;
397
398    envPtr = PgapGetEnvForContext(ctx);
399    paramPtr = (RpOptimParam*)PGAGetIndividual(ctx, p, pop)->chrom;
400
401    for (n=0; n < envPtr->numParams; n++) {
402        fprintf(fp, "#%4d: ", n);
403        switch (paramPtr[n].type) {
404        case RP_OPTIMPARAM_NUMBER:
405            fprintf(fp, "[%11.7g] (%s)\n", paramPtr[n].value.dval,
406                paramPtr[n].name);
407            break;
408        case RP_OPTIMPARAM_STRING:
409            fprintf(fp, "[%d]=\"%s\" (%s)\n", paramPtr[n].value.sval.num,
410                paramPtr[n].value.sval.str, paramPtr[n].name);
411            break;
412        default:
413            panic("bad parameter type in PgapPrintString()");
414        }
415    }
416}
417
418/*
419 * ----------------------------------------------------------------------
420 * PgapCopyString()
421 *
422 * Called by pgapack to copy one input string to another.
423 * ----------------------------------------------------------------------
424 */
425void
426PgapCopyString(ctx, p1, pop1, p2, pop2)
427    PGAContext *ctx;  /* pgapack context for this optimization */
428    int p1;           /* source sample # being run */
429    int pop1;         /* population containing p1 */
430    int p2;           /* destination sample # being run */
431    int pop2;         /* population containing p1 */
432{
433    int n;
434    RpOptimEnv *envPtr;
435    RpOptimParam *src, *dst;
436
437    envPtr = PgapGetEnvForContext(ctx);
438    src = (RpOptimParam*)PGAGetIndividual(ctx, p1, pop1)->chrom;
439    dst = (RpOptimParam*)PGAGetIndividual(ctx, p2, pop2)->chrom;
440
441    for (n=0; n < envPtr->numParams; n++) {
442        dst[n].type = src[n].type;
443        switch (src[n].type) {
444        case RP_OPTIMPARAM_NUMBER:
445            dst[n].value.dval = src[n].value.dval;
446            break;
447        case RP_OPTIMPARAM_STRING:
448            dst[n].value.sval.num = src[n].value.sval.num;
449            dst[n].value.sval.str = src[n].value.sval.str;
450            break;
451        default:
452            panic("bad parameter type in PgapCopyString()");
453        }
454    }
455}
456
457/*
458 * ----------------------------------------------------------------------
459 * PgapDuplicateString()
460 *
461 * Called by pgapack to compare two input strings.  Returns non-zero if
462 * the two are duplicates and 0 otherwise.
463 * ----------------------------------------------------------------------
464 */
465int
466PgapDuplicateString(ctx, p1, pop1, p2, pop2)
467    PGAContext *ctx;  /* pgapack context for this optimization */
468    int p1;           /* sample #p being run */
469    int pop1;         /* population containing p1 */
470    int p2;           /* sample #p being run */
471    int pop2;         /* population containing p1 */
472{
473    int n;
474    RpOptimEnv *envPtr;
475    RpOptimParam *param1, *param2;
476
477    envPtr = PgapGetEnvForContext(ctx);
478    param1 = (RpOptimParam*)PGAGetIndividual(ctx, p1, pop1)->chrom;
479    param2 = (RpOptimParam*)PGAGetIndividual(ctx, p2, pop2)->chrom;
480
481    for (n=0; n < envPtr->numParams; n++) {
482        if (param1[n].type != param2[n].type) {
483            return 0;  /* different! */
484        }
485        switch (param1[n].type) {
486        case RP_OPTIMPARAM_NUMBER:
487            if (param1[n].value.dval != param2[n].value.dval) {
488                return 0;  /* different! */
489            }
490            break;
491        case RP_OPTIMPARAM_STRING:
492            if (param1[n].value.sval.num != param2[n].value.sval.num) {
493                return 0;  /* different! */
494            }
495            break;
496        default:
497            panic("bad parameter type in PgapDuplicateString()");
498        }
499    }
500    return 1;
501}
502
503/*
504 * ----------------------------------------------------------------------
505 * PgapCopyString()
506 *
507 * Called by pgapack to copy one input string to another.
508 * ----------------------------------------------------------------------
509 */
510MPI_Datatype
511PgapBuildDT(ctx, p, pop)
512    PGAContext *ctx;  /* pgapack context for this optimization */
513    int p;            /* sample # being run */
514    int pop;          /* population containing sample */
515{
516    panic("MPI support not implemented!");
517    return NULL;
518}
519
520/*
521 * ======================================================================
522 *  OPTION:  -operation <=> PGA_MINIMIZE / PGA_MAXIMIZE
523 * ======================================================================
524 */
525int
526RpOption_ParseOper(interp, valObj, cdata, offset)
527    Tcl_Interp *interp;  /* interpreter handling this request */
528    Tcl_Obj *valObj;     /* set option to this new value */
529    ClientData cdata;    /* save in this data structure */
530    int offset;          /* save at this offset in cdata */
531{
532    int *ptr = (int*)(cdata+offset);
533    char *val = Tcl_GetStringFromObj(valObj, (int*)NULL);
534    if (strcmp(val,"minimize") == 0) {
535        *ptr = PGA_MINIMIZE;
536    }
537    else if (strcmp(val,"maximize") == 0) {
538        *ptr = PGA_MAXIMIZE;
539    }
540    else {
541        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
542            "bad value \"", val, "\": should be minimize, maximize",
543            (char*)NULL);
544        return TCL_ERROR;
545    }
546    return TCL_OK;
547}
548
549int
550RpOption_GetOper(interp, cdata, offset)
551    Tcl_Interp *interp;  /* interpreter handling this request */
552    ClientData cdata;    /* get from this data structure */
553    int offset;          /* get from this offset in cdata */
554{
555    int *ptr = (int*)(cdata+offset);
556    switch (*ptr) {
557    case PGA_MINIMIZE:
558        Tcl_SetResult(interp, "minimize", TCL_STATIC);
559        break;
560    case PGA_MAXIMIZE:
561        Tcl_SetResult(interp, "maximize", TCL_STATIC);
562        break;
563    default:
564        Tcl_SetResult(interp, "???", TCL_STATIC);
565        break;
566    }
567    return TCL_OK;
568}
569
570/*
571 * ======================================================================
572 *  OPTION:  -poprepl <=> PGASetPopReplacementType()
573 * ======================================================================
574 */
575int
576RpOption_ParsePopRepl(interp, valObj, cdata, offset)
577    Tcl_Interp *interp;  /* interpreter handling this request */
578    Tcl_Obj *valObj;     /* set option to this new value */
579    ClientData cdata;    /* save in this data structure */
580    int offset;          /* save at this offset in cdata */
581{
582    int *ptr = (int*)(cdata+offset);
583    char *val = Tcl_GetStringFromObj(valObj, (int*)NULL);
584    if (*val == 'b' && strcmp(val,"best") == 0) {
585        *ptr = PGA_POPREPL_BEST;
586    }
587    else if (*val == 'r' && strcmp(val,"random-repl") == 0) {
588        *ptr = PGA_POPREPL_RANDOM_REP;
589    }
590    else if (*val == 'r' && strcmp(val,"random-norepl") == 0) {
591        *ptr = PGA_POPREPL_RANDOM_NOREP;
592    }
593    else {
594        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
595            "bad value \"", val, "\": should be best, random-norepl,"
596            " or random-repl", (char*)NULL);
597        return TCL_ERROR;
598    }
599    return TCL_OK;
600}
601
602int
603RpOption_GetPopRepl(interp, cdata, offset)
604    Tcl_Interp *interp;  /* interpreter handling this request */
605    ClientData cdata;    /* get from this data structure */
606    int offset;          /* get from this offset in cdata */
607{
608    int *ptr = (int*)(cdata+offset);
609    switch (*ptr) {
610    case PGA_POPREPL_BEST:
611        Tcl_SetResult(interp, "best", TCL_STATIC);
612        break;
613    case PGA_POPREPL_RANDOM_REP:
614        Tcl_SetResult(interp, "random-repl", TCL_STATIC);
615        break;
616    case PGA_POPREPL_RANDOM_NOREP:
617        Tcl_SetResult(interp, "random-norepl", TCL_STATIC);
618        break;
619    default:
620        Tcl_SetResult(interp, "???", TCL_STATIC);
621        break;
622    }
623    return TCL_OK;
624}
625
626/*
627 * ======================================================================
628 *  ROUTINES FOR CONNECTING PGACONTEXT <=> RPOPTIMENV
629 * ======================================================================
630 * PgapLinkContext2Env()
631 *   This routine is used internally to establish a relationship between
632 *   a PGAContext token and its corresponding RpOptimEnv data.  The
633 *   PGA routines don't provide a way to pass the RpOptimEnv data along,
634 *   so we use these routines to find the correspondence.
635 *
636 * PgapGetEnvForContext()
637 *   Returns the RpOptimEnv associated with a given PGAContext.  If the
638 *   link has not been established via PgapLinkContext2Env(), then this
639 *   routine returns NULL.
640 *
641 * PgapUnlinkContext2Env()
642 *   Breaks the link between a PGAContext and its RpOptimEnv.  Should
643 *   be called when the PGAContext is destroyed and is no longer valid.
644 * ----------------------------------------------------------------------
645 */
646static Tcl_HashTable *Pgacontext2Rpenv = NULL;
647
648void
649PgapLinkContext2Env(ctx, envPtr)
650    PGAContext *ctx;      /* pgapack context for this optimization */
651    RpOptimEnv *envPtr;   /* corresponding Rappture optimization data */
652{
653    Tcl_HashEntry *ctxEntry;
654    int newEntry;
655
656    if (Pgacontext2Rpenv == NULL) {
657        Pgacontext2Rpenv = (Tcl_HashTable*)malloc(sizeof(Tcl_HashTable));
658        Tcl_InitHashTable(Pgacontext2Rpenv, TCL_ONE_WORD_KEYS);
659    }
660    ctxEntry = Tcl_CreateHashEntry(Pgacontext2Rpenv, (char*)ctx, &newEntry);
661    Tcl_SetHashValue(ctxEntry, (ClientData)envPtr);
662}
663
664RpOptimEnv*
665PgapGetEnvForContext(ctx)
666    PGAContext *ctx;
667{
668    Tcl_HashEntry *entryPtr;
669
670    if (Pgacontext2Rpenv) {
671        entryPtr = Tcl_FindHashEntry(Pgacontext2Rpenv, (char*)ctx);
672        if (entryPtr) {
673            return (RpOptimEnv*)Tcl_GetHashValue(entryPtr);
674        }
675    }
676    return NULL;
677}
678
679void
680PgapUnlinkContext2Env(ctx)
681    PGAContext *ctx;
682{
683    Tcl_HashEntry *entryPtr;
684
685    if (Pgacontext2Rpenv) {
686        entryPtr = Tcl_FindHashEntry(Pgacontext2Rpenv, (char*)ctx);
687        if (entryPtr) {
688            Tcl_DeleteHashEntry(entryPtr);
689        }
690    }
691}
Note: See TracBrowser for help on using the repository browser.