T-TEST: Avoid NaN in paired-sample correlation significance calcuation.
[pspp-builds.git] / src / language / dictionary / vector.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-9, 2000 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 <stdlib.h>
20
21 #include <data/format.h>
22 #include <data/procedure.h>
23 #include <data/dictionary.h>
24 #include <data/variable.h>
25 #include <language/command.h>
26 #include <language/lexer/format-parser.h>
27 #include <language/lexer/lexer.h>
28 #include <language/lexer/variable-parser.h>
29 #include <libpspp/assertion.h>
30 #include <libpspp/message.h>
31 #include <libpspp/misc.h>
32 #include <libpspp/pool.h>
33 #include <libpspp/str.h>
34
35 #include "intprops.h"
36 #include "xalloc.h"
37
38 #include "gettext.h"
39 #define _(msgid) gettext (msgid)
40
41 int
42 cmd_vector (struct lexer *lexer, struct dataset *ds)
43 {
44   struct dictionary *dict = dataset_dict (ds);
45   struct pool *pool = pool_create ();
46
47   do
48     {
49       char **vectors;
50       size_t vector_cnt, vector_cap;
51
52       /* Get the name(s) of the new vector(s). */
53       if (!lex_force_id (lexer))
54         return CMD_CASCADING_FAILURE;
55
56       vectors = NULL;
57       vector_cnt = vector_cap = 0;
58       while (lex_token (lexer) == T_ID)
59         {
60           size_t i;
61
62           if (dict_lookup_vector (dict, lex_tokid (lexer)))
63             {
64               msg (SE, _("A vector named %s already exists."),
65                    lex_tokid (lexer));
66               goto fail;
67             }
68
69           for (i = 0; i < vector_cnt; i++)
70             if (!strcasecmp (vectors[i], lex_tokid (lexer)))
71               {
72                 msg (SE, _("Vector name %s is given twice."),
73                      lex_tokid (lexer));
74                 goto fail;
75               }
76
77           if (vector_cnt == vector_cap)
78             vectors = pool_2nrealloc (pool,
79                                        vectors, &vector_cap, sizeof *vectors);
80           vectors[vector_cnt++] = pool_strdup (pool, lex_tokid (lexer));
81
82           lex_get (lexer);
83           lex_match (lexer, ',');
84         }
85
86       /* Now that we have the names it's time to check for the short
87          or long forms. */
88       if (lex_match (lexer, '='))
89         {
90           /* Long form. */
91           struct variable **v;
92           size_t nv;
93
94           if (vector_cnt > 1)
95             {
96               msg (SE, _("A slash must separate each vector "
97                          "specification in VECTOR's long form."));
98               goto fail;
99             }
100
101           if (!parse_variables_pool (lexer, pool, dict, &v, &nv,
102                                      PV_SAME_WIDTH | PV_DUPLICATE))
103             goto fail;
104
105           dict_create_vector (dict, vectors[0], v, nv);
106         }
107       else if (lex_match (lexer, '('))
108         {
109           /* Short form. */
110           struct fmt_spec format;
111           bool seen_format = false;
112
113           struct variable **vars;
114           int var_cnt;
115
116           size_t i;
117
118           var_cnt = 0;
119           format = fmt_for_output (FMT_F, 8, 2);
120           seen_format = false;
121           while (!lex_match (lexer, ')'))
122             {
123               if (lex_is_integer (lexer) && var_cnt == 0)
124                 {
125                   var_cnt = lex_integer (lexer);
126                   lex_get (lexer);
127                   if (var_cnt <= 0)
128                     {
129                       msg (SE, _("Vectors must have at least one element."));
130                       goto fail;
131                     }
132                 }
133               else if (lex_token (lexer) == T_ID && !seen_format)
134                 {
135                   seen_format = true;
136                   if (!parse_format_specifier (lexer, &format)
137                       || !fmt_check_output (&format)
138                       || !fmt_check_type_compat (&format, VAL_NUMERIC))
139                     goto fail;
140                 }
141               else
142                 {
143                   lex_error (lexer, NULL);
144                   goto fail;
145                 }
146               lex_match (lexer, ',');
147             }
148           if (var_cnt == 0)
149             {
150               lex_error (lexer, _("expecting vector length"));
151               goto fail;
152             }
153
154           /* Check that none of the variables exist and that
155              their names are no more than VAR_NAME_LEN bytes
156              long. */
157           for (i = 0; i < vector_cnt; i++)
158             {
159               int j;
160               for (j = 0; j < var_cnt; j++)
161                 {
162                   char name[VAR_NAME_LEN + INT_STRLEN_BOUND (int) + 1];
163                   sprintf (name, "%s%d", vectors[i], j + 1);
164                   if (strlen (name) > VAR_NAME_LEN)
165                     {
166                       msg (SE, _("%s is too long for a variable name."), name);
167                       goto fail;
168                     }
169                   if (dict_lookup_var (dict, name))
170                     {
171                       msg (SE, _("%s is an existing variable name."), name);
172                       goto fail;
173                     }
174                 }
175             }
176
177           /* Finally create the variables and vectors. */
178           vars = pool_nmalloc (pool, var_cnt, sizeof *vars);
179           for (i = 0; i < vector_cnt; i++)
180             {
181               int j;
182               for (j = 0; j < var_cnt; j++)
183                 {
184                   char name[VAR_NAME_LEN + 1];
185                   sprintf (name, "%s%d", vectors[i], j + 1);
186                   vars[j] = dict_create_var_assert (dict, name, 0);
187                   var_set_both_formats (vars[j], &format);
188                 }
189               dict_create_vector_assert (dict, vectors[i], vars, var_cnt);
190             }
191         }
192       else
193         {
194           lex_error (lexer, NULL);
195           goto fail;
196         }
197     }
198   while (lex_match (lexer, '/'));
199
200   pool_destroy (pool);
201   return lex_end_of_command (lexer);
202
203 fail:
204   pool_destroy (pool);
205   return CMD_FAILURE;
206 }