1 /* cbayes - Lisp interface to laplace approximation stuff */
2 /* Copyright (c) 1990, by Luke Tierney */
4 #include <stdlib.h> /* for calloc/realloc */
13 extern void maximize_callback(int, PTR
, PTR
, PTR
, PTR
, PTR
);
14 extern void evalfront(char **, int *, double *, double *, double *,
15 double *, double *, double *);
17 extern void maxfront();
18 extern void bufputstr(char *);
20 /************************************************************************/
22 /** Definitions and Globals **/
24 /************************************************************************/
28 static char *mem
[MAXALLOC
], memcount
;
31 int n
, m
, k
, itnlimit
, backtrack
, verbose
, vals_suppl
, exptilt
;
36 double typf
, h
, gradtol
, steptol
, maxstep
, dflt
, tilt
, newtilt
, hessadd
;
49 /************************************************************************/
51 /** Fake Replacements for S Interface **/
53 /************************************************************************/
58 static int inited
= FALSE
;
62 for (i
= 0; i
< MAXALLOC
; i
++) mem
[i
] = nil
;
70 makespace(void **pptr
, int size
) /* why are we using **char? */
73 return(1); /* we've done, by default, what we asked for. */
76 *pptr
= calloc(size
, 1);
78 *pptr
= realloc(*pptr
, size
);
80 if (size
> 0 && *pptr
== nil
) {
81 return(0); /* xlfail("memory allocation failed"); FIXME:AJR xlfail redef. */
87 /************************************************************************/
89 /** Callback Function **/
91 /************************************************************************/
95 double *x
, double *fval
, double *grad
, double *hess
,
98 maximize_callback(n
, (PTR
) x
,
99 (PTR
) fval
, (PTR
) grad
, (PTR
) hess
, (PTR
) derivs
);
103 call_S(char *fun
, long narg
, char **args
, char **mode
, long *length
,char **names
,
104 long nvals
, char **values
)
106 int n
= length
[0], derivs
;
107 static double *fval
= nil
, *grad
= nil
, *hess
= nil
;
109 makespace((void **)&fval
, 1 * sizeof(double)); /* probably should test the
110 result of this and the next
111 2 to make sure that they are
113 makespace((void **)&grad
, n
* sizeof(double));
114 makespace((void **)&hess
, n
* n
* sizeof(double));
116 callLminfun(n
,(double *)args
[0], fval
, grad
, hess
, &derivs
);
118 values
[0] = (char *) fval
;
119 values
[1] = (derivs
> 0) ? (char *) grad
: nil
;
120 values
[2] = (derivs
> 1) ? (char *) hess
: nil
;
127 /* FIXME:AJR: xlfail(s); */
131 /************************************************************************/
133 /** Numerical Derivatives **/
135 /************************************************************************/
138 numgrad_front(n
, px
, pgrad
, h
, pscale
)
140 PTR px
, pgrad
, pscale
;
146 evalfront((char **)&f
, &n
, (double *) px
,
147 &fval
, (double *) pgrad
, nil
, &h
, (double *) pscale
);
151 numhess_front(n
, px
, pf
, pgrad
, phess
, h
, pscale
)
153 PTR px
, pf
, pgrad
, phess
, pscale
;
158 evalfront((char **)&f
, &n
, (double *) px
,
159 (double *) pf
, (double *) pgrad
, (double *) phess
,
160 &h
, (double *) pscale
);
163 /************************************************************************/
165 /** Maximization Interface **/
167 /************************************************************************/
169 /* internals array information */
184 static MaxIPars
getMaxIPars(ipars
)
192 ip
.itnlimit
= ipars
[3];
193 ip
.backtrack
= ipars
[4];
194 ip
.verbose
= ipars
[5];
195 ip
.vals_suppl
= ipars
[6];
196 ip
.exptilt
= ipars
[7];
198 ip
.termcode
= ipars
[9];
203 static MaxDPars
getMaxDPars(dpars
)
210 dp
.gradtol
= dpars
[2];
211 dp
.steptol
= dpars
[3];
212 dp
.maxstep
= dpars
[4];
215 dp
.newtilt
= dpars
[7];
216 dp
.hessadd
= dpars
[8];
222 minfo_maximize(px
, pfvals
, pscale
, pip
, pdp
, verbose
)
223 PTR px
, pfvals
, pscale
, pip
, pdp
;
230 static double *dx
, *typx
, *fvals
;
234 typx
= (double *) pscale
;
235 fvals
= (double *) pfvals
;
237 ip
= getMaxIPars((int *) pip
);
238 dp
= getMaxDPars((double *) pdp
);
243 if (verbose
>= 0) ip
.verbose
= verbose
;
246 maxfront(&f
, nil
, nil
, dx
, typx
, fvals
, nil
, nil
, nil
,
247 &ip
, &dp
, nil
, &msg
);