X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=src%2Flanguage%2Fstats%2Foneway.c;h=791ee86978dabe586e1d41ae6bf2d01f968de094;hb=c84078d8498785e9a52945cc63fb663cd48027af;hp=a67493ec4a048b1ec5398c9a93722c4f55a03a7b;hpb=afcd7961919d0e2d3d8ecd240a14ace4a201e8d3;p=pspp diff --git a/src/language/stats/oneway.c b/src/language/stats/oneway.c index a67493ec4a..791ee86978 100644 --- a/src/language/stats/oneway.c +++ b/src/language/stats/oneway.c @@ -1,5 +1,5 @@ /* PSPP - a program for statistical analysis. - Copyright (C) 1997-9, 2000, 2007, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. + Copyright (C) 1997-9, 2000, 2007, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc. 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 @@ -16,6 +16,7 @@ #include +#include #include #include #include @@ -52,6 +53,7 @@ /* Workspace variable for each dependent variable */ struct per_var_ws { + struct interaction *iact; struct categoricals *cat; struct covariance *cov; struct levene *nl; @@ -384,6 +386,37 @@ static void show_homogeneity (const struct oneway_spec *, const struct oneway_wo static void output_oneway (const struct oneway_spec *, struct oneway_workspace *ws); static void run_oneway (const struct oneway_spec *cmd, struct casereader *input, const struct dataset *ds); + +static void +destroy_coeff_list (struct contrasts_node *coeff_list) +{ + struct coeff_node *cn = NULL; + struct coeff_node *cnx = NULL; + struct ll_list *cl = &coeff_list->coefficient_list; + + ll_for_each_safe (cn, cnx, struct coeff_node, ll, cl) + { + free (cn); + } + + free (coeff_list); +} + +static void +oneway_cleanup (struct oneway_spec *cmd) +{ + struct contrasts_node *coeff_list = NULL; + struct contrasts_node *coeff_next = NULL; + ll_for_each_safe (coeff_list, coeff_next, struct contrasts_node, ll, &cmd->contrast_list) + { + destroy_coeff_list (coeff_list); + } + + free (cmd->posthoc); +} + + + int cmd_oneway (struct lexer *lexer, struct dataset *ds) { @@ -417,9 +450,12 @@ cmd_oneway (struct lexer *lexer, struct dataset *ds) PV_NO_DUPLICATE | PV_NUMERIC)) goto error; - lex_force_match (lexer, T_BY); + if (!lex_force_match (lexer, T_BY)) + goto error; oneway.indep_var = parse_variable_const (lexer, dict); + if (oneway.indep_var == NULL) + goto error; while (lex_token (lexer) != T_ENDCMD) { @@ -469,7 +505,8 @@ cmd_oneway (struct lexer *lexer, struct dataset *ds) { if ( !lex_force_match (lexer, T_LPAREN)) goto error; - lex_force_num (lexer); + if (! lex_force_num (lexer)) + goto error; oneway.alpha = lex_number (lexer); lex_get (lexer); if ( !lex_force_match (lexer, T_RPAREN)) @@ -505,10 +542,14 @@ cmd_oneway (struct lexer *lexer, struct dataset *ds) } else { + destroy_coeff_list (cl); lex_error (lexer, NULL); goto error; } } + + if ( ll_count (coefficient_list) <= 0) + goto error; ll_push_tail (&oneway.contrast_list, &cl->ll); } @@ -560,10 +601,12 @@ cmd_oneway (struct lexer *lexer, struct dataset *ds) ok = proc_commit (ds) && ok; } + oneway_cleanup (&oneway); free (oneway.vars); return CMD_SUCCESS; error: + oneway_cleanup (&oneway); free (oneway.vars); return CMD_FAILURE; } @@ -602,6 +645,15 @@ makeit (const void *aux1, void *aux2 UNUSED) return dd; } +static void +killit (const void *aux1 UNUSED, void *aux2 UNUSED, void *user_data) +{ + struct descriptive_data *dd = user_data; + + dd_destroy (dd); +} + + static void updateit (const void *aux1, void *aux2, void *user_data, const struct ccase *c, double weight) @@ -659,15 +711,15 @@ run_oneway (const struct oneway_spec *cmd, for (v = 0; v < cmd->n_vars; ++v) { - struct interaction *inter = interaction_create (cmd->indep_var); - struct payload payload; payload.create = makeit; payload.update = updateit; - payload.destroy = NULL; + payload.calculate = NULL; + payload.destroy = killit; - ws.vws[v].cat = categoricals_create (&inter, 1, cmd->wv, - cmd->exclude); + ws.vws[v].iact = interaction_create (cmd->indep_var); + ws.vws[v].cat = categoricals_create (&ws.vws[v].iact, 1, cmd->wv, + cmd->exclude, cmd->exclude); categoricals_set_payload (ws.vws[v].cat, &payload, CONST_CAST (struct variable *, cmd->vars[v]), @@ -771,10 +823,11 @@ run_oneway (const struct oneway_spec *cmd, for (v = 0; v < cmd->n_vars; ++v) { + const gsl_matrix *ucm; gsl_matrix *cm; struct per_var_ws *pvw = &ws.vws[v]; const struct categoricals *cats = covariance_get_categoricals (pvw->cov); - const bool ok = categoricals_done (cats); + const bool ok = categoricals_sane (cats); if ( ! ok) { @@ -784,7 +837,10 @@ run_oneway (const struct oneway_spec *cmd, continue; } - cm = covariance_calculate_unnormalized (pvw->cov); + ucm = covariance_calculate_unnormalized (pvw->cov); + + cm = gsl_matrix_alloc (ucm->size1, ucm->size2); + gsl_matrix_memcpy (cm, ucm); moments1_calculate (ws.dd_total[v]->mom, &pvw->n, NULL, NULL, NULL, NULL); @@ -793,14 +849,13 @@ run_oneway (const struct oneway_spec *cmd, reg_sweep (cm, 0); pvw->sse = gsl_matrix_get (cm, 0, 0); + gsl_matrix_free (cm); pvw->ssa = pvw->sst - pvw->sse; pvw->n_groups = categoricals_n_total (cats); pvw->mse = (pvw->sst - pvw->ssa) / (pvw->n - pvw->n_groups); - - gsl_matrix_free (cm); } for (v = 0; v < cmd->n_vars; ++v) @@ -824,12 +879,15 @@ run_oneway (const struct oneway_spec *cmd, taint_destroy (taint); finish: + for (v = 0; v < cmd->n_vars; ++v) { covariance_destroy (ws.vws[v].cov); levene_destroy (ws.vws[v].nl); dd_destroy (ws.dd_total[v]); + interaction_destroy (ws.vws[v].iact); } + free (ws.vws); free (ws.dd_total); } @@ -860,6 +918,7 @@ output_oneway (const struct oneway_spec *cmd, struct oneway_workspace *ws) i, ll_count (cl), ws->actual_number_of_groups); ll_remove (&coeff_list->ll); + destroy_coeff_list (coeff_list); continue; } @@ -924,7 +983,7 @@ show_anova_table (const struct oneway_spec *cmd, const struct oneway_workspace * tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("df")); tab_text (t, 4, 0, TAB_CENTER | TAT_TITLE, _("Mean Square")); tab_text (t, 5, 0, TAB_CENTER | TAT_TITLE, _("F")); - tab_text (t, 6, 0, TAB_CENTER | TAT_TITLE, _("Significance")); + tab_text (t, 6, 0, TAB_CENTER | TAT_TITLE, _("Sig.")); for (i = 0; i < cmd->n_vars; ++i) @@ -951,28 +1010,28 @@ show_anova_table (const struct oneway_spec *cmd, const struct oneway_workspace * /* Sums of Squares */ - tab_double (t, 2, i * 3 + 1, 0, pvw->ssa, NULL); - tab_double (t, 2, i * 3 + 3, 0, pvw->sst, NULL); - tab_double (t, 2, i * 3 + 2, 0, pvw->sse, NULL); + tab_double (t, 2, i * 3 + 1, 0, pvw->ssa, NULL, RC_OTHER); + tab_double (t, 2, i * 3 + 3, 0, pvw->sst, NULL, RC_OTHER); + tab_double (t, 2, i * 3 + 2, 0, pvw->sse, NULL, RC_OTHER); /* Degrees of freedom */ - tab_fixed (t, 3, i * 3 + 1, 0, df1, 4, 0); - tab_fixed (t, 3, i * 3 + 2, 0, df2, 4, 0); - tab_fixed (t, 3, i * 3 + 3, 0, n - 1, 4, 0); + tab_double (t, 3, i * 3 + 1, 0, df1, NULL, RC_INTEGER); + tab_double (t, 3, i * 3 + 2, 0, df2, NULL, RC_INTEGER); + tab_double (t, 3, i * 3 + 3, 0, n - 1, NULL, RC_INTEGER); /* Mean Squares */ - tab_double (t, 4, i * 3 + 1, TAB_RIGHT, msa, NULL); - tab_double (t, 4, i * 3 + 2, TAB_RIGHT, pvw->mse, NULL); + tab_double (t, 4, i * 3 + 1, TAB_RIGHT, msa, NULL, RC_OTHER); + tab_double (t, 4, i * 3 + 2, TAB_RIGHT, pvw->mse, NULL, RC_OTHER); { const double F = msa / pvw->mse ; /* The F value */ - tab_double (t, 5, i * 3 + 1, 0, F, NULL); + tab_double (t, 5, i * 3 + 1, 0, F, NULL, RC_OTHER); /* The significance */ - tab_double (t, 6, i * 3 + 1, 0, gsl_cdf_fdist_Q (F, df1, df2), NULL); + tab_double (t, 6, i * 3 + 1, 0, gsl_cdf_fdist_Q (F, df1, df2), NULL, RC_PVALUE); } } @@ -1001,6 +1060,7 @@ show_descriptives (const struct oneway_spec *cmd, const struct oneway_workspace n_rows += ws->actual_number_of_groups + 1; t = tab_create (n_cols, n_rows); + tab_set_format (t, RC_WEIGHT, wfmt); tab_headers (t, 2, 0, 2, 0); /* Put a frame around the entire box, and vertical lines inside */ @@ -1077,29 +1137,29 @@ show_descriptives (const struct oneway_spec *cmd, const struct oneway_workspace /* Now fill in the numbers ... */ - tab_double (t, 2, row + count, 0, n, wfmt); + tab_double (t, 2, row + count, 0, n, NULL, RC_WEIGHT); - tab_double (t, 3, row + count, 0, mean, NULL); + tab_double (t, 3, row + count, 0, mean, NULL, RC_OTHER); - tab_double (t, 4, row + count, 0, std_dev, NULL); + tab_double (t, 4, row + count, 0, std_dev, NULL, RC_OTHER); - tab_double (t, 5, row + count, 0, std_error, NULL); + tab_double (t, 5, row + count, 0, std_error, NULL, RC_OTHER); /* Now the confidence interval */ T = gsl_cdf_tdist_Qinv (q, n - 1); tab_double (t, 6, row + count, 0, - mean - T * std_error, NULL); + mean - T * std_error, NULL, RC_OTHER); tab_double (t, 7, row + count, 0, - mean + T * std_error, NULL); + mean + T * std_error, NULL, RC_OTHER); /* Min and Max */ - tab_double (t, 8, row + count, 0, dd->minimum, fmt); - tab_double (t, 9, row + count, 0, dd->maximum, fmt); + tab_double (t, 8, row + count, 0, dd->minimum, fmt, RC_OTHER); + tab_double (t, 9, row + count, 0, dd->maximum, fmt, RC_OTHER); } if (categoricals_is_complete (cats)) @@ -1117,27 +1177,27 @@ show_descriptives (const struct oneway_spec *cmd, const struct oneway_workspace tab_text (t, 1, row + count, TAB_LEFT | TAT_TITLE, _("Total")); - tab_double (t, 2, row + count, 0, n, wfmt); + tab_double (t, 2, row + count, 0, n, NULL, RC_WEIGHT); - tab_double (t, 3, row + count, 0, mean, NULL); + tab_double (t, 3, row + count, 0, mean, NULL, RC_OTHER); - tab_double (t, 4, row + count, 0, std_dev, NULL); + tab_double (t, 4, row + count, 0, std_dev, NULL, RC_OTHER); - tab_double (t, 5, row + count, 0, std_error, NULL); + tab_double (t, 5, row + count, 0, std_error, NULL, RC_OTHER); /* Now the confidence interval */ T = gsl_cdf_tdist_Qinv (q, n - 1); tab_double (t, 6, row + count, 0, - mean - T * std_error, NULL); + mean - T * std_error, NULL, RC_OTHER); tab_double (t, 7, row + count, 0, - mean + T * std_error, NULL); + mean + T * std_error, NULL, RC_OTHER); /* Min and Max */ - tab_double (t, 8, row + count, 0, ws->dd_total[v]->minimum, fmt); - tab_double (t, 9, row + count, 0, ws->dd_total[v]->maximum, fmt); + tab_double (t, 8, row + count, 0, ws->dd_total[v]->minimum, fmt, RC_OTHER); + tab_double (t, 9, row + count, 0, ws->dd_total[v]->maximum, fmt, RC_OTHER); } row += categoricals_n_total (cats) + 1; @@ -1171,7 +1231,7 @@ show_homogeneity (const struct oneway_spec *cmd, const struct oneway_workspace * tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Levene Statistic")); tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("df1")); tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("df2")); - tab_text (t, 4, 0, TAB_CENTER | TAT_TITLE, _("Significance")); + tab_text (t, 4, 0, TAB_CENTER | TAT_TITLE, _("Sig.")); tab_title (t, _("Test of Homogeneity of Variances")); @@ -1192,12 +1252,12 @@ show_homogeneity (const struct oneway_spec *cmd, const struct oneway_workspace * tab_text (t, 0, v + 1, TAB_LEFT | TAT_TITLE, s); - tab_double (t, 1, v + 1, TAB_RIGHT, F, NULL); - tab_fixed (t, 2, v + 1, TAB_RIGHT, df1, 8, 0); - tab_fixed (t, 3, v + 1, TAB_RIGHT, df2, 8, 0); + tab_double (t, 1, v + 1, TAB_RIGHT, F, NULL, RC_OTHER); + tab_double (t, 2, v + 1, TAB_RIGHT, df1, NULL, RC_INTEGER); + tab_double (t, 3, v + 1, TAB_RIGHT, df2, NULL, RC_INTEGER); /* Now the significance */ - tab_double (t, 4, v + 1, TAB_RIGHT, gsl_cdf_fdist_Q (F, df1, df2), NULL); + tab_double (t, 4, v + 1, TAB_RIGHT, gsl_cdf_fdist_Q (F, df1, df2), NULL, RC_PVALUE); } tab_submit (t); @@ -1281,7 +1341,8 @@ show_contrast_coeffs (const struct oneway_spec *cmd, const struct oneway_workspa ds_destroy (&vstr); - tab_text_format (t, count + 2, c_num + 2, TAB_RIGHT, "%g", coeffn->coeff); + tab_text_format (t, count + 2, c_num + 2, TAB_RIGHT, "%.*g", + DBL_DIG + 1, coeffn->coeff); } ++c_num; } @@ -1333,6 +1394,8 @@ show_contrast_tests (const struct oneway_spec *cmd, const struct oneway_workspac { const struct per_var_ws *pvw = &ws->vws[v]; const struct categoricals *cats = covariance_get_categoricals (pvw->cov); + if (!categoricals_is_complete (cats)) + continue; struct ll *cli; int i = 0; int lines_per_variable = 2 * n_contrasts; @@ -1421,18 +1484,18 @@ show_contrast_tests (const struct oneway_spec *cmd, const struct oneway_workspac df_numerator = pow2 (df_numerator); tab_double (t, 3, (v * lines_per_variable) + i + 1, - TAB_RIGHT, contrast_value, NULL); + TAB_RIGHT, contrast_value, NULL, RC_OTHER); tab_double (t, 3, (v * lines_per_variable) + i + 1 + n_contrasts, - TAB_RIGHT, contrast_value, NULL); + TAB_RIGHT, contrast_value, NULL, RC_OTHER); std_error_contrast = sqrt (pvw->mse * coef_msq); /* Std. Error */ tab_double (t, 4, (v * lines_per_variable) + i + 1, TAB_RIGHT, std_error_contrast, - NULL); + NULL, RC_OTHER); T = fabs (contrast_value / std_error_contrast); @@ -1440,19 +1503,18 @@ show_contrast_tests (const struct oneway_spec *cmd, const struct oneway_workspac tab_double (t, 5, (v * lines_per_variable) + i + 1, TAB_RIGHT, T, - NULL); + NULL, RC_OTHER); /* Degrees of Freedom */ - tab_fixed (t, 6, (v * lines_per_variable) + i + 1, - TAB_RIGHT, df, - 8, 0); + tab_double (t, 6, (v * lines_per_variable) + i + 1, + TAB_RIGHT, df, NULL, RC_INTEGER); /* Significance TWO TAILED !!*/ tab_double (t, 7, (v * lines_per_variable) + i + 1, TAB_RIGHT, 2 * gsl_cdf_tdist_Q (T, df), - NULL); + NULL, RC_PVALUE); /* Now for the Variances NOT Equal case */ @@ -1460,25 +1522,30 @@ show_contrast_tests (const struct oneway_spec *cmd, const struct oneway_workspac tab_double (t, 4, (v * lines_per_variable) + i + 1 + n_contrasts, TAB_RIGHT, sec_vneq, - NULL); + NULL, RC_OTHER); T = contrast_value / sec_vneq; tab_double (t, 5, (v * lines_per_variable) + i + 1 + n_contrasts, TAB_RIGHT, T, - NULL); + NULL, RC_OTHER); df = df_numerator / df_denominator; tab_double (t, 6, (v * lines_per_variable) + i + 1 + n_contrasts, TAB_RIGHT, df, - NULL); + NULL, RC_OTHER); + + { + double p = gsl_cdf_tdist_P (T, df); + double q = gsl_cdf_tdist_Q (T, df); - /* The Significance */ - tab_double (t, 7, (v * lines_per_variable) + i + 1 + n_contrasts, - TAB_RIGHT, 2 * gsl_cdf_tdist_Q (T,df), - NULL); + /* The Significance */ + tab_double (t, 7, (v * lines_per_variable) + i + 1 + n_contrasts, + TAB_RIGHT, 2 * ((T > 0) ? q : p), + NULL, RC_PVALUE); + } } if ( v > 0 ) @@ -1523,7 +1590,7 @@ show_comparisons (const struct oneway_spec *cmd, const struct oneway_workspace * tab_vline (t, TAL_2, heading_cols, 0, n_rows - 1); - tab_title (t, _("Multiple Comparisons")); + tab_title (t, _("Multiple Comparisons (%s)"), var_to_string (cmd->vars[v])); tab_text_format (t, 1, 1, TAB_LEFT | TAT_TITLE, _("(I) %s"), var_to_string (cmd->indep_var)); tab_text_format (t, 2, 1, TAB_LEFT | TAT_TITLE, _("(J) %s"), var_to_string (cmd->indep_var)); @@ -1585,24 +1652,24 @@ show_comparisons (const struct oneway_spec *cmd, const struct oneway_workspace * moments1_calculate (dd_j->mom, &weight_j, &mean_j, &var_j, 0, 0); - tab_double (t, 3, r + rx, 0, mean_i - mean_j, 0); + tab_double (t, 3, r + rx, 0, mean_i - mean_j, NULL, RC_OTHER); std_err = pvw->mse; std_err *= weight_i + weight_j; std_err /= weight_i * weight_j; std_err = sqrt (std_err); - tab_double (t, 4, r + rx, 0, std_err, 0); + tab_double (t, 4, r + rx, 0, std_err, NULL, RC_OTHER); - tab_double (t, 5, r + rx, 0, 2 * multiple_comparison_sig (std_err, pvw, dd_i, dd_j, ph), 0); + tab_double (t, 5, r + rx, 0, 2 * multiple_comparison_sig (std_err, pvw, dd_i, dd_j, ph), NULL, RC_PVALUE); half_range = mc_half_range (cmd, pvw, std_err, dd_i, dd_j, ph); tab_double (t, 6, r + rx, 0, - (mean_i - mean_j) - half_range, 0 ); + (mean_i - mean_j) - half_range, NULL, RC_OTHER); tab_double (t, 7, r + rx, 0, - (mean_i - mean_j) + half_range, 0 ); + (mean_i - mean_j) + half_range, NULL, RC_OTHER); rx++; }