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

#ifndef ASC_EXPORT
# error "Where is ASC_EXPORT?"
#endif

extern ASC_EXPORT(int) bboxtest_register(void);

#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;

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