categoricals: Improve comments.
[pspp] / src / math / categoricals.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 2009, 2010, 2011, 2012, 2014 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 "math/categoricals.h"
20 #include "math/interaction.h"
21
22 #include <float.h>
23 #include <stdio.h>
24
25 #include "data/case.h"
26 #include "data/value.h"
27 #include "data/variable.h"
28 #include "libpspp/array.h"
29 #include "libpspp/hmap.h"
30 #include "libpspp/pool.h"
31 #include "libpspp/str.h"
32 #include "libpspp/hash-functions.h"
33
34 #include "gl/xalloc.h"
35
36 #define CATEGORICALS_DEBUG 0
37
38 struct value_node
39 {
40   struct hmap_node node;      /* Node in hash map. */
41
42   union value val;            /* The value */
43
44   int index;                  /* A zero based unique index for this value */
45 };
46
47
48 struct interaction_value
49 {
50   struct hmap_node node;      /* Node in hash map */
51
52   struct ccase *ccase;        /* A case (probably the first in the dataset) which matches
53                                  this value */
54
55   double cc;                  /* Total of the weights of cases matching this interaction */
56
57   void *user_data;            /* A pointer to data which the caller can store stuff */
58 };
59
60 static struct value_node *
61 lookup_value (const struct hmap *map, const union value *val, unsigned int hash, int width)
62 {
63   struct value_node *vn = NULL;
64   HMAP_FOR_EACH_WITH_HASH (vn, struct value_node, node, hash, map)
65     {
66       if (value_equal (&vn->val, val, width))
67         break;
68     }
69
70   return vn;
71 }
72
73 struct variable_node
74 {
75   struct hmap_node node;      /* Node in hash map. */
76   const struct variable *var; /* The variable */
77
78   struct hmap valmap;         /* A map of value nodes */
79   int n_vals;                 /* Number of values for this variable */
80 };
81
82
83 /* Comparison function to sort value_nodes in ascending order */
84 static int
85 compare_value_node_3way (const void *vn1_, const void *vn2_, const void *aux)
86 {
87   const struct value_node *const *vn1p = vn1_;
88   const struct value_node *const *vn2p = vn2_;
89
90   const struct variable_node *vn = aux;
91
92
93   return value_compare_3way (&(*vn1p)->val, &(*vn2p)->val, var_get_width (vn->var));
94 }
95
96
97
98 static struct variable_node *
99 lookup_variable (const struct hmap *map, const struct variable *var, unsigned int hash)
100 {
101   struct variable_node *vn = NULL;
102   HMAP_FOR_EACH_WITH_HASH (vn, struct variable_node, node, hash, map)
103     {
104       if (vn->var == var)
105         break;
106
107       fprintf (stderr, "%s:%d Warning: Hash table collision\n", __FILE__, __LINE__);
108     }
109
110   return vn;
111 }
112
113
114 struct interact_params
115 {
116   /* An example of each interaction that appears in the data, like a frequency
117      table for 'iact'.  By construction, the number of elements must be less
118      than or equal to 'n_cats'.
119
120      categoricals_update() updates 'ivmap' case-by-case, then
121      categoricals_done() dumps 'ivmap' into 'reverse_interaction_value_map' and
122      sorts it. */
123   struct hmap ivmap;
124   struct interaction_value **reverse_interaction_value_map;
125
126   const struct interaction *iact;
127
128   int base_subscript_short;
129   int base_subscript_long;
130
131   /* Product of hmap_count(&varnodes[*]->valmap), that is, the maximum number
132      of distinct values of this interaction. */
133   int n_cats;
134
135   /* An array of integers df_n * df_{n-1} * df_{n-2} ...
136      These are the products of the degrees of freedom for the current
137      variable and all preceding variables */
138   int *df_prod;
139
140   double *enc_sum;
141
142   /* Sum of reverse_interaction_value_map[*]->cc. */
143   double cc;
144 };
145
146
147 /* Comparison function to sort the reverse_value_map in ascending order */
148 static int
149 compare_interaction_value_3way (const void *vn1_, const void *vn2_, const void *aux)
150 {
151   const struct interaction_value *const *vn1p = vn1_;
152   const struct interaction_value *const *vn2p = vn2_;
153
154   const struct interact_params *iap = aux;
155
156   return interaction_case_cmp_3way (iap->iact, (*vn1p)->ccase, (*vn2p)->ccase);
157 }
158
159 struct categoricals
160 {
161   /* The weight variable */
162   const struct variable *wv;
163
164   /* An array of interact_params */
165   struct interact_params *iap;
166   size_t n_iap;
167
168   /* Map whose members are the union of the variables which comprise IAP */
169   struct hmap varmap;
170
171   /* The number of categorical variables which contain entries.
172      In the absence of missing values, this will be equal to N_IAP */
173   size_t n_vars;
174
175   /* A map to enable the lookup of variables indexed by subscript.
176      This map considers only the N - 1 of the N variables.
177   */
178   int *reverse_variable_map_short; /* 'df_sum' elements. */
179   size_t df_sum;
180
181   /* Like the above, but uses all N variables */
182   int *reverse_variable_map_long; /* 'n_cats_total' elements. */
183   size_t n_cats_total;
184
185   struct pool *pool;
186
187   /* Missing values in the factor variables to be excluded */
188   enum mv_class fctr_excl;
189
190   const void *aux1;
191   void *aux2;
192
193   bool sane;
194
195   const struct payload *payload;
196 };
197
198
199 bool
200 categoricals_isbalanced (const struct categoricals *cat)
201 {
202   int i;
203
204   for (i = 0 ; i < cat->n_iap; ++i)
205     {
206       int v;
207       const struct interact_params *iap = &cat->iap[i];
208
209       double oval = -1.0;
210       for (v = 0; v < hmap_count (&iap->ivmap); ++v)
211         {
212           const struct interaction_value *iv = iap->reverse_interaction_value_map[v];
213           if (oval == -1.0)
214             oval = iv->cc;
215           if (oval != iv->cc)
216             return false;
217         }
218     }
219   return true;
220 }
221
222
223 static void
224 categoricals_dump (const struct categoricals *cat)
225 {
226   if (CATEGORICALS_DEBUG)
227     {
228       int i;
229
230       printf ("Reverse Variable Map (short):\n");
231       for (i = 0; i < cat->df_sum; ++i)
232         {
233           printf (" %d", cat->reverse_variable_map_short[i]);
234         }
235       printf ("\n");
236
237       printf ("Reverse Variable Map (long):\n");
238       for (i = 0; i < cat->n_cats_total; ++i)
239         {
240           printf (" %d", cat->reverse_variable_map_long[i]);
241         }
242       printf ("\n");
243
244       printf ("Number of interactions %zu\n", cat->n_iap);
245       for (i = 0 ; i < cat->n_iap; ++i)
246         {
247           int v;
248           struct string str;
249           const struct interact_params *iap = &cat->iap[i];
250           const struct interaction *iact = iap->iact;
251
252           ds_init_empty (&str);
253           interaction_to_string (iact, &str);
254
255           printf ("\nInteraction: \"%s\" (number of categories: %d); ", ds_cstr (&str), iap->n_cats);
256           ds_destroy (&str);
257           printf ("Base index (short/long): %d/%d\n", iap->base_subscript_short, iap->base_subscript_long);
258
259           printf ("\t(");
260           for (v = 0; v < hmap_count (&iap->ivmap); ++v)
261             {
262               int vv;
263               const struct interaction_value *iv = iap->reverse_interaction_value_map[v];
264
265               if (v > 0)  printf ("   ");
266               printf ("{");
267               for (vv = 0; vv < iact->n_vars; ++vv)
268                 {
269                   const struct variable *var = iact->vars[vv];
270                   const union value *val = case_data (iv->ccase, var);
271                   unsigned int varhash = hash_pointer (var, 0);
272                   struct variable_node *vn = lookup_variable (&cat->varmap, var, varhash);
273
274                   const int width = var_get_width (var);
275                   unsigned int valhash = value_hash (val, width, 0);
276                   struct value_node *valn = lookup_value (&vn->valmap, val, valhash, width);
277
278                   assert (vn->var == var);
279
280                   printf ("%.*g(%d)", DBL_DIG + 1, val->f, valn->index);
281                   if (vv < iact->n_vars - 1)
282                     printf (", ");
283                 }
284               printf ("}");
285             }
286           printf (")\n");
287         }
288     }
289 }
290
291 void
292 categoricals_destroy (struct categoricals *cat)
293 {
294   struct variable_node *vn = NULL;
295   int i;
296   if (NULL == cat)
297     return;
298
299   for (i = 0; i < cat->n_iap; ++i)
300     {
301       struct interaction_value *iv = NULL;
302       /* Interate over each interaction value, and unref any cases that we reffed */
303       HMAP_FOR_EACH (iv, struct interaction_value, node, &cat->iap[i].ivmap)
304         {
305           if (cat->payload && cat->payload->destroy)
306             cat->payload->destroy (cat->aux1, cat->aux2, iv->user_data);
307           case_unref (iv->ccase);
308         }
309
310       free (cat->iap[i].enc_sum);
311       free (cat->iap[i].df_prod);
312       hmap_destroy (&cat->iap[i].ivmap);
313     }
314
315   /* Interate over each variable and delete its value map */
316   HMAP_FOR_EACH (vn, struct variable_node, node, &cat->varmap)
317     {
318       hmap_destroy (&vn->valmap);
319     }
320
321   hmap_destroy (&cat->varmap);
322
323   pool_destroy (cat->pool);
324
325   free (cat);
326 }
327
328
329
330 static struct interaction_value *
331 lookup_case (const struct hmap *map, const struct interaction *iact, const struct ccase *c)
332 {
333   struct interaction_value *iv = NULL;
334   size_t hash = interaction_case_hash (iact, c, 0);
335
336   HMAP_FOR_EACH_WITH_HASH (iv, struct interaction_value, node, hash, map)
337     {
338       if (interaction_case_equal (iact, c, iv->ccase))
339         break;
340
341       fprintf (stderr, "Warning: Hash table collision\n");
342     }
343
344   return iv;
345 }
346
347 /* Returns true iff CAT is sane, that is, if it is complete and has at least
348    one value. */
349 bool
350 categoricals_sane (const struct categoricals *cat)
351 {
352   return cat->sane;
353 }
354
355 /* Creates and returns a new categoricals object whose variables come from the
356    N_INTER interactions objects in the array starting at INTER.  (The INTER
357    objects must outlive the categoricals object because it uses them
358    internally.)
359
360    FCTR_EXCL determines which cases are listwise ignored by
361    categoricals_update(). */
362 struct categoricals *
363 categoricals_create (struct interaction *const*inter, size_t n_inter,
364                      const struct variable *wv, enum mv_class fctr_excl)
365 {
366   size_t i;
367   struct categoricals *cat = xmalloc (sizeof *cat);
368
369   cat->n_iap = n_inter;
370   cat->wv = wv;
371   cat->n_cats_total = 0;
372   cat->n_vars = 0;
373   cat->reverse_variable_map_short = NULL;
374   cat->reverse_variable_map_long = NULL;
375   cat->pool = pool_create ();
376   cat->fctr_excl = fctr_excl;
377   cat->payload = NULL;
378   cat->aux2 = NULL;
379   cat->sane = false;
380
381   cat->iap = pool_calloc (cat->pool, cat->n_iap, sizeof *cat->iap);
382
383   hmap_init (&cat->varmap);
384   for (i = 0 ; i < cat->n_iap; ++i)
385     {
386       int v;
387       hmap_init (&cat->iap[i].ivmap);
388       cat->iap[i].iact = inter[i];
389       cat->iap[i].cc = 0.0;
390       for (v = 0; v < inter[i]->n_vars; ++v)
391         {
392           const struct variable *var = inter[i]->vars[v];
393           unsigned int hash = hash_pointer (var, 0);
394           struct variable_node *vn = lookup_variable (&cat->varmap, var, hash);
395           if (vn == NULL)
396             {
397               vn = pool_malloc (cat->pool, sizeof *vn);
398               vn->var = var;
399               vn->n_vals = 0;
400               hmap_init (&vn->valmap);
401
402               hmap_insert (&cat->varmap, &vn->node,  hash);
403             }
404         }
405     }
406
407   return cat;
408 }
409
410
411
412 void
413 categoricals_update (struct categoricals *cat, const struct ccase *c)
414 {
415   int i;
416   struct variable_node *vn = NULL;
417   double weight;
418
419   if (NULL == cat)
420     return;
421
422   weight = cat->wv ? case_data (c, cat->wv)->f : 1.0;
423   weight = var_force_valid_weight (cat->wv, weight, NULL);
424
425   assert (NULL == cat->reverse_variable_map_short);
426   assert (NULL == cat->reverse_variable_map_long);
427
428   /* Interate over each variable, and add the value of that variable
429      to the appropriate map, if it's not already present. */
430   HMAP_FOR_EACH (vn, struct variable_node, node, &cat->varmap)
431     {
432       const int width = var_get_width (vn->var);
433       const union value *val = case_data (c, vn->var);
434       unsigned int hash = value_hash (val, width, 0);
435
436       struct value_node *valn = lookup_value (&vn->valmap, val, hash, width);
437       if (valn == NULL)
438         {
439           valn = pool_malloc (cat->pool, sizeof *valn);
440           valn->index = -1;
441           vn->n_vals++;
442           value_init (&valn->val, width);
443           value_copy (&valn->val, val, width);
444           hmap_insert (&vn->valmap, &valn->node, hash);
445         }
446     }
447
448   for (i = 0 ; i < cat->n_iap; ++i)
449     {
450       const struct interaction *iact = cat->iap[i].iact;
451
452       size_t hash;
453       struct interaction_value *node;
454
455       if ( interaction_case_is_missing (iact, c, cat->fctr_excl))
456         continue;
457
458       hash = interaction_case_hash (iact, c, 0);
459       node = lookup_case (&cat->iap[i].ivmap, iact, c);
460
461       if ( NULL == node)
462         {
463           node = pool_malloc (cat->pool, sizeof *node);
464           node->ccase = case_ref (c);
465           node->cc = weight;
466
467           hmap_insert (&cat->iap[i].ivmap, &node->node, hash);
468
469           if (cat->payload)
470             {
471               node->user_data = cat->payload->create (cat->aux1, cat->aux2);
472             }
473         }
474       else
475         {
476           node->cc += weight;
477         }
478       cat->iap[i].cc += weight;
479
480       if (cat->payload)
481         {
482           cat->payload->update (cat->aux1, cat->aux2, node->user_data, c, weight);
483         }
484     }
485 }
486
487 /* Return the number of categories (distinct values) for interaction IDX in
488    CAT. */
489 size_t
490 categoricals_n_count (const struct categoricals *cat, size_t n)
491 {
492   return hmap_count (&cat->iap[n].ivmap);
493 }
494
495
496 /* Returns the number of degrees of freedom for interaction IDX within CAT. */
497 size_t
498 categoricals_df (const struct categoricals *cat, size_t n)
499 {
500   const struct interact_params *iap = &cat->iap[n];
501   return iap->df_prod[iap->iact->n_vars - 1];
502 }
503
504
505 /* Return the total number of categories across all interactions in CAT. */
506 size_t
507 categoricals_n_total (const struct categoricals *cat)
508 {
509   if (!categoricals_is_complete (cat))
510     return 0;
511
512   return cat->n_cats_total;
513 }
514
515 /* Returns the total degrees of freedom for CAT. */
516 size_t
517 categoricals_df_total (const struct categoricals *cat)
518 {
519   if (NULL == cat)
520     return 0;
521
522   return cat->df_sum;
523 }
524
525 /* Returns true iff categoricals_done() has been called for CAT. */
526 bool
527 categoricals_is_complete (const struct categoricals *cat)
528 {
529   return (NULL != cat->reverse_variable_map_short);
530 }
531
532
533 /* This function must be called (once) before any call to the *_by_subscript or
534   *_by_category functions, but AFTER any calls to categoricals_update.  If this
535   function returns false, then no calls to _by_subscript or *_by_category are
536   allowed. */
537 void
538 categoricals_done (const struct categoricals *cat_)
539 {
540   /* Implementation Note: Whilst this function is O(n) in cat->n_cats_total, in most
541      uses it will be more efficient that using a tree based structure, since it
542      is called only once, and means that subsequent lookups will be O(1).
543
544      1 call of O(n) + 10^9 calls of O(1) is better than 10^9 calls of O(log n).
545   */
546   struct categoricals *cat = CONST_CAST (struct categoricals *, cat_);
547   int v;
548   int i;
549   int idx_short = 0;
550   int idx_long = 0;
551
552   if (NULL == cat)
553     return;
554
555   cat->df_sum = 0;
556   cat->n_cats_total = 0;
557
558   /* Calculate the degrees of freedom, and the number of categories */
559   for (i = 0 ; i < cat->n_iap; ++i)
560     {
561       int df = 1;
562       const struct interaction *iact = cat->iap[i].iact;
563
564       cat->iap[i].df_prod = iact->n_vars ? xcalloc (iact->n_vars, sizeof (int)) : NULL;
565
566       cat->iap[i].n_cats = 1;
567
568       for (v = 0 ; v < iact->n_vars; ++v)
569         {
570           int x;
571           const struct variable *var = iact->vars[v];
572
573           struct variable_node *vn = lookup_variable (&cat->varmap, var, hash_pointer (var, 0));
574
575           struct value_node *valnd = NULL;
576           struct value_node **array ;
577
578           assert (vn->n_vals == hmap_count (&vn->valmap));
579
580           if  (vn->n_vals == 0)
581             {
582               cat->sane = false;
583               return;
584             }
585
586           /* Sort the VALMAP here */
587           array = xcalloc (sizeof *array, vn->n_vals);
588           x = 0;
589           HMAP_FOR_EACH (valnd, struct value_node, node, &vn->valmap)
590             {
591               /* Note: This loop is probably superfluous, it could be done in the
592                update stage (at the expense of a realloc) */
593               array[x++] = valnd;
594             }
595
596           sort (array, vn->n_vals, sizeof (*array),
597                 compare_value_node_3way, vn);
598
599           for (x = 0; x <  vn->n_vals; ++x)
600             {
601               struct value_node *vvv = array[x];
602               vvv->index = x;
603             }
604           free (array);
605
606           cat->iap[i].df_prod[v] = df * (vn->n_vals - 1);
607           df = cat->iap[i].df_prod[v];
608
609           cat->iap[i].n_cats *= vn->n_vals;
610         }
611
612       if (v > 0)
613         cat->df_sum += cat->iap[i].df_prod [v - 1];
614
615       cat->n_cats_total += cat->iap[i].n_cats;
616     }
617
618
619   cat->reverse_variable_map_short = pool_calloc (cat->pool,
620                                                  cat->df_sum,
621                                                  sizeof *cat->reverse_variable_map_short);
622
623   cat->reverse_variable_map_long = pool_calloc (cat->pool,
624                                                 cat->n_cats_total,
625                                                 sizeof *cat->reverse_variable_map_long);
626
627   for (i = 0 ; i < cat->n_iap; ++i)
628     {
629       struct interaction_value *ivn = NULL;
630       int x = 0;
631       int ii;
632       struct interact_params *iap = &cat->iap[i];
633
634       iap->base_subscript_short = idx_short;
635       iap->base_subscript_long = idx_long;
636
637       iap->reverse_interaction_value_map = pool_calloc (cat->pool, iap->n_cats,
638                                                         sizeof *iap->reverse_interaction_value_map);
639
640       HMAP_FOR_EACH (ivn, struct interaction_value, node, &iap->ivmap)
641         {
642           iap->reverse_interaction_value_map[x++] = ivn;
643         }
644
645       assert (x <= iap->n_cats);
646
647       /* For some purposes (eg CONTRASTS in ONEWAY) the values need to be sorted */
648       sort (iap->reverse_interaction_value_map, x, sizeof (*iap->reverse_interaction_value_map),
649             compare_interaction_value_3way, iap);
650
651       /* Fill the remaining values with null */
652       for (ii = x ; ii < iap->n_cats; ++ii)
653         iap->reverse_interaction_value_map[ii] = NULL;
654
655       /* Populate the reverse variable maps. */
656       if (iap->df_prod)
657         {
658           for (ii = 0; ii < iap->df_prod [iap->iact->n_vars - 1]; ++ii)
659             cat->reverse_variable_map_short[idx_short++] = i;
660         }
661
662       for (ii = 0; ii < iap->n_cats; ++ii)
663         cat->reverse_variable_map_long[idx_long++] = i;
664     }
665
666   assert (cat->n_vars <= cat->n_iap);
667
668   categoricals_dump (cat);
669
670   /* Tally up the sums for all the encodings */
671   for (i = 0 ; i < cat->n_iap; ++i)
672     {
673       int x, y;
674       struct interact_params *iap = &cat->iap[i];
675       const struct interaction *iact = iap->iact;
676
677       const int df = iap->df_prod ? iap->df_prod [iact->n_vars - 1] : 0;
678
679       iap->enc_sum = xcalloc (df, sizeof (*(iap->enc_sum)));
680
681       for (y = 0; y < hmap_count (&iap->ivmap); ++y)
682         {
683           struct interaction_value *iv = iap->reverse_interaction_value_map[y];
684           for (x = iap->base_subscript_short; x < iap->base_subscript_short + df ;++x)
685             {
686               const double bin = categoricals_get_effects_code_for_case (cat, x, iv->ccase);
687               iap->enc_sum [x - iap->base_subscript_short] += bin * iv->cc;
688             }
689           if (cat->payload && cat->payload->calculate)
690             cat->payload->calculate (cat->aux1, cat->aux2, iv->user_data);
691         }
692     }
693
694   cat->sane = true;
695 }
696
697
698 static int
699 reverse_variable_lookup_short (const struct categoricals *cat, int subscript)
700 {
701   assert (cat->reverse_variable_map_short);
702   assert (subscript >= 0);
703   assert (subscript < cat->df_sum);
704
705   return cat->reverse_variable_map_short[subscript];
706 }
707
708 static int
709 reverse_variable_lookup_long (const struct categoricals *cat, int subscript)
710 {
711   assert (cat->reverse_variable_map_long);
712   assert (subscript >= 0);
713   assert (subscript < cat->n_cats_total);
714
715   return cat->reverse_variable_map_long[subscript];
716 }
717
718
719 /* Return the interaction corresponding to SUBSCRIPT */
720 const struct interaction *
721 categoricals_get_interaction_by_subscript (const struct categoricals *cat, int subscript)
722 {
723   int index = reverse_variable_lookup_short (cat, subscript);
724
725   return cat->iap[index].iact;
726 }
727
728 double
729 categoricals_get_weight_by_subscript (const struct categoricals *cat, int subscript)
730 {
731   int vindex = reverse_variable_lookup_short (cat, subscript);
732   const struct interact_params *vp = &cat->iap[vindex];
733
734   return vp->cc;
735 }
736
737 double
738 categoricals_get_sum_by_subscript (const struct categoricals *cat, int subscript)
739 {
740   int vindex = reverse_variable_lookup_short (cat, subscript);
741   const struct interact_params *vp = &cat->iap[vindex];
742
743   return   vp->enc_sum[subscript - vp->base_subscript_short];
744 }
745
746
747 /* Returns unity if the value in case C at SUBSCRIPT is equal to the category
748    for that subscript */
749 static double
750 categoricals_get_code_for_case (const struct categoricals *cat, int subscript,
751                                 const struct ccase *c,
752                                 bool effects_coding)
753 {
754   const struct interaction *iact = categoricals_get_interaction_by_subscript (cat, subscript);
755
756   const int i = reverse_variable_lookup_short (cat, subscript);
757
758   const int base_index = cat->iap[i].base_subscript_short;
759
760   int v;
761   double result = 1.0;
762
763   const struct interact_params *iap = &cat->iap[i];
764
765   double dfp = 1.0;
766   for (v = 0; v < iact->n_vars; ++v)
767     {
768       const struct variable *var = iact->vars[v];
769
770       const union value *val = case_data (c, var);
771       const int width = var_get_width (var);
772       const struct variable_node *vn = lookup_variable (&cat->varmap, var, hash_pointer (var, 0));
773
774       const unsigned int hash = value_hash (val, width, 0);
775       const struct value_node *valn = lookup_value (&vn->valmap, val, hash, width);
776
777       double bin = 1.0;
778
779       const double df = iap->df_prod[v] / dfp;
780
781       /* Translate the subscript into an index for the individual variable */
782       const int index = ((subscript - base_index) % iap->df_prod[v] ) / dfp;
783       dfp = iap->df_prod [v];
784
785       if (effects_coding && valn->index == df )
786         bin = -1.0;
787       else if ( valn->index != index )
788         bin = 0;
789
790       result *= bin;
791     }
792
793   return result;
794 }
795
796
797 /* Returns unity if the value in case C at SUBSCRIPT is equal to the category
798    for that subscript */
799 double
800 categoricals_get_dummy_code_for_case (const struct categoricals *cat, int subscript,
801                                      const struct ccase *c)
802 {
803   return categoricals_get_code_for_case (cat, subscript, c, false);
804 }
805
806 /* Returns unity if the value in case C at SUBSCRIPT is equal to the category
807    for that subscript.
808    Else if it is the last category, return -1.
809    Otherwise return 0.
810  */
811 double
812 categoricals_get_effects_code_for_case (const struct categoricals *cat, int subscript,
813                                         const struct ccase *c)
814 {
815   return categoricals_get_code_for_case (cat, subscript, c, true);
816 }
817
818
819 size_t
820 categoricals_get_n_variables (const struct categoricals *cat)
821 {
822   printf ("%s\n", __FUNCTION__);
823   return cat->n_vars;
824 }
825
826
827 /* Return a case containing the set of values corresponding to
828    the Nth Category of the IACTth interaction */
829 const struct ccase *
830 categoricals_get_case_by_category_real (const struct categoricals *cat, int iact, int n)
831 {
832   const struct interaction_value *vn;
833
834   const struct interact_params *vp = &cat->iap[iact];
835
836   if ( n >= hmap_count (&vp->ivmap))
837     return NULL;
838
839   vn = vp->reverse_interaction_value_map [n];
840
841   return vn->ccase;
842 }
843
844 /* Return a the user data corresponding to the Nth Category of the IACTth interaction. */
845 void *
846 categoricals_get_user_data_by_category_real (const struct categoricals *cat, int iact, int n)
847 {
848   const struct interact_params *vp = &cat->iap[iact];
849   const struct interaction_value *iv ;
850
851   if ( n >= hmap_count (&vp->ivmap))
852     return NULL;
853
854   iv = vp->reverse_interaction_value_map [n];
855
856   return iv->user_data;
857 }
858
859
860
861 /* Return a case containing the set of values corresponding to SUBSCRIPT */
862 const struct ccase *
863 categoricals_get_case_by_category (const struct categoricals *cat, int subscript)
864 {
865   int vindex = reverse_variable_lookup_long (cat, subscript);
866   const struct interact_params *vp = &cat->iap[vindex];
867   const struct interaction_value *vn = vp->reverse_interaction_value_map [subscript - vp->base_subscript_long];
868
869   return vn->ccase;
870 }
871
872 void *
873 categoricals_get_user_data_by_category (const struct categoricals *cat, int subscript)
874 {
875   int vindex = reverse_variable_lookup_long (cat, subscript);
876   const struct interact_params *vp = &cat->iap[vindex];
877
878   const struct interaction_value *iv = vp->reverse_interaction_value_map [subscript - vp->base_subscript_long];
879   return iv->user_data;
880 }
881
882
883 \f
884
885 void
886 categoricals_set_payload (struct categoricals *cat, const struct payload *p,
887                           const void *aux1, void *aux2)
888 {
889   cat->payload = p;
890   cat->aux1 = aux1;
891   cat->aux2 = aux2;
892 }