Ignore:
Timestamp:
Feb 21, 2008, 6:43:57 PM (16 years ago)
Author:
mmc
Message:

Optimization part is getting better. Fleshed out the plug-in for
PGApack, and integrated a first cut that includes the data handling.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/optimizer/src/plugin_pgapack.c

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