test/blackbox/bboxtest.c

/*  ASCEND modelling environment
    Copyright (C) 2006 Carnegie Mellon University

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2, or (at your option)
    any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330,
    Boston, MA 02111-1307, USA.
*//**
    @file
    black box semantics test.
*//*
    by Ben Allan
    Created: July 4, 2006
    Version: $Revision: 1.5 $
    Date last modified: $Date: 1997/07/18 12:20:07 $
*/

#include <utilities/ascConfig.h>
#include <utilities/ascMalloc.h>
#include <compiler/compiler.h>
#include <compiler/packages.h>
#include <compiler/instance_enum.h>
#include <utilities/ascPanic.h>
/* next 4 needed only because we use RealAtomValue on the DATA instance. */
#include <compiler/fractions.h>
#include <compiler/dimen.h>
#include <compiler/atomvalue.h>
#include <compiler/instquery.h>

#include <compiler/extcall.h>

/* #define BBOXTEST_DEBUG */

ExtBBoxInitFunc bboxtest_preslv;
ExtBBoxFunc bboxtest_fex;
ExtBBoxFunc bboxtest_jex;
ExtBBoxFinalFunc bboxtest_final;
#define N_INPUT_ARGS 1 /* formal arg count */
#define N_OUTPUT_ARGS 1 /* formal arg count */

extern 
ASC_EXPORT(int) bboxtest_register(void){
    double epsilon = 1.0e-14;

    char bboxtest_help[] = "This tests a simple black box y=k*x."
        " The value 'k' is provided to the blackbox as a data argument.";

    return CreateUserFunctionBlackBox("bboxtest"
        ,&bboxtest_preslv
        ,&bboxtest_fex, &bboxtest_jex
        ,NULL, &bboxtest_final
        ,N_INPUT_ARGS, N_OUTPUT_ARGS
        ,bboxtest_help
        ,epsilon
    );
}

/*------------------------------------------------------------------------------
  forward decls
*/

struct BBOXTEST_problem {
    double coef; /* coef in y=coef*x*/
    int n; /* number of equations. */
};

static int GetCoef( struct Instance *data, struct BBOXTEST_problem *problem);

static int CheckArgsOK(struct Instance *data
    ,struct gl_list_t *arglist, struct BBOXTEST_problem *problem
);

static int DoCalculation(struct BBoxInterp *interp
    ,int ninputs, int noutputs
    ,double *inputs, double *outputs
);

int DoDeriv(struct BBoxInterp *interp, int ninputs, double *jacobian);

#ifndef EXTERNAL_EPSILON
#define EXTERNAL_EPSILON 1.0e-12
#endif

/*----------------------------------------------------------------------------*/

/**
    This function is one of the registered functions. It operates in
    mode 'last_call'.

    In 'last_call' mode, the memory associated with the problem is
    released.
*/
void bboxtest_final(struct BBoxInterp *interp){
    struct BBOXTEST_problem *problem;

    if(interp->task != bb_last_call){
        ERROR_REPORTER_HERE(ASC_PROG_ERR,"Unexpected call to last_call fn");
        return;
    }

    if(interp->user_data != NULL) {
        problem = (struct BBOXTEST_problem *)interp->user_data;
        problem->coef *= -1;
        problem->n *= -1;
        ASC_FREE(problem);
        interp->user_data = NULL;
    }
}
/**
    This function is one of the registered functions. It operates in
     mode first_call.
    It creates a BBOXTEST_problem and calls a number of routines to check
    the arguments (data and arglist) and to cache the information
    processed away in the BBOXTEST_problem structure.

    In last_call mode, the memory associated with the problem is
    released.

    @return 0 on success
*/
int bboxtest_preslv(struct BBoxInterp *interp,
            struct Instance *data,
            struct gl_list_t *arglist

){
    struct BBOXTEST_problem *problem;

    if(interp->task != bb_first_call){
        ERROR_REPORTER_HERE(ASC_PROG_ERR,"Unexpected call to first_call fn");
        return -1;
    }

    if(interp->user_data!=NULL){
#ifdef BBOXTEST_DEBUG
        CONSOLE_DEBUG("user_data has already been allocated, no need to reallocate");
#endif
        return 0;
    }

    problem = ASC_NEW(struct BBOXTEST_problem);
    if(CheckArgsOK(data,arglist,problem)){
        CONSOLE_DEBUG("Problem with arguments");
        ASC_FREE(problem);
        return -2;
    }

    /* store the BBTEST_problem in the user_data pointer */
    interp->user_data = (void *)problem;
    return 0; /* success */
}

