generic/packages/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 <compiler/compiler.h>
#include <compiler/packages.h>
#include <compiler/instance_enum.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>
#include "bboxtest.h"

#define BBOXTEST_DEBUG 1

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

#define N_INPUT_ARGS 1 /* formal arg count */
#define N_OUTPUT_ARGS 1 /* formal arg count */

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){

    if (!data) {
        FPRINTF(stderr,"Error: bboxtest: expecting a data instance to be provided\n");
        return 1;
    }
    if (InstanceKind(data)!=REAL_CONSTANT_INST) {
        FPRINTF(stderr,"Error: bboxtest: expecting a real constant instance.\n");
        return 1;
    }

    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;
    int result;

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

    ninputs = CountNumberOfArgs(arglist,1,N_INPUT_ARGS);
    noutputs = CountNumberOfArgs(arglist,N_INPUT_ARGS+1,
                    N_INPUT_ARGS+N_OUTPUT_ARGS);
    if (ninputs != noutputs) {
        FPRINTF(stderr,"bboxtest: Length of input, output arguments mismatched.\n");
        return 1;
    }

    problem->n = (int)ninputs;
    result = GetCoef(data,problem); /* get the coef */
    if (result) {
        return 1;
    }

    return 0;
}


/**
    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) {
        if (interp->user_data != NULL) {
            problem = (struct BBOXTEST_problem *)interp->user_data;
            problem->coef *= -1;
            problem->n *= -1;
            free(problem);
        }
        interp->user_data = NULL;
    }
    /* shouldn't be here */
}
/**
    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.
*/
int bboxtest_preslv(struct BBoxInterp *interp,
            struct Instance *data,
            struct gl_list_t *arglist

){
    struct BBOXTEST_problem *problem;

#ifdef BBOXTEST_DEBUG
    FPRINTF(stdout,"bboxtest_preslv called (interp %p), (instance %p)\n",interp, interp->user_data);
#endif
    if (interp->task == bb_first_call) {
#ifdef BBOXTEST_DEBUG
    FPRINTF(stdout,"bboxtest_preslv called for bb_first_call");
#endif
        if (interp->user_data!=NULL) {
            /* we have been called before */
            return 0;
            /* the problem structure exists */
        } else {
            problem = (struct BBOXTEST_problem *)malloc(sizeof(struct BBOXTEST_problem));
            if(CheckArgsOK(data,arglist,problem)) {
                free(problem);
                return 1;
            }
            interp->user_data = (void *)problem;
            return 0;
        }
    }
#ifdef BBOXTEST_DEBUG
    FPRINTF(stdout,"bboxtest_preslv called in fish circumstance.");
#endif
    return 1; /* shouldn't be here ever. */
}


/*
    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;

    assert(ninputs == noutputs);
    problem = (struct BBOXTEST_problem *)interp->user_data;
    coef = problem->coef;

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

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

    interp->status = calc_all_ok;
    return 0;
}

int bboxtest_fex(struct BBoxInterp *interp,
        int ninputs,
        int noutputs,
        double *inputs,
        double *outputs,
        double *jacobian
){
    int nok;
    (void)jacobian;
    nok = DoCalculation(interp, ninputs, noutputs, inputs, outputs);
    if (nok) {
        return 1;
    } else {
        return 0;
    }
}

int DoDeriv(struct BBoxInterp *interp, int ninputs, double *jacobian)
{
    int i; int len;
    double coef;
    assert(interp!=NULL);
    assert(interp->user_data!=NULL);
    coef = ((struct BBOXTEST_problem *)interp->user_data)->coef;
    len = ninputs*ninputs;

#ifdef BBOXTEST_DEBUG
    FPRINTF(stdout,"bboxtest_jex called (instance %p)\n",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++) {
        FPRINTF(stdout,"J[%d]   = %12.8g\n", i, jacobian[i]);
    }
#endif
    return 0;
}

int bboxtest_jex(struct BBoxInterp *interp,
        int ninputs,
        int noutputs,
        double *inputs,
        double *outputs,
        double *jacobian
){
    int nok;
    (void)noutputs; 
    (void)outputs;
    (void)inputs;
    
    nok = DoDeriv(interp, ninputs, jacobian);
    if (nok) {
        return 1;
    } else {
        return 0;
    }
}

/**
    Registration function
*/
int bboxtest_register(void){
    int result;
    double epsilon = 1.0e-14;

    char bboxtest_help[] = "This tests a simple black box y=k*x";

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

#undef N_INPUT_ARGS
#undef N_OUTPUT_ARGS
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 <compiler/compiler.h>
30	#include <compiler/packages.h>
31	#include <compiler/instance_enum.h>
32	/* next 4 needed only because we use RealAtomValue on the DATA instance. */
33	#include <compiler/fractions.h>
34	#include <compiler/dimen.h>
35	#include <compiler/atomvalue.h>
36	#include <compiler/instquery.h>
37	/* */
38	#include <compiler/extcall.h>
39	#include "bboxtest.h"
40
41	#define BBOXTEST_DEBUG 1
42
43	#ifndef EXTERNAL_EPSILON
44	#define EXTERNAL_EPSILON 1.0e-12
45	#endif
46
47	#define N_INPUT_ARGS 1 /* formal arg count */
48	#define N_OUTPUT_ARGS 1 /* formal arg count */
49
50	struct BBOXTEST_problem {
51	double coef; /* coef in y=coefx/
52	int n; /* number of equations. */
53	};
54
55
56	static int GetCoef( struct Instance data, struct BBOXTEST_problem problem){
57
58	if (!data) {
59	FPRINTF(stderr,"Error: bboxtest: expecting a data instance to be provided\n");
60	return 1;
61	}
62	if (InstanceKind(data)!=REAL_CONSTANT_INST) {
63	FPRINTF(stderr,"Error: bboxtest: expecting a real constant instance.\n");
64	return 1;
65	}
66
67	problem->coef = RealAtomValue(data);
68	return 0;
69	}
70
71
72	static int CheckArgsOK(struct Instance *data,
73	struct gl_list_t *arglist,
74	struct BBOXTEST_problem *problem
75	){
76	unsigned long len,ninputs,noutputs;
77	int result;
78
79	if (!arglist) {
80	FPRINTF(stderr,"External function argument list does not exist\n");
81	return 1;
82	}
83	len = gl_length(arglist);
84	if (!len) {
85	FPRINTF(stderr,"No arguments to external function statement\n");
86	return 1;
87	}
88	if ((len!=(N_INPUT_ARGS+N_OUTPUT_ARGS))) {
89	FPRINTF(stderr,"Number of arguments does not match\n");
90	FPRINTF(stderr,"the external function prototype(array_of_realatom[set],array_of_realatom[set],real_constant\n");
91	return 1;
92	}
93
94	ninputs = CountNumberOfArgs(arglist,1,N_INPUT_ARGS);
95	noutputs = CountNumberOfArgs(arglist,N_INPUT_ARGS+1,
96	N_INPUT_ARGS+N_OUTPUT_ARGS);
97	if (ninputs != noutputs) {
98	FPRINTF(stderr,"bboxtest: Length of input, output arguments mismatched.\n");
99	return 1;
100	}
101
102	problem->n = (int)ninputs;
103	result = GetCoef(data,problem); /* get the coef */
104	if (result) {
105	return 1;
106	}
107
108	return 0;
109	}
110
111
112	/**
113	This function is one of the registered functions. It operates in
114	mode last_call.
115	In last_call mode, the memory associated with the problem is
116	released.
117	*/
118	void bboxtest_final(struct BBoxInterp *interp )
119	{
120	struct BBOXTEST_problem *problem;
121
122	if (interp->task == bb_last_call) {
123	if (interp->user_data != NULL) {
124	problem = (struct BBOXTEST_problem *)interp->user_data;
125	problem->coef *= -1;
126	problem->n *= -1;
127	free(problem);
128	}
129	interp->user_data = NULL;
130	}
131	/* shouldn't be here */
132	}
133	/**
134	This function is one of the registered functions. It operates in
135	mode first_call.
136	It creates a BBOXTEST_problem and calls a number of routines to check
137	the arguments (data and arglist) and to cache the information
138	processed away in the BBOXTEST_problem structure.
139
140	In last_call mode, the memory associated with the problem is
141	released.
142	*/
143	int bboxtest_preslv(struct BBoxInterp *interp,
144	struct Instance *data,
145	struct gl_list_t *arglist
146
147	){
148	struct BBOXTEST_problem *problem;
149
150	#ifdef BBOXTEST_DEBUG
151	FPRINTF(stdout,"bboxtest_preslv called (interp %p), (instance %p)\n",interp, interp->user_data);
152	#endif
153	if (interp->task == bb_first_call) {
154	#ifdef BBOXTEST_DEBUG
155	FPRINTF(stdout,"bboxtest_preslv called for bb_first_call");
156	#endif
157	if (interp->user_data!=NULL) {
158	/* we have been called before */
159	return 0;
160	/* the problem structure exists */
161	} else {
162	problem = (struct BBOXTEST_problem *)malloc(sizeof(struct BBOXTEST_problem));
163	if(CheckArgsOK(data,arglist,problem)) {
164	free(problem);
165	return 1;
166	}
167	interp->user_data = (void *)problem;
168	return 0;
169	}
170	}
171	#ifdef BBOXTEST_DEBUG
172	FPRINTF(stdout,"bboxtest_preslv called in fish circumstance.");
173	#endif
174	return 1; /* shouldn't be here ever. */
175	}
176
177
178	/*
179	This function provides support to bboxtest_fex which is one of the
180	registered functions. The input variables are x[set]
181	The output variables are y[set]. We do our loop
182	based on the ascend standard that sets are arbitrarily but
183	consistently ordered if they contain the same values.
184	*/
185
186	static int DoCalculation(struct BBoxInterp *interp,
187	int ninputs, int noutputs,
188	double *inputs,
189	double *outputs
190	){
191	struct BBOXTEST_problem *problem;
192	int c;
193	double coef;
194
195	assert(ninputs == noutputs);
196	problem = (struct BBOXTEST_problem *)interp->user_data;
197	coef = problem->coef;
198
199	for (c=0; c < ninputs; c++) {
200	outputs[c] = coef * inputs[c];
201	}
202
203	#ifdef BBOXTEST_DEBUG
204	FPRINTF(stdout,"bboxtest_fex called (instance %p)\n",interp->user_data);
205	for(c=0;c<ninputs;c++) {
206	FPRINTF(stdout,"x[%d] = %12.8g\n",c,inputs[c]);
207	}
208	for (c=0;c<noutputs;c++) {
209	FPRINTF(stdout,"y[%d] = %20.8g\n",c,outputs[c]);
210	}
211	#endif /* BBOXTEST_DEBUG */
212
213	interp->status = calc_all_ok;
214	return 0;
215	}
216
217	int bboxtest_fex(struct BBoxInterp *interp,
218	int ninputs,
219	int noutputs,
220	double *inputs,
221	double *outputs,
222	double *jacobian
223	){
224	int nok;
225	(void)jacobian;
226	nok = DoCalculation(interp, ninputs, noutputs, inputs, outputs);
227	if (nok) {
228	return 1;
229	} else {
230	return 0;
231	}
232	}
233
234	int DoDeriv(struct BBoxInterp interp, int ninputs, double jacobian)
235	{
236	int i; int len;
237	double coef;
238	assert(interp!=NULL);
239	assert(interp->user_data!=NULL);
240	coef = ((struct BBOXTEST_problem *)interp->user_data)->coef;
241	len = ninputs*ninputs;
242
243	#ifdef BBOXTEST_DEBUG
244	FPRINTF(stdout,"bboxtest_jex called (instance %p)\n",interp->user_data);
245	#endif
246	for (i = 0; i< len; i++) {
247	jacobian[i] = 0;
248	}
249
250	for (i = 0; i< ninputs; i++) {
251	jacobian[i*ninputs+i] = coef;
252	}
253	#ifdef BBOXTEST_DEBUG
254	for(i=0; i<len; i++) {
255	FPRINTF(stdout,"J[%d] = %12.8g\n", i, jacobian[i]);
256	}
257	#endif
258	return 0;
259	}
260
261	int bboxtest_jex(struct BBoxInterp *interp,
262	int ninputs,
263	int noutputs,
264	double *inputs,
265	double *outputs,
266	double *jacobian
267	){
268	int nok;
269	(void)noutputs;
270	(void)outputs;
271	(void)inputs;
272
273	nok = DoDeriv(interp, ninputs, jacobian);
274	if (nok) {
275	return 1;
276	} else {
277	return 0;
278	}
279	}
280
281	/**
282	Registration function
283	*/
284	int bboxtest_register(void){
285	int result;
286	double epsilon = 1.0e-14;
287
288	char bboxtest_help[] = "This tests a simple black box y=k*x";
289
290	result = CreateUserFunctionBlackBox("bboxtest",
291	bboxtest_preslv,
292	bboxtest_fex,
293	bboxtest_jex,
294	NULL,
295	bboxtest_final,
296	N_INPUT_ARGS,
297	N_OUTPUT_ARGS,
298	bboxtest_help,
299	epsilon);
300	return result;
301	}
302
303	#undef N_INPUT_ARGS
304	#undef N_OUTPUT_ARGS