source: trunk/packages/optimizer/src/plugin_pgapack.c @ 1049

Last change on this file since 1049 was 986, checked in by gah, 15 years ago

added global pgapack_abort flag to plugin and abort operation to optimizer

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