/*----------------------------------------------------------------------------*/

/** 
    Evaluate residuals

    @return 0 on success 
*/
int bboxtest_fex(struct BBoxInterp *interp,
        int ninputs,
        int noutputs,
        double *inputs,
        double *outputs,
        double *jacobian
){
    (void)jacobian;
    return DoCalculation(interp, ninputs, noutputs, inputs, outputs);
}

/*
    Evaluate jacobian
    @return 0 on success
*/
int bboxtest_jex(struct BBoxInterp *interp,
        int ninputs,
        int noutputs,
        double *inputs,
        double *outputs,
        double *jacobian
){
    (void)noutputs; 
    (void)outputs;
    (void)inputs;
    
    return DoDeriv(interp, ninputs, jacobian);
}

/*------------------------------------------------------------------------------
  utility routines
*/

static int GetCoef( struct Instance *data, struct BBOXTEST_problem *problem){

    if(!data){
        ERROR_REPORTER_HERE(ASC_USER_ERROR,"expecting a data instance to be provided");
        return 5;
    }
    if(InstanceKind(data)!=REAL_CONSTANT_INST) {
        ERROR_REPORTER_HERE(ASC_USER_ERROR,"expecting a real constant instance.");
        return 6;
    }

    problem->coef = RealAtomValue(data);
    return 0;
}

static int CheckArgsOK(struct Instance *data,
            struct gl_list_t *arglist,
            struct BBOXTEST_problem *problem
){
    unsigned long len,ninputs,noutputs;

    if (!arglist) {
        ERROR_REPORTER_HERE(ASC_USER_ERROR,"External function argument list does not exist.");
        return 1;
    }
    len = gl_length(arglist);
    if (!len) {
        ERROR_REPORTER_HERE(ASC_USER_ERROR,"No arguments to external function statement.");
        return 2;
    }
    if ((len!=(N_INPUT_ARGS+N_OUTPUT_ARGS))) {
        ERROR_REPORTER_HERE(ASC_USER_ERROR,"Number of arguments does not match"
            " the external function"
            " prototype(array_of_realatom[set],array_of_realatom[set],real_constant"
        );
        return 3;
    }

    ninputs = CountNumberOfArgs(arglist,1,N_INPUT_ARGS);
    noutputs = CountNumberOfArgs(arglist,N_INPUT_ARGS+1,
                    N_INPUT_ARGS+N_OUTPUT_ARGS);
    if (ninputs != noutputs) {
        ERROR_REPORTER_HERE(ASC_USER_ERROR,"Length of input, output arguments mismatched.");
        return 4;
    }

    problem->n = (int)ninputs;

    return GetCoef(data,problem); /* get the coef, return 0 on success means all was ok */
}

/*
    This function provides support to bboxtest_fex which is one of the
    registered functions. The input variables are x[set]
    The output variables are y[set]. We do our loop
    based on the ascend standard that sets are arbitrarily but
    consistently ordered if they contain the same values.
*/

static int DoCalculation(struct BBoxInterp *interp,
             int ninputs, int noutputs,
             double *inputs,
             double *outputs
){
    struct BBOXTEST_problem *problem;
    int c;
    double coef;

    if(ninputs != noutputs){
        ERROR_REPORTER_HERE(ASC_PROG_ERR,"ninputs != noutputs");
        return -1;
    }
    if(interp->user_data == NULL){
        ERROR_REPORTER_HERE(ASC_PROG_ERR,"user_data not supplied");
        return -2;
    }
    problem = (struct BBOXTEST_problem *)interp->user_data;
    coef = problem->coef;

    for (c=0; c < ninputs; c++) {
        outputs[c] = coef * inputs[c];
    }

#ifdef BBOXTEST_DEBUG
    CONSOLE_DEBUG("instance = %p",interp->user_data);
    for(c=0;c<ninputs;c++) {
        CONSOLE_DEBUG("x[%d]    = %12.8g",c,inputs[c]);
    }
    for (c=0;c<noutputs;c++) {
        CONSOLE_DEBUG("y[%d]    = %20.8g",c,outputs[c]);
    }
#endif /* BBOXTEST_DEBUG */

    interp->status = calc_all_ok;
    return 0;
}

int DoDeriv(struct BBoxInterp *interp, int ninputs, double *jacobian){
    int i; int len;
    double coef;
    if(interp==NULL){
        ERROR_REPORTER_HERE(ASC_PROG_ERR,"interp==NULL");
        return -1;
    }
    if(interp->user_data==NULL){
        ERROR_REPORTER_HERE(ASC_PROG_ERR,"interp->user_data==NULL");
        return -2;
    }
    coef = ((struct BBOXTEST_problem *)interp->user_data)->coef;
    len = ninputs*ninputs;

#ifdef BBOXTEST_DEBUG
    CONSOLE_DEBUG("instance = %p",interp->user_data);
#endif
    for (i = 0; i< len; i++) {
        jacobian[i] = 0;
    }
    
    for (i = 0; i< ninputs; i++) {
        jacobian[i*ninputs+i] = coef;
    }
#ifdef BBOXTEST_DEBUG
    for(i=0; i<len; i++) {
        CONSOLE_DEBUG("J[%d]    = %12.8g", i, jacobian[i]);
    }
#endif
    return 0;
}
1	/* ASCEND modelling environment
2	Copyright (C) 2006 Carnegie Mellon University
3
4	This program is free software; you can redistribute it and/or modify
5	it under the terms of the GNU General Public License as published by
6	the Free Software Foundation; either version 2, or (at your option)
7	any later version.
8
9	This program is distributed in the hope that it will be useful,
10	but WITHOUT ANY WARRANTY; without even the implied warranty of
11	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12	GNU General Public License for more details.
13
14	You should have received a copy of the GNU General Public License
15	along with this program; if not, write to the Free Software
16	Foundation, Inc., 59 Temple Place - Suite 330,
17	Boston, MA 02111-1307, USA.
18	//*
19	@file
20	black box semantics test.
21	//
22	by Ben Allan
23	Created: July 4, 2006
24	Version: $Revision: 1.5 $
25	Date last modified: $Date: 1997/07/18 12:20:07 $
26	*/
27
28	#include <utilities/ascConfig.h>
29	#include <utilities/ascMalloc.h>
30	#include <compiler/compiler.h>
31	#include <compiler/packages.h>
32	#include <compiler/instance_enum.h>
33	#include <utilities/ascPanic.h>
34	/* next 4 needed only because we use RealAtomValue on the DATA instance. */
35	#include <compiler/fractions.h>
36	#include <compiler/dimen.h>
37	#include <compiler/atomvalue.h>
38	#include <compiler/instquery.h>
39
40	#include <compiler/extcall.h>
41
42	/* #define BBOXTEST_DEBUG */
43
44	ExtBBoxInitFunc bboxtest_preslv;
45	ExtBBoxFunc bboxtest_fex;
46	ExtBBoxFunc bboxtest_jex;
47	ExtBBoxFinalFunc bboxtest_final;
48	#define N_INPUT_ARGS 1 /* formal arg count */
49	#define N_OUTPUT_ARGS 1 /* formal arg count */
50
51	extern
52	ASC_EXPORT(int) bboxtest_register(void){
53	double epsilon = 1.0e-14;
54
55	char bboxtest_help[] = "This tests a simple black box y=k*x."
56	" The value 'k' is provided to the blackbox as a data argument.";
57
58	return CreateUserFunctionBlackBox("bboxtest"
59	,&bboxtest_preslv
60	,&bboxtest_fex, &bboxtest_jex
61	,NULL, &bboxtest_final
62	,N_INPUT_ARGS, N_OUTPUT_ARGS
63	,bboxtest_help
64	,epsilon
65	);
66	}
67
68	/*------------------------------------------------------------------------------
69	forward decls
70	*/
71
72	struct BBOXTEST_problem {
73	double coef; /* coef in y=coefx/
74	int n; /* number of equations. */
75	};
76
77	static int GetCoef( struct Instance data, struct BBOXTEST_problem problem);
78
79	static int CheckArgsOK(struct Instance *data
80	,struct gl_list_t arglist, struct BBOXTEST_problem problem
81	);
82
83	static int DoCalculation(struct BBoxInterp *interp
84	,int ninputs, int noutputs
85	,double inputs, double outputs
86	);
87
88	int DoDeriv(struct BBoxInterp interp, int ninputs, double jacobian);
89
90	#ifndef EXTERNAL_EPSILON
91	#define EXTERNAL_EPSILON 1.0e-12
92	#endif
93
94	/----------------------------------------------------------------------------/
95
96	/**
97	This function is one of the registered functions. It operates in
98	mode 'last_call'.
99
100	In 'last_call' mode, the memory associated with the problem is
101	released.
102	*/
103	void bboxtest_final(struct BBoxInterp *interp){
104	struct BBOXTEST_problem *problem;
105
106	if(interp->task != bb_last_call){
107	ERROR_REPORTER_HERE(ASC_PROG_ERR,"Unexpected call to last_call fn");
108	return;
109	}
110
111	if(interp->user_data != NULL) {
112	problem = (struct BBOXTEST_problem *)interp->user_data;
113	problem->coef *= -1;
114	problem->n *= -1;
115	ASC_FREE(problem);
116	interp->user_data = NULL;
117	}
118	}
119	/**
120	This function is one of the registered functions. It operates in
121	mode first_call.
122	It creates a BBOXTEST_problem and calls a number of routines to check
123	the arguments (data and arglist) and to cache the information
124	processed away in the BBOXTEST_problem structure.
125
126	In last_call mode, the memory associated with the problem is
127	released.
128
129	@return 0 on success
130	*/
131	int bboxtest_preslv(struct BBoxInterp *interp,
132	struct Instance *data,
133	struct gl_list_t *arglist
134
135	){
136	struct BBOXTEST_problem *problem;
137
138	if(interp->task != bb_first_call){
139	ERROR_REPORTER_HERE(ASC_PROG_ERR,"Unexpected call to first_call fn");
140	return -1;
141	}
142
143	if(interp->user_data!=NULL){
144	#ifdef BBOXTEST_DEBUG
145	CONSOLE_DEBUG("user_data has already been allocated, no need to reallocate");
146	#endif
147	return 0;
148	}
149
150	problem = ASC_NEW(struct BBOXTEST_problem);
151	if(CheckArgsOK(data,arglist,problem)){
152	CONSOLE_DEBUG("Problem with arguments");
153	ASC_FREE(problem);
154	return -2;
155	}
156
157	/* store the BBTEST_problem in the user_data pointer */
158	interp->user_data = (void *)problem;
159	return 0; /* success */
160	}
161
162	/----------------------------------------------------------------------------/
163
164	/**
165	Evaluate residuals
166
167	@return 0 on success
168	*/
169	int bboxtest_fex(struct BBoxInterp *interp,
170	int ninputs,
171	int noutputs,
172	double *inputs,
173	double *outputs,
174	double *jacobian
175	){
176	(void)jacobian;
177	return DoCalculation(interp, ninputs, noutputs, inputs, outputs);
178	}
179
180	/*
181	Evaluate jacobian
182	@return 0 on success
183	*/
184	int bboxtest_jex(struct BBoxInterp *interp,
185	int ninputs,
186	int noutputs,
187	double *inputs,
188	double *outputs,
189	double *jacobian
190	){
191	(void)noutputs;
192	(void)outputs;
193	(void)inputs;
194
195	return DoDeriv(interp, ninputs, jacobian);
196	}
197
198	/*------------------------------------------------------------------------------
199	utility routines
200	*/
201
202	static int GetCoef( struct Instance data, struct BBOXTEST_problem problem){
203
204	if(!data){
205	ERROR_REPORTER_HERE(ASC_USER_ERROR,"expecting a data instance to be provided");
206	return 5;
207	}
208	if(InstanceKind(data)!=REAL_CONSTANT_INST) {
209	ERROR_REPORTER_HERE(ASC_USER_ERROR,"expecting a real constant instance.");
210	return 6;
211	}
212
213	problem->coef = RealAtomValue(data);
214	return 0;
215	}
216
217	static int CheckArgsOK(struct Instance *data,
218	struct gl_list_t *arglist,
219	struct BBOXTEST_problem *problem
220	){
221	unsigned long len,ninputs,noutputs;
222
223	if (!arglist) {
224	ERROR_REPORTER_HERE(ASC_USER_ERROR,"External function argument list does not exist.");
225	return 1;
226	}
227	len = gl_length(arglist);
228	if (!len) {
229	ERROR_REPORTER_HERE(ASC_USER_ERROR,"No arguments to external function statement.");
230	return 2;
231	}
232	if ((len!=(N_INPUT_ARGS+N_OUTPUT_ARGS))) {
233	ERROR_REPORTER_HERE(ASC_USER_ERROR,"Number of arguments does not match"
234	" the external function"
235	" prototype(array_of_realatom[set],array_of_realatom[set],real_constant"
236	);
237	return 3;
238	}
239
240	ninputs = CountNumberOfArgs(arglist,1,N_INPUT_ARGS);
241	noutputs = CountNumberOfArgs(arglist,N_INPUT_ARGS+1,
242	N_INPUT_ARGS+N_OUTPUT_ARGS);
243	if (ninputs != noutputs) {
244	ERROR_REPORTER_HERE(ASC_USER_ERROR,"Length of input, output arguments mismatched.");
245	return 4;
246	}
247
248	problem->n = (int)ninputs;
249
250	return GetCoef(data,problem); /* get the coef, return 0 on success means all was ok */
251	}
252
253	/*
254	This function provides support to bboxtest_fex which is one of the
255	registered functions. The input variables are x[set]
256	The output variables are y[set]. We do our loop
257	based on the ascend standard that sets are arbitrarily but
258	consistently ordered if they contain the same values.
259	*/
260
261	static int DoCalculation(struct BBoxInterp *interp,
262	int ninputs, int noutputs,
263	double *inputs,
264	double *outputs
265	){
266	struct BBOXTEST_problem *problem;
267	int c;
268	double coef;
269
270	if(ninputs != noutputs){
271	ERROR_REPORTER_HERE(ASC_PROG_ERR,"ninputs != noutputs");
272	return -1;
273	}
274	if(interp->user_data == NULL){
275	ERROR_REPORTER_HERE(ASC_PROG_ERR,"user_data not supplied");
276	return -2;
277	}
278	problem = (struct BBOXTEST_problem *)interp->user_data;
279	coef = problem->coef;
280
281	for (c=0; c < ninputs; c++) {
282	outputs[c] = coef * inputs[c];
283	}
284
285	#ifdef BBOXTEST_DEBUG
286	CONSOLE_DEBUG("instance = %p",interp->user_data);
287	for(c=0;c<ninputs;c++) {
288	CONSOLE_DEBUG("x[%d] = %12.8g",c,inputs[c]);
289	}
290	for (c=0;c<noutputs;c++) {
291	CONSOLE_DEBUG("y[%d] = %20.8g",c,outputs[c]);
292	}
293	#endif /* BBOXTEST_DEBUG */
294
295	interp->status = calc_all_ok;
296	return 0;
297	}
298
299	int DoDeriv(struct BBoxInterp interp, int ninputs, double jacobian){
300	int i; int len;
301	double coef;
302	if(interp==NULL){
303	ERROR_REPORTER_HERE(ASC_PROG_ERR,"interp==NULL");
304	return -1;
305	}
306	if(interp->user_data==NULL){
307	ERROR_REPORTER_HERE(ASC_PROG_ERR,"interp->user_data==NULL");
308	return -2;
309	}
310	coef = ((struct BBOXTEST_problem *)interp->user_data)->coef;
311	len = ninputs*ninputs;
312
313	#ifdef BBOXTEST_DEBUG
314	CONSOLE_DEBUG("instance = %p",interp->user_data);
315	#endif
316	for (i = 0; i< len; i++) {
317	jacobian[i] = 0;
318	}
319
320	for (i = 0; i< ninputs; i++) {
321	jacobian[i*ninputs+i] = coef;
322	}
323	#ifdef BBOXTEST_DEBUG
324	for(i=0; i<len; i++) {
325	CONSOLE_DEBUG("J[%d] = %12.8g", i, jacobian[i]);
326	}
327	#endif
328	return 0;
329	}