int model_test_driver (const char *param, DATASET *dset,
gretlopt opt, PRN *prn)
{
GretlObjType type;
gretlopt testopt;
void *ptr;
int k = 0;
int err = 0;
if (opt == OPT_NONE || opt == OPT_Q) {
pprintf(prn, "modtest: no options selected\n");
return 0;
}
err = incompatible_options(opt, OPT_A | OPT_H | OPT_L | OPT_S |
OPT_N | OPT_P | OPT_W | OPT_X);
if (err) {
return err;
}
ptr = get_last_model(&type);
if (ptr == NULL) {
return E_DATA;
}
if (type == GRETL_OBJ_EQN && exact_fit_check(ptr, prn)) {
return 0;
}
if (opt & (OPT_A | OPT_H)) {
/* autocorrelation and arch: lag order */
k = atoi(param);
if (k == 0) {
k = dset->pd;
}
}
testopt = (opt & OPT_Q)? OPT_Q : OPT_NONE;
/* non-linearity (squares) */
if (!err && (opt & OPT_S)) {
if (type == GRETL_OBJ_EQN) {
err = nonlinearity_test(ptr, dset, AUX_SQ,
testopt, prn);
} else {
err = E_NOTIMP;
}
}
/* non-linearity (logs) */
if (!err && (opt & OPT_L)) {
if (type == GRETL_OBJ_EQN) {
err = nonlinearity_test(ptr, dset, AUX_LOG,
testopt, prn);
} else {
err = E_NOTIMP;
}
}
/* heteroskedasticity (White or Breusch-Pagan) */
if (!err && (opt & (OPT_W | OPT_X | OPT_B))) {
if (type == GRETL_OBJ_EQN) {
transcribe_option_flags(&testopt, opt, OPT_B | OPT_X);
if ((opt & OPT_B) && (opt & OPT_R)) {
testopt |= OPT_R;
}
err = whites_test(ptr, dset, testopt, prn);
} else {
err = E_NOTIMP;
}
}
/* autocorrelation */
if (!err && (opt & OPT_A)) {
if (type == GRETL_OBJ_EQN) {
err = autocorr_test(ptr, k, dset, testopt, prn);
} else if (type == GRETL_OBJ_VAR) {
err = gretl_VAR_autocorrelation_test(ptr, k, dset,
testopt, prn);
} else if (type == GRETL_OBJ_SYS) {
err = system_autocorrelation_test(ptr, k, testopt, prn);
} else {
err = E_NOTIMP;
}
}
/* ARCH */
if (!err && (opt & OPT_H)) {
if (type == GRETL_OBJ_EQN) {
err = arch_test(ptr, k, dset, testopt, prn);
} else if (type == GRETL_OBJ_VAR) {
err = gretl_VAR_arch_test(ptr, k, dset,
testopt, prn);
} else if (type == GRETL_OBJ_SYS) {
err = system_arch_test(ptr, k, testopt, prn);
} else {
err = E_NOTIMP;
}
}
/* normality of residual */
if (!err && (opt & OPT_N)) {
err = last_model_test_uhat(dset, testopt, prn);
}
/* groupwise heteroskedasticity */
if (!err && (opt & OPT_P)) {
if (type == GRETL_OBJ_EQN) {
err = groupwise_hetero_test(ptr, dset, testopt, prn);
} else {
err = E_NOTIMP;
}
}
/* common factor restriction */
if (!err && (opt & OPT_C)) {
if (type == GRETL_OBJ_EQN) {
err = comfac_test(ptr, dset, testopt, prn);
} else {
err = E_NOTIMP;
}
}
return err;
}
static int parse_options (int *pargc, char ***pargv, gretlopt *popt,
double *scriptval, char *fname)
{
char **argv;
int argc, gotfile = 0;
gretlopt opt = OPT_NONE;
int err = 0;
*fname = '\0';
if (pargv == NULL) {
return 0;
}
argc = *pargc;
argv = *pargv;
while (*++argv) {
const char *s = *argv;
if (!strcmp(s, "-e") || !strncmp(s, "--english", 9)) {
opt |= OPT_ENGLISH;
} else if (!strcmp(s, "-b") || !strncmp(s, "--batch", 7)) {
opt |= OPT_BATCH;
} else if (!strcmp(s, "-h") || !strcmp(s, "--help")) {
opt |= OPT_HELP;
} else if (!strcmp(s, "-v") || !strcmp(s, "--version")) {
opt |= OPT_VERSION;
} else if (!strcmp(s, "-r") || !strncmp(s, "--run", 5)) {
opt |= OPT_RUNIT;
} else if (!strcmp(s, "-d") || !strncmp(s, "--db", 4)) {
opt |= OPT_DBOPEN;
} else if (!strcmp(s, "-w") || !strncmp(s, "--webdb", 7)) {
opt |= OPT_WEBDB;
} else if (!strcmp(s, "-c") || !strncmp(s, "--dump", 6)) {
opt |= OPT_DUMP;
} else if (!strcmp(s, "-q") || !strcmp(s, "--quiet")) {
opt |= OPT_QUIET;
} else if (!strcmp(s, "-m") || !strcmp(s, "--makepkg")) {
opt |= OPT_MAKEPKG;
} else if (!strncmp(s, "--scriptopt=", 12)) {
*scriptval = atof(s + 12);
} else if (*s == '-') {
/* not a valid option */
err = E_DATA;
break;
} else if (!gotfile) {
strncat(fname, s, MAXLEN - 1);
gotfile = 1;
}
argc--;
}
if (!err) {
err = incompatible_options(opt, OPT_BATCH | OPT_RUNIT |
OPT_DBOPEN | OPT_WEBDB | OPT_MAKEPKG);
if (!err) {
err = incompatible_options(opt, OPT_ENGLISH | OPT_BASQUE);
}
}
*pargc = argc;
*pargv = argv;
*popt = opt;
return err;
}
int do_modprint (const char *line, gretlopt opt, PRN *prn)
{
gretl_matrix *coef_se = NULL;
gretl_matrix *addstats = NULL;
char *parnames = NULL;
char *litstr = NULL;
const char *s;
char name[VNAMELEN];
int err = 0;
err = incompatible_options(opt, OPT_C | OPT_R | OPT_T);
if (err) {
return err;
}
/* skip the command word, if present */
s = line;
s += strspn(s, " ");
if (!strncmp(s, "modprint ", 9)) {
s += 9;
}
/* first up, name of k x 2 matrix */
if (gretl_scan_varname(s, name) == 1) {
coef_se = get_matrix_by_name(name);
if (coef_se == NULL) {
err = E_UNKVAR;
} else if (gretl_matrix_cols(coef_se) != 2) {
gretl_errmsg_set(_("modprint: the first matrix argument must have 2 columns"));
err = E_DATA;
}
} else {
err = E_PARSE;
}
if (!err) {
/* second up, string containing names */
s += strspn(s, " ");
s += strlen(name);
s += strspn(s, " ");
if (*s == '"') {
/* got a string literal */
litstr = gretl_quoted_string_strdup(s, &s);
if (litstr == NULL) {
err = E_PARSE;
} else {
parnames = litstr;
s += strspn(s, " ");
}
} else if (gretl_scan_varname(s, name) == 1) {
parnames = (char *) get_string_by_name(name);
if (parnames == NULL) {
err = E_UNKVAR;
} else {
/* advance past string name */
s += strspn(s, " ");
s += strlen(name);
s += strspn(s, " ");
}
} else {
err = E_PARSE;
}
}
if (!err) {
/* optional third field: extra matrix */
if (*s != '\0') {
gretl_scan_varname(s, name);
addstats = get_matrix_by_name(name);
if (addstats == NULL) {
err = E_UNKVAR;
}
}
}
if (!err) {
PrnFormat fmt = GRETL_FORMAT_TXT;
if (opt & OPT_C) {
fmt = GRETL_FORMAT_CSV;
} else if (opt & OPT_R) {
fmt = GRETL_FORMAT_RTF;
} else if (opt & OPT_T) {
fmt = GRETL_FORMAT_TEX;
if (opt & OPT_O) {
fmt |= GRETL_FORMAT_DOC;
}
}
gretl_print_set_format(prn, fmt);
err = print_model_from_matrices(coef_se, addstats, parnames, prn);
}
free(litstr);
return err;
}
