/* nag_opt_lsq_uncon_quasi_deriv_comp (e04gbc) Example Program.
*
* Copyright 2024 Numerical Algorithms Group.
*
* Mark 30.1, 2024.
*
*/
#include <math.h>
#include <nag.h>
#include <stdio.h>
#include <string.h>
#ifdef __cplusplus
extern "C" {
#endif
static void NAG_CALL lsqfun(Integer m, Integer n, const double x[],
double fvec[], double fjac[], Integer tdfjac,
Nag_Comm *comm);
#ifdef __cplusplus
}
#endif
#define MMAX 15
#define TMAX 3
/* Define a user structure template to store data in lsqfun. */
struct user {
double y[MMAX];
double t[MMAX][TMAX];
};
int main(void) {
const char *optionsfile = "e04gbce.opt";
Integer exit_status = 0;
Nag_Boolean print;
Integer i, j, m, n, nt, tdfjac;
Nag_Comm comm;
Nag_E04_Opt options;
double *fjac = 0, fsumsq, *fvec = 0, *x = 0;
struct user s;
NagError fail;
INIT_FAIL(fail);
printf(
"nag_opt_lsq_uncon_quasi_deriv_comp (e04gbc) Example Program Results\n");
fflush(stdout);
scanf(" %*[^\n]"); /* Skip heading in data file */
n = 3;
m = 15;
if (m >= 1 && n <= m) {
if (!(fjac = NAG_ALLOC(m * n, double)) || !(fvec = NAG_ALLOC(m, double)) ||
!(x = NAG_ALLOC(n, double))) {
printf("Allocation failure\n");
exit_status = -1;
goto END;
}
tdfjac = n;
} else {
printf("Invalid m or n.\n");
exit_status = 1;
return exit_status;
}
/* Read data into structure.
* Observations t (j = 0, 1, 2) are held in s->t[i][j]
* (i = 0, 1, 2, . . ., 14)
*/
nt = 3;
for (i = 0; i < m; ++i) {
scanf("%lf", &s.y[i]);
for (j = 0; j < nt; ++j)
scanf("%lf", &s.t[i][j]);
}
/* Set up the starting point */
x[0] = 0.5;
x[1] = 1.0;
x[2] = 1.5;
/* Initialize options structure and read option values from file */
print = Nag_TRUE;
/* nag_opt_init (e04xxc).
* Initialization function for option setting
*/
nag_opt_init(&options);
/* nag_opt_read (e04xyc).
* Read options from a text file
*/
nag_opt_read("e04gbc", optionsfile, &options, print, "stdout", &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_opt_read (e04xyc).\n%s\n", fail.message);
exit_status = 1;
goto END;
}
/* Assign address of user defined structure to
* comm.p for communication to lsqfun().
*/
comm.p = (Pointer)&s;
/* Call the optimization routine */
/* nag_opt_lsq_uncon_quasi_deriv_comp (e04gbc), see above. */
nag_opt_lsq_uncon_quasi_deriv_comp(m, n, lsqfun, x, &fsumsq, fvec, fjac,
tdfjac, &options, &comm, &fail);
if (fail.code != NE_NOERROR) {
printf(
"Error/Warning from nag_opt_lsq_uncon_quasi_deriv_comp (e04gbc).\n%s\n",
fail.message);
if (fail.code != NW_COND_MIN)
exit_status = 1;
}
/* Free memory allocated by nag_opt_lsq_uncon_quasi_deriv_comp (e04gbc)
to pointers s and v */
/* nag_opt_free (e04xzc).
* Memory freeing function for use with option setting
*/
nag_opt_free(&options, "all", &fail);
if (fail.code != NE_NOERROR) {
printf("Error from nag_opt_free (e04xzc).\n%s\n", fail.message);
exit_status = 2;
}
END:
NAG_FREE(fjac);
NAG_FREE(fvec);
NAG_FREE(x);
return exit_status;
}
static void NAG_CALL lsqfun(Integer m, Integer n, const double x[],
double fvec[], double fjac[], Integer tdfjac,
Nag_Comm *comm) {
/* Function to evaluate the residuals and their 1st derivatives.
*
* This function is also suitable for use when Nag_Lin_NoDeriv is specified
* for linear minimization instead of the default of Nag_Lin_Deriv,
* since it can deal with comm->flag = 0 or 1 as well as comm->flag = 2.
*
* To avoid the use of a global varibale this example assigns the address
* of a user defined structure to comm.p in the main program (where the
* data was also read in).
* The address of this structure is recovered in each call to lsqfun()
* from comm->p and the structure used in the calculation of the residuals.
*/
#define FJAC(I, J) fjac[(I)*tdfjac + (J)]
Integer i;
double denom, dummy;
struct user *s = (struct user *)comm->p;
for (i = 0; i < m; ++i) {
denom = x[1] * s->t[i][1] + x[2] * s->t[i][2];
if (comm->flag != 1)
fvec[i] = x[0] + s->t[i][0] / denom - s->y[i];
if (comm->flag != 0) {
FJAC(i, 0) = 1.0;
dummy = -1.0 / (denom * denom);
FJAC(i, 1) = s->t[i][0] * s->t[i][1] * dummy;
FJAC(i, 2) = s->t[i][0] * s->t[i][2] * dummy;
}
}
} /* lsqfun */