Context Navigation

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

Last change on this file since 1166 was 1166, checked in by liveletlive, 16 years ago
Changes Made: Vanilla restart added, no modifications can be made to existing parameters in the middle of a run. Only mutation creates a new population on restart. New configuration options added: MutationandCrossover? option. amount to be mutated made configurable. configration for (not)allowing duplicate strings added. app-qdot and simple modified to keep pace with these changes.
File size: 34.0 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: