Context Navigation

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

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

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

Download in other formats: