The R Project SVN – R – Diff – /trunk/src/appl/uncmin.c



	}
	x[i] = tempi;
    }
} /* fdhess */
 
#if 0
static void d1fcn_dum(int n, double *x, double *g, void *state)
{
/*	dummy routine to prevent unsatisfied external diagnostic
 *	when specific analytic gradient function not supplied. */
}

static void d2fcn_dum(int nr, int n, double *x, double *h, void *state)
{
/*	dummy routine to prevent unsatisfied external diagnostic
 *	when specific analytic hessian function not supplied. */
}
#endif
 
static void mvmltl(int nr, int n, double *a, double *x, double *y)
{
/*	compute y = l x
 *	where l is a lower triangular matrix stored in a

    return;
} /* optchk */
 
static void
prt_result(int nr, int n, const double x[], double f, const double g[],
	   const double *a, const double p[], int itncnt, int iflg)
{
/*
 *  PURPOSE
 *
 *  Print information on current iteration.

 *	iexp	     --> =1 if optimization function fcn is expensive to
 *			 evaluate, =0 otherwise.  if set then hessian will
 *			 be evaluated by secant update instead of
 *			 analytically or by finite differences
 *	msg	    <--> on input:  ( > 0) message to inhibit certain
 *			   automatic checks; see do_nlm() in optimize.c
 *			 on output: ( < 0) error code; =0 no error
 *	ndigit	     --> number of good digits in optimization function fcn
 *	itnlim	     --> maximum number of allowable iterations
 *	iagflg	     --> =1 if analytic gradient supplied
 *	iahflg	     --> =1 if analytic hessian supplied

 
    optdrv_end(nr, n, xpls, x, gpls, g, fpls, f, a, p, *itncnt,
	       *itrmcd, msg, prt_result);
} /* optdrv */
 
#if 0
static void
dfault(int n, double *x,
       double *typsiz, double *fscale,
       int *method, int *iexp, int *msg,
       int *ndigit, int *itnlim, int *iagflg, int *iahflg,

	 itnlim, iagflg, iahflg, dlt, gradtl, stepmx, steptl,
	 xpls, fpls, gpls, itrmcd, a, wrk, &wrk[nr], &wrk[nr * 2],
	 &wrk[nr * 4], &wrk[nr * 5], &wrk[nr * 6], &wrk[nr * 7],
	 &wrk[nr * 8], &itncnt);
} /* optif0 */
#endif
 
/* ---- this one is called from optimize.c : --------------- */
void
optif9(int nr, int n, double *x, fcn_p fcn, fcn_p d1fcn, d2fcn_p d2fcn,
       void *state, double *typsiz, double fscale, int method,
       int iexp, int *msg, int ndigit, int itnlim, int iagflg, int iahflg,
       double dlt, double gradtl, double stepmx, double steptl,

 *			 considered close enough to terminate algorithm
 *	xpls(n)	    <--> on exit:  xpls is local minimum
 *	fpls	    <--> on exit:  function value at solution, xpls
 *	gpls(n)	    <--> on exit:  gradient at solution xpls
 *	itrmcd	    <--	 termination code (in 0..5 ; 0 is "perfect");
 *			see optcode() in optimize.c for meaning
 *	a(n,n)	     --> workspace for hessian (or estimate)
 *			 and its cholesky decomposition
 *	wrk(n,8)     --> workspace
 *	itncnt	    <--> iteration count
 */

Rev 60517	Rev 61646
Line 108...	Line 108...
108	`}`	108	`}`
109	`x[i] = tempi;`	109	`x[i] = tempi;`
110	`}`	110	`}`
111	`} /* fdhess */`	111	`} /* fdhess */`
112		112
-		113	`#if 0`
113	`static void d1fcn_dum(int n, double x, double g, void *state)`	114	`static void d1fcn_dum(int n, double x, double g, void *state)`
114	`{`	115	`{`
115	`/* dummy routine to prevent unsatisfied external diagnostic`	116	`/* dummy routine to prevent unsatisfied external diagnostic`
116	`* when specific analytic gradient function not supplied. */`	117	`* when specific analytic gradient function not supplied. */`
117	`}`	118	`}`
Line 119...	Line 120...
119	`static void d2fcn_dum(int nr, int n, double x, double h, void *state)`	120	`static void d2fcn_dum(int nr, int n, double x, double h, void *state)`
120	`{`	121	`{`
121	`/* dummy routine to prevent unsatisfied external diagnostic`	122	`/* dummy routine to prevent unsatisfied external diagnostic`
122	`* when specific analytic hessian function not supplied. */`	123	`* when specific analytic hessian function not supplied. */`
123	`}`	124	`}`
-		125	`#endif`
124		126
125	`static void mvmltl(int nr, int n, double a, double x, double *y)`	127	`static void mvmltl(int nr, int n, double a, double x, double *y)`
126	`{`	128	`{`
127	`/* compute y = l x`	129	`/* compute y = l x`
128	`* where l is a lower triangular matrix stored in a`	130	`* where l is a lower triangular matrix stored in a`
Line 2066...	Line 2068...
2066	`return;`	2068	`return;`
2067	`} /* optchk */`	2069	`} /* optchk */`
2068		2070
2069	`static void`	2071	`static void`
2070	`prt_result(int nr, int n, const double x[], double f, const double g[],`	2072	`prt_result(int nr, int n, const double x[], double f, const double g[],`
2071	`const double *a, const double p[], int itncnt, int iflg)`	2073	`const double *a, const double p[], int itncnt, int iflg)`
2072	`{`	2074	`{`
2073	`/*`	2075	`/*`
2074	`* PURPOSE`	2076	`* PURPOSE`
2075	`*`	2077	`*`
2076	`* Print information on current iteration.`	2078	`* Print information on current iteration.`
Line 2191...	Line 2193...
2191	`* iexp --> =1 if optimization function fcn is expensive to`	2193	`* iexp --> =1 if optimization function fcn is expensive to`
2192	`* evaluate, =0 otherwise. if set then hessian will`	2194	`* evaluate, =0 otherwise. if set then hessian will`
2193	`* be evaluated by secant update instead of`	2195	`* be evaluated by secant update instead of`
2194	`* analytically or by finite differences`	2196	`* analytically or by finite differences`
2195	`* msg <--> on input: ( > 0) message to inhibit certain`	2197	`* msg <--> on input: ( > 0) message to inhibit certain`
2196	`* automatic checks; see do_nlm() in ../main/optimize.c`	2198	`* automatic checks; see do_nlm() in optimize.c`
2197	`* on output: ( < 0) error code; =0 no error`	2199	`* on output: ( < 0) error code; =0 no error`
2198	`* ndigit --> number of good digits in optimization function fcn`	2200	`* ndigit --> number of good digits in optimization function fcn`
2199	`* itnlim --> maximum number of allowable iterations`	2201	`* itnlim --> maximum number of allowable iterations`
2200	`* iagflg --> =1 if analytic gradient supplied`	2202	`* iagflg --> =1 if analytic gradient supplied`
2201	`* iahflg --> =1 if analytic hessian supplied`	2203	`* iahflg --> =1 if analytic hessian supplied`
Line 2443...	Line 2445...
2443		2445
2444	`optdrv_end(nr, n, xpls, x, gpls, g, fpls, f, a, p, *itncnt,`	2446	`optdrv_end(nr, n, xpls, x, gpls, g, fpls, f, a, p, *itncnt,`
2445	`*itrmcd, msg, prt_result);`	2447	`*itrmcd, msg, prt_result);`
2446	`} /* optdrv */`	2448	`} /* optdrv */`
2447		2449
-		2450	`#if 0`
2448	`static void`	2451	`static void`
2449	`dfault(int n, double *x,`	2452	`dfault(int n, double *x,`
2450	`double typsiz, double fscale,`	2453	`double typsiz, double fscale,`
2451	`int method, int iexp, int *msg,`	2454	`int method, int iexp, int *msg,`
2452	`int ndigit, int itnlim, int iagflg, int iahflg,`	2455	`int ndigit, int itnlim, int iagflg, int iahflg,`
Line 2543...	Line 2546...
2543	`itnlim, iagflg, iahflg, dlt, gradtl, stepmx, steptl,`	2546	`itnlim, iagflg, iahflg, dlt, gradtl, stepmx, steptl,`
2544	`xpls, fpls, gpls, itrmcd, a, wrk, &wrk[nr], &wrk[nr * 2],`	2547	`xpls, fpls, gpls, itrmcd, a, wrk, &wrk[nr], &wrk[nr * 2],`
2545	`&wrk[nr * 4], &wrk[nr * 5], &wrk[nr * 6], &wrk[nr * 7],`	2548	`&wrk[nr * 4], &wrk[nr * 5], &wrk[nr * 6], &wrk[nr * 7],`
2546	`&wrk[nr * 8], &itncnt);`	2549	`&wrk[nr * 8], &itncnt);`
2547	`} /* optif0 */`	2550	`} /* optif0 */`
-		2551	`#endif`
2548		2552
2549	`/* ---- this one is called from ../main/optimize.c : --------------- */`	2553	`/* ---- this one is called from optimize.c : --------------- */`
2550	`void`	2554	`void`
2551	`optif9(int nr, int n, double *x, fcn_p fcn, fcn_p d1fcn, d2fcn_p d2fcn,`	2555	`optif9(int nr, int n, double *x, fcn_p fcn, fcn_p d1fcn, d2fcn_p d2fcn,`
2552	`void state, double typsiz, double fscale, int method,`	2556	`void state, double typsiz, double fscale, int method,`
2553	`int iexp, int *msg, int ndigit, int itnlim, int iagflg, int iahflg,`	2557	`int iexp, int *msg, int ndigit, int itnlim, int iagflg, int iahflg,`
2554	`double dlt, double gradtl, double stepmx, double steptl,`	2558	`double dlt, double gradtl, double stepmx, double steptl,`
Line 2598...	Line 2602...
2598	`* considered close enough to terminate algorithm`	2602	`* considered close enough to terminate algorithm`
2599	`* xpls(n) <--> on exit: xpls is local minimum`	2603	`* xpls(n) <--> on exit: xpls is local minimum`
2600	`* fpls <--> on exit: function value at solution, xpls`	2604	`* fpls <--> on exit: function value at solution, xpls`
2601	`* gpls(n) <--> on exit: gradient at solution xpls`	2605	`* gpls(n) <--> on exit: gradient at solution xpls`
2602	`* itrmcd <-- termination code (in 0..5 ; 0 is "perfect");`	2606	`* itrmcd <-- termination code (in 0..5 ; 0 is "perfect");`
2603	`* see optcode() in ../main/optimize.c for meaning`	2607	`* see optcode() in optimize.c for meaning`
2604	`* a(n,n) --> workspace for hessian (or estimate)`	2608	`* a(n,n) --> workspace for hessian (or estimate)`
2605	`* and its cholesky decomposition`	2609	`* and its cholesky decomposition`
2606	`* wrk(n,8) --> workspace`	2610	`* wrk(n,8) --> workspace`
2607	`* itncnt <--> iteration count`	2611	`* itncnt <--> iteration count`
2608	`*/`	2612	`*/`

The R Project SVN R

(root)/trunk/src/appl/uncmin.c – Rev 60517 → 61646