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

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

added more options to configure PGAPack.
These include: mutation rate, crossover rate, stoppage criteria
and random number seed (for reproducibility of runs)

File size: 31.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    int stpcriteria;     /*stoppage criteria <=> PGASetStoppingRuleType()*/
25    int randnumseed;  /*Random Number Seed <=> PGASetRandomSeed()*/
26    double mutnrate;     /*Mutation Rate <=> PGASetMutationProb()*/
27    double crossovrate;  /*Crossover Rate <=> PGASetCrossoverProb();*/
28} PgapackData;
29
30RpCustomTclOptionGet RpOption_GetStpCriteria;
31RpCustomTclOptionParse RpOption_ParseStpCriteria;
32RpTclOptionType RpOption_StpCriteria = {
33        "pga_stpcriteria", RpOption_ParseStpCriteria,RpOption_GetStpCriteria,NULL
34};
35
36RpCustomTclOptionParse RpOption_ParseOper;
37RpCustomTclOptionGet RpOption_GetOper;
38RpTclOptionType RpOption_Oper = {
39    "pga_operation", RpOption_ParseOper, RpOption_GetOper, NULL
40};
41
42RpCustomTclOptionParse RpOption_ParsePopRepl;
43RpCustomTclOptionGet RpOption_GetPopRepl;
44RpTclOptionType RpOption_PopRepl = {
45    "pga_poprepl", RpOption_ParsePopRepl, RpOption_GetPopRepl, NULL
46};
47
48
49typedef struct PgapackRuntimeDataTable{
50        double **data;                          /*Actual data per sample, like values of the genes, fitness of a sample, etc*/
51        int num_of_rows;                        /*Number of rows alloced..should be constant for a run*/
52        int no_of_samples_evaled;       /*Number of samples evaluated so far*/
53        int no_of_columns;                                      /*Number of columns allocated to the data table so far*/
54}PgapackRuntimeDataTable;
55
56RpTclOption PgapackOptions[] = {
57  {"-maxruns", RP_OPTION_INT, Rp_Offset(PgapackData,maxRuns)},
58  {"-operation", &RpOption_Oper, Rp_Offset(PgapackData,operation)},
59  {"-poprepl", &RpOption_PopRepl, Rp_Offset(PgapackData,popRepl)},
60  {"-popsize", RP_OPTION_INT, Rp_Offset(PgapackData,popSize)},
61  {"-mutnrate",RP_OPTION_DOUBLE,Rp_Offset(PgapackData,mutnrate)},
62  {"-crossovrate",RP_OPTION_DOUBLE,Rp_Offset(PgapackData,crossovrate)},
63  {"-randnumseed",RP_OPTION_INT,Rp_Offset(PgapackData,randnumseed)},
64  {"-stpcriteria",&RpOption_StpCriteria,Rp_Offset(PgapackData,stpcriteria)},
65  {NULL, NULL, 0}
66};
67
68static double PgapEvaluate _ANSI_ARGS_((PGAContext *ctx, int p, int pop));
69static void PgapCreateString _ANSI_ARGS_((PGAContext *ctx, int, int, int));
70static int PgapMutation _ANSI_ARGS_((PGAContext *ctx, int, int, double));
71static void PgapCrossover _ANSI_ARGS_((PGAContext *ctx, int, int, int,
72    int, int, int));
73static void PgapPrintString _ANSI_ARGS_((PGAContext *ctx, FILE*, int, int));
74static void PgapCopyString _ANSI_ARGS_((PGAContext *ctx, int, int, int, int));
75static int PgapDuplicateString _ANSI_ARGS_((PGAContext *ctx, int, int, int, int));
76static MPI_Datatype PgapBuildDT _ANSI_ARGS_((PGAContext *ctx, int, int));
77
78static void PgapLinkContext2Env _ANSI_ARGS_((PGAContext *ctx,
79    RpOptimEnv *envPtr));
80static RpOptimEnv* PgapGetEnvForContext _ANSI_ARGS_((PGAContext *ctx));
81static void PgapUnlinkContext2Env _ANSI_ARGS_((PGAContext *ctx));
82void PGARuntimeDataTableInit _ANSI_ARGS_((RpOptimEnv *envPtr));
83void PGARuntimeDataTableDeInit();
84void GetSampleInformation _ANSI_ARGS_((char *buffer, int sampleNumber));
85void PGARuntimeDataTableSetSampleValue _ANSI_ARGS_((RpOptimParam *chrom, double fitness));
86static PgapackRuntimeDataTable table;
87/*
88 * ----------------------------------------------------------------------
89 * PgapackInit()
90 *
91 * This routine is called whenever a new optimization object is created
92 * to initialize Pgapack.  Returns a pointer to PgapackData that is
93 * used in later routines.
94 * ----------------------------------------------------------------------
95 */
96ClientData
97PgapackInit()
98{
99    PgapackData *dataPtr;
100
101    dataPtr = (PgapackData*)malloc(sizeof(PgapackData));
102    dataPtr->operation = PGA_MINIMIZE;
103    dataPtr->maxRuns = 10000;
104    dataPtr->popRepl = PGA_POPREPL_BEST;
105    dataPtr->popSize = 200;
106    dataPtr->crossovrate = 0.85;
107    dataPtr->mutnrate = 0.05; /*by default in PGAPack 1/stringlength*/
108    dataPtr->randnumseed = 1; /*should be a number greater than one, PGAPack requires it*/
109    dataPtr->stpcriteria = PGA_STOP_NOCHANGE;
110    return (ClientData)dataPtr;
111}
112
113int pgapack_abort = 0;
114
115/*
116 * ----------------------------------------------------------------------
117 * PgapackRun()
118 *
119 * This routine is called to kick off an optimization run.  Sets up
120 * a PGApack context and starts invoking runs.
121 * ----------------------------------------------------------------------
122 */
123RpOptimStatus
124PgapackRun(envPtr, evalProc, fitnessExpr)
125    RpOptimEnv *envPtr;           /* optimization environment */
126    RpOptimEvaluator *evalProc;   /* call this proc to run tool */
127    char *fitnessExpr;            /* fitness function in string form */
128{
129    PgapackData *dataPtr =(PgapackData*)envPtr->pluginData;
130    PGAContext *ctx;
131
132    /* pgapack requires at least one arg -- the executable name */
133    /* fake it here by just saying something like "rappture" */
134    int argc = 1; char *argv[] = {"rappture"};
135
136    pgapack_abort = 0;          /* FALSE */
137    PGASetAbortVar(&pgapack_abort);
138
139    ctx = PGACreate(&argc, argv, PGA_DATATYPE_USER, envPtr->numParams,
140        dataPtr->operation);
141
142    PGASetMaxGAIterValue(ctx, dataPtr->maxRuns);
143    PGASetPopSize(ctx, dataPtr->popSize);
144    PGASetPopReplaceType(ctx, dataPtr->popRepl);
145    PGASetStoppingRuleType(ctx, dataPtr->stpcriteria);
146    PGASetMutationProb(ctx,dataPtr->mutnrate);
147    PGASetCrossoverProb(ctx,dataPtr->crossovrate);
148    PGASetRandomSeed(ctx,dataPtr->randnumseed);
149    PGASetCrossoverType(ctx, PGA_CROSSOVER_UNIFORM);
150
151
152    PGASetUserFunction(ctx, PGA_USERFUNCTION_CREATESTRING, PgapCreateString);
153    PGASetUserFunction(ctx, PGA_USERFUNCTION_MUTATION, PgapMutation);
154    PGASetUserFunction(ctx, PGA_USERFUNCTION_CROSSOVER, PgapCrossover);
155    PGASetUserFunction(ctx, PGA_USERFUNCTION_PRINTSTRING, PgapPrintString);
156    PGASetUserFunction(ctx, PGA_USERFUNCTION_COPYSTRING, PgapCopyString);
157    PGASetUserFunction(ctx, PGA_USERFUNCTION_DUPLICATE, PgapDuplicateString);
158    PGASetUserFunction(ctx, PGA_USERFUNCTION_BUILDDATATYPE, PgapBuildDT);
159
160    envPtr->evalProc = evalProc;   /* plug these in for later during eval */
161    envPtr->fitnessExpr = fitnessExpr;
162
163    /*
164     * We need a way to convert from a PGAContext to our RpOptimEnv
165     * data.  This happens when Pgapack calls routines like
166     * PgapCreateString, passing in the PGAContext, but nothing else.
167     * Call PgapLinkContext2Env() here, so later on we can figure
168     * out how many parameters, names, types, etc.
169     */
170    PgapLinkContext2Env(ctx, envPtr);
171
172    PGASetUp(ctx);
173    PGARun(ctx, PgapEvaluate);
174    PGADestroy(ctx);
175    PgapUnlinkContext2Env(ctx);
176
177    if (pgapack_abort) {
178        return RP_OPTIM_ABORTED;
179    }
180    return RP_OPTIM_SUCCESS;
181}
182
183/*
184 * ----------------------------------------------------------------------
185 * PgapackEvaluate()
186 *
187 * Called by PGApack whenever a set of input values needs to be
188 * evaluated.  Passes the values on to the underlying Rappture tool,
189 * launches a run, and computes the value of the fitness function.
190 * Returns the value for the fitness function.
191 * ----------------------------------------------------------------------
192 */
193double
194PgapEvaluate(ctx, p, pop)
195    PGAContext *ctx;  /* pgapack context for this optimization */
196    int p;            /* sample #p being run */
197    int pop;          /* identifier for this population */
198   
199{
200    double fit = 0.0;
201    RpOptimEnv *envPtr;
202    RpOptimParam *paramPtr;
203    RpOptimStatus status;
204    envPtr = PgapGetEnvForContext(ctx);
205    paramPtr = (RpOptimParam*)PGAGetIndividual(ctx, p, pop)->chrom;
206    status = (*envPtr->evalProc)(envPtr, paramPtr, envPtr->numParams, &fit);
207       
208    if (pgapack_abort) {
209        fprintf(stderr, "==WARNING: run aborted!");
210        return 0.0;
211    }
212       
213    if (status != RP_OPTIM_SUCCESS) {
214        fprintf(stderr, "==WARNING: run failed!");
215        PgapPrintString(ctx, stderr, p, pop);
216    }
217       
218        /*populate the table with this sample*/
219        PGARuntimeDataTableSetSampleValue(paramPtr,fit);
220    return fit;
221}
222
223/*
224 * ----------------------------------------------------------------------
225 * PgapackCleanup()
226 *
227 * This routine is called whenever an optimization object is deleted
228 * to clean up data associated with the object.  Frees the data
229 * allocated in PgapackInit.
230 * ----------------------------------------------------------------------
231 */
232void
233PgapackCleanup(cdata)
234    ClientData cdata;  /* data from to be cleaned up */
235{
236    PgapackData *dataPtr = (PgapackData*)cdata;
237    free(dataPtr);
238}
239
240/*
241 * ======================================================================
242 *  ROUTINES FOR MANAGING DATA STRINGS
243 * ======================================================================
244 * PgapCreateString()
245 *
246 * Called by pgapack to create the so-called "string" of data used for
247 * an evaluation.
248 * ----------------------------------------------------------------------
249 */
250void
251PgapCreateString(ctx, p, pop, initFlag)
252    PGAContext *ctx;  /* pgapack context for this optimization */
253    int p;            /* sample #p being run */
254    int pop;          /* identifier for this population */
255    int initFlag;     /* non-zero => fields should be initialized */
256{
257    int n, ival;
258    double dval;
259    RpOptimEnv *envPtr;
260    RpOptimParam *oldParamPtr, *newParamPtr;
261    PGAIndividual *newData;
262    RpOptimParamNumber *numPtr;
263    RpOptimParamString *strPtr;
264
265    envPtr = PgapGetEnvForContext(ctx);
266
267    newData = PGAGetIndividual(ctx, p, pop);
268    newData->chrom = malloc(envPtr->numParams*sizeof(RpOptimParam));
269    newParamPtr = (RpOptimParam*)newData->chrom;
270
271    for (n=0; n < envPtr->numParams; n++) {
272        oldParamPtr = envPtr->paramList[n];
273        newParamPtr[n].name = oldParamPtr->name;
274        newParamPtr[n].type = oldParamPtr->type;
275        switch (oldParamPtr->type) {
276        case RP_OPTIMPARAM_NUMBER:
277            newParamPtr[n].value.dval = 0.0;
278            break;
279        case RP_OPTIMPARAM_STRING:
280            newParamPtr[n].value.sval.num = -1;
281            newParamPtr[n].value.sval.str = NULL;
282            break;
283        default:
284            panic("bad parameter type in PgapCreateString()");
285        }
286    }
287
288    if (initFlag) {
289        for (n=0; n < envPtr->numParams; n++) {
290            switch (newParamPtr[n].type) {
291            case RP_OPTIMPARAM_NUMBER:
292                numPtr = (RpOptimParamNumber*)envPtr->paramList[n];
293                dval = PGARandom01(ctx,0);
294                newParamPtr[n].value.dval =
295                    (numPtr->max - numPtr->min)*dval + numPtr->min;
296                break;
297            case RP_OPTIMPARAM_STRING:
298                strPtr = (RpOptimParamString*)envPtr->paramList[n];
299                ival = (int)floor(PGARandom01(ctx,0) * strPtr->numValues);
300                envPtr->paramList[n]->value.sval.num = ival;
301                envPtr->paramList[n]->value.sval.str = strPtr->values[ival];
302                break;
303            default:
304                panic("bad parameter type in PgapCreateString()");
305            }
306        }
307    }
308}
309
310/*
311 * ----------------------------------------------------------------------
312 * PgapMutation()
313 *
314 * Called by pgapack to perform random mutations on the input data
315 * used for evaluation.
316 * ----------------------------------------------------------------------
317 */
318int
319PgapMutation(ctx, p, pop, mr)
320    PGAContext *ctx;  /* pgapack context for this optimization */
321    int p;            /* sample #p being run */
322    int pop;          /* identifier for this population */
323    double mr;        /* probability of mutation for each gene */
324{
325    int count = 0;    /* number of mutations */
326
327    int n, ival;
328    RpOptimEnv *envPtr;
329    RpOptimParam *paramPtr;
330    RpOptimParamNumber *numPtr;
331    RpOptimParamString *strPtr;
332
333    envPtr = PgapGetEnvForContext(ctx);
334    paramPtr = (RpOptimParam*)PGAGetIndividual(ctx, p, pop)->chrom;
335
336    for (n=0; n < envPtr->numParams; n++) {
337        if (PGARandomFlip(ctx, mr)) {
338            /* won the coin toss -- change this parameter */
339            count++;
340
341            switch (paramPtr[n].type) {
342            case RP_OPTIMPARAM_NUMBER:
343                /* bump the value up/down a little, randomly */
344                if (PGARandomFlip(ctx, 0.5)) {
345                    paramPtr[n].value.dval += 0.1*paramPtr[n].value.dval;
346                } else {
347                    paramPtr[n].value.dval -= 0.1*paramPtr[n].value.dval;
348                }
349                /* make sure the resulting value is still in bounds */
350                numPtr = (RpOptimParamNumber*)envPtr->paramList[n];
351                if (paramPtr[n].value.dval > numPtr->max) {
352                    paramPtr[n].value.dval = numPtr->max;
353                }
354                if (paramPtr[n].value.dval < numPtr->min) {
355                    paramPtr[n].value.dval = numPtr->min;
356                }
357                break;
358
359            case RP_OPTIMPARAM_STRING:
360                ival = paramPtr[n].value.sval.num;
361                if (PGARandomFlip(ctx, 0.5)) {
362                    ival += 1;
363                } else {
364                    ival -= 1;
365                }
366                strPtr = (RpOptimParamString*)envPtr->paramList[n];
367                if (ival < 0) ival = 0;
368                if (ival >= strPtr->numValues) ival = strPtr->numValues-1;
369                paramPtr[n].value.sval.num = ival;
370                paramPtr[n].value.sval.str = strPtr->values[ival];
371                break;
372
373            default:
374                panic("bad parameter type in PgapMutation()");
375            }
376        }
377    }
378    return count;
379}
380
381/*
382 * ----------------------------------------------------------------------
383 * PgapCrossover()
384 *
385 * Called by pgapack to perform cross-over mutations on the input data
386 * used for evaluation.
387 * ----------------------------------------------------------------------
388 */
389void
390PgapCrossover(ctx, p1, p2, pop1, c1, c2, pop2)
391    PGAContext *ctx;  /* pgapack context for this optimization */
392    int p1;           /* sample # for parent of input string1 */
393    int p2;           /* sample # for parent of input string2 */
394    int pop1;         /* population containing p1 and p2 */
395    int c1;           /* sample # for child of input string1 */
396    int c2;           /* sample # for child of input string2 */
397    int pop2;         /* population containing c1 and c2 */
398{
399    int n;
400    RpOptimEnv *envPtr;
401    RpOptimParam *parent1, *parent2, *child1, *child2;
402    double pu;
403
404    envPtr = PgapGetEnvForContext(ctx);
405    parent1 = (RpOptimParam*)PGAGetIndividual(ctx, p1, pop1)->chrom;
406    parent2 = (RpOptimParam*)PGAGetIndividual(ctx, p2, pop1)->chrom;
407    child1  = (RpOptimParam*)PGAGetIndividual(ctx, c1, pop2)->chrom;
408    child2  = (RpOptimParam*)PGAGetIndividual(ctx, c2, pop2)->chrom;
409
410    pu = PGAGetUniformCrossoverProb(ctx);
411
412    for (n=0; n < envPtr->numParams; n++) {
413        if (PGARandomFlip(ctx, pu)) {
414            /* child inherits from parent */
415            memcpy(&child1[n], &parent1[n], sizeof(RpOptimParam));
416            memcpy(&child2[n], &parent2[n], sizeof(RpOptimParam));
417        } else {
418            /* crossover */
419            memcpy(&child1[n], &parent2[n], sizeof(RpOptimParam));
420            memcpy(&child2[n], &parent1[n], sizeof(RpOptimParam));
421        }
422    }
423}
424
425/*
426 * ----------------------------------------------------------------------
427 * PgapPrintString()
428 *
429 * Called by pgapack to format the values for a particular string of
430 * input data.
431 * ----------------------------------------------------------------------
432 */
433void
434PgapPrintString(ctx, fp, p, pop)
435    PGAContext *ctx;  /* pgapack context for this optimization */
436    FILE *fp;         /* write to this file pointer */
437    int p;            /* sample #p being run */
438    int pop;          /* identifier for this population */
439{
440    int n;
441    RpOptimEnv *envPtr;
442    RpOptimParam *paramPtr;
443
444    envPtr = PgapGetEnvForContext(ctx);
445    paramPtr = (RpOptimParam*)PGAGetIndividual(ctx, p, pop)->chrom;
446
447    for (n=0; n < envPtr->numParams; n++) {
448        fprintf(fp, "#%4d: ", n);
449        switch (paramPtr[n].type) {
450        case RP_OPTIMPARAM_NUMBER:
451            fprintf(fp, "[%11.7g] (%s)\n", paramPtr[n].value.dval,
452                paramPtr[n].name);
453            break;
454        case RP_OPTIMPARAM_STRING:
455            fprintf(fp, "[%d]=\"%s\" (%s)\n", paramPtr[n].value.sval.num,
456                paramPtr[n].value.sval.str, paramPtr[n].name);
457            break;
458        default:
459            panic("bad parameter type in PgapPrintString()");
460        }
461    }
462}
463
464/*
465 * ----------------------------------------------------------------------
466 * PgapCopyString()
467 *
468 * Called by pgapack to copy one input string to another.
469 * ----------------------------------------------------------------------
470 */
471void
472PgapCopyString(ctx, p1, pop1, p2, pop2)
473    PGAContext *ctx;  /* pgapack context for this optimization */
474    int p1;           /* source sample # being run */
475    int pop1;         /* population containing p1 */
476    int p2;           /* destination sample # being run */
477    int pop2;         /* population containing p1 */
478{
479    int n;
480    RpOptimEnv *envPtr;
481    RpOptimParam *src, *dst;
482
483    envPtr = PgapGetEnvForContext(ctx);
484    src = (RpOptimParam*)PGAGetIndividual(ctx, p1, pop1)->chrom;
485    dst = (RpOptimParam*)PGAGetIndividual(ctx, p2, pop2)->chrom;
486
487    for (n=0; n < envPtr->numParams; n++) {
488        dst[n].type = src[n].type;
489        switch (src[n].type) {
490        case RP_OPTIMPARAM_NUMBER:
491            dst[n].value.dval = src[n].value.dval;
492            break;
493        case RP_OPTIMPARAM_STRING:
494            dst[n].value.sval.num = src[n].value.sval.num;
495            dst[n].value.sval.str = src[n].value.sval.str;
496            break;
497        default:
498            panic("bad parameter type in PgapCopyString()");
499        }
500    }
501}
502
503/*
504 * ----------------------------------------------------------------------
505 * PgapDuplicateString()
506 *
507 * Called by pgapack to compare two input strings.  Returns non-zero if
508 * the two are duplicates and 0 otherwise.
509 * ----------------------------------------------------------------------
510 */
511int
512PgapDuplicateString(ctx, p1, pop1, p2, pop2)
513    PGAContext *ctx;  /* pgapack context for this optimization */
514    int p1;           /* sample #p being run */
515    int pop1;         /* population containing p1 */
516    int p2;           /* sample #p being run */
517    int pop2;         /* population containing p1 */
518{
519    int n;
520    RpOptimEnv *envPtr;
521    RpOptimParam *param1, *param2;
522
523    envPtr = PgapGetEnvForContext(ctx);
524    param1 = (RpOptimParam*)PGAGetIndividual(ctx, p1, pop1)->chrom;
525    param2 = (RpOptimParam*)PGAGetIndividual(ctx, p2, pop2)->chrom;
526
527    for (n=0; n < envPtr->numParams; n++) {
528        if (param1[n].type != param2[n].type) {
529            return 0;  /* different! */
530        }
531        switch (param1[n].type) {
532        case RP_OPTIMPARAM_NUMBER:
533            if (param1[n].value.dval != param2[n].value.dval) {
534                return 0;  /* different! */
535            }
536            break;
537        case RP_OPTIMPARAM_STRING:
538            if (param1[n].value.sval.num != param2[n].value.sval.num) {
539                return 0;  /* different! */
540            }
541            break;
542        default:
543            panic("bad parameter type in PgapDuplicateString()");
544        }
545    }
546    return 1;
547}
548
549
550
551/*
552 * ----------------------------------------------------------------------
553 * PgapCopyString()
554 *
555 * Called by pgapack to copy one input string to another.
556 * ----------------------------------------------------------------------
557 */
558MPI_Datatype
559PgapBuildDT(ctx, p, pop)
560    PGAContext *ctx;  /* pgapack context for this optimization */
561    int p;            /* sample # being run */
562    int pop;          /* population containing sample */
563{
564    panic("MPI support not implemented!");
565    return NULL;
566}
567
568/*
569 * ======================================================================
570 *  OPTION:  -operation <=> PGA_MINIMIZE / PGA_MAXIMIZE
571 * ======================================================================
572 */
573int
574RpOption_ParseOper(interp, valObj, cdata, offset)
575    Tcl_Interp *interp;  /* interpreter handling this request */
576    Tcl_Obj *valObj;     /* set option to this new value */
577    ClientData cdata;    /* save in this data structure */
578    int offset;          /* save at this offset in cdata */
579{
580    int *ptr = (int*)(cdata+offset);
581    char *val = Tcl_GetStringFromObj(valObj, (int*)NULL);
582    if (strcmp(val,"minimize") == 0) {
583        *ptr = PGA_MINIMIZE;
584    }
585    else if (strcmp(val,"maximize") == 0) {
586        *ptr = PGA_MAXIMIZE;
587    }
588    else {
589        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
590            "bad value \"", val, "\": should be minimize, maximize",
591            (char*)NULL);
592        return TCL_ERROR;
593    }
594    return TCL_OK;
595}
596
597int
598RpOption_GetOper(interp, cdata, offset)
599    Tcl_Interp *interp;  /* interpreter handling this request */
600    ClientData cdata;    /* get from this data structure */
601    int offset;          /* get from this offset in cdata */
602{
603    int *ptr = (int*)(cdata+offset);
604    switch (*ptr) {
605    case PGA_MINIMIZE:
606        Tcl_SetResult(interp, "minimize", TCL_STATIC);
607        break;
608    case PGA_MAXIMIZE:
609        Tcl_SetResult(interp, "maximize", TCL_STATIC);
610        break;
611    default:
612        Tcl_SetResult(interp, "???", TCL_STATIC);
613        break;
614    }
615    return TCL_OK;
616}
617
618/*
619 * ======================================================================
620 *  OPTION:  -poprepl <=> PGASetPopReplacementType()
621 * ======================================================================
622 */
623int
624RpOption_ParsePopRepl(interp, valObj, cdata, offset)
625    Tcl_Interp *interp;  /* interpreter handling this request */
626    Tcl_Obj *valObj;     /* set option to this new value */
627    ClientData cdata;    /* save in this data structure */
628    int offset;          /* save at this offset in cdata */
629{
630    int *ptr = (int*)(cdata+offset);
631    char *val = Tcl_GetStringFromObj(valObj, (int*)NULL);
632    if (*val == 'b' && strcmp(val,"best") == 0) {
633        *ptr = PGA_POPREPL_BEST;
634    }
635    else if (*val == 'r' && strcmp(val,"random-repl") == 0) {
636        *ptr = PGA_POPREPL_RANDOM_REP;
637    }
638    else if (*val == 'r' && strcmp(val,"random-norepl") == 0) {
639        *ptr = PGA_POPREPL_RANDOM_NOREP;
640    }
641    else {
642        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
643            "bad value \"", val, "\": should be best, random-norepl,"
644            " or random-repl", (char*)NULL);
645        return TCL_ERROR;
646    }
647    return TCL_OK;
648}
649
650int
651RpOption_GetPopRepl(interp, cdata, offset)
652    Tcl_Interp *interp;  /* interpreter handling this request */
653    ClientData cdata;    /* get from this data structure */
654    int offset;          /* get from this offset in cdata */
655{
656    int *ptr = (int*)(cdata+offset);
657    switch (*ptr) {
658    case PGA_POPREPL_BEST:
659        Tcl_SetResult(interp, "best", TCL_STATIC);
660        break;
661    case PGA_POPREPL_RANDOM_REP:
662        Tcl_SetResult(interp, "random-repl", TCL_STATIC);
663        break;
664    case PGA_POPREPL_RANDOM_NOREP:
665        Tcl_SetResult(interp, "random-norepl", TCL_STATIC);
666        break;
667    default:
668        Tcl_SetResult(interp, "???", TCL_STATIC);
669        break;
670    }
671    return TCL_OK;
672}
673
674/*
675 * ======================================================================
676 *  OPTION:  -stpcriteria <=> PGA_STOP_MAXITER / PGA_STOP_NOCHANGE / PGA_STOP_TOOSIMILAR
677 * ======================================================================
678 */
679int
680RpOption_ParseStpCriteria(interp, valObj, cdata, offset)
681    Tcl_Interp *interp;  /* interpreter handling this request */
682    Tcl_Obj *valObj;     /* set option to this new value */
683    ClientData cdata;    /* save in this data structure */
684    int offset;          /* save at this offset in cdata */
685{
686    int *ptr = (int*)(cdata+offset);
687    char *val = Tcl_GetStringFromObj(valObj, (int*)NULL);
688    if (strcmp(val,"maxiter") == 0) {
689        *ptr = PGA_STOP_MAXITER;
690    }
691    else if (strcmp(val,"nochange") == 0) {
692        *ptr = PGA_STOP_NOCHANGE;
693    }
694    else if (strcmp(val,"toosimilar") == 0){
695        *ptr = PGA_STOP_TOOSIMILAR;
696    }
697    else {
698        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
699            "bad value \"", val, "\": should be maxiter, nochange or toosimilar",
700            (char*)NULL);
701        return TCL_ERROR;
702    }
703    return TCL_OK;
704}
705
706int
707RpOption_GetStpCriteria(interp, cdata, offset)
708    Tcl_Interp *interp;  /* interpreter handling this request */
709    ClientData cdata;    /* get from this data structure */
710    int offset;          /* get from this offset in cdata */
711{
712    int *ptr = (int*)(cdata+offset);
713    switch (*ptr) {
714    case PGA_STOP_MAXITER:
715        Tcl_SetResult(interp, "maxiter", TCL_STATIC);
716        break;
717    case PGA_STOP_NOCHANGE:
718        Tcl_SetResult(interp, "nochange", TCL_STATIC);
719        break;
720    case PGA_STOP_TOOSIMILAR:
721        Tcl_SetResult(interp, "toosimilar", TCL_STATIC);
722        break;
723    default:
724        Tcl_SetResult(interp, "???", TCL_STATIC);
725        break;
726    }
727    return TCL_OK;
728}
729
730/*
731 * ======================================================================
732 *  ROUTINES FOR CONNECTING PGACONTEXT <=> RPOPTIMENV
733 * ======================================================================
734 * PgapLinkContext2Env()
735 *   This routine is used internally to establish a relationship between
736 *   a PGAContext token and its corresponding RpOptimEnv data.  The
737 *   PGA routines don't provide a way to pass the RpOptimEnv data along,
738 *   so we use these routines to find the correspondence.
739 *
740 * PgapGetEnvForContext()
741 *   Returns the RpOptimEnv associated with a given PGAContext.  If the
742 *   link has not been established via PgapLinkContext2Env(), then this
743 *   routine returns NULL.
744 *
745 * PgapUnlinkContext2Env()
746 *   Breaks the link between a PGAContext and its RpOptimEnv.  Should
747 *   be called when the PGAContext is destroyed and is no longer valid.
748 * ----------------------------------------------------------------------
749 */
750static Tcl_HashTable *Pgacontext2Rpenv = NULL;
751
752void
753PgapLinkContext2Env(ctx, envPtr)
754    PGAContext *ctx;      /* pgapack context for this optimization */
755    RpOptimEnv *envPtr;   /* corresponding Rappture optimization data */
756{
757    Tcl_HashEntry *ctxEntry;
758    int newEntry;
759
760    if (Pgacontext2Rpenv == NULL) {
761        Pgacontext2Rpenv = (Tcl_HashTable*)malloc(sizeof(Tcl_HashTable));
762        Tcl_InitHashTable(Pgacontext2Rpenv, TCL_ONE_WORD_KEYS);
763    }
764    ctxEntry = Tcl_CreateHashEntry(Pgacontext2Rpenv, (char*)ctx, &newEntry);
765    Tcl_SetHashValue(ctxEntry, (ClientData)envPtr);
766}
767
768RpOptimEnv*
769PgapGetEnvForContext(ctx)
770    PGAContext *ctx;
771{
772    Tcl_HashEntry *entryPtr;
773
774    if (Pgacontext2Rpenv) {
775        entryPtr = Tcl_FindHashEntry(Pgacontext2Rpenv, (char*)ctx);
776        if (entryPtr) {
777            return (RpOptimEnv*)Tcl_GetHashValue(entryPtr);
778        }
779    }
780    return NULL;
781}
782
783void
784PgapUnlinkContext2Env(ctx)
785    PGAContext *ctx;
786{
787    Tcl_HashEntry *entryPtr;
788
789    if (Pgacontext2Rpenv) {
790        entryPtr = Tcl_FindHashEntry(Pgacontext2Rpenv, (char*)ctx);
791        if (entryPtr) {
792            Tcl_DeleteHashEntry(entryPtr);
793        }
794    }
795}
796/*---------------------------------------------------------------------------------
797 * PGARuntimeDTInit(): It initializes the runtime data table.
798 * The table is organized slightly counter-intuitively
799 * Instead of a
800 *  param1|param2|param3  |param4...
801 *      val11 |val12 |val13   |val14...
802 *      val12 |val22 |val23   |val24....
803 * orientation, it is organized as
804 *      param1|val11|val12
805 *      param2|val21|val22
806 *      param3|val31|val32
807 *      param4|val41|val42
808 * Reallocating for additional columns is easier than reallocating additional rows and then
809 * reallocating for columns
810 * --------------------------------------------------------------------------------
811 */
812
813void PGARuntimeDataTableInit(envPtr)
814RpOptimEnv *envPtr;
815{   
816        int i;
817        if(envPtr != NULL){
818                table.num_of_rows = (envPtr->numParams)+1;
819                table.data = malloc((table.num_of_rows)*sizeof(double*));
820                if(table.data == NULL){
821                        panic("\nAllocation for Runtime Data Table failed\n");
822                }
823                for(i=0;i<table.num_of_rows;i++){
824                        table.data[i] = malloc(PGAPACK_RUNTIME_TABLE_DEFAULT_SIZE*sizeof(double));
825                        if(table.data[i] == NULL){
826                                panic("\nAllocation for Runtime Data Table failed\n");
827                        }                       
828                }
829                table.no_of_samples_evaled = 0;
830                table.no_of_columns = PGAPACK_RUNTIME_TABLE_DEFAULT_SIZE;
831               
832        }else{
833                panic("\nError: NULL Environment variable OR Table pointer passed to Data Table Init\n");
834        }
835}
836
837void PGARuntimeDataTableDeInit()
838{       
839        int i;
840        if((&table) == NULL){
841                panic("Error: Table not present, therefore cannot free memory..");
842        }
843        for(i=0;i<table.num_of_rows;i++){
844                free(table.data[i]);
845        }
846        free(table.data);
847}
848
849void PGARuntimeDataTableSetSampleValue(chrom,fitness)
850RpOptimParam *chrom;
851double fitness;
852{
853        int i;
854        printf("\nSetting sample value.......................\n");
855        if(chrom!=NULL && (&table)!=NULL){
856                (table.no_of_samples_evaled)+=1;
857                if((table.no_of_samples_evaled) > table.no_of_columns){
858                        /* then Reallocate space for more columns)*/
859                        (table.no_of_columns)+=(table.no_of_columns);
860                                //TODO GTG: Delete printing stuff
861                        for(i=0;i<(table.num_of_rows);i++){
862                                table.data[i] = realloc(table.data[i],table.no_of_columns);
863                                if(table.data[i]==NULL){
864                                        panic("\nError: Could not Reallocate more space for the table");
865                                }                               
866                        }
867                }else{
868                        if(chrom->type == RP_OPTIMPARAM_NUMBER){
869                                for(i=0;i<(table.num_of_rows);i++){
870                                        if(i==0){
871                                                table.data[i][(table.no_of_samples_evaled)-1] = fitness;
872                                                printf("\nSample Number %d:- Fitness: %lf\t",table.no_of_samples_evaled,fitness);
873                                        }else{
874                                                table.data[i][(table.no_of_samples_evaled)-1] = chrom[i-1].value.dval;
875                                                printf("Param %d %lf\t",i,table.data[i][(table.no_of_samples_evaled)-1]);
876                                        }
877                }
878                        }else{
879                                panic("\n Chromosome value is RP_OPTIMPARAM_STRING\n");
880                                //GTG TODO: find out what happens in this case. Will we be better off handling Tcl_objects?
881                        }       
882                }
883        }else{
884                panic("\nError:Either Chromosome, or table passed to PGARuntimeDataTableSetSampleValue() is NULL\n");
885        }
886       
887}
888
889void GetSampleInformation(buffer,sampleNumber)
890        char *buffer;
891        int sampleNumber;
892{
893        int i;
894        char tempBuff[50];
895        printf("\nFetching sample information.........................\n");
896        if((&table) == NULL){
897                panic("Table uninitialized");
898        }
899        if(sampleNumber<=0){
900                sprintf(buffer,"\nNumber of Samples Evaluated so far: %d\n",(table.no_of_samples_evaled)+1);
901                return;
902        }
903        if(((table.num_of_rows)-1)*10>SINGLE_SAMPLE_DATA_BUFFER_DEFAULT_SIZE){
904                buffer = realloc(buffer,50+25*(table.num_of_rows));
905                //resizing the buffer, keeping 50 for display related jazz, around 12-15 characs for param names
906                //and 10 characs for Fl.pt. display of the value
907                if(buffer == NULL){
908                        panic("\nError: Could not reallocate space for sample data buffer");
909                }
910        }
911        for(i=0;i<(table.num_of_rows);i++){
912                if(i==0){
913                        sprintf(buffer,"\nSample Number %d ----> Fitness: %lf  ",sampleNumber,table.data[i][sampleNumber-1]);
914                }else{
915                        sprintf(tempBuff,"Param %d: %lf  ",i,table.data[i][sampleNumber-1]);
916                        strcat(buffer,tempBuff);
917                }
918        }
919        strcat(buffer,"\n");
920}
Note: See TracBrowser for help on using the repository browser.