1 /* PSPP - computes sample statistics.
2 Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
3 Written by Ben Pfaff <blp@gnu.org>.
5 This program is free software; you can redistribute it and/or
6 modify it under the terms of the GNU General Public License as
7 published by the Free Software Foundation; either version 2 of the
8 License, or (at your option) any later version.
10 This program is distributed in the hope that it will be useful, but
11 WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
25 #include "algorithm.h"
32 #include "file-handle.h"
40 #include "debug-print.h"
42 /* FIXME: /N subcommand not implemented. It should be pretty simple,
45 /* Format type enums. */
52 /* Matrix section enums. */
60 /* Diagonal inclusion enums. */
88 /* 0=vector, 1=matrix, 2=scalar. */
89 static const int content_type[PROX + 1] =
91 0, 2, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1,
94 /* Name of each content type. */
95 static const char *content_names[PROX + 1] =
97 "N", "N", "N_MATRIX", "MEAN", "STDDEV", "COUNT", "MSE",
98 "DFE", "MAT", "COV", "CORR", "PROX",
101 /* A MATRIX DATA input program. */
102 struct matrix_data_pgm
104 struct pool *container; /* Arena used for all allocations. */
105 struct file_handle *data_file; /* The data file to be read. */
108 enum format_type fmt; /* LIST or FREE. */
109 enum matrix_section section;/* LOWER or UPPER or FULL. */
110 enum include_diagonal diag; /* DIAGONAL or NODIAGONAL. */
112 int explicit_rowtype; /* ROWTYPE_ specified explicitly in data? */
113 struct variable *rowtype_, *varname_; /* ROWTYPE_, VARNAME_ variables. */
115 struct variable *single_split; /* Single SPLIT FILE variable. */
117 /* Factor variables. */
118 int n_factors; /* Number of factor variables. */
119 struct variable **factors; /* Factor variables. */
120 int is_per_factor[PROX + 1]; /* Is there per-factor data? */
122 int cells; /* Number of cells, or -1 if none. */
124 int pop_n; /* Population N specified by user. */
126 /* CONTENTS subcommand. */
127 int contents[EOC * 3 + 1]; /* Contents. */
128 int n_contents; /* Number of entries. */
130 /* Continuous variables. */
131 int n_continuous; /* Number of continuous variables. */
132 int first_continuous; /* Index into default_dict.var of
133 first continuous variable. */
136 static const struct case_source_class matrix_data_with_rowtype_source_class;
137 static const struct case_source_class matrix_data_without_rowtype_source_class;
139 static int compare_variables_by_mxd_vartype (const void *pa,
141 static void read_matrices_without_rowtype (struct matrix_data_pgm *);
142 static void read_matrices_with_rowtype (struct matrix_data_pgm *);
143 static int string_to_content_type (char *, int *);
146 cmd_matrix_data (void)
149 struct matrix_data_pgm *mx;
153 discard_variables ();
155 pool = pool_create ();
156 mx = pool_alloc (pool, sizeof *mx);
157 mx->container = pool;
158 mx->data_file = inline_file;
162 mx->explicit_rowtype = 0;
165 mx->single_split = NULL;
168 memset (mx->is_per_factor, 0, sizeof mx->is_per_factor);
172 mx->n_continuous = 0;
173 mx->first_continuous = 0;
178 if (lex_match_id ("VARIABLES"))
185 msg (SE, _("VARIABLES subcommand multiply specified."));
191 if (!parse_DATA_LIST_vars (&v, &nv, PV_NO_DUPLICATE))
197 for (i = 0; i < nv; i++)
198 if (!strcmp (v[i], "VARNAME_"))
200 msg (SE, _("VARNAME_ cannot be explicitly specified on "
202 for (i = 0; i < nv; i++)
212 for (i = 0; i < nv; i++)
214 struct variable *new_var;
216 if (strcmp (v[i], "ROWTYPE_"))
218 new_var = dict_create_var_assert (default_dict, v[i], 0);
219 new_var->p.mxd.vartype = MXD_CONTINUOUS;
220 new_var->p.mxd.subtype = i;
223 mx->explicit_rowtype = 1;
230 mx->rowtype_ = dict_create_var_assert (default_dict,
232 mx->rowtype_->p.mxd.vartype = MXD_ROWTYPE;
233 mx->rowtype_->p.mxd.subtype = 0;
236 else if (lex_match_id ("FILE"))
239 mx->data_file = fh_parse_file_handle ();
240 if (mx->data_file == NULL)
243 else if (lex_match_id ("FORMAT"))
247 while (token == T_ID)
249 if (lex_match_id ("LIST"))
251 else if (lex_match_id ("FREE"))
253 else if (lex_match_id ("LOWER"))
255 else if (lex_match_id ("UPPER"))
257 else if (lex_match_id ("FULL"))
259 else if (lex_match_id ("DIAGONAL"))
261 else if (lex_match_id ("NODIAGONAL"))
262 mx->diag = NODIAGONAL;
265 lex_error (_("in FORMAT subcommand"));
270 else if (lex_match_id ("SPLIT"))
276 msg (SE, _("SPLIT subcommand multiply specified."));
283 lex_error (_("in SPLIT subcommand"));
287 if (dict_lookup_var (default_dict, tokid) == NULL
288 && (lex_look_ahead () == '.' || lex_look_ahead () == '/'))
290 if (!strcmp (tokid, "ROWTYPE_") || !strcmp (tokid, "VARNAME_"))
292 msg (SE, _("Split variable may not be named ROWTYPE_ "
297 mx->single_split = dict_create_var_assert (default_dict,
301 mx->single_split->p.mxd.vartype = MXD_CONTINUOUS;
303 dict_set_split_vars (default_dict, &mx->single_split, 1);
307 struct variable **split;
310 if (!parse_variables (default_dict, &split, &n, PV_NO_DUPLICATE))
313 dict_set_split_vars (default_dict, split, n);
317 struct variable *const *split = dict_get_split_vars (default_dict);
318 size_t split_cnt = dict_get_split_cnt (default_dict);
321 for (i = 0; i < split_cnt; i++)
323 if (split[i]->p.mxd.vartype != MXD_CONTINUOUS)
325 msg (SE, _("Split variable %s is already another type."),
329 split[i]->p.mxd.vartype = MXD_SPLIT;
330 split[i]->p.mxd.subtype = i;
334 else if (lex_match_id ("FACTORS"))
340 msg (SE, _("FACTORS subcommand multiply specified."));
345 if (!parse_variables (default_dict, &mx->factors, &mx->n_factors, PV_NONE))
351 for (i = 0; i < mx->n_factors; i++)
353 if (mx->factors[i]->p.mxd.vartype != MXD_CONTINUOUS)
355 msg (SE, _("Factor variable %s is already another type."),
359 mx->factors[i]->p.mxd.vartype = MXD_FACTOR;
360 mx->factors[i]->p.mxd.subtype = i;
364 else if (lex_match_id ("CELLS"))
370 msg (SE, _("CELLS subcommand multiply specified."));
374 if (!lex_integer_p () || lex_integer () < 1)
376 lex_error (_("expecting positive integer"));
380 mx->cells = lex_integer ();
383 else if (lex_match_id ("N"))
389 msg (SE, _("N subcommand multiply specified."));
393 if (!lex_integer_p () || lex_integer () < 1)
395 lex_error (_("expecting positive integer"));
399 mx->pop_n = lex_integer ();
402 else if (lex_match_id ("CONTENTS"))
404 int inside_parens = 0;
405 unsigned collide = 0;
410 msg (SE, _("CONTENTS subcommand multiply specified."));
420 for (i = 0; i <= PROX; i++)
421 mx->is_per_factor[i] = 0;
430 msg (SE, _("Nested parentheses not allowed."));
436 else if (lex_match (')'))
440 msg (SE, _("Mismatched right parenthesis (`(')."));
443 if (mx->contents[mx->n_contents - 1] == LPAREN)
445 msg (SE, _("Empty parentheses not allowed."));
458 lex_error (_("in CONTENTS subcommand"));
462 content_type = string_to_content_type (tokid,
464 if (content_type == -1)
466 lex_error (_("in CONTENTS subcommand"));
471 if (collide & (1 << collide_index))
473 msg (SE, _("Content multiply specified for %s."),
474 content_names[content_type]);
477 collide |= (1 << collide_index);
480 mx->is_per_factor[item] = inside_parens;
482 mx->contents[mx->n_contents++] = item;
484 if (token == '/' || token == '.')
490 msg (SE, _("Missing right parenthesis."));
493 mx->contents[mx->n_contents] = EOC;
504 lex_error (_("expecting end of command"));
510 msg (SE, _("Missing VARIABLES subcommand."));
514 if (!mx->n_contents && !mx->explicit_rowtype)
516 msg (SW, _("CONTENTS subcommand not specified: assuming file "
517 "contains only CORR matrix."));
519 mx->contents[0] = CORR;
520 mx->contents[1] = EOC;
524 if (mx->n_factors && !mx->explicit_rowtype && mx->cells == -1)
526 msg (SE, _("Missing CELLS subcommand. CELLS is required "
527 "when ROWTYPE_ is not given in the data and "
528 "factors are present."));
532 if (mx->explicit_rowtype && mx->single_split)
534 msg (SE, _("Split file values must be present in the data when "
535 "ROWTYPE_ is present."));
539 /* Create VARNAME_. */
541 mx->varname_ = dict_create_var_assert (default_dict, "VARNAME_", 8);
542 mx->varname_->p.mxd.vartype = MXD_VARNAME;
543 mx->varname_->p.mxd.subtype = 0;
546 /* Sort the dictionary variables into the desired order for the
547 system file output. */
552 dict_get_vars (default_dict, &v, &nv, 0);
553 qsort (v, nv, sizeof *v, compare_variables_by_mxd_vartype);
554 dict_reorder_vars (default_dict, v, nv);
560 static const struct fmt_spec fmt_tab[MXD_COUNT] =
571 mx->first_continuous = -1;
572 for (i = 0; i < dict_get_var_cnt (default_dict); i++)
574 struct variable *v = dict_get_var (default_dict, i);
575 int type = v->p.mxd.vartype;
577 assert (type >= 0 && type < MXD_COUNT);
578 v->print = v->write = fmt_tab[type];
580 if (type == MXD_CONTINUOUS)
582 if (mx->first_continuous == -1 && type == MXD_CONTINUOUS)
583 mx->first_continuous = i;
587 if (mx->n_continuous == 0)
589 msg (SE, _("No continuous variables specified."));
593 if (!dfm_open_for_reading (mx->data_file))
596 if (mx->explicit_rowtype)
597 read_matrices_with_rowtype (mx);
599 read_matrices_without_rowtype (mx);
601 pool_destroy (mx->container);
606 discard_variables ();
608 pool_destroy (mx->container);
612 /* Look up string S as a content-type name and return the
613 corresponding enumerated value, or -1 if there is no match. If
614 COLLIDE is non-NULL then *COLLIDE returns a value (suitable for use
615 as a bit-index) which can be used for determining whether a related
616 statistic has already been used. */
618 string_to_content_type (char *s, int *collide)
629 {N_VECTOR, 0, "N_VECTOR"},
631 {N_SCALAR, 0, "N_SCALAR"},
632 {N_MATRIX, 1, "N_MATRIX"},
634 {STDDEV, 3, "STDDEV"},
646 for (tp = tab; tp->value != -1; tp++)
647 if (!strcmp (s, tp->string))
650 *collide = tp->collide;
657 /* Compare two variables using p.mxd.vartype and p.mxd.subtype
660 compare_variables_by_mxd_vartype (const void *a_, const void *b_)
662 struct variable *const *pa = a_;
663 struct variable *const *pb = b_;
664 const struct matrix_data_proc *a = &(*pa)->p.mxd;
665 const struct matrix_data_proc *b = &(*pb)->p.mxd;
667 if (a->vartype != b->vartype)
668 return a->vartype > b->vartype ? 1 : -1;
670 return a->subtype < b->subtype ? -1 : a->subtype > b->subtype;
673 /* Matrix tokenizer. */
675 /* Matrix token types. */
676 enum matrix_token_type
682 /* A MATRIX DATA parsing token. */
685 enum matrix_token_type type;
686 double number; /* MNUM: token value. */
687 char *string; /* MSTR: token string; not null-terminated. */
688 int length; /* MSTR: tokstr length. */
691 static int mget_token (struct matrix_token *, struct file_handle *);
694 #define mget_token(TOKEN, HANDLE) mget_token_dump(TOKEN, HANDLE)
697 mdump_token (const struct matrix_token *token)
702 printf (" #%g", token->number);
705 printf (" '%.*s'", token->length, token->string);
714 mget_token_dump (struct matrix_token *token, struct file_handle *data_file)
716 int result = (mget_token) (token, data_file);
722 /* Return the current position in DATA_FILE. */
724 context (struct file_handle *data_file)
728 if (dfm_eof (data_file))
729 strcpy (buf, "at end of file");
732 struct len_string line;
735 dfm_get_record (data_file, &line);
736 sp = ls_c_str (&line);
737 while (sp < ls_end (&line) && isspace ((unsigned char) *sp))
739 if (sp >= ls_end (&line))
740 strcpy (buf, "at end of line");
746 dp = stpcpy (buf, "before `");
747 while (sp < ls_end (&line) && !isspace ((unsigned char) *sp)
760 /* Is there at least one token left in the data file? */
762 another_token (struct file_handle *data_file)
766 struct len_string line;
769 if (dfm_eof (data_file))
771 dfm_get_record (data_file, &line);
773 cp = ls_c_str (&line);
774 while (isspace ((unsigned char) *cp) && cp < ls_end (&line))
777 if (cp < ls_end (&line))
779 dfm_forward_columns (data_file, cp - ls_c_str (&line));
783 dfm_forward_record (data_file);
787 /* Parse a MATRIX DATA token from mx->data_file into TOKEN. */
789 (mget_token) (struct matrix_token *token, struct file_handle *data_file)
791 struct len_string line;
795 if (!another_token (data_file))
798 dfm_get_record (data_file, &line);
799 first_column = dfm_column_start (data_file);
801 /* Three types of fields: quoted with ', quoted with ", unquoted. */
802 cp = ls_c_str (&line);
803 if (*cp == '\'' || *cp == '"')
808 token->string = ++cp;
809 while (cp < ls_end (&line) && *cp != quote)
811 token->length = cp - token->string;
812 if (cp < ls_end (&line))
815 msg (SW, _("Scope of string exceeds line."));
819 int is_num = isdigit ((unsigned char) *cp) || *cp == '.';
821 token->string = cp++;
822 while (cp < ls_end (&line)
823 && !isspace ((unsigned char) *cp) && *cp != ','
824 && *cp != '-' && *cp != '+')
826 if (isdigit ((unsigned char) *cp))
829 if ((tolower ((unsigned char) *cp) == 'd'
830 || tolower ((unsigned char) *cp) == 'e')
831 && (cp[1] == '+' || cp[1] == '-'))
837 token->length = cp - token->string;
838 assert (token->length);
844 di.s = token->string;
845 di.e = token->string + token->length;
846 di.v = (union value *) &token->number;
847 di.f1 = first_column;
848 di.format.type = FMT_F;
849 di.format.w = token->length;
859 dfm_forward_columns (data_file, cp - ls_c_str (&line));
864 /* Forcibly skip the end of a line for content type CONTENT in
867 force_eol (struct file_handle *data_file, const char *content)
869 struct len_string line;
872 if (dfm_eof (data_file))
874 dfm_get_record (data_file, &line);
876 cp = ls_c_str (&line);
877 while (isspace ((unsigned char) *cp) && cp < ls_end (&line))
880 if (cp < ls_end (&line))
882 msg (SE, _("End of line expected %s while reading %s."),
883 context (data_file), content);
887 dfm_forward_record (data_file);
891 /* Back end, omitting ROWTYPE_. */
895 struct matrix_data_pgm *mx; /* MATRIX DATA program. */
896 double ***data; /* MATRIX DATA data. */
897 double *factor_values; /* Factor values. */
898 int max_cell_idx; /* Max-numbered cell that we have
899 read so far, plus one. */
900 double *split_values; /* SPLIT FILE variable values. */
903 static int nr_read_splits (struct nr_aux_data *, int compare);
904 static int nr_read_factors (struct nr_aux_data *, int cell);
905 static void nr_output_data (struct nr_aux_data *, struct ccase *,
906 write_case_func *, write_case_data);
907 static void matrix_data_read_without_rowtype (struct case_source *source,
912 /* Read from the data file and write it to the active file. */
914 read_matrices_without_rowtype (struct matrix_data_pgm *mx)
916 struct nr_aux_data nr;
923 nr.factor_values = xmalloc (sizeof *nr.factor_values * mx->n_factors * mx->cells);
925 nr.split_values = xmalloc (sizeof *nr.split_values
926 * dict_get_split_cnt (default_dict));
928 vfm_source = create_case_source (&matrix_data_without_rowtype_source_class,
931 procedure (NULL, NULL);
933 free (nr.split_values);
934 free (nr.factor_values);
936 fh_close_handle (mx->data_file);
939 /* Mirror data across the diagonal of matrix CP which contains
940 CONTENT type data. */
942 fill_matrix (struct matrix_data_pgm *mx, int content, double *cp)
944 int type = content_type[content];
946 if (type == 1 && mx->section != FULL)
948 if (mx->diag == NODIAGONAL)
950 const double fill = content == CORR ? 1.0 : SYSMIS;
953 for (i = 0; i < mx->n_continuous; i++)
954 cp[i * (1 + mx->n_continuous)] = fill;
960 if (mx->section == LOWER)
962 int n_lines = mx->n_continuous;
963 if (mx->section != FULL && mx->diag == NODIAGONAL)
966 for (r = 1; r < n_lines; r++)
967 for (c = 0; c < r; c++)
968 cp[r + c * mx->n_continuous] = cp[c + r * mx->n_continuous];
972 assert (mx->section == UPPER);
973 for (r = 1; r < mx->n_continuous; r++)
974 for (c = 0; c < r; c++)
975 cp[c + r * mx->n_continuous] = cp[r + c * mx->n_continuous];
983 for (c = 1; c < mx->n_continuous; c++)
988 /* Read data lines for content type CONTENT from the data file.
989 If PER_FACTOR is nonzero, then factor information is read from
990 the data file. Data is for cell number CELL. */
992 nr_read_data_lines (struct nr_aux_data *nr,
993 int per_factor, int cell, int content, int compare)
995 struct matrix_data_pgm *mx = nr->mx;
996 const int type = content_type[content]; /* Content type. */
997 int n_lines; /* Number of lines to parse from data file for this type. */
998 double *cp; /* Current position in vector or matrix. */
1005 n_lines = mx->n_continuous;
1006 if (mx->section != FULL && mx->diag == NODIAGONAL)
1010 cp = nr->data[content][cell];
1011 if (type == 1 && mx->section == LOWER && mx->diag == NODIAGONAL)
1012 cp += mx->n_continuous;
1014 for (i = 0; i < n_lines; i++)
1018 if (!nr_read_splits (nr, 1))
1020 if (per_factor && !nr_read_factors (nr, cell))
1027 n_cols = mx->n_continuous;
1030 switch (mx->section)
1037 n_cols = mx->n_continuous - i;
1038 if (mx->diag == NODIAGONAL)
1045 n_cols = mx->n_continuous;
1063 for (j = 0; j < n_cols; j++)
1065 struct matrix_token token;
1066 if (!mget_token (&token, mx->data_file))
1068 if (token.type != MNUM)
1070 msg (SE, _("expecting value for %s %s"),
1071 dict_get_var (default_dict, j)->name,
1072 context (mx->data_file));
1076 *cp++ = token.number;
1079 && !force_eol (mx->data_file, content_names[content]))
1081 debug_printf (("\n"));
1084 if (mx->section == LOWER)
1085 cp += mx->n_continuous - n_cols;
1088 fill_matrix (mx, content, nr->data[content][cell]);
1093 /* When ROWTYPE_ does not appear in the data, reads the matrices and
1094 writes them to the output file. Returns success. */
1096 matrix_data_read_without_rowtype (struct case_source *source,
1098 write_case_func *write_case,
1099 write_case_data wc_data)
1101 struct nr_aux_data *nr = source->aux;
1102 struct matrix_data_pgm *mx = nr->mx;
1107 nr->data = pool_alloc (mx->container, (PROX + 1) * sizeof *nr->data);
1112 for (i = 0; i <= PROX; i++)
1116 for (cp = mx->contents; *cp != EOC; cp++)
1117 if (*cp != LPAREN && *cp != RPAREN)
1119 int per_factor = mx->is_per_factor[*cp];
1122 n_entries = mx->n_continuous;
1123 if (content_type[*cp] == 1)
1124 n_entries *= mx->n_continuous;
1127 int n_vectors = per_factor ? mx->cells : 1;
1130 nr->data[*cp] = pool_alloc (mx->container,
1131 n_vectors * sizeof **nr->data);
1133 for (i = 0; i < n_vectors; i++)
1134 nr->data[*cp][i] = pool_alloc (mx->container,
1135 n_entries * sizeof ***nr->data);
1144 if (!nr_read_splits (nr, 0))
1147 for (bp = mx->contents; *bp != EOC; bp = np)
1151 /* Trap the CONTENTS that we should parse in this pass
1152 between bp and ep. Set np to the starting bp for next
1157 while (*ep != RPAREN)
1165 while (*ep != EOC && *ep != LPAREN)
1174 for (i = 0; i < (per_factor ? mx->cells : 1); i++)
1178 for (cp = bp; cp < ep; cp++)
1179 if (!nr_read_data_lines (nr, per_factor, i, *cp, cp != bp))
1185 nr_output_data (nr, c, write_case, wc_data);
1187 if (dict_get_split_cnt (default_dict) == 0
1188 || !another_token (mx->data_file))
1193 /* Read the split file variables. If COMPARE is 1, compares the
1194 values read to the last values read and returns 1 if they're equal,
1197 nr_read_splits (struct nr_aux_data *nr, int compare)
1199 struct matrix_data_pgm *mx = nr->mx;
1200 static int just_read = 0; /* FIXME: WTF? */
1204 if (compare && just_read)
1210 if (dict_get_split_vars (default_dict) == NULL)
1213 if (mx->single_split)
1217 = ++dict_get_split_vars (default_dict)[0]->p.mxd.subtype;
1224 split_cnt = dict_get_split_cnt (default_dict);
1225 for (i = 0; i < split_cnt; i++)
1227 struct matrix_token token;
1228 if (!mget_token (&token, mx->data_file))
1230 if (token.type != MNUM)
1232 msg (SE, _("Syntax error expecting SPLIT FILE value %s."),
1233 context (mx->data_file));
1238 nr->split_values[i] = token.number;
1239 else if (nr->split_values[i] != token.number)
1241 msg (SE, _("Expecting value %g for %s."),
1242 nr->split_values[i],
1243 dict_get_split_vars (default_dict)[i]->name);
1251 /* Read the factors for cell CELL. If COMPARE is 1, compares the
1252 values read to the last values read and returns 1 if they're equal,
1255 nr_read_factors (struct nr_aux_data *nr, int cell)
1257 struct matrix_data_pgm *mx = nr->mx;
1260 if (mx->n_factors == 0)
1263 assert (nr->max_cell_idx >= cell);
1264 if (cell != nr->max_cell_idx)
1275 for (i = 0; i < mx->n_factors; i++)
1277 struct matrix_token token;
1278 if (!mget_token (&token, mx->data_file))
1280 if (token.type != MNUM)
1282 msg (SE, _("Syntax error expecting factor value %s."),
1283 context (mx->data_file));
1288 nr->factor_values[i + mx->n_factors * cell] = token.number;
1289 else if (nr->factor_values[i + mx->n_factors * cell] != token.number)
1291 msg (SE, _("Syntax error expecting value %g for %s %s."),
1292 nr->factor_values[i + mx->n_factors * cell],
1293 mx->factors[i]->name, context (mx->data_file));
1302 /* Write the contents of a cell having content type CONTENT and data
1303 CP to the active file. */
1305 dump_cell_content (struct matrix_data_pgm *mx, int content, double *cp,
1307 write_case_func *write_case, write_case_data wc_data)
1309 int type = content_type[content];
1312 st_bare_pad_copy (case_data_rw (c, mx->rowtype_->fv)->s,
1313 content_names[content], 8);
1316 memset (case_data_rw (c, mx->varname_->fv)->s, ' ', 8);
1320 int n_lines = (type == 1) ? mx->n_continuous : 1;
1323 for (i = 0; i < n_lines; i++)
1327 for (j = 0; j < mx->n_continuous; j++)
1329 int fv = dict_get_var (default_dict, mx->first_continuous + j)->fv;
1330 case_data_rw (c, fv)->f = *cp;
1334 st_bare_pad_copy (case_data_rw (c, mx->varname_->fv)->s,
1335 dict_get_var (default_dict,
1336 mx->first_continuous + i)->name,
1338 write_case (wc_data);
1343 /* Finally dump out everything from nr_data[] to the output file. */
1345 nr_output_data (struct nr_aux_data *nr, struct ccase *c,
1346 write_case_func *write_case, write_case_data wc_data)
1348 struct matrix_data_pgm *mx = nr->mx;
1351 struct variable *const *split;
1355 split_cnt = dict_get_split_cnt (default_dict);
1356 split = dict_get_split_vars (default_dict);
1357 for (i = 0; i < split_cnt; i++)
1358 case_data_rw (c, split[i]->fv)->f = nr->split_values[i];
1365 for (cell = 0; cell < mx->cells; cell++)
1370 for (factor = 0; factor < mx->n_factors; factor++)
1372 case_data_rw (c, mx->factors[factor]->fv)->f
1373 = nr->factor_values[factor + cell * mx->n_factors];
1374 debug_printf (("f:%s ", mx->factors[factor]->name));
1381 for (content = 0; content <= PROX; content++)
1382 if (mx->is_per_factor[content])
1384 assert (nr->data[content] != NULL
1385 && nr->data[content][cell] != NULL);
1387 dump_cell_content (mx, content, nr->data[content][cell],
1388 c, write_case, wc_data);
1400 for (factor = 0; factor < mx->n_factors; factor++)
1401 case_data_rw (c, mx->factors[factor]->fv)->f = SYSMIS;
1404 for (content = 0; content <= PROX; content++)
1405 if (!mx->is_per_factor[content] && nr->data[content] != NULL)
1406 dump_cell_content (mx, content, nr->data[content][0],
1407 c, write_case, wc_data);
1411 /* Back end, with ROWTYPE_. */
1413 /* All the data for one set of factor values. */
1417 int n_rows[PROX + 1];
1418 double *data[PROX + 1];
1419 struct factor_data *next;
1422 /* With ROWTYPE_ auxiliary data. */
1425 struct matrix_data_pgm *mx; /* MATRIX DATA program. */
1426 int content; /* Type of current row. */
1427 double *split_values; /* SPLIT FILE variable values. */
1428 struct factor_data *data; /* All the data. */
1429 struct factor_data *current; /* Current factor. */
1432 static int wr_read_splits (struct wr_aux_data *, struct ccase *,
1433 write_case_func *, write_case_data);
1434 static int wr_output_data (struct wr_aux_data *, struct ccase *,
1435 write_case_func *, write_case_data);
1436 static int wr_read_rowtype (struct wr_aux_data *,
1437 const struct matrix_token *, struct file_handle *);
1438 static int wr_read_factors (struct wr_aux_data *);
1439 static int wr_read_indeps (struct wr_aux_data *);
1440 static void matrix_data_read_with_rowtype (struct case_source *,
1445 /* When ROWTYPE_ appears in the data, reads the matrices and writes
1446 them to the output file. */
1448 read_matrices_with_rowtype (struct matrix_data_pgm *mx)
1450 struct wr_aux_data wr;
1454 wr.split_values = NULL;
1459 vfm_source = create_case_source (&matrix_data_with_rowtype_source_class,
1461 procedure (NULL, NULL);
1463 free (wr.split_values);
1464 fh_close_handle (mx->data_file);
1467 /* Read from the data file and write it to the active file. */
1469 matrix_data_read_with_rowtype (struct case_source *source,
1471 write_case_func *write_case,
1472 write_case_data wc_data)
1474 struct wr_aux_data *wr = source->aux;
1475 struct matrix_data_pgm *mx = wr->mx;
1479 if (!wr_read_splits (wr, c, write_case, wc_data))
1482 if (!wr_read_factors (wr))
1485 if (!wr_read_indeps (wr))
1488 while (another_token (mx->data_file));
1490 wr_output_data (wr, c, write_case, wc_data);
1493 /* Read the split file variables. If they differ from the previous
1494 set of split variables then output the data. Returns success. */
1496 wr_read_splits (struct wr_aux_data *wr,
1498 write_case_func *write_case, write_case_data wc_data)
1500 struct matrix_data_pgm *mx = wr->mx;
1504 split_cnt = dict_get_split_cnt (default_dict);
1508 if (wr->split_values)
1513 wr->split_values = xmalloc (split_cnt * sizeof *wr->split_values);
1520 for (i = 0; i < split_cnt; i++)
1522 struct matrix_token token;
1523 if (!mget_token (&token, mx->data_file))
1525 if (token.type != MNUM)
1527 msg (SE, _("Syntax error %s expecting SPLIT FILE value."),
1528 context (mx->data_file));
1532 if (compare && wr->split_values[i] != token.number && !different)
1534 if (!wr_output_data (wr, c, write_case, wc_data))
1539 wr->split_values[i] = token.number;
1546 /* Compares doubles A and B, treating SYSMIS as greatest. */
1548 compare_doubles (const void *a_, const void *b_, void *aux UNUSED)
1550 const double *a = a_;
1551 const double *b = b_;
1555 else if (*a == SYSMIS)
1557 else if (*b == SYSMIS)
1565 /* Return strcmp()-type comparison of the MX->n_factors factors at _A and
1566 _B. Sort missing values toward the end. */
1568 compare_factors (const void *a_, const void *b_, void *mx_)
1570 struct matrix_data_pgm *mx = mx_;
1571 struct factor_data *const *pa = a_;
1572 struct factor_data *const *pb = b_;
1573 const double *a = (*pa)->factors;
1574 const double *b = (*pb)->factors;
1576 return lexicographical_compare_3way (a, mx->n_factors,
1579 compare_doubles, NULL);
1582 /* Write out the data for the current split file to the active
1585 wr_output_data (struct wr_aux_data *wr,
1587 write_case_func *write_case, write_case_data wc_data)
1589 struct matrix_data_pgm *mx = wr->mx;
1592 struct variable *const *split;
1596 split_cnt = dict_get_split_cnt (default_dict);
1597 split = dict_get_split_vars (default_dict);
1598 for (i = 0; i < split_cnt; i++)
1599 case_data_rw (c, split[i]->fv)->f = wr->split_values[i];
1602 /* Sort the wr->data list. */
1604 struct factor_data **factors;
1605 struct factor_data *iter;
1608 factors = xmalloc (sizeof *factors * mx->cells);
1610 for (i = 0, iter = wr->data; iter; iter = iter->next, i++)
1613 sort (factors, mx->cells, sizeof *factors, compare_factors, mx);
1615 wr->data = factors[0];
1616 for (i = 0; i < mx->cells - 1; i++)
1617 factors[i]->next = factors[i + 1];
1618 factors[mx->cells - 1]->next = NULL;
1623 /* Write out records for every set of factor values. */
1625 struct factor_data *iter;
1627 for (iter = wr->data; iter; iter = iter->next)
1632 for (factor = 0; factor < mx->n_factors; factor++)
1634 case_data_rw (c, mx->factors[factor]->fv)->f
1635 = iter->factors[factor];
1636 debug_printf (("f:%s ", factors[factor]->name));
1643 for (content = 0; content <= PROX; content++)
1645 if (!iter->n_rows[content])
1649 int type = content_type[content];
1650 int n_lines = (type == 1
1652 - (mx->section != FULL && mx->diag == NODIAGONAL))
1655 if (n_lines != iter->n_rows[content])
1657 msg (SE, _("Expected %d lines of data for %s content; "
1658 "actually saw %d lines. No data will be "
1659 "output for this content."),
1660 n_lines, content_names[content],
1661 iter->n_rows[content]);
1666 fill_matrix (mx, content, iter->data[content]);
1668 dump_cell_content (mx, content, iter->data[content],
1669 c, write_case, wc_data);
1675 pool_destroy (mx->container);
1676 mx->container = pool_create ();
1678 wr->data = wr->current = NULL;
1683 /* Sets ROWTYPE_ based on the given TOKEN read from DATA_FILE.
1686 wr_read_rowtype (struct wr_aux_data *wr,
1687 const struct matrix_token *token,
1688 struct file_handle *data_file)
1690 if (wr->content != -1)
1692 msg (SE, _("Multiply specified ROWTYPE_ %s."), context (data_file));
1695 if (token->type != MSTR)
1697 msg (SE, _("Syntax error %s expecting ROWTYPE_ string."),
1698 context (data_file));
1706 memcpy (s, token->string, min (15, token->length));
1707 s[min (15, token->length)] = 0;
1709 for (cp = s; *cp; cp++)
1710 *cp = toupper ((unsigned char) *cp);
1712 wr->content = string_to_content_type (s, NULL);
1715 if (wr->content == -1)
1717 msg (SE, _("Syntax error %s."), context (data_file));
1724 /* Read the factors for the current row. Select a set of factors and
1725 point wr_current to it. */
1727 wr_read_factors (struct wr_aux_data *wr)
1729 struct matrix_data_pgm *mx = wr->mx;
1730 double *factor_values = local_alloc (sizeof *factor_values * mx->n_factors);
1736 for (i = 0; i < mx->n_factors; i++)
1738 struct matrix_token token;
1739 if (!mget_token (&token, mx->data_file))
1741 if (token.type == MSTR)
1743 if (!wr_read_rowtype (wr, &token, mx->data_file))
1745 if (!mget_token (&token, mx->data_file))
1748 if (token.type != MNUM)
1750 msg (SE, _("Syntax error expecting factor value %s."),
1751 context (mx->data_file));
1755 factor_values[i] = token.number;
1758 if (wr->content == -1)
1760 struct matrix_token token;
1761 if (!mget_token (&token, mx->data_file))
1763 if (!wr_read_rowtype (wr, &token, mx->data_file))
1767 /* Try the most recent factor first as a simple caching
1773 for (i = 0; i < mx->n_factors; i++)
1774 if (factor_values[i] != wr->current->factors[i])
1779 /* Linear search through the list. */
1782 struct factor_data *iter;
1784 for (iter = wr->data; iter; iter = iter->next)
1788 for (i = 0; i < mx->n_factors; i++)
1789 if (factor_values[i] != iter->factors[i])
1799 /* Not found. Make a new item. */
1801 struct factor_data *new = pool_alloc (mx->container, sizeof *new);
1803 new->factors = pool_alloc (mx->container, sizeof *new->factors * mx->n_factors);
1808 for (i = 0; i < mx->n_factors; i++)
1809 new->factors[i] = factor_values[i];
1815 for (i = 0; i <= PROX; i++)
1818 new->data[i] = NULL;
1822 new->next = wr->data;
1823 wr->data = wr->current = new;
1828 local_free (factor_values);
1832 local_free (factor_values);
1836 /* Read the independent variables into wr->current. */
1838 wr_read_indeps (struct wr_aux_data *wr)
1840 struct matrix_data_pgm *mx = wr->mx;
1841 struct factor_data *c = wr->current;
1842 const int type = content_type[wr->content];
1843 const int n_rows = c->n_rows[wr->content];
1847 /* Allocate room for data if necessary. */
1848 if (c->data[wr->content] == NULL)
1850 int n_items = mx->n_continuous;
1852 n_items *= mx->n_continuous;
1854 c->data[wr->content] = pool_alloc (mx->container,
1855 sizeof **c->data * n_items);
1858 cp = &c->data[wr->content][n_rows * mx->n_continuous];
1860 /* Figure out how much to read from this line. */
1867 msg (SE, _("Duplicate specification for %s."),
1868 content_names[wr->content]);
1872 n_cols = mx->n_continuous;
1877 if (n_rows >= mx->n_continuous - (mx->section != FULL && mx->diag == NODIAGONAL))
1879 msg (SE, _("Too many rows of matrix data for %s."),
1880 content_names[wr->content]);
1884 switch (mx->section)
1887 n_cols = n_rows + 1;
1888 if (mx->diag == NODIAGONAL)
1889 cp += mx->n_continuous;
1893 n_cols = mx->n_continuous - n_rows;
1894 if (mx->diag == NODIAGONAL)
1901 n_cols = mx->n_continuous;
1912 c->n_rows[wr->content]++;
1914 debug_printf ((" (c=%p,r=%d,n=%d)", c, n_rows + 1, n_cols));
1916 /* Read N_COLS items at CP. */
1920 for (j = 0; j < n_cols; j++)
1922 struct matrix_token token;
1923 if (!mget_token (&token, mx->data_file))
1925 if (token.type != MNUM)
1927 msg (SE, _("Syntax error expecting value for %s %s."),
1928 dict_get_var (default_dict, mx->first_continuous + j)->name,
1929 context (mx->data_file));
1933 *cp++ = token.number;
1936 && !force_eol (mx->data_file, content_names[wr->content]))
1938 debug_printf (("\n"));
1944 /* Matrix source. */
1946 static const struct case_source_class matrix_data_with_rowtype_source_class =
1950 matrix_data_read_with_rowtype,
1954 static const struct case_source_class
1955 matrix_data_without_rowtype_source_class =
1959 matrix_data_read_without_rowtype,