/* * Copyright (c) by Allin Cottrell * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. * */ /* model_table.c for gretl */ #include "gretl.h" #include "model_table.h" #include "session.h" #include "textutil.h" #include "texprint.h" static MODEL **table_models; static int n_models; static char **pnames; static int n_params; static int use_tstats; static int depvarnum; static int colwidth; static void print_rtf_row_spec (PRN *prn, int tall); #define MAX_PORTRAIT_MODELS 6 #define MAX_TABLE_MODELS 12 static void mtable_errmsg (char *msg, int gui) { if (gui) { errbox(msg); } else { gretl_errmsg_set(msg); } } static int real_table_n_models (void) { int i, len = 0; for (i=0; iID == table_models[i]->ID) { return 1; } } return 0; } int model_table_n_models (void) { return n_models; } int model_table_landscape (void) { return n_models > MAX_PORTRAIT_MODELS; } MODEL *model_table_model_by_index (int i) { if (i >= 0 && i < n_models) { return table_models[i]; } else { return NULL; } } void clear_model_table (PRN *prn) { int i; for (i=0; ilist[1]; } } return -1; } static int model_table_precheck (MODEL *pmod, int add_mode) { int gui = (add_mode != MODEL_ADD_BY_CMD); if (pmod == NULL) { return 1; } /* NLS, MLE and GMM models won't work */ if (pmod->ci == NLS || pmod->ci == MLE || pmod->ci == GMM || pmod->ci == ARBOND) { mtable_errmsg(_("Sorry, this model can't be put in the model table"), gui); return 1; } /* nor will ARMA */ if (pmod->ci == ARMA || pmod->ci == GARCH) { mtable_errmsg(_("Sorry, ARMA models can't be put in the model table"), gui); return 1; } /* nor TSLS */ if (pmod->ci == TSLS) { mtable_errmsg(_("Sorry, TSLS models can't be put in the model table"), gui); return 1; } if (n_models > 0) { int dv = model_table_depvar(); /* check that the dependent variable is in common */ if (pmod->list[1] != dv) { mtable_errmsg(_("Can't add model to table -- this model has a " "different dependent variable"), gui); return 1; } /* check that model is not already on the list */ if (in_model_table(pmod)) { mtable_errmsg(_("Model is already included in the table"), 0); return 1; } /* check that the model table is not already full */ if (model_table_too_many(gui)) { return 1; } } return 0; } static int real_add_to_model_table (MODEL *pmod, int add_mode, PRN *prn) { /* is the list started or not? */ if (n_models == 0) { table_models = mymalloc(sizeof *table_models); if (table_models == NULL) { return 1; } n_models = 1; } else { MODEL **mods; n_models++; mods = myrealloc(table_models, n_models * sizeof *mods); if (mods == NULL) { clear_model_table(NULL); return 1; } table_models = mods; } table_models[n_models - 1] = pmod; /* augment refcount so model won't get deleted */ gretl_object_ref(pmod, GRETL_OBJ_EQN); if (add_mode == MODEL_ADD_FROM_MENU) { infobox(_("Model added to table")); } else if (add_mode == MODEL_ADD_BY_CMD) { pputs(prn, _("Model added to table")); pputc(prn, '\n'); } mark_session_changed(); return 0; } int add_to_model_table (MODEL *pmod, int add_mode, PRN *prn) { if (model_table_precheck(pmod, add_mode)) { return 1; } return real_add_to_model_table(pmod, add_mode, prn); } static int on_param_list (const char *pname) { int i; for (i=0; incoeff && !err; i++) { gretl_model_get_param_name(pmod, datainfo, i, pname); if (!on_param_list(pname)) { err = strings_array_add(&pnames, &n_params, pname); } } return err; } static int make_full_param_list (void) { const MODEL *pmod; int first = 1; int i, err = 0; free_strings_array(pnames, n_params); pnames = NULL; n_params = 0; for (i=0; ici; } else if (table_models[i]->ci != ci0) { return 0; } } } return ci0; } static int common_df (void) { int i, dfn0 = -1, dfd0 = -1; for (i=0; idfn; dfd0 = table_models[i]->dfd; } else { if (table_models[i]->dfn != dfn0 || table_models[i]->dfd != dfd0) { return 0; } } } } return 1; } static const char *short_estimator_string (const MODEL *pmod, PRN *prn) { if (pmod->ci == HSK) return N_("HSK"); else if (pmod->ci == CORC) return N_("CORC"); else if (pmod->ci == HILU) return N_("HILU"); else if (pmod->ci == PWE) return N_("PWE"); else if (pmod->ci == ARCH) return N_("ARCH"); else if (pmod->ci == WLS) { if (gretl_model_get_int(pmod, "iters")) { return N_("MLE"); } else { return N_("WLS"); } } else if (pmod->ci == PANEL) { if (gretl_model_get_int(pmod, "fixed-effects")) { return N_("Within"); } else if (gretl_model_get_int(pmod, "random-effects")) { return N_("GLS"); } else { return N_("Between"); } } else { return estimator_string(pmod, prn); } } static const char *get_asts (double pval) { return (pval >= 0.1)? " " : (pval >= 0.05)? "* " : "**"; } static const char *tex_get_asts (double pval) { return (pval >= 0.1)? "" : (pval >= 0.05)? "$^{*}$" : "$^{**}$"; } static const char *get_pre_asts (double pval) { return (pval >= 0.1)? "" : (pval >= 0.05)? "$\\,$" : "$\\,\\,$"; } static void print_model_table_coeffs (int namewidth, PRN *prn) { int i, j, k; const MODEL *pmod; char tmp[32]; int tex = tex_format(prn); int rtf = rtf_format(prn); /* loop across all variables that appear in any model */ for (i=0; i= 0) { double x = screen_zero(pmod->coeff[k]); double s = screen_zero(pmod->sderr[k]); double pval; char numstr[32]; if (floateq(s, 0.0)) { if (floateq(x, 0.0)) { pval = 1.0; } else { pval = 0.0001; } } else { pval = coeff_pval(pmod->ci, x / s, pmod->dfd); } sprintf(numstr, "%#.4g", x); gretl_fix_exponent(numstr); if (tex) { if (x < 0) { pprintf(prn, "& %s$-$%s%s ", get_pre_asts(pval), numstr + 1, tex_get_asts(pval)); } else { pprintf(prn, "& %s%s%s ", get_pre_asts(pval), numstr, tex_get_asts(pval)); } } else if (rtf) { pprintf(prn, "\\qc %s%s\\cell ", numstr, get_asts(pval)); } else { /* note: strlen(asts) = 2 */ pprintf(prn, "%*s%s", (first)? colwidth : colwidth - 2, numstr, get_asts(pval)); } first = 0; } else { /* variable not present in this column */ if (tex) { pputs(prn, "& "); } else if (rtf) { pputs(prn, "\\qc \\cell "); } else { bufspace(colwidth, prn); } } } /* terminate the coefficient row and start the next one, which holds standard errors */ if (tex) { pputs(prn, "\\\\\n"); } else if (rtf) { pputs(prn, "\\intbl \\row\n"); print_rtf_row_spec(prn, 1); pputs(prn, "\\intbl "); } else { pputc(prn, '\n'); bufspace(namewidth + 2, prn); } /* print the t-stats or standard errors across a row */ first = 1; for (j=0; j= 0) { char numstr[32]; double val; if (use_tstats) { val = pmod->coeff[k] / pmod->sderr[k]; } else { val = pmod->sderr[k]; } sprintf(numstr, "%#.4g", val); gretl_fix_exponent(numstr); if (tex) { if (val < 0) { pprintf(prn, "& \\footnotesize{($-$%s)} ", numstr + 1); } else { pprintf(prn, "& \\footnotesize{(%s)} ", numstr); } } else if (rtf) { if (first) { pputs(prn, "\\qc \\cell "); } pprintf(prn, "\\qc (%s)\\cell ", numstr); first = 0; } else { sprintf(tmp, "(%s)", numstr); pprintf(prn, "%*s", colwidth, tmp); } } else { /* variable not present in this column */ if (tex) { pputs(prn, "& "); } else if (rtf) { pputs(prn, "\\qc \\cell "); } else { bufspace(colwidth, prn); } } } if (tex) { pputs(prn, "\\\\ [4pt] \n"); } else if (rtf) { pputs(prn, "\\intbl \\row\n"); } else { pputs(prn, "\n\n"); } } } static int any_log_lik (void) { int i; for (i=0; ilnL)) { return 1; } } return 0; } static int any_r_squared (void) { int i; for (i=0; irsq)) { return 1; } } return 0; } static void print_n_r_squared (int width0, PRN *prn, int *binary) { const MODEL *pmod; int same_df, any_R2, any_ll; int tex = tex_format(prn); int rtf = rtf_format(prn); int j; if (rtf) { print_rtf_row_spec(prn, 0); } if (tex) { pprintf(prn, "$%s$ ", _("n")); } else if (rtf) { pprintf(prn, "\\intbl \\qc %s\\cell ", _("n")); } else { pprintf(prn, "%*s", width0, _("n")); } for (j=0; jnobs); } else if (rtf) { pprintf(prn, "\\qc %d\\cell ", pmod->nobs); } else { pprintf(prn, "%*d", colwidth, pmod->nobs); } } } if (tex) { pputs(prn, "\\\\\n"); } else if (rtf) { pputs(prn, "\\intbl \\row\n\\intbl "); } else { pputc(prn, '\n'); } same_df = common_df(); any_R2 = any_r_squared(); any_ll = any_log_lik(); if (any_R2) { /* print R^2 values */ if (tex) { pputs(prn, (same_df)? "$R^2$" : "$\\bar R^2$ "); } else if (rtf) { pprintf(prn, "\\qc %s\\cell ", (same_df)? "R{\\super 2}" : _("Adj. R{\\super 2}")); } else { pprintf(prn, "%*s", width0, (same_df)? _("R-squared") : _("Adj. R**2")); } for (j=0; jrsq)) { if (tex) { pputs(prn, "& "); } else if (rtf) { pputs(prn, "\\qc \\cell "); } else { pputs(prn, " "); } } else if (pmod->ci == LOGIT || pmod->ci == PROBIT) { *binary = 1; /* McFadden */ if (tex) { pprintf(prn, "& %.4f ", pmod->rsq); } else if (rtf) { pprintf(prn, "\\qc %.4f\\cell ", pmod->rsq); } else { pprintf(prn, "%#*.4g", colwidth, pmod->rsq); } } else { double rsq = (same_df)? pmod->rsq : pmod->adjrsq; if (tex) { pprintf(prn, "& %.4f ", rsq); } else if (rtf) { pprintf(prn, "\\qc %.4f\\cell ", rsq); } else { pprintf(prn, "%#*.4g", colwidth, rsq); } } } if (tex) { pputs(prn, "\\\\\n"); } else if (rtf) { pputs(prn, "\\intbl \\row\n"); } else { pputc(prn, '\n'); if (!any_ll) { pputc(prn, '\n'); } } } if (any_ll) { /* print log-likelihoods */ if (tex) { pputs(prn, "$\\ell$"); } else if (rtf) { pputs(prn, "\\qc lnL\\cell "); } else { pprintf(prn, "%*s", width0, "lnL"); } for (j=0; jlnL)) { if (tex) { pputs(prn, "& "); } else if (rtf) { pputs(prn, "\\qc \\cell "); } else { pputs(prn, " "); } } else { if (tex) { if (pmod->lnL > 0) { pprintf(prn, "& %.2f ", pmod->lnL); } else { pprintf(prn, "& $-$%.2f ", -pmod->lnL); } } else if (rtf) { pprintf(prn, "\\qc %.3f\\cell ", pmod->lnL); } else { pprintf(prn, "%#*.6g", colwidth, pmod->lnL); } } } if (tex) { pputs(prn, "\\\\\n"); } else if (rtf) { pputs(prn, "\\intbl \\row\n"); } else { pputs(prn, "\n\n"); } } } static int max_namelen (void) { int i, len, maxlen = 8; for (i=0; i maxlen) { maxlen = len; } } return maxlen; } int display_model_table (int gui) { int j, ci; int binary = 0; int winwidth = 78; int namelen; PRN *prn; if (model_table_is_empty()) { mtable_errmsg(_("The model table is empty"), gui); return 1; } if (make_full_param_list()) { return 1; } namelen = max_namelen(); colwidth = 13; if (bufopen(&prn)) { clear_model_table(NULL); return 1; } ci = common_estimator(); if (ci > 0) { /* all models use same estimation procedure */ pprintf(prn, _("%s estimates"), _(estimator_string(table_models[0], prn))); pputc(prn, '\n'); } pprintf(prn, _("Dependent variable: %s\n"), datainfo->varname[depvarnum]); pputc(prn, '\n'); bufspace(namelen + 4, prn); for (j=0; jname != NULL) { *modhd = '\0'; strncat(modhd, table_models[j]->name, 31); } else { sprintf(modhd, _("Model %d"), table_models[j]->ID); } print_centered(modhd, colwidth, prn); } pputc(prn, '\n'); if (ci == 0) { char est[32]; bufspace(namelen + 4, prn); for (j=0; j 5) { winwidth = 90; } view_buffer(prn, winwidth, 450, _("gretl: model table"), VIEW_MODELTABLE, NULL); return 0; } static int tex_print_model_table (PRN *prn) { int j, ci; int binary = 0; char tmp[32]; if (model_table_is_empty()) { mtable_errmsg(_("The model table is empty"), 1); return 1; } if (make_full_param_list()) { return 1; } ci = common_estimator(); pputs(prn, "\\begin{center}\n"); if (ci > 0) { /* all models use same estimation procedure */ pprintf(prn, I_("%s estimates"), I_(estimator_string(table_models[0], prn))); pputs(prn, "\\\\\n"); } tex_escape(tmp, datainfo->varname[depvarnum]); pprintf(prn, "%s: %s \\\\\n", I_("Dependent variable"), tmp); pputs(prn, "\\vspace{1em}\n\n"); pputs(prn, "\\begin{longtable}{l"); for (j=0; jname != NULL) { *modhd = '\0'; strncat(modhd, table_models[j]->name, 16); tex_escape(tmp, modhd); strcpy(modhd, tmp); } else { sprintf(modhd, I_("Model %d"), table_models[j]->ID); } pprintf(prn, " & %s ", modhd); } pputs(prn, "\\\\ "); if (ci == 0) { char est[32]; pputc(prn, '\n'); for (j=0; j 0) { /* all models use same estimation procedure */ pputs(prn, "\\par \\qc "); pprintf(prn, I_("%s estimates"), I_(estimator_string(table_models[0], prn))); pputc(prn, '\n'); } pprintf(prn, "\\par \\qc %s: %s\n\\par\n\\par\n{", I_("Dependent variable"), datainfo->varname[depvarnum]); /* RTF row stuff */ print_rtf_row_spec(prn, 1); pputs(prn, "\\intbl \\qc \\cell "); for (j=0; jname != NULL) { *modhd = '\0'; strncat(modhd, table_models[j]->name, 31); } else { sprintf(modhd, I_("Model %d"), table_models[j]->ID); } pprintf(prn, "\\qc %s\\cell ", modhd); } pputs(prn, "\\intbl \\row\n"); if (ci == 0) { char est[32]; pputs(prn, "\\intbl \\qc \\cell "); for (j=0; jID); if (cpy == NULL) { cpy = gretl_model_copy(pmod); if (cpy == NULL) { err = E_ALLOC; } else { freeit = 1; } } if (!err) { err = real_add_to_model_table(cpy, MODEL_ADD_BY_CMD, prn); } if (err && freeit) { gretl_model_free(cpy); } } return err; } int modeltab_parse_line (const char *line, PRN *prn) { char cmdword[9]; int err = 0; if (sscanf(line, "%*s %8s", cmdword) != 1) { return E_PARSE; } if (!strcmp(cmdword, "add")) { err = cli_modeltab_add(prn); } else if (!strcmp(cmdword, "show")) { err = display_model_table(0); } else if (!strcmp(cmdword, "free")) { if (model_table_is_empty()) { mtable_errmsg(_("The model table is empty"), 0); err = 1; } else { clear_model_table(prn); } } return err; } void model_table_dialog (void) { const char *opts[] = { N_("standard errors in parentheses"), N_("t-statistics in parentheses") }; int opt; opt = radio_dialog(_("model table options"), NULL, opts, 2, use_tstats, 0); if (opt >= 0) { use_tstats = opt; } }