MATRIX DATA: Allow non-symetric matrices if /FORMAT = FULL.
[pspp] / src / language / data-io / matrix-data.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 2017 Free Software Foundation, Inc.
3
4    This program is free software: you can redistribute it and/or modify
5    it under the terms of the GNU General Public License as published by
6    the Free Software Foundation, either version 3 of the License, or
7    (at your option) any later version.
8
9    This program is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12    GNU General Public License for more details.
13
14    You should have received a copy of the GNU General Public License
15    along with this program.  If not, see <http://www.gnu.org/licenses/>. */
16
17 #include <config.h>
18
19 #include "data/case.h"
20 #include "data/casereader.h"
21 #include "data/casewriter.h"
22 #include "data/dataset.h"
23 #include "data/dictionary.h"
24 #include "data/format.h"
25 #include "data/transformations.h"
26 #include "data/variable.h"
27 #include "language/command.h"
28 #include "language/data-io/data-parser.h"
29 #include "language/data-io/data-reader.h"
30 #include "language/data-io/file-handle.h"
31 #include "language/data-io/inpt-pgm.h"
32 #include "language/data-io/placement-parser.h"
33 #include "language/lexer/lexer.h"
34 #include "language/lexer/variable-parser.h"
35 #include "libpspp/i18n.h"
36 #include "libpspp/message.h"
37 #include "libpspp/misc.h"
38
39 #include "gl/xsize.h"
40 #include "gl/xalloc.h"
41
42 #include "gettext.h"
43 #define _(msgid) gettext (msgid)
44 \f
45 /* DATA LIST transformation data. */
46 struct data_list_trns
47   {
48     struct data_parser *parser; /* Parser. */
49     struct dfm_reader *reader;  /* Data file reader. */
50     struct variable *end;       /* Variable specified on END subcommand. */
51   };
52
53 static trns_free_func data_list_trns_free;
54 static trns_proc_func data_list_trns_proc;
55
56 enum diagonal
57   {
58     DIAGONAL,
59     NO_DIAGONAL
60   };
61
62 enum triangle
63   {
64     LOWER,
65     UPPER,
66     FULL
67   };
68
69 static const int ROWTYPE_WIDTH = 8;
70
71 struct matrix_format
72 {
73   enum triangle triangle;
74   enum diagonal diagonal;
75   const struct variable *rowtype;
76   const struct variable *varname;
77   int n_continuous_vars;
78   struct variable **split_vars;
79   size_t n_split_vars;
80 };
81
82 /*
83 valid rowtype_ values:
84   CORR,
85   COV,
86   MAT,
87
88
89   MSE,
90   DFE,
91   MEAN,
92   STDDEV (or SD),
93   N_VECTOR (or N),
94   N_SCALAR,
95   N_MATRIX,
96   COUNT,
97   PROX.
98 */
99
100 /* Sets the value of OUTCASE which corresponds to VNAME
101    to the value STR.  VNAME must be of type string.
102  */
103 static void
104 set_varname_column (struct ccase *outcase, const struct variable *vname,
105      const char *str)
106 {
107   int len = var_get_width (vname);
108   uint8_t *s = value_str_rw (case_data_rw (outcase, vname), len);
109
110   strncpy ((char *) s, str, len);
111 }
112
113 static void
114 blank_varname_column (struct ccase *outcase, const struct variable *vname)
115 {
116   int len = var_get_width (vname);
117   uint8_t *s = value_str_rw (case_data_rw (outcase, vname), len);
118
119   memset (s, ' ', len);
120 }
121
122 static struct casereader *
123 preprocess (struct casereader *casereader0, const struct dictionary *dict, void *aux)
124 {
125   struct matrix_format *mformat = aux;
126   const struct caseproto *proto = casereader_get_proto (casereader0);
127   struct casewriter *writer;
128   writer = autopaging_writer_create (proto);
129
130   double **matrices = NULL;
131   size_t n_splits = 0;
132
133   const size_t sizeof_matrix =
134     sizeof (double) * mformat->n_continuous_vars * mformat->n_continuous_vars;
135
136
137   /* Make an initial pass to populate our temporary matrix */
138   struct casereader *pass0 = casereader_clone (casereader0);
139   struct ccase *c;
140   unsigned int prev_split_hash = 1;
141   int row = (mformat->triangle == LOWER && mformat->diagonal == NO_DIAGONAL) ? 1 : 0;
142   for (; (c = casereader_read (pass0)) != NULL; case_unref (c))
143     {
144       int s;
145       unsigned int split_hash = 0;
146       for (s = 0; s < mformat->n_split_vars; ++s)
147         {
148           const struct variable *svar = mformat->split_vars[s];
149           const union value *sv = case_data (c, svar);
150           split_hash = value_hash (sv, var_get_width (svar), split_hash);
151         }
152
153       if (matrices == NULL || prev_split_hash != split_hash)
154         {
155           row = (mformat->triangle == LOWER && mformat->diagonal == NO_DIAGONAL) ?
156             1 : 0;
157
158           n_splits++;
159           matrices = xrealloc (matrices, sizeof (double*)  * n_splits);
160           matrices[n_splits - 1] = xmalloc (sizeof_matrix);
161         }
162
163       prev_split_hash = split_hash;
164
165       int c_offset = (mformat->triangle == UPPER) ? row : 0;
166       if (mformat->triangle == UPPER && mformat->diagonal == NO_DIAGONAL)
167         c_offset++;
168       const union value *v = case_data (c, mformat->rowtype);
169       const char *val = (const char *) value_str (v, ROWTYPE_WIDTH);
170       if (0 == strncasecmp (val, "corr    ", ROWTYPE_WIDTH) ||
171           0 == strncasecmp (val, "cov     ", ROWTYPE_WIDTH))
172         {
173           int col;
174           for (col = c_offset; col < mformat->n_continuous_vars; ++col)
175             {
176               const struct variable *var =
177                 dict_get_var (dict,
178                               1 + col - c_offset +
179                               var_get_dict_index (mformat->varname));
180
181               double e = case_data (c, var)->f;
182               if (e == SYSMIS)
183                 continue;
184
185               /* Fill in the lower triangle */
186               (matrices[n_splits-1])[col + mformat->n_continuous_vars * row] = e;
187
188               if (mformat->triangle != FULL)
189                 /* Fill in the upper triangle */
190                 (matrices[n_splits-1]) [row + mformat->n_continuous_vars * col] = e;
191             }
192           row++;
193         }
194     }
195   casereader_destroy (pass0);
196
197   /* Now make a second pass to fill in the other triangle from our
198      temporary matrix */
199   const int idx = var_get_dict_index (mformat->varname);
200   row = 0;
201   struct ccase *prev_case = NULL;
202   prev_split_hash = 1;
203   n_splits = 0;
204   for (; (c = casereader_read (casereader0)) != NULL; prev_case = c)
205     {
206       int s;
207       unsigned int split_hash = 0;
208       for (s = 0; s < mformat->n_split_vars; ++s)
209         {
210           const struct variable *svar = mformat->split_vars[s];
211           const union value *sv = case_data (c, svar);
212           split_hash = value_hash (sv, var_get_width (svar), split_hash);
213         }
214       if (prev_split_hash != split_hash)
215         {
216           n_splits++;
217           row = 0;
218         }
219
220       prev_split_hash = split_hash;
221
222       case_unref (prev_case);
223       struct ccase *outcase = case_create (proto);
224       case_copy (outcase, 0, c, 0, caseproto_get_n_widths (proto));
225       const union value *v = case_data (c, mformat->rowtype);
226       const char *val = (const char *) value_str (v, ROWTYPE_WIDTH);
227       if (0 == strncasecmp (val, "corr    ", ROWTYPE_WIDTH) ||
228           0 == strncasecmp (val, "cov     ", ROWTYPE_WIDTH))
229         {
230           int col;
231           const struct variable *var = dict_get_var (dict, idx + 1 + row);
232           set_varname_column (outcase, mformat->varname, var_get_name (var));
233           value_copy (case_data_rw (outcase, mformat->rowtype), v, ROWTYPE_WIDTH);
234
235           for (col = 0; col < mformat->n_continuous_vars; ++col)
236             {
237               union value *dest_val =
238                 case_data_rw_idx (outcase,
239                                   1 + col + var_get_dict_index (mformat->varname));
240               dest_val->f = (matrices[n_splits - 1])[col + mformat->n_continuous_vars * row];
241               if (col == row && mformat->diagonal == NO_DIAGONAL)
242                 dest_val->f = 1.0;
243             }
244           row++;
245         }
246       else
247         {
248           blank_varname_column (outcase, mformat->varname);
249         }
250
251       /* Special case for SD and N_VECTOR: Rewrite as STDDEV and N respectively */
252       if (0 == strncasecmp (val, "sd      ", ROWTYPE_WIDTH))
253         {
254           value_copy_buf_rpad (case_data_rw (outcase, mformat->rowtype), ROWTYPE_WIDTH,
255                                (uint8_t *) "STDDEV", 6, ' ');
256         }
257       else if (0 == strncasecmp (val, "n_vector", ROWTYPE_WIDTH))
258         {
259           value_copy_buf_rpad (case_data_rw (outcase, mformat->rowtype), ROWTYPE_WIDTH,
260                                (uint8_t *) "N", 1, ' ');
261         }
262
263       casewriter_write (writer, outcase);
264     }
265
266   /* If NODIAGONAL is specified, then a final case must be written */
267   if (mformat->diagonal == NO_DIAGONAL)
268     {
269       int col;
270       struct ccase *outcase = case_create (proto);
271
272       if (prev_case)
273         case_copy (outcase, 0, prev_case, 0, caseproto_get_n_widths (proto));
274
275       const struct variable *var = dict_get_var (dict, idx + 1 + row);
276       set_varname_column (outcase, mformat->varname, var_get_name (var));
277
278       for (col = 0; col < mformat->n_continuous_vars; ++col)
279         {
280           union value *dest_val =
281             case_data_rw_idx (outcase, 1 + col +
282                               var_get_dict_index (mformat->varname));
283           dest_val->f = (matrices[n_splits - 1]) [col + mformat->n_continuous_vars * row];
284           if (col == row && mformat->diagonal == NO_DIAGONAL)
285             dest_val->f = 1.0;
286         }
287
288       casewriter_write (writer, outcase);
289     }
290
291   if (prev_case)
292     case_unref (prev_case);
293
294   int i;
295   for (i = 0 ; i < n_splits; ++i)
296     free (matrices[i]);
297   free (matrices);
298   struct casereader *reader1 = casewriter_make_reader (writer);
299   casereader_destroy (casereader0);
300   return reader1;
301 }
302
303 int
304 cmd_matrix (struct lexer *lexer, struct dataset *ds)
305 {
306   struct dictionary *dict;
307   struct data_parser *parser;
308   struct dfm_reader *reader;
309   struct file_handle *fh = NULL;
310   char *encoding = NULL;
311   struct matrix_format mformat;
312   int i;
313   size_t n_names;
314   char **names = NULL;
315
316   mformat.triangle = LOWER;
317   mformat.diagonal = DIAGONAL;
318   mformat.n_split_vars = 0;
319   mformat.split_vars = NULL;
320
321   dict = (in_input_program ()
322           ? dataset_dict (ds)
323           : dict_create (get_default_encoding ()));
324   parser = data_parser_create (dict);
325   reader = NULL;
326
327   data_parser_set_type (parser, DP_DELIMITED);
328   data_parser_set_warn_missing_fields (parser, false);
329   data_parser_set_span (parser, false);
330
331   mformat.rowtype = dict_create_var (dict, "ROWTYPE_", ROWTYPE_WIDTH);
332
333   mformat.n_continuous_vars = 0;
334   mformat.n_split_vars = 0;
335
336   if (! lex_force_match_id (lexer, "VARIABLES"))
337     goto error;
338
339   lex_match (lexer, T_EQUALS);
340
341   if (! parse_mixed_vars (lexer, dict, &names, &n_names, PV_NO_DUPLICATE))
342     {
343       int i;
344       for (i = 0; i < n_names; ++i)
345         free (names[i]);
346       free (names);
347       goto error;
348     }
349
350   int longest_name = 0;
351   for (i = 0; i < n_names; ++i)
352     {
353       maximize_int (&longest_name, strlen (names[i]));
354     }
355
356   mformat.varname = dict_create_var (dict, "VARNAME_",
357                                      8 * DIV_RND_UP (longest_name, 8));
358
359   for (i = 0; i < n_names; ++i)
360     {
361       if (0 == strcasecmp (names[i], "ROWTYPE_"))
362         {
363           const struct fmt_spec fmt = fmt_for_input (FMT_A, 8, 0);
364           data_parser_add_delimited_field (parser,
365                                            &fmt,
366                                            var_get_case_index (mformat.rowtype),
367                                            "ROWTYPE_");
368         }
369       else
370         {
371           const struct fmt_spec fmt = fmt_for_input (FMT_F, 10, 4);
372           struct variable *v = dict_create_var (dict, names[i], 0);
373           var_set_both_formats (v, &fmt);
374           data_parser_add_delimited_field (parser,
375                                            &fmt,
376                                            var_get_case_index (mformat.varname) +
377                                            ++mformat.n_continuous_vars,
378                                            names[i]);
379         }
380     }
381   for (i = 0; i < n_names; ++i)
382     free (names[i]);
383   free (names);
384
385   while (lex_token (lexer) != T_ENDCMD)
386     {
387       if (! lex_force_match (lexer, T_SLASH))
388         goto error;
389
390       if (lex_match_id (lexer, "FORMAT"))
391         {
392           lex_match (lexer, T_EQUALS);
393
394           while (lex_token (lexer) != T_SLASH && (lex_token (lexer) != T_ENDCMD))
395             {
396               if (lex_match_id (lexer, "LIST"))
397                 {
398                   data_parser_set_span (parser, false);
399                 }
400               else if (lex_match_id (lexer, "FREE"))
401                 {
402                   data_parser_set_span (parser, true);
403                 }
404               else if (lex_match_id (lexer, "UPPER"))
405                 {
406                   mformat.triangle = UPPER;
407                 }
408               else if (lex_match_id (lexer, "LOWER"))
409                 {
410                   mformat.triangle = LOWER;
411                 }
412               else if (lex_match_id (lexer, "FULL"))
413                 {
414                   mformat.triangle = FULL;
415                 }
416               else if (lex_match_id (lexer, "DIAGONAL"))
417                 {
418                   mformat.diagonal = DIAGONAL;
419                 }
420               else if (lex_match_id (lexer, "NODIAGONAL"))
421                 {
422                   mformat.diagonal = NO_DIAGONAL;
423                 }
424               else
425                 {
426                   lex_error (lexer, NULL);
427                   goto error;
428                 }
429             }
430         }
431       else if (lex_match_id (lexer, "FILE"))
432         {
433           lex_match (lexer, T_EQUALS);
434           fh_unref (fh);
435           fh = fh_parse (lexer, FH_REF_FILE | FH_REF_INLINE, NULL);
436           if (fh == NULL)
437             goto error;
438         }
439       else if (lex_match_id (lexer, "SPLIT"))
440         {
441           lex_match (lexer, T_EQUALS);
442           if (! parse_variables (lexer, dict, &mformat.split_vars, &mformat.n_split_vars, 0))
443             {
444               free (mformat.split_vars);
445               goto error;
446             }
447           int i;
448           for (i = 0; i < mformat.n_split_vars; ++i)
449             {
450               const struct fmt_spec fmt = fmt_for_input (FMT_F, 4, 0);
451               var_set_both_formats (mformat.split_vars[i], &fmt);
452             }
453           dict_reorder_vars (dict, mformat.split_vars, mformat.n_split_vars);
454           mformat.n_continuous_vars -= mformat.n_split_vars;
455         }
456       else
457         {
458           lex_error (lexer, NULL);
459           goto error;
460         }
461     }
462
463   if (mformat.diagonal == NO_DIAGONAL && mformat.triangle == FULL)
464     {
465       msg (SE, _("FORMAT = FULL and FORMAT = NODIAGONAL are mutually exclusive."));
466       goto error;
467     }
468
469   if (fh == NULL)
470     fh = fh_inline_file ();
471   fh_set_default_handle (fh);
472
473   if (!data_parser_any_fields (parser))
474     {
475       msg (SE, _("At least one variable must be specified."));
476       goto error;
477     }
478
479   if (lex_end_of_command (lexer) != CMD_SUCCESS)
480     goto error;
481
482   reader = dfm_open_reader (fh, lexer, encoding);
483   if (reader == NULL)
484     goto error;
485
486   if (in_input_program ())
487     {
488       struct data_list_trns *trns = xmalloc (sizeof *trns);
489       trns->parser = parser;
490       trns->reader = reader;
491       trns->end = NULL;
492       add_transformation (ds, data_list_trns_proc, data_list_trns_free, trns);
493     }
494   else
495     {
496       data_parser_make_active_file (parser, ds, reader, dict, preprocess, &mformat);
497     }
498
499   fh_unref (fh);
500   free (encoding);
501   free (mformat.split_vars);
502
503   return CMD_DATA_LIST;
504
505  error:
506   data_parser_destroy (parser);
507   if (!in_input_program ())
508     dict_destroy (dict);
509   fh_unref (fh);
510   free (encoding);
511   free (mformat.split_vars);
512   return CMD_CASCADING_FAILURE;
513 }
514
515 \f
516 /* Input procedure. */
517
518 /* Destroys DATA LIST transformation TRNS.
519    Returns true if successful, false if an I/O error occurred. */
520 static bool
521 data_list_trns_free (void *trns_)
522 {
523   struct data_list_trns *trns = trns_;
524   data_parser_destroy (trns->parser);
525   dfm_close_reader (trns->reader);
526   free (trns);
527   return true;
528 }
529
530 /* Handle DATA LIST transformation TRNS, parsing data into *C. */
531 static int
532 data_list_trns_proc (void *trns_, struct ccase **c, casenumber case_num UNUSED)
533 {
534   struct data_list_trns *trns = trns_;
535   int retval;
536
537   *c = case_unshare (*c);
538   if (data_parser_parse (trns->parser, trns->reader, *c))
539     retval = TRNS_CONTINUE;
540   else if (dfm_reader_error (trns->reader) || dfm_eof (trns->reader) > 1)
541     {
542       /* An I/O error, or encountering end of file for a second
543          time, should be escalated into a more serious error. */
544       retval = TRNS_ERROR;
545     }
546   else
547     retval = TRNS_END_FILE;
548
549   /* If there was an END subcommand handle it. */
550   if (trns->end != NULL)
551     {
552       double *end = &case_data_rw (*c, trns->end)->f;
553       if (retval == TRNS_END_FILE)
554         {
555           *end = 1.0;
556           retval = TRNS_CONTINUE;
557         }
558       else
559         *end = 0.0;
560     }
561
562   return retval;
563 }
564