/* nag_correg_robustm (g02hac) Example Program.
*
* Copyright 2024 Numerical Algorithms Group.
*
* Mark 30.2, 2024.
*
*/
#include <ctype.h>
#include <nag.h>
#include <stdio.h>
#define C(I, J) c[(I)*tdc + J]
#define X(I, J) x[(I)*tdx + J]
int main(void) {
Integer exit_status = 0, i, j, m, max_iter, n, print_iter, tdc, tdx;
double *c = 0, cpsi, cucv, dchi, *hpsi = 0, *info = 0, *rs = 0, sigma,
*theta = 0;
double tol, *wt = 0, *x = 0, *y = 0;
char nag_enum_arg[40];
Nag_CovMatrixEst covmat_est;
Nag_PsiFun psifun;
Nag_RegType regtype;
Nag_SigmaEst sigma_est;
NagError fail;
INIT_FAIL(fail);
printf("nag_correg_robustm (g02hac) Example Program Results\n\n");
/* Skip heading in data file */
scanf("%*[^\n]");
scanf("%" NAG_IFMT " %" NAG_IFMT "", &n, &m);
if (n > 1 && (m >= 1 && m <= n)) {
if (!(c = NAG_ALLOC(m * m, double)) || !(theta = NAG_ALLOC(m, double)) ||
!(x = NAG_ALLOC(n * m, double)) || !(y = NAG_ALLOC(n, double)) ||
!(rs = NAG_ALLOC(n, double)) || !(wt = NAG_ALLOC(n, double)) ||
!(info = NAG_ALLOC(4, double)) || !(hpsi = NAG_ALLOC(3, double))) {
printf("Allocation failure\n");
exit_status = -1;
goto END;
}
tdc = m;
tdx = m;
} else {
printf("Invalid n or m.\n");
exit_status = 1;
return exit_status;
}
/* Read in x and y */
for (i = 0; i < n; i++) {
for (j = 0; j < m; j++)
scanf("%lf", &X(i, j));
scanf("%lf", &y[i]);
}
/* Read in control parameters */
scanf(" %39s", nag_enum_arg);
/* nag_enum_name_to_value (x04nac).
* Converts NAG enum member name to value
*/
regtype = (Nag_RegType)nag_enum_name_to_value(nag_enum_arg);
scanf(" %39s", nag_enum_arg);
psifun = (Nag_PsiFun)nag_enum_name_to_value(nag_enum_arg);
scanf(" %39s", nag_enum_arg);
sigma_est = (Nag_SigmaEst)nag_enum_name_to_value(nag_enum_arg);
/* Read in appropriate weight function parameters. */
if (regtype != Nag_HuberReg) {
scanf(" %39s %lf", nag_enum_arg, &cucv);
covmat_est = (Nag_CovMatrixEst)nag_enum_name_to_value(nag_enum_arg);
}
if (psifun != Nag_Lsq) {
if (psifun == Nag_HuberFun)
scanf("%lf", &cpsi);
else
cpsi = 0.0;
if (psifun == Nag_HampelFun)
for (j = 0; j < 3; j++)
scanf("%lf", &hpsi[j]);
if (sigma_est == Nag_SigmaChi)
scanf("%lf", &dchi);
}
/* Set values of remaining parameters */
tol = 5e-5;
max_iter = 50;
/* Change print_iter to a positive value if monitoring information
* is required
*/
print_iter = 1;
sigma = 1.0e0;
for (i = 0; i < m; ++i)
theta[i] = 0.0e0;
/* nag_correg_robustm (g02hac).
* Robust regression, standard M-estimates
*/
fflush(stdout);
nag_correg_robustm(regtype, psifun, sigma_est, covmat_est, n, m, x, tdx, y,
cpsi, hpsi, cucv, dchi, theta, &sigma, c, tdc, rs, wt, tol,
max_iter, print_iter, 0, info, &fail);
if ((fail.code == NE_NOERROR) || (fail.code == NE_THETA_ITER_EXCEEDED) ||
(fail.code == NE_LSQ_FAIL_CONV) || (fail.code == NE_MAT_SINGULAR) ||
(fail.code == NE_WT_LSQ_NOT_FULL_RANK) ||
(fail.code == NE_REG_MAT_SINGULAR) ||
(fail.code == NE_COV_MAT_FACTOR_ZERO) ||
(fail.code == NE_VAR_THETA_LEQ_ZERO) ||
(fail.code == NE_ERR_DOF_LEQ_ZERO) ||
(fail.code == NE_ESTIM_SIGMA_ZERO)) {
if (fail.code != NE_NOERROR) {
printf("Error from nag_correg_robustm (g02hac).\n%s\n", fail.message);
printf(" Some of the following results may be unreliable\n");
}
printf("Sigma = %10.4f\n\n", sigma);
printf(" Theta Standard errors\n\n");
for (j = 0; j < m; ++j)
printf("%12.4f %13.4f\n", theta[j], C(j, j));
printf("\n Weights Residuals\n\n");
for (i = 0; i < n; ++i)
printf("%12.4f %13.4f\n", wt[i], rs[i]);
} else {
printf("Error from nag_correg_robustm (g02hac).\n%s\n", fail.message);
exit_status = 1;
goto END;
}
END:
NAG_FREE(c);
NAG_FREE(theta);
NAG_FREE(x);
NAG_FREE(y);
NAG_FREE(rs);
NAG_FREE(wt);
NAG_FREE(info);
NAG_FREE(hpsi);
return exit_status;
}