+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <stdlib.h>
-#include "alloc.h"
-#include "any-writer.h"
-#include "case.h"
-#include "casefile.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "file-handle.h"
-#include "lexer.h"
-#include "misc.h"
-#include "moments.h"
-#include "pool.h"
-#include "settings.h"
-#include "sfm-write.h"
-#include "sort-prs.h"
-#include "sort.h"
-#include "str.h"
-#include "var.h"
-#include "vfm.h"
-#include "vfmP.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* Specifies how to make an aggregate variable. */
-struct agr_var
- {
- struct agr_var *next; /* Next in list. */
-
- /* Collected during parsing. */
- struct variable *src; /* Source variable. */
- struct variable *dest; /* Target variable. */
- int function; /* Function. */
- int include_missing; /* 1=Include user-missing values. */
- union value arg[2]; /* Arguments. */
-
- /* Accumulated during AGGREGATE execution. */
- double dbl[3];
- int int1, int2;
- char *string;
- int missing;
- struct moments1 *moments;
- };
-
-/* Aggregation functions. */
-enum
- {
- NONE, SUM, MEAN, SD, MAX, MIN, PGT, PLT, PIN, POUT, FGT, FLT, FIN,
- FOUT, N, NU, NMISS, NUMISS, FIRST, LAST,
- N_AGR_FUNCS, N_NO_VARS, NU_NO_VARS,
- FUNC = 0x1f, /* Function mask. */
- FSTRING = 1<<5, /* String function bit. */
- };
-
-/* Attributes of an aggregation function. */
-struct agr_func
- {
- const char *name; /* Aggregation function name. */
- size_t n_args; /* Number of arguments. */
- int alpha_type; /* When given ALPHA arguments, output type. */
- struct fmt_spec format; /* Format spec if alpha_type != ALPHA. */
- };
-
-/* Attributes of aggregation functions. */
-static const struct agr_func agr_func_tab[] =
- {
- {"<NONE>", 0, -1, {0, 0, 0}},
- {"SUM", 0, -1, {FMT_F, 8, 2}},
- {"MEAN", 0, -1, {FMT_F, 8, 2}},
- {"SD", 0, -1, {FMT_F, 8, 2}},
- {"MAX", 0, ALPHA, {-1, -1, -1}},
- {"MIN", 0, ALPHA, {-1, -1, -1}},
- {"PGT", 1, NUMERIC, {FMT_F, 5, 1}},
- {"PLT", 1, NUMERIC, {FMT_F, 5, 1}},
- {"PIN", 2, NUMERIC, {FMT_F, 5, 1}},
- {"POUT", 2, NUMERIC, {FMT_F, 5, 1}},
- {"FGT", 1, NUMERIC, {FMT_F, 5, 3}},
- {"FLT", 1, NUMERIC, {FMT_F, 5, 3}},
- {"FIN", 2, NUMERIC, {FMT_F, 5, 3}},
- {"FOUT", 2, NUMERIC, {FMT_F, 5, 3}},
- {"N", 0, NUMERIC, {FMT_F, 7, 0}},
- {"NU", 0, NUMERIC, {FMT_F, 7, 0}},
- {"NMISS", 0, NUMERIC, {FMT_F, 7, 0}},
- {"NUMISS", 0, NUMERIC, {FMT_F, 7, 0}},
- {"FIRST", 0, ALPHA, {-1, -1, -1}},
- {"LAST", 0, ALPHA, {-1, -1, -1}},
- {NULL, 0, -1, {-1, -1, -1}},
- {"N", 0, NUMERIC, {FMT_F, 7, 0}},
- {"NU", 0, NUMERIC, {FMT_F, 7, 0}},
- };
-
-/* Missing value types. */
-enum missing_treatment
- {
- ITEMWISE, /* Missing values item by item. */
- COLUMNWISE /* Missing values column by column. */
- };
-
-/* An entire AGGREGATE procedure. */
-struct agr_proc
- {
- /* We have either an output file or a sink. */
- struct any_writer *writer; /* Output file, or null if none. */
- struct case_sink *sink; /* Sink, or null if none. */
-
- /* Break variables. */
- struct sort_criteria *sort; /* Sort criteria. */
- struct variable **break_vars; /* Break variables. */
- size_t break_var_cnt; /* Number of break variables. */
- struct ccase break_case; /* Last values of break variables. */
-
- enum missing_treatment missing; /* How to treat missing values. */
- struct agr_var *agr_vars; /* First aggregate variable. */
- struct dictionary *dict; /* Aggregate dictionary. */
- int case_cnt; /* Counts aggregated cases. */
- struct ccase agr_case; /* Aggregate case for output. */
- };
-
-static void initialize_aggregate_info (struct agr_proc *,
- const struct ccase *);
-
-/* Prototypes. */
-static int parse_aggregate_functions (struct agr_proc *);
-static void agr_destroy (struct agr_proc *);
-static int aggregate_single_case (struct agr_proc *agr,
- const struct ccase *input,
- struct ccase *output);
-static void dump_aggregate_info (struct agr_proc *agr, struct ccase *output);
-
-/* Aggregating to the active file. */
-static int agr_to_active_file (struct ccase *, void *aux);
-
-/* Aggregating to a system file. */
-static int presorted_agr_to_sysfile (struct ccase *, void *aux);
-\f
-/* Parsing. */
-
-/* Parses and executes the AGGREGATE procedure. */
-int
-cmd_aggregate (void)
-{
- struct agr_proc agr;
- struct file_handle *out_file = NULL;
-
- bool copy_documents = false;
- bool presorted = false;
- bool saw_direction;
-
- memset(&agr, 0 , sizeof (agr));
- agr.missing = ITEMWISE;
- case_nullify (&agr.break_case);
-
- agr.dict = dict_create ();
- dict_set_label (agr.dict, dict_get_label (default_dict));
- dict_set_documents (agr.dict, dict_get_documents (default_dict));
-
- /* OUTFILE subcommand must be first. */
- if (!lex_force_match_id ("OUTFILE"))
- goto error;
- lex_match ('=');
- if (!lex_match ('*'))
- {
- out_file = fh_parse (FH_REF_FILE | FH_REF_SCRATCH);
- if (out_file == NULL)
- goto error;
- }
-
- /* Read most of the subcommands. */
- for (;;)
- {
- lex_match ('/');
-
- if (lex_match_id ("MISSING"))
- {
- lex_match ('=');
- if (!lex_match_id ("COLUMNWISE"))
- {
- lex_error (_("while expecting COLUMNWISE"));
- goto error;
- }
- agr.missing = COLUMNWISE;
- }
- else if (lex_match_id ("DOCUMENT"))
- copy_documents = true;
- else if (lex_match_id ("PRESORTED"))
- presorted = true;
- else if (lex_match_id ("BREAK"))
- {
- int i;
-
- lex_match ('=');
- agr.sort = sort_parse_criteria (default_dict,
- &agr.break_vars, &agr.break_var_cnt,
- &saw_direction, NULL);
- if (agr.sort == NULL)
- goto error;
-
- for (i = 0; i < agr.break_var_cnt; i++)
- dict_clone_var_assert (agr.dict, agr.break_vars[i],
- agr.break_vars[i]->name);
-
- /* BREAK must follow the options. */
- break;
- }
- else
- {
- lex_error (_("expecting BREAK"));
- goto error;
- }
- }
- if (presorted && saw_direction)
- msg (SW, _("When PRESORTED is specified, specifying sorting directions "
- "with (A) or (D) has no effect. Output data will be sorted "
- "the same way as the input data."));
-
- /* Read in the aggregate functions. */
- lex_match ('/');
- if (!parse_aggregate_functions (&agr))
- goto error;
-
- /* Delete documents. */
- if (!copy_documents)
- dict_set_documents (agr.dict, NULL);
-
- /* Cancel SPLIT FILE. */
- dict_set_split_vars (agr.dict, NULL, 0);
-
- /* Initialize. */
- agr.case_cnt = 0;
- case_create (&agr.agr_case, dict_get_next_value_idx (agr.dict));
-
- /* Output to active file or external file? */
- if (out_file == NULL)
- {
- /* The active file will be replaced by the aggregated data,
- so TEMPORARY is moot. */
- cancel_temporary ();
-
- if (agr.sort != NULL && !presorted)
- sort_active_file_in_place (agr.sort);
-
- agr.sink = create_case_sink (&storage_sink_class, agr.dict, NULL);
- if (agr.sink->class->open != NULL)
- agr.sink->class->open (agr.sink);
- vfm_sink = create_case_sink (&null_sink_class, default_dict, NULL);
- procedure (agr_to_active_file, &agr);
- if (agr.case_cnt > 0)
- {
- dump_aggregate_info (&agr, &agr.agr_case);
- agr.sink->class->write (agr.sink, &agr.agr_case);
- }
- dict_destroy (default_dict);
- default_dict = agr.dict;
- agr.dict = NULL;
- vfm_source = agr.sink->class->make_source (agr.sink);
- free_case_sink (agr.sink);
- }
- else
- {
- agr.writer = any_writer_open (out_file, agr.dict);
- if (agr.writer == NULL)
- goto error;
-
- if (agr.sort != NULL && !presorted)
- {
- /* Sorting is needed. */
- struct casefile *dst;
- struct casereader *reader;
- struct ccase c;
-
- dst = sort_active_file_to_casefile (agr.sort);
- if (dst == NULL)
- goto error;
- reader = casefile_get_destructive_reader (dst);
- while (casereader_read_xfer (reader, &c))
- {
- if (aggregate_single_case (&agr, &c, &agr.agr_case))
- any_writer_write (agr.writer, &agr.agr_case);
- case_destroy (&c);
- }
- casereader_destroy (reader);
- casefile_destroy (dst);
- }
- else
- {
- /* Active file is already sorted. */
- procedure (presorted_agr_to_sysfile, &agr);
- }
-
- if (agr.case_cnt > 0)
- {
- dump_aggregate_info (&agr, &agr.agr_case);
- any_writer_write (agr.writer, &agr.agr_case);
- }
- }
-
- agr_destroy (&agr);
- return CMD_SUCCESS;
-
-error:
- agr_destroy (&agr);
- return CMD_FAILURE;
-}
-
-/* Parse all the aggregate functions. */
-static int
-parse_aggregate_functions (struct agr_proc *agr)
-{
- struct agr_var *tail; /* Tail of linked list starting at agr->vars. */
-
- /* Parse everything. */
- tail = NULL;
- for (;;)
- {
- char **dest;
- char **dest_label;
- size_t n_dest;
-
- int include_missing;
- const struct agr_func *function;
- int func_index;
-
- union value arg[2];
-
- struct variable **src;
- size_t n_src;
-
- size_t i;
-
- dest = NULL;
- dest_label = NULL;
- n_dest = 0;
- src = NULL;
- function = NULL;
- n_src = 0;
- arg[0].c = NULL;
- arg[1].c = NULL;
-
- /* Parse the list of target variables. */
- while (!lex_match ('='))
- {
- size_t n_dest_prev = n_dest;
-
- if (!parse_DATA_LIST_vars (&dest, &n_dest,
- PV_APPEND | PV_SINGLE | PV_NO_SCRATCH))
- goto error;
-
- /* Assign empty labels. */
- {
- int j;
-
- dest_label = xnrealloc (dest_label, n_dest, sizeof *dest_label);
- for (j = n_dest_prev; j < n_dest; j++)
- dest_label[j] = NULL;
- }
-
- if (token == T_STRING)
- {
- ds_truncate (&tokstr, 255);
- dest_label[n_dest - 1] = xstrdup (ds_c_str (&tokstr));
- lex_get ();
- }
- }
-
- /* Get the name of the aggregation function. */
- if (token != T_ID)
- {
- lex_error (_("expecting aggregation function"));
- goto error;
- }
-
- include_missing = 0;
- if (tokid[strlen (tokid) - 1] == '.')
- {
- include_missing = 1;
- tokid[strlen (tokid) - 1] = 0;
- }
-
- for (function = agr_func_tab; function->name; function++)
- if (!strcasecmp (function->name, tokid))
- break;
- if (NULL == function->name)
- {
- msg (SE, _("Unknown aggregation function %s."), tokid);
- goto error;
- }
- func_index = function - agr_func_tab;
- lex_get ();
-
- /* Check for leading lparen. */
- if (!lex_match ('('))
- {
- if (func_index == N)
- func_index = N_NO_VARS;
- else if (func_index == NU)
- func_index = NU_NO_VARS;
- else
- {
- lex_error (_("expecting `('"));
- goto error;
- }
- }
- else
- {
- /* Parse list of source variables. */
- {
- int pv_opts = PV_NO_SCRATCH;
-
- if (func_index == SUM || func_index == MEAN || func_index == SD)
- pv_opts |= PV_NUMERIC;
- else if (function->n_args)
- pv_opts |= PV_SAME_TYPE;
-
- if (!parse_variables (default_dict, &src, &n_src, pv_opts))
- goto error;
- }
-
- /* Parse function arguments, for those functions that
- require arguments. */
- if (function->n_args != 0)
- for (i = 0; i < function->n_args; i++)
- {
- int type;
-
- lex_match (',');
- if (token == T_STRING)
- {
- arg[i].c = xstrdup (ds_c_str (&tokstr));
- type = ALPHA;
- }
- else if (lex_is_number ())
- {
- arg[i].f = tokval;
- type = NUMERIC;
- } else {
- msg (SE, _("Missing argument %d to %s."), i + 1,
- function->name);
- goto error;
- }
-
- lex_get ();
-
- if (type != src[0]->type)
- {
- msg (SE, _("Arguments to %s must be of same type as "
- "source variables."),
- function->name);
- goto error;
- }
- }
-
- /* Trailing rparen. */
- if (!lex_match(')'))
- {
- lex_error (_("expecting `)'"));
- goto error;
- }
-
- /* Now check that the number of source variables match
- the number of target variables. If we check earlier
- than this, the user can get very misleading error
- message, i.e. `AGGREGATE x=SUM(y t).' will get this
- error message when a proper message would be more
- like `unknown variable t'. */
- if (n_src != n_dest)
- {
- msg (SE, _("Number of source variables (%u) does not match "
- "number of target variables (%u)."),
- (unsigned) n_src, (unsigned) n_dest);
- goto error;
- }
-
- if ((func_index == PIN || func_index == POUT
- || func_index == FIN || func_index == FOUT)
- && ((src[0]->type == NUMERIC && arg[0].f > arg[1].f)
- || (src[0]->type == ALPHA
- && str_compare_rpad (arg[0].c, arg[1].c) > 0)))
- {
- union value t = arg[0];
- arg[0] = arg[1];
- arg[1] = t;
-
- msg (SW, _("The value arguments passed to the %s function "
- "are out-of-order. They will be treated as if "
- "they had been specified in the correct order."),
- function->name);
- }
- }
-
- /* Finally add these to the linked list of aggregation
- variables. */
- for (i = 0; i < n_dest; i++)
- {
- struct agr_var *v = xmalloc (sizeof *v);
-
- /* Add variable to chain. */
- if (agr->agr_vars != NULL)
- tail->next = v;
- else
- agr->agr_vars = v;
- tail = v;
- tail->next = NULL;
- v->moments = NULL;
-
- /* Create the target variable in the aggregate
- dictionary. */
- {
- struct variable *destvar;
-
- v->function = func_index;
-
- if (src)
- {
- v->src = src[i];
-
- if (src[i]->type == ALPHA)
- {
- v->function |= FSTRING;
- v->string = xmalloc (src[i]->width);
- }
-
- if (function->alpha_type == ALPHA)
- destvar = dict_clone_var (agr->dict, v->src, dest[i]);
- else
- {
- assert (v->src->type == NUMERIC
- || function->alpha_type == NUMERIC);
- destvar = dict_create_var (agr->dict, dest[i], 0);
- if (destvar != NULL)
- {
- if ((func_index == N || func_index == NMISS)
- && dict_get_weight (default_dict) != NULL)
- destvar->print = destvar->write = f8_2;
- else
- destvar->print = destvar->write = function->format;
- }
- }
- } else {
- v->src = NULL;
- destvar = dict_create_var (agr->dict, dest[i], 0);
- if (func_index == N_NO_VARS
- && dict_get_weight (default_dict) != NULL)
- destvar->print = destvar->write = f8_2;
- else
- destvar->print = destvar->write = function->format;
- }
-
- if (!destvar)
- {
- msg (SE, _("Variable name %s is not unique within the "
- "aggregate file dictionary, which contains "
- "the aggregate variables and the break "
- "variables."),
- dest[i]);
- goto error;
- }
-
- free (dest[i]);
- destvar->init = 0;
- if (dest_label[i])
- {
- destvar->label = dest_label[i];
- dest_label[i] = NULL;
- }
-
- v->dest = destvar;
- }
-
- v->include_missing = include_missing;
-
- if (v->src != NULL)
- {
- int j;
-
- if (v->src->type == NUMERIC)
- for (j = 0; j < function->n_args; j++)
- v->arg[j].f = arg[j].f;
- else
- for (j = 0; j < function->n_args; j++)
- v->arg[j].c = xstrdup (arg[j].c);
- }
- }
-
- if (src != NULL && src[0]->type == ALPHA)
- for (i = 0; i < function->n_args; i++)
- {
- free (arg[i].c);
- arg[i].c = NULL;
- }
-
- free (src);
- free (dest);
- free (dest_label);
-
- if (!lex_match ('/'))
- {
- if (token == '.')
- return 1;
-
- lex_error ("expecting end of command");
- return 0;
- }
- continue;
-
- error:
- for (i = 0; i < n_dest; i++)
- {
- free (dest[i]);
- free (dest_label[i]);
- }
- free (dest);
- free (dest_label);
- free (arg[0].c);
- free (arg[1].c);
- if (src && n_src && src[0]->type == ALPHA)
- for (i = 0; i < function->n_args; i++)
- {
- free (arg[i].c);
- arg[i].c = NULL;
- }
- free (src);
-
- return 0;
- }
-}
-
-/* Destroys AGR. */
-static void
-agr_destroy (struct agr_proc *agr)
-{
- struct agr_var *iter, *next;
-
- any_writer_close (agr->writer);
- if (agr->sort != NULL)
- sort_destroy_criteria (agr->sort);
- free (agr->break_vars);
- case_destroy (&agr->break_case);
- for (iter = agr->agr_vars; iter; iter = next)
- {
- next = iter->next;
-
- if (iter->function & FSTRING)
- {
- size_t n_args;
- size_t i;
-
- n_args = agr_func_tab[iter->function & FUNC].n_args;
- for (i = 0; i < n_args; i++)
- free (iter->arg[i].c);
- free (iter->string);
- }
- else if (iter->function == SD)
- moments1_destroy (iter->moments);
- free (iter);
- }
- if (agr->dict != NULL)
- dict_destroy (agr->dict);
-
- case_destroy (&agr->agr_case);
-}
-\f
-/* Execution. */
-
-static void accumulate_aggregate_info (struct agr_proc *,
- const struct ccase *);
-static void dump_aggregate_info (struct agr_proc *, struct ccase *);
-
-/* Processes a single case INPUT for aggregation. If output is
- warranted, writes it to OUTPUT and returns nonzero.
- Otherwise, returns zero and OUTPUT is unmodified. */
-static int
-aggregate_single_case (struct agr_proc *agr,
- const struct ccase *input, struct ccase *output)
-{
- bool finished_group = false;
-
- if (agr->case_cnt++ == 0)
- initialize_aggregate_info (agr, input);
- else if (case_compare (&agr->break_case, input,
- agr->break_vars, agr->break_var_cnt))
- {
- dump_aggregate_info (agr, output);
- finished_group = true;
-
- initialize_aggregate_info (agr, input);
- }
-
- accumulate_aggregate_info (agr, input);
- return finished_group;
-}
-
-/* Accumulates aggregation data from the case INPUT. */
-static void
-accumulate_aggregate_info (struct agr_proc *agr,
- const struct ccase *input)
-{
- struct agr_var *iter;
- double weight;
- int bad_warn = 1;
-
- weight = dict_get_case_weight (default_dict, input, &bad_warn);
-
- for (iter = agr->agr_vars; iter; iter = iter->next)
- if (iter->src)
- {
- const union value *v = case_data (input, iter->src->fv);
-
- if ((!iter->include_missing
- && mv_is_value_missing (&iter->src->miss, v))
- || (iter->include_missing && iter->src->type == NUMERIC
- && v->f == SYSMIS))
- {
- switch (iter->function)
- {
- case NMISS:
- case NMISS | FSTRING:
- iter->dbl[0] += weight;
- break;
- case NUMISS:
- case NUMISS | FSTRING:
- iter->int1++;
- break;
- }
- iter->missing = 1;
- continue;
- }
-
- /* This is horrible. There are too many possibilities. */
- switch (iter->function)
- {
- case SUM:
- iter->dbl[0] += v->f * weight;
- iter->int1 = 1;
- break;
- case MEAN:
- iter->dbl[0] += v->f * weight;
- iter->dbl[1] += weight;
- break;
- case SD:
- moments1_add (iter->moments, v->f, weight);
- break;
- case MAX:
- iter->dbl[0] = max (iter->dbl[0], v->f);
- iter->int1 = 1;
- break;
- case MAX | FSTRING:
- if (memcmp (iter->string, v->s, iter->src->width) < 0)
- memcpy (iter->string, v->s, iter->src->width);
- iter->int1 = 1;
- break;
- case MIN:
- iter->dbl[0] = min (iter->dbl[0], v->f);
- iter->int1 = 1;
- break;
- case MIN | FSTRING:
- if (memcmp (iter->string, v->s, iter->src->width) > 0)
- memcpy (iter->string, v->s, iter->src->width);
- iter->int1 = 1;
- break;
- case FGT:
- case PGT:
- if (v->f > iter->arg[0].f)
- iter->dbl[0] += weight;
- iter->dbl[1] += weight;
- break;
- case FGT | FSTRING:
- case PGT | FSTRING:
- if (memcmp (iter->arg[0].c, v->s, iter->src->width) < 0)
- iter->dbl[0] += weight;
- iter->dbl[1] += weight;
- break;
- case FLT:
- case PLT:
- if (v->f < iter->arg[0].f)
- iter->dbl[0] += weight;
- iter->dbl[1] += weight;
- break;
- case FLT | FSTRING:
- case PLT | FSTRING:
- if (memcmp (iter->arg[0].c, v->s, iter->src->width) > 0)
- iter->dbl[0] += weight;
- iter->dbl[1] += weight;
- break;
- case FIN:
- case PIN:
- if (iter->arg[0].f <= v->f && v->f <= iter->arg[1].f)
- iter->dbl[0] += weight;
- iter->dbl[1] += weight;
- break;
- case FIN | FSTRING:
- case PIN | FSTRING:
- if (memcmp (iter->arg[0].c, v->s, iter->src->width) <= 0
- && memcmp (iter->arg[1].c, v->s, iter->src->width) >= 0)
- iter->dbl[0] += weight;
- iter->dbl[1] += weight;
- break;
- case FOUT:
- case POUT:
- if (iter->arg[0].f > v->f || v->f > iter->arg[1].f)
- iter->dbl[0] += weight;
- iter->dbl[1] += weight;
- break;
- case FOUT | FSTRING:
- case POUT | FSTRING:
- if (memcmp (iter->arg[0].c, v->s, iter->src->width) > 0
- || memcmp (iter->arg[1].c, v->s, iter->src->width) < 0)
- iter->dbl[0] += weight;
- iter->dbl[1] += weight;
- break;
- case N:
- case N | FSTRING:
- iter->dbl[0] += weight;
- break;
- case NU:
- case NU | FSTRING:
- iter->int1++;
- break;
- case FIRST:
- if (iter->int1 == 0)
- {
- iter->dbl[0] = v->f;
- iter->int1 = 1;
- }
- break;
- case FIRST | FSTRING:
- if (iter->int1 == 0)
- {
- memcpy (iter->string, v->s, iter->src->width);
- iter->int1 = 1;
- }
- break;
- case LAST:
- iter->dbl[0] = v->f;
- iter->int1 = 1;
- break;
- case LAST | FSTRING:
- memcpy (iter->string, v->s, iter->src->width);
- iter->int1 = 1;
- break;
- case NMISS:
- case NMISS | FSTRING:
- case NUMISS:
- case NUMISS | FSTRING:
- /* Our value is not missing or it would have been
- caught earlier. Nothing to do. */
- break;
- default:
- assert (0);
- }
- } else {
- switch (iter->function)
- {
- case N_NO_VARS:
- iter->dbl[0] += weight;
- break;
- case NU_NO_VARS:
- iter->int1++;
- break;
- default:
- assert (0);
- }
- }
-}
-
-/* We've come to a record that differs from the previous in one or
- more of the break variables. Make an output record from the
- accumulated statistics in the OUTPUT case. */
-static void
-dump_aggregate_info (struct agr_proc *agr, struct ccase *output)
-{
- {
- int value_idx = 0;
- int i;
-
- for (i = 0; i < agr->break_var_cnt; i++)
- {
- struct variable *v = agr->break_vars[i];
- memcpy (case_data_rw (output, value_idx),
- case_data (&agr->break_case, v->fv),
- sizeof (union value) * v->nv);
- value_idx += v->nv;
- }
- }
-
- {
- struct agr_var *i;
-
- for (i = agr->agr_vars; i; i = i->next)
- {
- union value *v = case_data_rw (output, i->dest->fv);
-
- if (agr->missing == COLUMNWISE && i->missing != 0
- && (i->function & FUNC) != N && (i->function & FUNC) != NU
- && (i->function & FUNC) != NMISS && (i->function & FUNC) != NUMISS)
- {
- if (i->dest->type == ALPHA)
- memset (v->s, ' ', i->dest->width);
- else
- v->f = SYSMIS;
- continue;
- }
-
- switch (i->function)
- {
- case SUM:
- v->f = i->int1 ? i->dbl[0] : SYSMIS;
- break;
- case MEAN:
- v->f = i->dbl[1] != 0.0 ? i->dbl[0] / i->dbl[1] : SYSMIS;
- break;
- case SD:
- {
- double variance;
-
- /* FIXME: we should use two passes. */
- moments1_calculate (i->moments, NULL, NULL, &variance,
- NULL, NULL);
- if (variance != SYSMIS)
- v->f = sqrt (variance);
- else
- v->f = SYSMIS;
- }
- break;
- case MAX:
- case MIN:
- v->f = i->int1 ? i->dbl[0] : SYSMIS;
- break;
- case MAX | FSTRING:
- case MIN | FSTRING:
- if (i->int1)
- memcpy (v->s, i->string, i->dest->width);
- else
- memset (v->s, ' ', i->dest->width);
- break;
- case FGT:
- case FGT | FSTRING:
- case FLT:
- case FLT | FSTRING:
- case FIN:
- case FIN | FSTRING:
- case FOUT:
- case FOUT | FSTRING:
- v->f = i->dbl[1] ? i->dbl[0] / i->dbl[1] : SYSMIS;
- break;
- case PGT:
- case PGT | FSTRING:
- case PLT:
- case PLT | FSTRING:
- case PIN:
- case PIN | FSTRING:
- case POUT:
- case POUT | FSTRING:
- v->f = i->dbl[1] ? i->dbl[0] / i->dbl[1] * 100.0 : SYSMIS;
- break;
- case N:
- case N | FSTRING:
- v->f = i->dbl[0];
- break;
- case NU:
- case NU | FSTRING:
- v->f = i->int1;
- break;
- case FIRST:
- case LAST:
- v->f = i->int1 ? i->dbl[0] : SYSMIS;
- break;
- case FIRST | FSTRING:
- case LAST | FSTRING:
- if (i->int1)
- memcpy (v->s, i->string, i->dest->width);
- else
- memset (v->s, ' ', i->dest->width);
- break;
- case N_NO_VARS:
- v->f = i->dbl[0];
- break;
- case NU_NO_VARS:
- v->f = i->int1;
- break;
- case NMISS:
- case NMISS | FSTRING:
- v->f = i->dbl[0];
- break;
- case NUMISS:
- case NUMISS | FSTRING:
- v->f = i->int1;
- break;
- default:
- assert (0);
- }
- }
- }
-}
-
-/* Resets the state for all the aggregate functions. */
-static void
-initialize_aggregate_info (struct agr_proc *agr, const struct ccase *input)
-{
- struct agr_var *iter;
-
- case_destroy (&agr->break_case);
- case_clone (&agr->break_case, input);
-
- for (iter = agr->agr_vars; iter; iter = iter->next)
- {
- iter->missing = 0;
- iter->dbl[0] = iter->dbl[1] = iter->dbl[2] = 0.0;
- iter->int1 = iter->int2 = 0;
- switch (iter->function)
- {
- case MIN:
- iter->dbl[0] = DBL_MAX;
- break;
- case MIN | FSTRING:
- memset (iter->string, 255, iter->src->width);
- break;
- case MAX:
- iter->dbl[0] = -DBL_MAX;
- break;
- case MAX | FSTRING:
- memset (iter->string, 0, iter->src->width);
- break;
- case SD:
- if (iter->moments == NULL)
- iter->moments = moments1_create (MOMENT_VARIANCE);
- else
- moments1_clear (iter->moments);
- break;
- default:
- break;
- }
- }
-}
-\f
-/* Aggregate each case as it comes through. Cases which aren't needed
- are dropped. */
-static int
-agr_to_active_file (struct ccase *c, void *agr_)
-{
- struct agr_proc *agr = agr_;
-
- if (aggregate_single_case (agr, c, &agr->agr_case))
- agr->sink->class->write (agr->sink, &agr->agr_case);
-
- return 1;
-}
-
-/* Aggregate the current case and output it if we passed a
- breakpoint. */
-static int
-presorted_agr_to_sysfile (struct ccase *c, void *agr_)
-{
- struct agr_proc *agr = agr_;
-
- if (aggregate_single_case (agr, c, &agr->agr_case))
- any_writer_write (agr->writer, &agr->agr_case);
-
- return 1;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-/* Copyright (C) 2001 Free Software Foundation, Inc.
-
- This file is part of the GNU ISO C++ Library. This library is free
- software; you can redistribute it and/or modify it under the
- terms of the GNU General Public License as published by the
- Free Software Foundation; either version 2, or (at your option)
- any later version.
-
- This library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License along
- with this library; see the file COPYING. If not, write to the Free
- Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
- USA.
-
- As a special exception, you may use this file as part of a free software
- library without restriction. Specifically, if other files instantiate
- templates or use macros or inline functions from this file, or you compile
- this file and link it with other files to produce an executable, this
- file does not by itself cause the resulting executable to be covered by
- the GNU General Public License. This exception does not however
- invalidate any other reasons why the executable file might be covered by
- the GNU General Public License. */
-
-/*
- *
- * Copyright (c) 1994
- * Hewlett-Packard Company
- *
- * Permission to use, copy, modify, distribute and sell this software
- * and its documentation for any purpose is hereby granted without fee,
- * provided that the above copyright notice appear in all copies and
- * that both that copyright notice and this permission notice appear
- * in supporting documentation. Hewlett-Packard Company makes no
- * representations about the suitability of this software for any
- * purpose. It is provided "as is" without express or implied warranty.
- *
- *
- * Copyright (c) 1996
- * Silicon Graphics Computer Systems, Inc.
- *
- * Permission to use, copy, modify, distribute and sell this software
- * and its documentation for any purpose is hereby granted without fee,
- * provided that the above copyright notice appear in all copies and
- * that both that copyright notice and this permission notice appear
- * in supporting documentation. Silicon Graphics makes no
- * representations about the suitability of this software for any
- * purpose. It is provided "as is" without express or implied warranty.
- */
-
-/* Copyright (C) 1991, 1992, 1996, 1997, 1999 Free Software Foundation, Inc.
- This file is part of the GNU C Library.
- Written by Douglas C. Schmidt (schmidt@ics.uci.edu).
-
- The GNU C Library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2.1 of the License, or (at your option) any later version.
-
- The GNU C Library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with the GNU C Library; if not, write to the Free
- Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301 USA. */
-
-#include <config.h>
-#include "algorithm.h"
-#include <gsl/gsl_rng.h>
-#include <limits.h>
-#include <stdlib.h>
-#include <string.h>
-#include "alloc.h"
-
-/* Some of the assertions in this file are very expensive. We
- don't use them by default. */
-#ifdef EXTRA_CHECKS
-#define expensive_assert(X) assert(X)
-#else
-#define expensive_assert(X) ((void) 0)
-#endif
-#include "error.h"
-\f
-/* Finds an element in ARRAY, which contains COUNT elements of
- SIZE bytes each, using COMPARE for comparisons. Returns the
- first element in ARRAY that matches TARGET, or a null pointer
- on failure. AUX is passed to each comparison as auxiliary
- data. */
-void *
-find (const void *array, size_t count, size_t size,
- const void *target,
- algo_compare_func *compare, void *aux)
-{
- const char *element = array;
-
- while (count-- > 0)
- {
- if (compare (target, element, aux) == 0)
- return (void *) element;
-
- element += size;
- }
-
- return NULL;
-}
-
-/* Counts and return the number of elements in ARRAY, which
- contains COUNT elements of SIZE bytes each, which are equal to
- ELEMENT as compared with COMPARE. AUX is passed as auxiliary
- data to COMPARE. */
-size_t
-count_equal (const void *array, size_t count, size_t size,
- const void *element,
- algo_compare_func *compare, void *aux)
-{
- const char *first = array;
- size_t equal_cnt = 0;
-
- while (count-- > 0)
- {
- if (compare (element, first, aux) == 0)
- equal_cnt++;
-
- first += size;
- }
-
- return equal_cnt;
-}
-
-/* Counts and return the number of elements in ARRAY, which
- contains COUNT elements of SIZE bytes each, for which
- PREDICATE returns nonzero. AUX is passed as auxiliary data to
- PREDICATE. */
-size_t
-count_if (const void *array, size_t count, size_t size,
- algo_predicate_func *predicate, void *aux)
-{
- const char *first = array;
- size_t nonzero_cnt = 0;
-
- while (count-- > 0)
- {
- if (predicate (first, aux) != 0)
- nonzero_cnt++;
-
- first += size;
- }
-
- return nonzero_cnt;
-}
-\f
-/* Byte-wise swap two items of size SIZE. */
-#define SWAP(a, b, size) \
- do \
- { \
- register size_t __size = (size); \
- register char *__a = (a), *__b = (b); \
- do \
- { \
- char __tmp = *__a; \
- *__a++ = *__b; \
- *__b++ = __tmp; \
- } while (--__size > 0); \
- } while (0)
-
-/* Makes the elements in ARRAY unique, by moving up duplicates,
- and returns the new number of elements in the array. Sorted
- arrays only. Arguments same as for sort() above. */
-size_t
-unique (void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux)
-{
- char *first = array;
- char *last = first + size * count;
- char *result = array;
-
- for (;;)
- {
- first += size;
- if (first >= last)
- {
- assert (adjacent_find_equal (array, count,
- size, compare, aux) == NULL);
- return count;
- }
-
- if (compare (result, first, aux))
- {
- result += size;
- if (result != first)
- memcpy (result, first, size);
- }
- else
- count--;
- }
-}
-
-/* Helper function that calls sort(), then unique(). */
-size_t
-sort_unique (void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux)
-{
- sort (array, count, size, compare, aux);
- return unique (array, count, size, compare, aux);
-}
-\f
-/* Reorders ARRAY, which contains COUNT elements of SIZE bytes
- each, so that the elements for which PREDICATE returns nonzero
- precede those for which PREDICATE returns zero. AUX is
- passed to each predicate as auxiliary data. Returns the
- number of elements for which PREDICATE returns nonzero. Not
- stable. */
-size_t
-partition (void *array, size_t count, size_t size,
- algo_predicate_func *predicate, void *aux)
-{
- size_t nonzero_cnt = count;
- char *first = array;
- char *last = first + nonzero_cnt * size;
-
- for (;;)
- {
- /* Move FIRST forward to point to first element that fails
- PREDICATE. */
- for (;;)
- {
- if (first == last)
- goto done;
- else if (!predicate (first, aux))
- break;
-
- first += size;
- }
- nonzero_cnt--;
-
- /* Move LAST backward to point to last element that passes
- PREDICATE. */
- for (;;)
- {
- last -= size;
-
- if (first == last)
- goto done;
- else if (predicate (last, aux))
- break;
- else
- nonzero_cnt--;
- }
-
- /* By swapping FIRST and LAST we extend the starting and
- ending sequences that pass and fail, respectively,
- PREDICATE. */
- SWAP (first, last, size);
- first += size;
- }
-
- done:
- assert (is_partitioned (array, count, size, nonzero_cnt, predicate, aux));
- return nonzero_cnt;
-}
-
-/* Checks whether ARRAY, which contains COUNT elements of SIZE
- bytes each, is partitioned such that PREDICATE returns nonzero
- for the first NONZERO_CNT elements and zero for the remaining
- elements. AUX is passed as auxiliary data to PREDICATE. */
-int
-is_partitioned (const void *array, size_t count, size_t size,
- size_t nonzero_cnt,
- algo_predicate_func *predicate, void *aux)
-{
- const char *first = array;
- size_t idx;
-
- assert (nonzero_cnt <= count);
- for (idx = 0; idx < nonzero_cnt; idx++)
- if (predicate (first + idx * size, aux) == 0)
- return 0;
- for (idx = nonzero_cnt; idx < count; idx++)
- if (predicate (first + idx * size, aux) != 0)
- return 0;
- return 1;
-}
-\f
-/* Copies the COUNT elements of SIZE bytes each from ARRAY to
- RESULT, except that elements for which PREDICATE is false are
- not copied. Returns the number of elements copied. AUX is
- passed to PREDICATE as auxiliary data. */
-size_t
-copy_if (const void *array, size_t count, size_t size,
- void *result,
- algo_predicate_func *predicate, void *aux)
-{
- const char *input = array;
- const char *last = input + size * count;
- char *output = result;
- size_t nonzero_cnt = 0;
-
- while (input < last)
- {
- if (predicate (input, aux))
- {
- memcpy (output, input, size);
- output += size;
- nonzero_cnt++;
- }
-
- input += size;
- }
-
- assert (nonzero_cnt == count_if (array, count, size, predicate, aux));
- assert (nonzero_cnt == count_if (result, nonzero_cnt, size, predicate, aux));
-
- return nonzero_cnt;
-}
-
-/* Removes N elements starting at IDX from ARRAY, which consists
- of COUNT elements of SIZE bytes each, by shifting the elements
- following them, if any, into its position. */
-void
-remove_range (void *array_, size_t count, size_t size,
- size_t idx, size_t n)
-{
- char *array = array_;
-
- assert (array != NULL);
- assert (idx <= count);
- assert (idx + n <= count);
-
- if (idx + n < count)
- memmove (array + idx * size, array + (idx + n) * size,
- size * (count - idx - n));
-}
-
-/* Removes element IDX from ARRAY, which consists of COUNT
- elements of SIZE bytes each, by shifting the elements
- following it, if any, into its position. */
-void
-remove_element (void *array, size_t count, size_t size,
- size_t idx)
-{
- remove_range (array, count, size, idx, 1);
-}
-
-/* Moves an element in ARRAY, which consists of COUNT elements of
- SIZE bytes each, from OLD_IDX to NEW_IDX, shifting around
- other elements as needed. Runs in O(abs(OLD_IDX - NEW_IDX))
- time. */
-void
-move_element (void *array_, size_t count, size_t size,
- size_t old_idx, size_t new_idx)
-{
- assert (array_ != NULL || count == 0);
- assert (old_idx < count);
- assert (new_idx < count);
-
- if (old_idx != new_idx)
- {
- char *array = array_;
- char *element = xmalloc (size);
- char *new = array + new_idx * size;
- char *old = array + old_idx * size;
-
- memcpy (element, old, size);
- if (new < old)
- memmove (new + size, new, (old_idx - new_idx) * size);
- else
- memmove (old, old + size, (new_idx - old_idx) * size);
- memcpy (new, element, size);
-
- free (element);
- }
-}
-
-/* A predicate and its auxiliary data. */
-struct pred_aux
- {
- algo_predicate_func *predicate;
- void *aux;
- };
-
-static int
-not (const void *data, void *pred_aux_)
-{
- const struct pred_aux *pred_aux = pred_aux_;
-
- return !pred_aux->predicate (data, pred_aux->aux);
-}
-
-/* Removes elements equal to ELEMENT from ARRAY, which consists
- of COUNT elements of SIZE bytes each. Returns the number of
- remaining elements. AUX is passed to COMPARE as auxiliary
- data. */
-size_t
-remove_equal (void *array, size_t count, size_t size,
- void *element,
- algo_compare_func *compare, void *aux)
-{
- char *first = array;
- char *last = first + count * size;
- char *result;
-
- for (;;)
- {
- if (first >= last)
- goto done;
- if (compare (first, element, aux) == 0)
- break;
-
- first += size;
- }
-
- result = first;
- count--;
- for (;;)
- {
- first += size;
- if (first >= last)
- goto done;
-
- if (compare (first, element, aux) == 0)
- {
- count--;
- continue;
- }
-
- memcpy (result, first, size);
- result += size;
- }
-
- done:
- assert (count_equal (array, count, size, element, compare, aux) == 0);
- return count;
-}
-
-/* Copies the COUNT elements of SIZE bytes each from ARRAY to
- RESULT, except that elements for which PREDICATE is true are
- not copied. Returns the number of elements copied. AUX is
- passed to PREDICATE as auxiliary data. */
-size_t
-remove_copy_if (const void *array, size_t count, size_t size,
- void *result,
- algo_predicate_func *predicate, void *aux)
-{
- struct pred_aux pred_aux;
- pred_aux.predicate = predicate;
- pred_aux.aux = aux;
- return copy_if (array, count, size, result, not, &pred_aux);
-}
-\f
-/* Searches ARRAY, which contains COUNT of SIZE bytes each, using
- a binary search. Returns any element that equals VALUE, if
- one exists, or a null pointer otherwise. ARRAY must ordered
- according to COMPARE. AUX is passed to COMPARE as auxiliary
- data. */
-void *
-binary_search (const void *array, size_t count, size_t size,
- void *value,
- algo_compare_func *compare, void *aux)
-{
- assert (array != NULL);
- assert (count <= INT_MAX);
- assert (compare != NULL);
-
- if (count != 0)
- {
- const char *first = array;
- int low = 0;
- int high = count - 1;
-
- while (low <= high)
- {
- int middle = (low + high) / 2;
- const char *element = first + middle * size;
- int cmp = compare (value, element, aux);
-
- if (cmp > 0)
- low = middle + 1;
- else if (cmp < 0)
- high = middle - 1;
- else
- return (void *) element;
- }
- }
-
- expensive_assert (find (array, count, size, value, compare, aux) == NULL);
- return NULL;
-}
-\f
-/* Lexicographically compares ARRAY1, which contains COUNT1
- elements of SIZE bytes each, to ARRAY2, which contains COUNT2
- elements of SIZE bytes, according to COMPARE. Returns a
- strcmp()-type result. AUX is passed to COMPARE as auxiliary
- data. */
-int
-lexicographical_compare_3way (const void *array1, size_t count1,
- const void *array2, size_t count2,
- size_t size,
- algo_compare_func *compare, void *aux)
-{
- const char *first1 = array1;
- const char *first2 = array2;
- size_t min_count = count1 < count2 ? count1 : count2;
-
- while (min_count > 0)
- {
- int cmp = compare (first1, first2, aux);
- if (cmp != 0)
- return cmp;
-
- first1 += size;
- first2 += size;
- min_count--;
- }
-
- return count1 < count2 ? -1 : count1 > count2;
-}
-\f
-/* If you consider tuning this algorithm, you should consult first:
- Engineering a sort function; Jon Bentley and M. Douglas McIlroy;
- Software - Practice and Experience; Vol. 23 (11), 1249-1265, 1993. */
-
-#include <limits.h>
-#include <stdlib.h>
-#include <string.h>
-
-/* Discontinue quicksort algorithm when partition gets below this size.
- This particular magic number was chosen to work best on a Sun 4/260. */
-#define MAX_THRESH 4
-
-/* Stack node declarations used to store unfulfilled partition obligations. */
-typedef struct
- {
- char *lo;
- char *hi;
- } stack_node;
-
-/* The next 4 #defines implement a very fast in-line stack abstraction. */
-/* The stack needs log (total_elements) entries (we could even subtract
- log(MAX_THRESH)). Since total_elements has type size_t, we get as
- upper bound for log (total_elements):
- bits per byte (CHAR_BIT) * sizeof(size_t). */
-#define STACK_SIZE (CHAR_BIT * sizeof(size_t))
-#define PUSH(low, high) ((void) ((top->lo = (low)), (top->hi = (high)), ++top))
-#define POP(low, high) ((void) (--top, (low = top->lo), (high = top->hi)))
-#define STACK_NOT_EMPTY (stack < top)
-
-
-/* Order size using quicksort. This implementation incorporates
- four optimizations discussed in Sedgewick:
-
- 1. Non-recursive, using an explicit stack of pointer that store the
- next array partition to sort. To save time, this maximum amount
- of space required to store an array of SIZE_MAX is allocated on the
- stack. Assuming a 32-bit (64 bit) integer for size_t, this needs
- only 32 * sizeof(stack_node) == 256 bytes (for 64 bit: 1024 bytes).
- Pretty cheap, actually.
-
- 2. Chose the pivot element using a median-of-three decision tree.
- This reduces the probability of selecting a bad pivot value and
- eliminates certain extraneous comparisons.
-
- 3. Only quicksorts TOTAL_ELEMS / MAX_THRESH partitions, leaving
- insertion sort to order the MAX_THRESH items within each partition.
- This is a big win, since insertion sort is faster for small, mostly
- sorted array segments.
-
- 4. The larger of the two sub-partitions is always pushed onto the
- stack first, with the algorithm then concentrating on the
- smaller partition. This *guarantees* no more than log (total_elems)
- stack size is needed (actually O(1) in this case)! */
-
-void
-sort (void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux)
-{
- char *const first = array;
- const size_t max_thresh = MAX_THRESH * size;
-
- if (count == 0)
- /* Avoid lossage with unsigned arithmetic below. */
- return;
-
- if (count > MAX_THRESH)
- {
- char *lo = first;
- char *hi = &lo[size * (count - 1)];
- stack_node stack[STACK_SIZE];
- stack_node *top = stack + 1;
-
- while (STACK_NOT_EMPTY)
- {
- char *left_ptr;
- char *right_ptr;
-
- /* Select median value from among LO, MID, and HI. Rearrange
- LO and HI so the three values are sorted. This lowers the
- probability of picking a pathological pivot value and
- skips a comparison for both the LEFT_PTR and RIGHT_PTR in
- the while loops. */
-
- char *mid = lo + size * ((hi - lo) / size >> 1);
-
- if (compare (mid, lo, aux) < 0)
- SWAP (mid, lo, size);
- if (compare (hi, mid, aux) < 0)
- SWAP (mid, hi, size);
- else
- goto jump_over;
- if (compare (mid, lo, aux) < 0)
- SWAP (mid, lo, size);
- jump_over:;
-
- left_ptr = lo + size;
- right_ptr = hi - size;
-
- /* Here's the famous ``collapse the walls'' section of quicksort.
- Gotta like those tight inner loops! They are the main reason
- that this algorithm runs much faster than others. */
- do
- {
- while (compare (left_ptr, mid, aux) < 0)
- left_ptr += size;
-
- while (compare (mid, right_ptr, aux) < 0)
- right_ptr -= size;
-
- if (left_ptr < right_ptr)
- {
- SWAP (left_ptr, right_ptr, size);
- if (mid == left_ptr)
- mid = right_ptr;
- else if (mid == right_ptr)
- mid = left_ptr;
- left_ptr += size;
- right_ptr -= size;
- }
- else if (left_ptr == right_ptr)
- {
- left_ptr += size;
- right_ptr -= size;
- break;
- }
- }
- while (left_ptr <= right_ptr);
-
- /* Set up pointers for next iteration. First determine whether
- left and right partitions are below the threshold size. If so,
- ignore one or both. Otherwise, push the larger partition's
- bounds on the stack and continue sorting the smaller one. */
-
- if ((size_t) (right_ptr - lo) <= max_thresh)
- {
- if ((size_t) (hi - left_ptr) <= max_thresh)
- /* Ignore both small partitions. */
- POP (lo, hi);
- else
- /* Ignore small left partition. */
- lo = left_ptr;
- }
- else if ((size_t) (hi - left_ptr) <= max_thresh)
- /* Ignore small right partition. */
- hi = right_ptr;
- else if ((right_ptr - lo) > (hi - left_ptr))
- {
- /* Push larger left partition indices. */
- PUSH (lo, right_ptr);
- lo = left_ptr;
- }
- else
- {
- /* Push larger right partition indices. */
- PUSH (left_ptr, hi);
- hi = right_ptr;
- }
- }
- }
-
- /* Once the FIRST array is partially sorted by quicksort the rest
- is completely sorted using insertion sort, since this is efficient
- for partitions below MAX_THRESH size. FIRST points to the beginning
- of the array to sort, and END_PTR points at the very last element in
- the array (*not* one beyond it!). */
-
-#define min(x, y) ((x) < (y) ? (x) : (y))
-
- {
- char *const end_ptr = &first[size * (count - 1)];
- char *tmp_ptr = first;
- char *thresh = min(end_ptr, first + max_thresh);
- register char *run_ptr;
-
- /* Find smallest element in first threshold and place it at the
- array's beginning. This is the smallest array element,
- and the operation speeds up insertion sort's inner loop. */
-
- for (run_ptr = tmp_ptr + size; run_ptr <= thresh; run_ptr += size)
- if (compare (run_ptr, tmp_ptr, aux) < 0)
- tmp_ptr = run_ptr;
-
- if (tmp_ptr != first)
- SWAP (tmp_ptr, first, size);
-
- /* Insertion sort, running from left-hand-side up to right-hand-side. */
-
- run_ptr = first + size;
- while ((run_ptr += size) <= end_ptr)
- {
- tmp_ptr = run_ptr - size;
- while (compare (run_ptr, tmp_ptr, aux) < 0)
- tmp_ptr -= size;
-
- tmp_ptr += size;
- if (tmp_ptr != run_ptr)
- {
- char *trav;
-
- trav = run_ptr + size;
- while (--trav >= run_ptr)
- {
- char c = *trav;
- char *hi, *lo;
-
- for (hi = lo = trav; (lo -= size) >= tmp_ptr; hi = lo)
- *hi = *lo;
- *hi = c;
- }
- }
- }
- }
-
- assert (is_sorted (array, count, size, compare, aux));
-}
-
-/* Tests whether ARRAY, which contains COUNT elements of SIZE
- bytes each, is sorted in order according to COMPARE. AUX is
- passed to COMPARE as auxiliary data. */
-int
-is_sorted (const void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux)
-{
- const char *first = array;
- size_t idx;
-
- for (idx = 0; idx + 1 < count; idx++)
- if (compare (first + idx * size, first + (idx + 1) * size, aux) > 0)
- return 0;
-
- return 1;
-}
-\f
-/* Computes the generalized set difference, ARRAY1 minus ARRAY2,
- into RESULT, and returns the number of elements written to
- RESULT. If a value appears M times in ARRAY1 and N times in
- ARRAY2, then it will appear max(M - N, 0) in RESULT. ARRAY1
- and ARRAY2 must be sorted, and RESULT is sorted and stable.
- ARRAY1 consists of COUNT1 elements, ARRAY2 of COUNT2 elements,
- each SIZE bytes. AUX is passed to COMPARE as auxiliary
- data. */
-size_t set_difference (const void *array1, size_t count1,
- const void *array2, size_t count2,
- size_t size,
- void *result_,
- algo_compare_func *compare, void *aux)
-{
- const char *first1 = array1;
- const char *last1 = first1 + count1 * size;
- const char *first2 = array2;
- const char *last2 = first2 + count2 * size;
- char *result = result_;
- size_t result_count = 0;
-
- while (first1 != last1 && first2 != last2)
- {
- int cmp = compare (first1, first2, aux);
- if (cmp < 0)
- {
- memcpy (result, first1, size);
- first1 += size;
- result += size;
- result_count++;
- }
- else if (cmp > 0)
- first2 += size;
- else
- {
- first1 += size;
- first2 += size;
- }
- }
-
- while (first1 != last1)
- {
- memcpy (result, first1, size);
- first1 += size;
- result += size;
- result_count++;
- }
-
- return result_count;
-}
-\f
-/* Finds the first pair of adjacent equal elements in ARRAY,
- which has COUNT elements of SIZE bytes. Returns the first
- element in ARRAY such that COMPARE returns zero when it and
- its successor element are compared, or a null pointer if no
- such element exists. AUX is passed to COMPARE as auxiliary
- data. */
-void *
-adjacent_find_equal (const void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux)
-{
- const char *first = array;
- const char *last = first + count * size;
-
- while (first < last && first + size < last)
- {
- if (compare (first, first + size, aux) == 0)
- return (void *) first;
- first += size;
- }
-
- return NULL;
-}
-\f
-/* ARRAY contains COUNT elements of SIZE bytes each. Initially
- the first COUNT - 1 elements of these form a heap, followed by
- a single element not part of the heap. This function adds the
- final element, forming a heap of COUNT elements in ARRAY.
- Uses COMPARE to compare elements, passing AUX as auxiliary
- data. */
-void
-push_heap (void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux)
-{
- char *first = array;
- size_t i;
-
- expensive_assert (count < 1 || is_heap (array, count - 1,
- size, compare, aux));
- for (i = count; i > 1; i /= 2)
- {
- char *parent = first + (i / 2 - 1) * size;
- char *element = first + (i - 1) * size;
- if (compare (parent, element, aux) < 0)
- SWAP (parent, element, size);
- else
- break;
- }
- expensive_assert (is_heap (array, count, size, compare, aux));
-}
-
-/* ARRAY contains COUNT elements of SIZE bytes each. Initially
- the children of ARRAY[idx - 1] are heaps, but ARRAY[idx - 1]
- may be smaller than its children. This function fixes that,
- so that ARRAY[idx - 1] itself is a heap. Uses COMPARE to
- compare elements, passing AUX as auxiliary data. */
-static void
-heapify (void *array, size_t count, size_t size,
- size_t idx,
- algo_compare_func *compare, void *aux)
-{
- char *first = array;
-
- for (;;)
- {
- size_t left = 2 * idx;
- size_t right = left + 1;
- size_t largest = idx;
-
- if (left <= count
- && compare (first + size * (left - 1),
- first + size * (idx - 1), aux) > 0)
- largest = left;
-
- if (right <= count
- && compare (first + size * (right - 1),
- first + size * (largest - 1), aux) > 0)
- largest = right;
-
- if (largest == idx)
- break;
-
- SWAP (first + size * (idx - 1), first + size * (largest - 1), size);
- idx = largest;
- }
-}
-
-/* ARRAY contains COUNT elements of SIZE bytes each. Initially
- all COUNT elements form a heap. This function moves the
- largest element in the heap to the final position in ARRAY and
- reforms a heap of the remaining COUNT - 1 elements at the
- beginning of ARRAY. Uses COMPARE to compare elements, passing
- AUX as auxiliary data. */
-void
-pop_heap (void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux)
-{
- char *first = array;
-
- expensive_assert (is_heap (array, count, size, compare, aux));
- SWAP (first, first + (count - 1) * size, size);
- heapify (first, count - 1, size, 1, compare, aux);
- expensive_assert (count < 1 || is_heap (array, count - 1,
- size, compare, aux));
-}
-
-/* Turns ARRAY, which contains COUNT elements of SIZE bytes, into
- a heap. Uses COMPARE to compare elements, passing AUX as
- auxiliary data. */
-void
-make_heap (void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux)
-{
- size_t idx;
-
- for (idx = count / 2; idx >= 1; idx--)
- heapify (array, count, size, idx, compare, aux);
- expensive_assert (count < 1 || is_heap (array, count, size, compare, aux));
-}
-
-/* ARRAY contains COUNT elements of SIZE bytes each. Initially
- all COUNT elements form a heap. This function turns the heap
- into a fully sorted array. Uses COMPARE to compare elements,
- passing AUX as auxiliary data. */
-void
-sort_heap (void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux)
-{
- char *first = array;
- size_t idx;
-
- expensive_assert (is_heap (array, count, size, compare, aux));
- for (idx = count; idx >= 2; idx--)
- {
- SWAP (first, first + (idx - 1) * size, size);
- heapify (array, idx - 1, size, 1, compare, aux);
- }
- expensive_assert (is_sorted (array, count, size, compare, aux));
-}
-
-/* ARRAY contains COUNT elements of SIZE bytes each. This
- function tests whether ARRAY is a heap and returns 1 if so, 0
- otherwise. Uses COMPARE to compare elements, passing AUX as
- auxiliary data. */
-int
-is_heap (const void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux)
-{
- const char *first = array;
- size_t child;
-
- for (child = 2; child <= count; child++)
- {
- size_t parent = child / 2;
- if (compare (first + (parent - 1) * size,
- first + (child - 1) * size, aux) < 0)
- return 0;
- }
-
- return 1;
-}
-
+++ /dev/null
-#ifndef ALGORITHM_H
-#define ALGORITHM_H 1
-
-#include <stddef.h>
-
-/* Compares A and B, given auxiliary data AUX, and returns a
- strcmp()-type result. */
-typedef int algo_compare_func (const void *a, const void *b, void *aux);
-
-/* Tests a predicate on DATA, given auxiliary data AUX, and
- returns nonzero if true or zero if false. */
-typedef int algo_predicate_func (const void *data, void *aux);
-
-/* Returns a random number in the range 0 through MAX exclusive,
- given auxiliary data AUX. */
-typedef unsigned algo_random_func (unsigned max, void *aux);
-
-/* A generally suitable random function. */
-algo_random_func algo_default_random;
-
-/* Finds an element in ARRAY, which contains COUNT elements of
- SIZE bytes each, using COMPARE for comparisons. Returns the
- first element in ARRAY that matches TARGET, or a null pointer
- on failure. AUX is passed to each comparison as auxiliary
- data. */
-void *find (const void *array, size_t count, size_t size,
- const void *target,
- algo_compare_func *compare, void *aux);
-
-/* Counts and return the number of elements in ARRAY, which
- contains COUNT elements of SIZE bytes each, which are equal to
- ELEMENT as compared with COMPARE. AUX is passed as auxiliary
- data to COMPARE. */
-size_t count_equal (const void *array, size_t count, size_t size,
- const void *element,
- algo_compare_func *compare, void *aux);
-
-/* Counts and return the number of elements in ARRAY, which
- contains COUNT elements of SIZE bytes each, for which
- PREDICATE returns nonzero. AUX is passed as auxiliary data to
- PREDICATE. */
-size_t count_if (const void *array, size_t count, size_t size,
- algo_predicate_func *predicate, void *aux);
-
-/* Sorts ARRAY, which contains COUNT elements of SIZE bytes each,
- using COMPARE for comparisons. AUX is passed to each
- comparison as auxiliary data. */
-void sort (void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux);
-
-/* Tests whether ARRAY, which contains COUNT elements of SIZE
- bytes each, is sorted in order according to COMPARE. AUX is
- passed to COMPARE as auxiliary data. */
-int is_sorted (const void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux);
-
-/* Makes the elements in ARRAY unique, by moving up duplicates,
- and returns the new number of elements in the array. Sorted
- arrays only. Arguments same as for sort() above. */
-size_t unique (void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux);
-
-/* Helper function that calls sort(), then unique(). */
-size_t sort_unique (void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux);
-
-/* Reorders ARRAY, which contains COUNT elements of SIZE bytes
- each, so that the elements for which PREDICATE returns nonzero
- precede those for which PREDICATE returns zero. AUX is passed
- as auxiliary data to PREDICATE. Returns the number of
- elements for which PREDICATE returns nonzero. Not stable. */
-size_t partition (void *array, size_t count, size_t size,
- algo_predicate_func *predicate, void *aux);
-
-/* Checks whether ARRAY, which contains COUNT elements of SIZE
- bytes each, is partitioned such that PREDICATE returns nonzero
- for the first NONZERO_CNT elements and zero for the remaining
- elements. AUX is passed as auxiliary data to PREDICATE. */
-int is_partitioned (const void *array, size_t count, size_t size,
- size_t nonzero_cnt,
- algo_predicate_func *predicate, void *aux);
-
-/* Randomly reorders ARRAY, which contains COUNT elements of SIZE
- bytes each. Uses RANDOM as a source of random data, passing
- AUX as the auxiliary data. RANDOM may be null to use a
- default random source. */
-void random_shuffle (void *array, size_t count, size_t size,
- algo_random_func *random, void *aux);
-
-/* Copies the COUNT elements of SIZE bytes each from ARRAY to
- RESULT, except that elements for which PREDICATE is false are
- not copied. Returns the number of elements copied. AUX is
- passed to PREDICATE as auxiliary data. */
-size_t copy_if (const void *array, size_t count, size_t size,
- void *result,
- algo_predicate_func *predicate, void *aux);
-
-/* Removes N elements starting at IDX from ARRAY, which consists
- of COUNT elements of SIZE bytes each, by shifting the elements
- following them, if any, into its position. */
-void remove_range (void *array, size_t count, size_t size,
- size_t idx, size_t n);
-
-/* Removes element IDX from ARRAY, which consists of COUNT
- elements of SIZE bytes each, by shifting the elements
- following it, if any, into its position. */
-void remove_element (void *array, size_t count, size_t size,
- size_t idx);
-
-/* Moves an element in ARRAY, which consists of COUNT elements of
- SIZE bytes each, from OLD_IDX to NEW_IDX, shifting around
- other elements as needed. Runs in O(abs(OLD_IDX - NEW_IDX))
- time. */
-void move_element (void *array, size_t count, size_t size,
- size_t old_idx, size_t new_idx);
-
-/* Removes elements equal to ELEMENT from ARRAY, which consists
- of COUNT elements of SIZE bytes each. Returns the number of
- remaining elements. AUX is passed to COMPARE as auxiliary
- data. */
-size_t remove_equal (void *array, size_t count, size_t size,
- void *element,
- algo_compare_func *compare, void *aux);
-
-/* Copies the COUNT elements of SIZE bytes each from ARRAY to
- RESULT, except that elements for which PREDICATE is true are
- not copied. Returns the number of elements copied. AUX is
- passed to PREDICATE as auxiliary data. */
-size_t remove_copy_if (const void *array, size_t count, size_t size,
- void *result,
- algo_predicate_func *predicate, void *aux);
-
-/* Searches ARRAY, which contains COUNT elements of SIZE bytes
- each, for VALUE, using a binary search. ARRAY must ordered
- according to COMPARE. AUX is passed to COMPARE as auxiliary
- data. */
-void *binary_search (const void *array, size_t count, size_t size,
- void *value,
- algo_compare_func *compare, void *aux);
-
-/* Lexicographically compares ARRAY1, which contains COUNT1
- elements of SIZE bytes each, to ARRAY2, which contains COUNT2
- elements of SIZE bytes, according to COMPARE. Returns a
- strcmp()-type result. AUX is passed to COMPARE as auxiliary
- data. */
-int lexicographical_compare_3way (const void *array1, size_t count1,
- const void *array2, size_t count2,
- size_t size,
- algo_compare_func *compare, void *aux);
-
-/* Computes the generalized set difference, ARRAY1 minus ARRAY2,
- into RESULT, and returns the number of elements written to
- RESULT. If a value appears M times in ARRAY1 and N times in
- ARRAY2, then it will appear max(M - N, 0) in RESULT. ARRAY1
- and ARRAY2 must be sorted, and RESULT is sorted and stable.
- ARRAY1 consists of COUNT1 elements, ARRAY2 of COUNT2 elements,
- each SIZE bytes. AUX is passed to COMPARE as auxiliary
- data. */
-size_t set_difference (const void *array1, size_t count1,
- const void *array2, size_t count2,
- size_t size,
- void *result,
- algo_compare_func *compare, void *aux);
-
-/* Finds the first pair of adjacent equal elements in ARRAY,
- which has COUNT elements of SIZE bytes. Returns the first
- element in ARRAY such that COMPARE returns zero when it and
- its successor element are compared. AUX is passed to COMPARE
- as auxiliary data. */
-void *adjacent_find_equal (const void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux);
-
-/* ARRAY contains COUNT elements of SIZE bytes each. Initially
- the first COUNT - 1 elements of these form a heap, followed by
- a single element not part of the heap. This function adds the
- final element, forming a heap of COUNT elements in ARRAY.
- Uses COMPARE to compare elements, passing AUX as auxiliary
- data. */
-void push_heap (void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux);
-
-/* ARRAY contains COUNT elements of SIZE bytes each. Initially
- all COUNT elements form a heap. This function moves the
- largest element in the heap to the final position in ARRAY and
- reforms a heap of the remaining COUNT - 1 elements at the
- beginning of ARRAY. Uses COMPARE to compare elements, passing
- AUX as auxiliary data. */
-void pop_heap (void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux);
-
-/* Turns ARRAY, which contains COUNT elements of SIZE bytes, into
- a heap. Uses COMPARE to compare elements, passing AUX as
- auxiliary data. */
-void make_heap (void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux);
-
-/* ARRAY contains COUNT elements of SIZE bytes each. Initially
- all COUNT elements form a heap. This function turns the heap
- into a fully sorted array. Uses COMPARE to compare elements,
- passing AUX as auxiliary data. */
-void sort_heap (void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux);
-
-/* ARRAY contains COUNT elements of SIZE bytes each. This
- function tests whether ARRAY is a heap and returns 1 if so, 0
- otherwise. Uses COMPARE to compare elements, passing AUX as
- auxiliary data. */
-int is_heap (const void *array, size_t count, size_t size,
- algo_compare_func *compare, void *aux);
-
-
-#endif /* algorithm.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "alloc.h"
-#include <stdlib.h>
-
-/* Allocates and returns N elements of S bytes each.
- N must be nonnegative, S must be positive.
- Returns a null pointer if the memory cannot be obtained,
- including the case where N * S overflows the range of size_t. */
-void *
-nmalloc (size_t n, size_t s)
-{
- return !xalloc_oversized (n, s) ? malloc (n * s) : NULL;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !alloc_h
-#define alloc_h 1
-
-#include <stddef.h>
-
-/* malloc() wrapper functions. */
-#include "xalloc.h"
-
-void *nmalloc (size_t n, size_t s);
-
-/* alloca() wrapper functions. */
-#if defined (HAVE_ALLOCA) || defined (C_ALLOCA)
-#ifdef HAVE_ALLOCA_H
-#include <alloca.h>
-#endif
-#define local_alloc(X) alloca (X)
-#define local_free(P) ((void) 0)
-#else
-#define local_alloc(X) xmalloc (X)
-#define local_free(P) free (P)
-#endif
-
-#endif /* alloc.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "any-reader.h"
-#include <assert.h>
-#include <errno.h>
-#include <stdbool.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include "error.h"
-#include "file-handle-def.h"
-#include "filename.h"
-#include "pfm-read.h"
-#include "sfm-read.h"
-#include "str.h"
-#include "scratch-reader.h"
-#include "xalloc.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* Type of file backing an any_reader. */
-enum any_reader_type
- {
- SYSTEM_FILE, /* System file. */
- PORTABLE_FILE, /* Portable file. */
- SCRATCH_FILE /* Scratch file. */
- };
-
-/* Reader for any type of case-structured file. */
-struct any_reader
- {
- enum any_reader_type type; /* Type of file. */
- void *private; /* Private data. */
- };
-
-/* Result of type detection. */
-enum detect_result
- {
- YES, /* It is this type. */
- NO, /* It is not this type. */
- IO_ERROR /* File couldn't be opened. */
- };
-
-/* Tries to detect whether HANDLE represents a given type of
- file, by opening the file and passing it to DETECT, and
- returns a detect_result. */
-static enum detect_result
-try_detect (struct file_handle *handle, bool (*detect) (FILE *))
-{
- FILE *file;
- bool is_type;
-
- file = fn_open (fh_get_filename (handle), "rb");
- if (file == NULL)
- {
- msg (ME, _("An error occurred while opening \"%s\": %s."),
- fh_get_filename (handle), strerror (errno));
- return IO_ERROR;
- }
-
- is_type = detect (file);
-
- fn_close (fh_get_filename (handle), file);
-
- return is_type ? YES : NO;
-}
-
-/* If PRIVATE is non-null, creates and returns a new any_reader,
- initializing its fields to TYPE and PRIVATE. If PRIVATE is a
- null pointer, just returns a null pointer. */
-static struct any_reader *
-make_any_reader (enum any_reader_type type, void *private)
-{
- if (private != NULL)
- {
- struct any_reader *reader = xmalloc (sizeof *reader);
- reader->type = type;
- reader->private = private;
- return reader;
- }
- else
- return NULL;
-}
-
-/* Creates an any_reader for HANDLE. On success, returns the new
- any_reader and stores the file's dictionary into *DICT. On
- failure, returns a null pointer. */
-struct any_reader *
-any_reader_open (struct file_handle *handle, struct dictionary **dict)
-{
- switch (fh_get_referent (handle))
- {
- case FH_REF_FILE:
- {
- enum detect_result result;
-
- result = try_detect (handle, sfm_detect);
- if (result == IO_ERROR)
- return NULL;
- else if (result == YES)
- return make_any_reader (SYSTEM_FILE,
- sfm_open_reader (handle, dict, NULL));
-
- result = try_detect (handle, pfm_detect);
- if (result == IO_ERROR)
- return NULL;
- else if (result == YES)
- return make_any_reader (PORTABLE_FILE,
- pfm_open_reader (handle, dict, NULL));
-
- msg (SE, _("\"%s\" is not a system or portable file."),
- fh_get_filename (handle));
- return NULL;
- }
-
- case FH_REF_INLINE:
- msg (SE, _("The inline file is not allowed here."));
- return NULL;
-
- case FH_REF_SCRATCH:
- return make_any_reader (SCRATCH_FILE,
- scratch_reader_open (handle, dict));
- }
- abort ();
-}
-
-/* Reads a single case from READER into C.
- Returns true if successful, false at end of file or on error. */
-bool
-any_reader_read (struct any_reader *reader, struct ccase *c)
-{
- switch (reader->type)
- {
- case SYSTEM_FILE:
- return sfm_read_case (reader->private, c);
-
- case PORTABLE_FILE:
- return pfm_read_case (reader->private, c);
-
- case SCRATCH_FILE:
- return scratch_reader_read_case (reader->private, c);
- }
- abort ();
-}
-
-/* Closes READER. */
-void
-any_reader_close (struct any_reader *reader)
-{
- if (reader == NULL)
- return;
-
- switch (reader->type)
- {
- case SYSTEM_FILE:
- sfm_close_reader (reader->private);
- break;
-
- case PORTABLE_FILE:
- pfm_close_reader (reader->private);
- break;
-
- case SCRATCH_FILE:
- scratch_reader_close (reader->private);
- break;
-
- default:
- abort ();
- }
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef ANY_READER_H
-#define ANY_READER_H 1
-
-#include <stdbool.h>
-
-struct file_handle;
-struct dictionary;
-struct ccase;
-struct any_reader *any_reader_open (struct file_handle *,
- struct dictionary **);
-bool any_reader_read (struct any_reader *, struct ccase *);
-void any_reader_close (struct any_reader *);
-
-#endif /* any-reader.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "any-writer.h"
-#include <assert.h>
-#include <errno.h>
-#include <stdbool.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include "error.h"
-#include "file-handle-def.h"
-#include "filename.h"
-#include "pfm-write.h"
-#include "sfm-write.h"
-#include "str.h"
-#include "scratch-writer.h"
-#include "xalloc.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* Type of file backing an any_writer. */
-enum any_writer_type
- {
- SYSTEM_FILE, /* System file. */
- PORTABLE_FILE, /* Portable file. */
- SCRATCH_FILE /* Scratch file. */
- };
-
-/* Writer for any type of case-structured file. */
-struct any_writer
- {
- enum any_writer_type type; /* Type of file. */
- void *private; /* Private data. */
- };
-
-/* Creates and returns a writer for HANDLE with the given DICT. */
-struct any_writer *
-any_writer_open (struct file_handle *handle, struct dictionary *dict)
-{
- switch (fh_get_referent (handle))
- {
- case FH_REF_FILE:
- {
- struct any_writer *writer;
- char *extension;
-
- extension = fn_extension (fh_get_filename (handle));
- str_lowercase (extension);
-
- if (!strcmp (extension, ".por"))
- writer = any_writer_from_pfm_writer (
- pfm_open_writer (handle, dict, pfm_writer_default_options ()));
- else
- writer = any_writer_from_sfm_writer (
- sfm_open_writer (handle, dict, sfm_writer_default_options ()));
- free (extension);
-
- return writer;
- }
-
- case FH_REF_INLINE:
- msg (ME, _("The inline file is not allowed here."));
- return NULL;
-
- case FH_REF_SCRATCH:
- return any_writer_from_scratch_writer (scratch_writer_open (handle,
- dict));
- }
-
- abort ();
-}
-
-/* If PRIVATE is non-null, creates and returns a new any_writer,
- initializing its fields to TYPE and PRIVATE. If PRIVATE is a
- null pointer, just returns a null pointer. */
-static struct any_writer *
-make_any_writer (enum any_writer_type type, void *private)
-{
- if (private != NULL)
- {
- struct any_writer *writer = xmalloc (sizeof *writer);
- writer->type = type;
- writer->private = private;
- return writer;
- }
- else
- return NULL;
-}
-
-/* If SFM_WRITER is non-null, encapsulates SFM_WRITER in an
- any_writer and returns it. If SFM_WRITER is null, just
- returns a null pointer.
-
- Useful when you need to pass options to sfm_open_writer().
- Typical usage:
- any_writer_from_sfm_writer (sfm_open_writer (fh, dict, opts))
- If you don't need to pass options, then any_writer_open() by
- itself is easier and more straightforward. */
-struct any_writer *
-any_writer_from_sfm_writer (struct sfm_writer *sfm_writer)
-{
- return make_any_writer (SYSTEM_FILE, sfm_writer);
-}
-
-/* If PFM_WRITER is non-null, encapsulates PFM_WRITER in an
- any_writer and returns it. If PFM_WRITER is null, just
- returns a null pointer.
-
- Useful when you need to pass options to pfm_open_writer().
- Typical usage:
- any_writer_from_pfm_writer (pfm_open_writer (fh, dict, opts))
- If you don't need to pass options, then any_writer_open() by
- itself is easier and more straightforward. */
-struct any_writer *
-any_writer_from_pfm_writer (struct pfm_writer *pfm_writer)
-{
- return make_any_writer (PORTABLE_FILE, pfm_writer);
-}
-
-/* If SCRATCH_WRITER is non-null, encapsulates SCRATCH_WRITER in
- an any_writer and returns it. If SCRATCH_WRITER is null, just
- returns a null pointer.
-
- Not particularly useful. Included just for consistency. */
-struct any_writer *
-any_writer_from_scratch_writer (struct scratch_writer *scratch_writer)
-{
- return make_any_writer (SCRATCH_FILE, scratch_writer);
-}
-
-/* Writes cases C to WRITER.
- Returns true if successful, false on failure. */
-bool
-any_writer_write (struct any_writer *writer, const struct ccase *c)
-{
- switch (writer->type)
- {
- case SYSTEM_FILE:
- return sfm_write_case (writer->private, c);
-
- case PORTABLE_FILE:
- return pfm_write_case (writer->private, c);
-
- case SCRATCH_FILE:
- scratch_writer_write_case (writer->private, c);
- return true;
- }
- abort ();
-}
-
-/* Closes WRITER. */
-void
-any_writer_close (struct any_writer *writer)
-{
- if (writer == NULL)
- return;
-
- switch (writer->type)
- {
- case SYSTEM_FILE:
- sfm_close_writer (writer->private);
- break;
-
- case PORTABLE_FILE:
- pfm_close_writer (writer->private);
- break;
-
- case SCRATCH_FILE:
- scratch_writer_close (writer->private);
- break;
-
- default:
- abort ();
- }
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef ANY_WRITER_H
-#define ANY_WRITER_H 1
-
-#include <stdbool.h>
-
-struct file_handle;
-struct dictionary;
-struct ccase;
-struct sfm_writer;
-struct pfm_writer;
-struct scratch_writer;
-
-struct any_writer *any_writer_open (struct file_handle *, struct dictionary *);
-struct any_writer *any_writer_from_sfm_writer (struct sfm_writer *);
-struct any_writer *any_writer_from_pfm_writer (struct pfm_writer *);
-struct any_writer *any_writer_from_scratch_writer (struct scratch_writer *);
-
-bool any_writer_write (struct any_writer *, const struct ccase *);
-void any_writer_close (struct any_writer *);
-
-#endif /* any-writer.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <stdlib.h>
-#include "any-reader.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "file-handle.h"
-#include "hash.h"
-#include "lexer.h"
-#include "str.h"
-#include "value-labels.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-/* Parses and executes APPLY DICTIONARY. */
-int
-cmd_apply_dictionary (void)
-{
- struct file_handle *handle;
- struct any_reader *reader;
- struct dictionary *dict;
-
- int n_matched = 0;
-
- int i;
-
- lex_match_id ("FROM");
- lex_match ('=');
- handle = fh_parse (FH_REF_FILE | FH_REF_SCRATCH);
- if (!handle)
- return CMD_FAILURE;
-
- reader = any_reader_open (handle, &dict);
- if (dict == NULL)
- return CMD_FAILURE;
- any_reader_close (reader);
-
- for (i = 0; i < dict_get_var_cnt (dict); i++)
- {
- struct variable *s = dict_get_var (dict, i);
- struct variable *t = dict_lookup_var (default_dict, s->name);
- if (t == NULL)
- continue;
-
- n_matched++;
- if (s->type != t->type)
- {
- msg (SW, _("Variable %s is %s in target file, but %s in "
- "source file."),
- s->name,
- t->type == ALPHA ? _("string") : _("numeric"),
- s->type == ALPHA ? _("string") : _("numeric"));
- continue;
- }
-
- if (s->label && strcspn (s->label, " ") != strlen (s->label))
- {
- free (t->label);
- t->label = s->label;
- s->label = NULL;
- }
-
- if (val_labs_count (s->val_labs) && t->width > MAX_SHORT_STRING)
- msg (SW, _("Cannot add value labels from source file to "
- "long string variable %s."),
- s->name);
- else if (val_labs_count (s->val_labs))
- {
- /* Whether to apply the value labels. */
- int apply = 1;
-
- if (t->width < s->width)
- {
- struct val_labs_iterator *i;
- struct val_lab *lab;
-
- for (lab = val_labs_first (s->val_labs, &i); lab != NULL;
- lab = val_labs_next (s->val_labs, &i))
- {
- int j;
-
- /* We will apply the value labels only if all
- the truncated characters are blanks. */
- for (j = t->width; j < s->width; j++)
- if (lab->value.s[j] != ' ')
- {
- val_labs_done (&i);
- apply = 0;
- break;
- }
- }
- }
- else
- {
- /* Fortunately, we follow the convention that all value
- label values are right-padded with spaces, so it is
- unnecessary to bother padding values here. */
- }
-
- if (apply)
- {
- val_labs_destroy (t->val_labs);
- t->val_labs = s->val_labs;
- val_labs_set_width (t->val_labs, t->width);
- s->val_labs = val_labs_create (s->width);
- }
- }
-
- if (!mv_is_empty (&s->miss) && t->width > MAX_SHORT_STRING)
- msg (SW, _("Cannot apply missing values from source file to "
- "long string variable %s."),
- s->name);
- else if (!mv_is_empty (&s->miss))
- {
- if (mv_is_resizable (&s->miss, t->width))
- {
- mv_copy (&t->miss, &s->miss);
- mv_resize (&t->miss, t->width);
- }
- }
-
- if (s->type == NUMERIC)
- {
- t->print = s->print;
- t->write = s->write;
- }
- }
-
- if (!n_matched)
- msg (SW, _("No matching variables found between the source "
- "and target files."));
-
- /* Weighting. */
- if (dict_get_weight (dict) != NULL)
- {
- struct variable *new_weight
- = dict_lookup_var (default_dict, dict_get_weight (dict)->name);
-
- if (new_weight != NULL)
- dict_set_weight (default_dict, new_weight);
- }
-
- any_reader_close (reader);
-
- return lex_end_of_command ();
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <ctype.h>
-#include <errno.h>
-#include <limits.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "error.h"
-#include "filename.h"
-#include "glob.h"
-#include "main.h"
-#include "misc.h"
-#include "output.h"
-#include "pool.h"
-#include "version.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* ASCII driver options: (defaults listed first)
-
- output-file="pspp.list"
- char-set=ascii|latin1
- form-feed-string="\f" Written as a formfeed.
- newline-string=default|"\r\n"|"\n"
- Written as a newline.
- paginate=on|off Formfeeds are desired?
- tab-width=8 Width of a tab; 0 to not use tabs.
- init="" Written at beginning of output.
- done="" Written at end of output.
-
- headers=on|off Put headers at top of page?
- length=66
- width=130
- lpi=6 Only used to determine font size.
- cpi=10
- squeeze=off|on Squeeze multiple newlines into exactly one.
-
- left-margin=0
- right-margin=0
- top-margin=2
- bottom-margin=2
-
- box[x]="strng" Sets box character X (X in base 4: 0-3333).
- italic-on=overstrike|"strng" Turns on italic (underline).
- italic-off=""|"strng" Turns off italic; ignored for overstrike.
- bold-on=overstrike|"strng" Turns on bold.
- bold-off=""|"strng" Turns off bold; ignored for overstrike.
- bold-italic-on=overstrike|"strng" Turns on bold-italic.
- bold-italic-off=""|"strng" Turns off bold-italic; ignored for overstrike.
- overstrike-style=single|line Can we print a whole line then BS over it, or
- must we go char by char, as on a terminal?
- carriage-return-style=bs|cr Must we return the carriage with a sequence of
- BSes, or will a single CR do it?
- */
-
-/* Disable messages by failed range checks. */
-/*#define SUPPRESS_WARNINGS 1 */
-
-/* Character set. */
-enum
- {
- CHS_ASCII, /* 7-bit ASCII */
- CHS_LATIN1 /* Latin 1; not really supported at the moment */
- };
-
-/* Overstrike style. */
-enum
- {
- OVS_SINGLE, /* Overstrike each character: "a\b_b\b_c\b_" */
- OVS_LINE /* Overstrike lines: "abc\b\b\b___" (or if
- newline is "\r\n", then "abc\r___"). Easier
- on the printer, doesn't work on a tty. */
- };
-
-/* Basic output strings. */
-enum
- {
- OPS_INIT, /* Document initialization string. */
- OPS_DONE, /* Document uninit string. */
- OPS_FORMFEED, /* Formfeed string. */
- OPS_NEWLINE, /* Newline string. */
-
- OPS_COUNT /* Number of output strings. */
- };
-
-/* Line styles bit shifts. */
-enum
- {
- LNS_TOP = 0,
- LNS_LEFT = 2,
- LNS_BOTTOM = 4,
- LNS_RIGHT = 6,
-
- LNS_COUNT = 256
- };
-
-/* Carriage return style. */
-enum
- {
- CRS_BS, /* Multiple backspaces. */
- CRS_CR /* Single carriage return. */
- };
-
-/* Assembles a byte from four taystes. */
-#define TAYSTE2BYTE(T, L, B, R) \
- (((T) << LNS_TOP) \
- | ((L) << LNS_LEFT) \
- | ((B) << LNS_BOTTOM) \
- | ((R) << LNS_RIGHT))
-
-/* Extract tayste with shift value S from byte B. */
-#define BYTE2TAYSTE(B, S) \
- (((B) >> (S)) & 3)
-
-/* Font style; take one of the first group |'d with one of the second group. */
-enum
- {
- FSTY_ON = 000, /* Turn font on. */
- FSTY_OFF = 001, /* Turn font off. */
-
- FSTY_ITALIC = 0, /* Italic font. */
- FSTY_BOLD = 2, /* Bold font. */
- FSTY_BOLD_ITALIC = 4, /* Bold-italic font. */
-
- FSTY_COUNT = 6 /* Number of font styles. */
- };
-
-/* A line of text. */
-struct line
- {
- unsigned short *chars; /* Characters and attributes. */
- int char_cnt; /* Length. */
- int char_cap; /* Allocated bytes. */
- };
-
-/* ASCII output driver extension record. */
-struct ascii_driver_ext
- {
- /* User parameters. */
- int char_set; /* CHS_ASCII/CHS_LATIN1; no-op right now. */
- int headers; /* 1=print headers at top of page. */
- int page_length; /* Page length in lines. */
- int page_width; /* Page width in characters. */
- int lpi; /* Lines per inch. */
- int cpi; /* Characters per inch. */
- int left_margin; /* Left margin in characters. */
- int right_margin; /* Right margin in characters. */
- int top_margin; /* Top margin in lines. */
- int bottom_margin; /* Bottom margin in lines. */
- int paginate; /* 1=insert formfeeds. */
- int tab_width; /* Width of a tab; 0 not to use tabs. */
- struct fixed_string ops[OPS_COUNT]; /* Basic output strings. */
- struct fixed_string box[LNS_COUNT]; /* Line & box drawing characters. */
- struct fixed_string fonts[FSTY_COUNT]; /* Font styles; NULL=overstrike. */
- int overstrike_style; /* OVS_SINGLE or OVS_LINE. */
- int carriage_return_style; /* Carriage return style. */
- int squeeze_blank_lines; /* 1=squeeze multiple blank lines into one. */
-
- /* Internal state. */
- struct file_ext file; /* Output file. */
- int page_number; /* Current page number. */
- struct line *lines; /* Page content. */
- int lines_cap; /* Number of lines allocated. */
- int w, l; /* Actual width & length w/o margins, etc. */
- int cur_font; /* Current font by OUTP_F_*. */
-#if GLOBAL_DEBUGGING
- int debug; /* Set by som_text_draw(). */
-#endif
- };
-
-static int postopen (struct file_ext *);
-static int preclose (struct file_ext *);
-
-static struct outp_option_info *option_info;
-
-static int
-ascii_open_global (struct outp_class *this UNUSED)
-{
- option_info = xmalloc (sizeof *option_info);
- option_info->initial = 0;
- option_info->options = 0;
- return 1;
-}
-
-
-static char *s;
-static int
-ascii_close_global (struct outp_class *this UNUSED)
-{
- free(option_info->initial);
- free(option_info->options);
- free(option_info);
- free(s);
- return 1;
-}
-
-static int *
-ascii_font_sizes (struct outp_class *this UNUSED, int *n_valid_sizes)
-{
- static int valid_sizes[] = {12, 12, 0, 0};
-
- assert (n_valid_sizes);
- *n_valid_sizes = 1;
- return valid_sizes;
-}
-
-static int
-ascii_preopen_driver (struct outp_driver *this)
-{
- struct ascii_driver_ext *x;
- int i;
-
- assert (this->driver_open == 0);
- msg (VM (1), _("ASCII driver initializing as `%s'..."), this->name);
- this->ext = x = xmalloc (sizeof *x);
- x->char_set = CHS_ASCII;
- x->headers = 1;
- x->page_length = 66;
- x->page_width = 79;
- x->lpi = 6;
- x->cpi = 10;
- x->left_margin = 0;
- x->right_margin = 0;
- x->top_margin = 2;
- x->bottom_margin = 2;
- x->paginate = 1;
- x->tab_width = 8;
- for (i = 0; i < OPS_COUNT; i++)
- ls_null (&x->ops[i]);
- for (i = 0; i < LNS_COUNT; i++)
- ls_null (&x->box[i]);
- for (i = 0; i < FSTY_COUNT; i++)
- ls_null (&x->fonts[i]);
- x->overstrike_style = OVS_SINGLE;
- x->carriage_return_style = CRS_BS;
- x->squeeze_blank_lines = 0;
- x->file.filename = NULL;
- x->file.mode = "wb";
- x->file.file = NULL;
- x->file.sequence_no = &x->page_number;
- x->file.param = x;
- x->file.postopen = postopen;
- x->file.preclose = preclose;
- x->page_number = 0;
- x->lines = NULL;
- x->lines_cap = 0;
- x->cur_font = OUTP_F_R;
-#if GLOBAL_DEBUGGING
- x->debug = 0;
-#endif
- return 1;
-}
-
-static int
-ascii_postopen_driver (struct outp_driver *this)
-{
- struct ascii_driver_ext *x = this->ext;
-
- assert (this->driver_open == 0);
-
- if (NULL == x->file.filename)
- x->file.filename = xstrdup ("pspp.list");
-
- x->w = x->page_width - x->left_margin - x->right_margin;
- x->l = (x->page_length - (x->headers ? 3 : 0) - x->top_margin
- - x->bottom_margin - 1);
- if (x->w < 59 || x->l < 15)
- {
- msg (SE, _("ascii driver: Area of page excluding margins and headers "
- "must be at least 59 characters wide by 15 lines long. Page as "
- "configured is only %d characters by %d lines."), x->w, x->l);
- return 0;
- }
-
- this->res = x->lpi * x->cpi;
- this->horiz = x->lpi;
- this->vert = x->cpi;
- this->width = x->w * this->horiz;
- this->length = x->l * this->vert;
-
- if (ls_null_p (&x->ops[OPS_FORMFEED]))
- ls_create (&x->ops[OPS_FORMFEED], "\f");
- if (ls_null_p (&x->ops[OPS_NEWLINE])
- || !strcmp (ls_c_str (&x->ops[OPS_NEWLINE]), "default"))
- {
- ls_create (&x->ops[OPS_NEWLINE], "\n");
- x->file.mode = "wt";
- }
-
- {
- int i;
-
- for (i = 0; i < LNS_COUNT; i++)
- {
- char c[2];
- c[1] = 0;
- if (!ls_null_p (&x->box[i]))
- continue;
- switch (i)
- {
- case TAYSTE2BYTE (0, 0, 0, 0):
- c[0] = ' ';
- break;
-
- case TAYSTE2BYTE (0, 1, 0, 0):
- case TAYSTE2BYTE (0, 1, 0, 1):
- case TAYSTE2BYTE (0, 0, 0, 1):
- c[0] = '-';
- break;
-
- case TAYSTE2BYTE (1, 0, 0, 0):
- case TAYSTE2BYTE (1, 0, 1, 0):
- case TAYSTE2BYTE (0, 0, 1, 0):
- c[0] = '|';
- break;
-
- case TAYSTE2BYTE (0, 3, 0, 0):
- case TAYSTE2BYTE (0, 3, 0, 3):
- case TAYSTE2BYTE (0, 0, 0, 3):
- case TAYSTE2BYTE (0, 2, 0, 0):
- case TAYSTE2BYTE (0, 2, 0, 2):
- case TAYSTE2BYTE (0, 0, 0, 2):
- c[0] = '=';
- break;
-
- case TAYSTE2BYTE (3, 0, 0, 0):
- case TAYSTE2BYTE (3, 0, 3, 0):
- case TAYSTE2BYTE (0, 0, 3, 0):
- case TAYSTE2BYTE (2, 0, 0, 0):
- case TAYSTE2BYTE (2, 0, 2, 0):
- case TAYSTE2BYTE (0, 0, 2, 0):
- c[0] = '#';
- break;
-
- default:
- if (BYTE2TAYSTE (i, LNS_LEFT) > 1
- || BYTE2TAYSTE (i, LNS_TOP) > 1
- || BYTE2TAYSTE (i, LNS_RIGHT) > 1
- || BYTE2TAYSTE (i, LNS_BOTTOM) > 1)
- c[0] = '#';
- else
- c[0] = '+';
- break;
- }
- ls_create (&x->box[i], c);
- }
- }
-
- {
- int i;
-
- this->cp_x = this->cp_y = 0;
- this->font_height = this->vert;
- this->prop_em_width = this->horiz;
- this->fixed_width = this->horiz;
-
- this->horiz_line_width[0] = 0;
- this->vert_line_width[0] = 0;
-
- for (i = 1; i < OUTP_L_COUNT; i++)
- {
- this->horiz_line_width[i] = this->vert;
- this->vert_line_width[i] = this->horiz;
- }
-
- for (i = 0; i < (1 << OUTP_L_COUNT); i++)
- {
- this->horiz_line_spacing[i] = (i & ~1) ? this->vert : 0;
- this->vert_line_spacing[i] = (i & ~1) ? this->horiz : 0;
- }
- }
-
- this->driver_open = 1;
- msg (VM (2), _("%s: Initialization complete."), this->name);
-
- return 1;
-}
-
-static int
-ascii_close_driver (struct outp_driver *this)
-{
- struct ascii_driver_ext *x = this->ext;
- int i;
-
- assert (this->driver_open == 1);
- msg (VM (2), _("%s: Beginning closing..."), this->name);
-
- x = this->ext;
- for (i = 0; i < OPS_COUNT; i++)
- ls_destroy (&x->ops[i]);
- for (i = 0; i < LNS_COUNT; i++)
- ls_destroy (&x->box[i]);
- for (i = 0; i < FSTY_COUNT; i++)
- ls_destroy (&x->fonts[i]);
- if (x->lines != NULL)
- {
- int line;
-
- for (line = 0; line < x->lines_cap; line++)
- free (x->lines[line].chars);
- free (x->lines);
- }
- fn_close_ext (&x->file);
- free (x->file.filename);
- free (x);
-
- this->driver_open = 0;
- msg (VM (3), _("%s: Finished closing."), this->name);
-
- return 1;
-}
-
-/* Generic option types. */
-enum
- {
- pos_int_arg = -10,
- nonneg_int_arg,
- string_arg,
- font_string_arg,
- boolean_arg
- };
-
-static struct outp_option option_tab[] =
- {
- {"headers", boolean_arg, 0},
- {"output-file", 1, 0},
- {"char-set", 2, 0},
- {"length", pos_int_arg, 0},
- {"width", pos_int_arg, 1},
- {"lpi", pos_int_arg, 2},
- {"cpi", pos_int_arg, 3},
- {"init", string_arg, 0},
- {"done", string_arg, 1},
- {"left-margin", nonneg_int_arg, 0},
- {"right-margin", nonneg_int_arg, 1},
- {"top-margin", nonneg_int_arg, 2},
- {"bottom-margin", nonneg_int_arg, 3},
- {"paginate", boolean_arg, 1},
- {"form-feed-string", string_arg, 2},
- {"newline-string", string_arg, 3},
- {"italic-on", font_string_arg, 0},
- {"italic-off", font_string_arg, 1},
- {"bold-on", font_string_arg, 2},
- {"bold-off", font_string_arg, 3},
- {"bold-italic-on", font_string_arg, 4},
- {"bold-italic-off", font_string_arg, 5},
- {"overstrike-style", 3, 0},
- {"tab-width", nonneg_int_arg, 4},
- {"carriage-return-style", 4, 0},
- {"squeeze", boolean_arg, 2},
- {"", 0, 0},
- };
-
-static void
-ascii_option (struct outp_driver *this, const char *key,
- const struct string *val)
-{
- struct ascii_driver_ext *x = this->ext;
- int cat, subcat;
- const char *value;
-
- value = ds_c_str (val);
- if (!strncmp (key, "box[", 4))
- {
- char *tail;
- int indx = strtol (&key[4], &tail, 4);
- if (*tail != ']' || indx < 0 || indx > LNS_COUNT)
- {
- msg (SE, _("Bad index value for `box' key: syntax is box[INDEX], "
- "0 <= INDEX < %d decimal, with INDEX expressed in base 4."),
- LNS_COUNT);
- return;
- }
- if (!ls_null_p (&x->box[indx]))
- msg (SW, _("Duplicate value for key `%s'."), key);
- ls_create (&x->box[indx], value);
- return;
- }
-
- cat = outp_match_keyword (key, option_tab, option_info, &subcat);
- switch (cat)
- {
- case 0:
- msg (SE, _("Unknown configuration parameter `%s' for ascii device driver."),
- key);
- break;
- case 1:
- free (x->file.filename);
- x->file.filename = xstrdup (value);
- break;
- case 2:
- if (!strcmp (value, "ascii"))
- x->char_set = CHS_ASCII;
- else if (!strcmp (value, "latin1"))
- x->char_set = CHS_LATIN1;
- else
- msg (SE, _("Unknown character set `%s'. Valid character sets are "
- "`ascii' and `latin1'."), value);
- break;
- case 3:
- if (!strcmp (value, "single"))
- x->overstrike_style = OVS_SINGLE;
- else if (!strcmp (value, "line"))
- x->overstrike_style = OVS_LINE;
- else
- msg (SE, _("Unknown overstrike style `%s'. Valid overstrike styles "
- "are `single' and `line'."), value);
- break;
- case 4:
- if (!strcmp (value, "bs"))
- x->carriage_return_style = CRS_BS;
- else if (!strcmp (value, "cr"))
- x->carriage_return_style = CRS_CR;
- else
- msg (SE, _("Unknown carriage return style `%s'. Valid carriage "
- "return styles are `cr' and `bs'."), value);
- break;
- case pos_int_arg:
- {
- char *tail;
- int arg;
-
- errno = 0;
- arg = strtol (value, &tail, 0);
- if (arg < 1 || errno == ERANGE || *tail)
- {
- msg (SE, _("Positive integer required as value for `%s'."), key);
- break;
- }
- switch (subcat)
- {
- case 0:
- x->page_length = arg;
- break;
- case 1:
- x->page_width = arg;
- break;
- case 2:
- x->lpi = arg;
- break;
- case 3:
- x->cpi = arg;
- break;
- default:
- assert (0);
- }
- }
- break;
- case nonneg_int_arg:
- {
- char *tail;
- int arg;
-
- errno = 0;
- arg = strtol (value, &tail, 0);
- if (arg < 0 || errno == ERANGE || *tail)
- {
- msg (SE, _("Zero or positive integer required as value for `%s'."),
- key);
- break;
- }
- switch (subcat)
- {
- case 0:
- x->left_margin = arg;
- break;
- case 1:
- x->right_margin = arg;
- break;
- case 2:
- x->top_margin = arg;
- break;
- case 3:
- x->bottom_margin = arg;
- break;
- case 4:
- x->tab_width = arg;
- break;
- default:
- assert (0);
- }
- }
- break;
- case string_arg:
- {
- struct fixed_string *s;
- switch (subcat)
- {
- case 0:
- s = &x->ops[OPS_INIT];
- break;
- case 1:
- s = &x->ops[OPS_DONE];
- break;
- case 2:
- s = &x->ops[OPS_FORMFEED];
- break;
- case 3:
- s = &x->ops[OPS_NEWLINE];
- break;
- default:
- assert (0);
- abort ();
- }
- ls_create (s, value);
- }
- break;
- case font_string_arg:
- {
- if (!strcmp (value, "overstrike"))
- {
- ls_destroy (&x->fonts[subcat]);
- return;
- }
- ls_create (&x->fonts[subcat], value);
- }
- break;
- case boolean_arg:
- {
- int setting;
- if (!strcmp (value, "on") || !strcmp (value, "true")
- || !strcmp (value, "yes") || atoi (value))
- setting = 1;
- else if (!strcmp (value, "off") || !strcmp (value, "false")
- || !strcmp (value, "no") || !strcmp (value, "0"))
- setting = 0;
- else
- {
- msg (SE, _("Boolean value expected for %s."), key);
- return;
- }
- switch (subcat)
- {
- case 0:
- x->headers = setting;
- break;
- case 1:
- x->paginate = setting;
- break;
- case 2:
- x->squeeze_blank_lines = setting;
- break;
- default:
- assert (0);
- }
- }
- break;
- default:
- assert (0);
- }
-}
-
-int
-postopen (struct file_ext *f)
-{
- struct ascii_driver_ext *x = f->param;
- struct fixed_string *s = &x->ops[OPS_INIT];
-
- if (!ls_empty_p (s) && fwrite (ls_c_str (s), ls_length (s), 1, f->file) < 1)
- {
- msg (ME, _("ASCII output driver: %s: %s"),
- f->filename, strerror (errno));
- return 0;
- }
- return 1;
-}
-
-int
-preclose (struct file_ext *f)
-{
- struct ascii_driver_ext *x = f->param;
- struct fixed_string *d = &x->ops[OPS_DONE];
-
- if (!ls_empty_p (d) && fwrite (ls_c_str (d), ls_length (d), 1, f->file) < 1)
- {
- msg (ME, _("ASCII output driver: %s: %s"),
- f->filename, strerror (errno));
- return 0;
- }
- return 1;
-}
-
-static int
-ascii_open_page (struct outp_driver *this)
-{
- struct ascii_driver_ext *x = this->ext;
- int i;
-
- assert (this->driver_open && !this->page_open);
- x->page_number++;
- if (!fn_open_ext (&x->file))
- {
- msg (ME, _("ASCII output driver: %s: %s"), x->file.filename,
- strerror (errno));
- return 0;
- }
-
- if (x->l > x->lines_cap)
- {
- x->lines = xnrealloc (x->lines, x->l, sizeof *x->lines);
- for (i = x->lines_cap; i < x->l; i++)
- {
- struct line *line = &x->lines[i];
- line->chars = NULL;
- line->char_cap = 0;
- }
- x->lines_cap = x->l;
- }
-
- for (i = 0; i < x->l; i++)
- x->lines[i].char_cnt = 0;
-
- this->page_open = 1;
- return 1;
-}
-
-/* Ensures that at least the first L characters of line I in the
- driver identified by struct ascii_driver_ext *X have been cleared out. */
-static inline void
-expand_line (struct ascii_driver_ext *x, int i, int l)
-{
- struct line *line;
- int j;
-
- assert (i < x->lines_cap);
- line = &x->lines[i];
- if (l > line->char_cap)
- {
- line->char_cap = l * 2;
- line->chars = xnrealloc (line->chars,
- line->char_cap, sizeof *line->chars);
- }
- for (j = line->char_cnt; j < l; j++)
- line->chars[j] = ' ';
- line->char_cnt = l;
-}
-
-/* Puts line L at (H,K) in the current output page. Assumes
- struct ascii_driver_ext named `ext'. */
-#define draw_line(H, K, L) \
- ext->lines[K].chars[H] = (L) | 0x800
-
-/* Line styles for each position. */
-#define T(STYLE) (STYLE<<LNS_TOP)
-#define L(STYLE) (STYLE<<LNS_LEFT)
-#define B(STYLE) (STYLE<<LNS_BOTTOM)
-#define R(STYLE) (STYLE<<LNS_RIGHT)
-
-static void
-ascii_line_horz (struct outp_driver *this, const struct rect *r,
- const struct color *c UNUSED, int style)
-{
- struct ascii_driver_ext *ext = this->ext;
- int x1 = r->x1 / this->horiz;
- int x2 = r->x2 / this->horiz;
- int y1 = r->y1 / this->vert;
- int x;
-
- assert (this->driver_open && this->page_open);
- if (x1 == x2)
- return;
-#if GLOBAL_DEBUGGING
- if (x1 > x2
- || x1 < 0 || x1 >= ext->w
- || x2 <= 0 || x2 > ext->w
- || y1 < 0 || y1 >= ext->l)
- {
-#if !SUPPRESS_WARNINGS
- printf (_("ascii_line_horz: bad hline (%d,%d),%d out of (%d,%d)\n"),
- x1, x2, y1, ext->w, ext->l);
-#endif
- return;
- }
-#endif
-
- if (ext->lines[y1].char_cnt < x2)
- expand_line (ext, y1, x2);
-
- for (x = x1; x < x2; x++)
- draw_line (x, y1, (style << LNS_LEFT) | (style << LNS_RIGHT));
-}
-
-static void
-ascii_line_vert (struct outp_driver *this, const struct rect *r,
- const struct color *c UNUSED, int style)
-{
- struct ascii_driver_ext *ext = this->ext;
- int x1 = r->x1 / this->horiz;
- int y1 = r->y1 / this->vert;
- int y2 = r->y2 / this->vert;
- int y;
-
- assert (this->driver_open && this->page_open);
- if (y1 == y2)
- return;
-#if GLOBAL_DEBUGGING
- if (y1 > y2
- || x1 < 0 || x1 >= ext->w
- || y1 < 0 || y1 >= ext->l
- || y2 < 0 || y2 > ext->l)
- {
-#if !SUPPRESS_WARNINGS
- printf (_("ascii_line_vert: bad vline %d,(%d,%d) out of (%d,%d)\n"),
- x1, y1, y2, ext->w, ext->l);
-#endif
- return;
- }
-#endif
-
- for (y = y1; y < y2; y++)
- if (ext->lines[y].char_cnt <= x1)
- expand_line (ext, y, x1 + 1);
-
- for (y = y1; y < y2; y++)
- draw_line (x1, y, (style << LNS_TOP) | (style << LNS_BOTTOM));
-}
-
-static void
-ascii_line_intersection (struct outp_driver *this, const struct rect *r,
- const struct color *c UNUSED,
- const struct outp_styles *style)
-{
- struct ascii_driver_ext *ext = this->ext;
- int x = r->x1 / this->horiz;
- int y = r->y1 / this->vert;
- int l;
-
- assert (this->driver_open && this->page_open);
-#if GLOBAL_DEBUGGING
- if (x < 0 || x >= ext->w || y < 0 || y >= ext->l)
- {
-#if !SUPPRESS_WARNINGS
- printf (_("ascii_line_intersection: bad intsct (%d,%d) out of (%d,%d)\n"),
- x, y, ext->w, ext->l);
-#endif
- return;
- }
-#endif
-
- l = ((style->l << LNS_LEFT) | (style->r << LNS_RIGHT)
- | (style->t << LNS_TOP) | (style->b << LNS_BOTTOM));
-
- if (ext->lines[y].char_cnt <= x)
- expand_line (ext, y, x + 1);
- draw_line (x, y, l);
-}
-
-/* FIXME: Later we could set this up so that for certain devices it
- performs shading? */
-static void
-ascii_box (struct outp_driver *this UNUSED, const struct rect *r UNUSED,
- const struct color *bord UNUSED, const struct color *fill UNUSED)
-{
- assert (this->driver_open && this->page_open);
-}
-
-/* Polylines not supported. */
-static void
-ascii_polyline_begin (struct outp_driver *this UNUSED, const struct color *c UNUSED)
-{
- assert (this->driver_open && this->page_open);
-}
-static void
-ascii_polyline_point (struct outp_driver *this UNUSED, int x UNUSED, int y UNUSED)
-{
- assert (this->driver_open && this->page_open);
-}
-static void
-ascii_polyline_end (struct outp_driver *this UNUSED)
-{
- assert (this->driver_open && this->page_open);
-}
-
-static void
-ascii_text_set_font_by_name (struct outp_driver * this, const char *s)
-{
- struct ascii_driver_ext *x = this->ext;
- int len = strlen (s);
-
- assert (this->driver_open && this->page_open);
- x->cur_font = OUTP_F_R;
- if (len == 0)
- return;
- if (s[len - 1] == 'I')
- {
- if (len > 1 && s[len - 2] == 'B')
- x->cur_font = OUTP_F_BI;
- else
- x->cur_font = OUTP_F_I;
- }
- else if (s[len - 1] == 'B')
- x->cur_font = OUTP_F_B;
-}
-
-static void
-ascii_text_set_font_by_position (struct outp_driver *this, int pos)
-{
- struct ascii_driver_ext *x = this->ext;
- assert (this->driver_open && this->page_open);
- x->cur_font = pos >= 0 && pos < 4 ? pos : 0;
-}
-
-static void
-ascii_text_set_font_by_family (struct outp_driver *this UNUSED, const char *s UNUSED)
-{
- assert (this->driver_open && this->page_open);
-}
-
-static const char *
-ascii_text_get_font_name (struct outp_driver *this)
-{
- struct ascii_driver_ext *x = this->ext;
-
- assert (this->driver_open && this->page_open);
- switch (x->cur_font)
- {
- case OUTP_F_R:
- return "R";
- case OUTP_F_I:
- return "I";
- case OUTP_F_B:
- return "B";
- case OUTP_F_BI:
- return "BI";
- default:
- assert (0);
- }
- abort ();
-}
-
-static const char *
-ascii_text_get_font_family (struct outp_driver *this UNUSED)
-{
- assert (this->driver_open && this->page_open);
- return "";
-}
-
-static int
-ascii_text_set_size (struct outp_driver *this, int size)
-{
- assert (this->driver_open && this->page_open);
- return size == this->vert;
-}
-
-static int
-ascii_text_get_size (struct outp_driver *this, int *em_width)
-{
- assert (this->driver_open && this->page_open);
- if (em_width)
- *em_width = this->horiz;
- return this->vert;
-}
-
-static void text_draw (struct outp_driver *this, struct outp_text *t);
-
-/* Divides the text T->S into lines of width T->H. Sets T->V to the
- number of lines necessary. Actually draws the text if DRAW is
- nonzero.
-
- You probably don't want to look at this code. */
-static void
-delineate (struct outp_driver *this, struct outp_text *t, int draw)
-{
- /* Width we're fitting everything into. */
- int width = t->h / this->horiz;
-
- /* Maximum `y' position we can write to. */
- int max_y;
-
- /* Current position in string, character following end of string. */
- const char *s = ls_c_str (&t->s);
- const char *end = ls_end (&t->s);
-
- /* Temporary struct outp_text to pass to low-level function. */
- struct outp_text temp;
-
-#if GLOBAL_DEBUGGING && 0
- if (!ext->debug)
- {
- ext->debug = 1;
- printf (_("%s: horiz=%d, vert=%d\n"), this->name, this->horiz, this->vert);
- }
-#endif
-
- if (!width)
- {
- t->h = t->v = 0;
- return;
- }
-
- if (draw)
- {
- temp.options = t->options;
- ls_shallow_copy (&temp.s, &t->s);
- temp.h = t->h / this->horiz;
- temp.x = t->x / this->horiz;
- }
- else
- t->y = 0;
- temp.y = t->y / this->vert;
-
- if (t->options & OUTP_T_VERT)
- max_y = (t->v / this->vert) + temp.y - 1;
- else
- max_y = INT_MAX;
-
- while (end - s > width)
- {
- const char *beg = s;
- const char *space;
-
- /* Find first space before &s[width]. */
- space = &s[width];
- for (;;)
- {
- if (space > s)
- {
- if (!isspace ((unsigned char) space[-1]))
- {
- space--;
- continue;
- }
- else
- s = space;
- }
- else
- s = space = &s[width];
- break;
- }
-
- /* Draw text. */
- if (draw)
- {
- ls_init (&temp.s, beg, space - beg);
- temp.w = space - beg;
- text_draw (this, &temp);
- }
- if (++temp.y > max_y)
- return;
-
- /* Find first nonspace after space. */
- while (s < end && isspace ((unsigned char) *s))
- s++;
- }
- if (s < end)
- {
- if (draw)
- {
- ls_init (&temp.s, s, end - s);
- temp.w = end - s;
- text_draw (this, &temp);
- }
- temp.y++;
- }
-
- t->v = (temp.y * this->vert) - t->y;
-}
-
-static void
-ascii_text_metrics (struct outp_driver *this, struct outp_text *t)
-{
- assert (this->driver_open && this->page_open);
- if (!(t->options & OUTP_T_HORZ))
- {
- t->v = this->vert;
- t->h = ls_length (&t->s) * this->horiz;
- }
- else
- delineate (this, t, 0);
-}
-
-static void
-ascii_text_draw (struct outp_driver *this, struct outp_text *t)
-{
- /* FIXME: orientations not supported. */
- assert (this->driver_open && this->page_open);
- if (!(t->options & OUTP_T_HORZ))
- {
- struct outp_text temp;
-
- temp.options = t->options;
- temp.s = t->s;
- temp.h = temp.v = 0;
- temp.x = t->x / this->horiz;
- temp.y = t->y / this->vert;
- text_draw (this, &temp);
- ascii_text_metrics (this, t);
-
- return;
- }
- delineate (this, t, 1);
-}
-
-static void
-text_draw (struct outp_driver *this, struct outp_text *t)
-{
- struct ascii_driver_ext *ext = this->ext;
- unsigned attr = ext->cur_font << 8;
-
- int x = t->x;
- int y = t->y;
-
- char *s = ls_c_str (&t->s);
-
- /* Expand the line with the assumption that S takes up LEN character
- spaces (sometimes it takes up less). */
- int min_len;
-
- assert (this->driver_open && this->page_open);
- switch (t->options & OUTP_T_JUST_MASK)
- {
- case OUTP_T_JUST_LEFT:
- break;
- case OUTP_T_JUST_CENTER:
- x -= (t->h - t->w) / 2; /* fall through */
- case OUTP_T_JUST_RIGHT:
- x += (t->h - t->w);
- break;
- default:
- assert (0);
- }
-
- if (!(t->y < ext->l && x < ext->w))
- return;
- min_len = min (x + ls_length (&t->s), ext->w);
- if (ext->lines[t->y].char_cnt < min_len)
- expand_line (ext, t->y, min_len);
-
- {
- int len = ls_length (&t->s);
-
- if (len + x > ext->w)
- len = ext->w - x;
- while (len--)
- ext->lines[y].chars[x++] = *s++ | attr;
- }
-}
-\f
-/* ascii_close_page () and support routines. */
-
-#define LINE_BUF_SIZE 1024
-static char *line_buf;
-static char *line_p;
-
-static inline int
-commit_line_buf (struct outp_driver *this)
-{
- struct ascii_driver_ext *x = this->ext;
-
- if ((int) fwrite (line_buf, 1, line_p - line_buf, x->file.file)
- < line_p - line_buf)
- {
- msg (ME, _("Writing `%s': %s"), x->file.filename, strerror (errno));
- return 0;
- }
-
- line_p = line_buf;
- return 1;
-}
-
-/* Writes everything from BP to EP exclusive into line_buf, or to
- THIS->output if line_buf overflows. */
-static inline void
-output_string (struct outp_driver *this, const char *bp, const char *ep)
-{
- if (LINE_BUF_SIZE - (line_p - line_buf) >= ep - bp)
- {
- memcpy (line_p, bp, ep - bp);
- line_p += ep - bp;
- }
- else
- while (bp < ep)
- {
- if (LINE_BUF_SIZE - (line_p - line_buf) <= 1 && !commit_line_buf (this))
- return;
- *line_p++ = *bp++;
- }
-}
-
-/* Writes everything from BP to EP exclusive into line_buf, or to
- THIS->output if line_buf overflows. Returns 1 if additional passes
- over the line are required. FIXME: probably could do a lot of
- optimization here. */
-static inline int
-output_shorts (struct outp_driver *this,
- const unsigned short *bp, const unsigned short *ep)
-{
- struct ascii_driver_ext *ext = this->ext;
- size_t remaining = LINE_BUF_SIZE - (line_p - line_buf);
- int result = 0;
-
- for (; bp < ep; bp++)
- {
- if (*bp & 0x800)
- {
- struct fixed_string *box = &ext->box[*bp & 0xff];
- size_t len = ls_length (box);
-
- if (remaining >= len)
- {
- memcpy (line_p, ls_c_str (box), len);
- line_p += len;
- remaining -= len;
- }
- else
- {
- if (!commit_line_buf (this))
- return 0;
- output_string (this, ls_c_str (box), ls_end (box));
- remaining = LINE_BUF_SIZE - (line_p - line_buf);
- }
- }
- else if (*bp & 0x0300)
- {
- struct fixed_string *on;
- char buf[5];
- int len;
-
- switch (*bp & 0x0300)
- {
- case OUTP_F_I << 8:
- on = &ext->fonts[FSTY_ON | FSTY_ITALIC];
- break;
- case OUTP_F_B << 8:
- on = &ext->fonts[FSTY_ON | FSTY_BOLD];
- break;
- case OUTP_F_BI << 8:
- on = &ext->fonts[FSTY_ON | FSTY_BOLD_ITALIC];
- break;
- default:
- assert (0);
- abort ();
- }
- if (!on)
- {
- if (ext->overstrike_style == OVS_SINGLE)
- switch (*bp & 0x0300)
- {
- case OUTP_F_I << 8:
- buf[0] = '_';
- buf[1] = '\b';
- buf[2] = *bp;
- len = 3;
- break;
- case OUTP_F_B << 8:
- buf[0] = *bp;
- buf[1] = '\b';
- buf[2] = *bp;
- len = 3;
- break;
- case OUTP_F_BI << 8:
- buf[0] = '_';
- buf[1] = '\b';
- buf[2] = *bp;
- buf[3] = '\b';
- buf[4] = *bp;
- len = 5;
- break;
- default:
- assert (0);
- abort ();
- }
- else
- {
- buf[0] = *bp;
- result = len = 1;
- }
- }
- else
- {
- buf[0] = *bp;
- len = 1;
- }
- output_string (this, buf, &buf[len]);
- }
- else if (remaining)
- {
- *line_p++ = *bp;
- remaining--;
- }
- else
- {
- if (!commit_line_buf (this))
- return 0;
- remaining = LINE_BUF_SIZE - (line_p - line_buf);
- *line_p++ = *bp;
- }
- }
-
- return result;
-}
-
-/* Writes CH into line_buf N times, or to THIS->output if line_buf
- overflows. */
-static inline void
-output_char (struct outp_driver *this, int n, char ch)
-{
- if (LINE_BUF_SIZE - (line_p - line_buf) >= n)
- {
- memset (line_p, ch, n);
- line_p += n;
- }
- else
- while (n--)
- {
- if (LINE_BUF_SIZE - (line_p - line_buf) <= 1 && !commit_line_buf (this))
- return;
- *line_p++ = ch;
- }
-}
-
-/* Advance the carriage from column 0 to the left margin. */
-static void
-advance_to_left_margin (struct outp_driver *this)
-{
- struct ascii_driver_ext *ext = this->ext;
- int margin;
-
- margin = ext->left_margin;
- if (margin == 0)
- return;
- if (ext->tab_width && margin >= ext->tab_width)
- {
- output_char (this, margin / ext->tab_width, '\t');
- margin %= ext->tab_width;
- }
- if (margin)
- output_char (this, margin, ' ');
-}
-
-/* Move the output file carriage N_CHARS left, to the left margin. */
-static void
-return_carriage (struct outp_driver *this, int n_chars)
-{
- struct ascii_driver_ext *ext = this->ext;
-
- switch (ext->carriage_return_style)
- {
- case CRS_BS:
- output_char (this, n_chars, '\b');
- break;
- case CRS_CR:
- output_char (this, 1, '\r');
- advance_to_left_margin (this);
- break;
- default:
- assert (0);
- abort ();
- }
-}
-
-/* Writes COUNT lines from the line buffer in THIS, starting at line
- number FIRST. */
-static void
-output_lines (struct outp_driver *this, int first, int count)
-{
- struct ascii_driver_ext *ext = this->ext;
- int line_num;
-
- struct fixed_string *newline = &ext->ops[OPS_NEWLINE];
-
- int n_chars;
- int n_passes;
-
- if (NULL == ext->file.file)
- return;
-
- /* Iterate over all the lines to be output. */
- for (line_num = first; line_num < first + count; line_num++)
- {
- struct line *line = &ext->lines[line_num];
- unsigned short *p = line->chars;
- unsigned short *end_p = p + line->char_cnt;
- unsigned short *bp, *ep;
- unsigned short attr = 0;
-
- assert (end_p >= p);
-
- /* Squeeze multiple blank lines into a single blank line if
- requested. */
- if (ext->squeeze_blank_lines
- && line_num > first
- && ext->lines[line_num].char_cnt == 0
- && ext->lines[line_num - 1].char_cnt == 0)
- continue;
-
- /* Output every character in the line in the appropriate
- manner. */
- n_passes = 1;
- bp = ep = p;
- n_chars = 0;
- advance_to_left_margin (this);
- for (;;)
- {
- while (ep < end_p && attr == (*ep & 0x0300))
- ep++;
- if (output_shorts (this, bp, ep))
- n_passes = 2;
- n_chars += ep - bp;
- bp = ep;
-
- if (bp >= end_p)
- break;
-
- /* Turn off old font. */
- if (attr != (OUTP_F_R << 8))
- {
- struct fixed_string *off;
-
- switch (attr)
- {
- case OUTP_F_I << 8:
- off = &ext->fonts[FSTY_OFF | FSTY_ITALIC];
- break;
- case OUTP_F_B << 8:
- off = &ext->fonts[FSTY_OFF | FSTY_BOLD];
- break;
- case OUTP_F_BI << 8:
- off = &ext->fonts[FSTY_OFF | FSTY_BOLD_ITALIC];
- break;
- default:
- assert (0);
- abort ();
- }
- if (off)
- output_string (this, ls_c_str (off), ls_end (off));
- }
-
- /* Turn on new font. */
- attr = (*bp & 0x0300);
- if (attr != (OUTP_F_R << 8))
- {
- struct fixed_string *on;
-
- switch (attr)
- {
- case OUTP_F_I << 8:
- on = &ext->fonts[FSTY_ON | FSTY_ITALIC];
- break;
- case OUTP_F_B << 8:
- on = &ext->fonts[FSTY_ON | FSTY_BOLD];
- break;
- case OUTP_F_BI << 8:
- on = &ext->fonts[FSTY_ON | FSTY_BOLD_ITALIC];
- break;
- default:
- assert (0);
- abort ();
- }
- if (on)
- output_string (this, ls_c_str (on), ls_end (on));
- }
-
- ep = bp + 1;
- }
- if (n_passes > 1)
- {
- char ch;
-
- return_carriage (this, n_chars);
- n_chars = 0;
- bp = ep = p;
- for (;;)
- {
- while (ep < end_p && (*ep & 0x0300) == (OUTP_F_R << 8))
- ep++;
- if (ep >= end_p)
- break;
- output_char (this, ep - bp, ' ');
-
- switch (*ep & 0x0300)
- {
- case OUTP_F_I << 8:
- ch = '_';
- break;
- case OUTP_F_B << 8:
- ch = *ep;
- break;
- case OUTP_F_BI << 8:
- ch = *ep;
- n_passes = 3;
- break;
- default:
- assert (0);
- abort ();
- }
- output_char (this, 1, ch);
- n_chars += ep - bp + 1;
- bp = ep + 1;
- ep = bp;
- }
- }
- if (n_passes > 2)
- {
- return_carriage (this, n_chars);
- bp = ep = p;
- for (;;)
- {
- while (ep < end_p && (*ep & 0x0300) != (OUTP_F_BI << 8))
- ep++;
- if (ep >= end_p)
- break;
- output_char (this, ep - bp, ' ');
- output_char (this, 1, '_');
- bp = ep + 1;
- ep = bp;
- }
- }
-
- output_string (this, ls_c_str (newline), ls_end (newline));
- }
-}
-
-
-static int
-ascii_close_page (struct outp_driver *this)
-{
- static int s_len;
-
- struct ascii_driver_ext *x = this->ext;
- int nl_len, ff_len, total_len;
- char *cp;
- int i;
-
- assert (this->driver_open && this->page_open);
-
- if (!line_buf)
- line_buf = xmalloc (LINE_BUF_SIZE);
- line_p = line_buf;
-
- nl_len = ls_length (&x->ops[OPS_NEWLINE]);
- if (x->top_margin)
- {
- total_len = x->top_margin * nl_len;
- if (s_len < total_len)
- {
- s_len = total_len;
- s = xrealloc (s, s_len);
- }
- for (cp = s, i = 0; i < x->top_margin; i++)
- {
- memcpy (cp, ls_c_str (&x->ops[OPS_NEWLINE]), nl_len);
- cp += nl_len;
- }
- output_string (this, s, &s[total_len]);
- }
- if (x->headers)
- {
- int len;
-
- total_len = nl_len + x->w;
- if (s_len < total_len + 1)
- {
- s_len = total_len + 1;
- s = xrealloc (s, s_len);
- }
-
- memset (s, ' ', x->w);
-
- {
- char temp[40];
-
- snprintf (temp, 80, _("%s - Page %d"), get_start_date (),
- x->page_number);
- memcpy (&s[x->w - strlen (temp)], temp, strlen (temp));
- }
-
- if (outp_title && outp_subtitle)
- {
- len = min ((int) strlen (outp_title), x->w);
- memcpy (s, outp_title, len);
- }
- memcpy (&s[x->w], ls_c_str (&x->ops[OPS_NEWLINE]), nl_len);
- output_string (this, s, &s[total_len]);
-
- memset (s, ' ', x->w);
- len = strlen (version) + 3 + strlen (host_system);
- if (len < x->w)
- sprintf (&s[x->w - len], "%s - %s" , version, host_system);
- if (outp_subtitle || outp_title)
- {
- char *string = outp_subtitle ? outp_subtitle : outp_title;
- len = min ((int) strlen (string), x->w);
- memcpy (s, string, len);
- }
- memcpy (&s[x->w], ls_c_str (&x->ops[OPS_NEWLINE]), nl_len);
- output_string (this, s, &s[total_len]);
- output_string (this, &s[x->w], &s[total_len]);
- }
- if (line_p != line_buf && !commit_line_buf (this))
- return 0;
-
- output_lines (this, 0, x->l);
-
- ff_len = ls_length (&x->ops[OPS_FORMFEED]);
- total_len = x->bottom_margin * nl_len + ff_len;
- if (s_len < total_len)
- s = xrealloc (s, total_len);
- for (cp = s, i = 0; i < x->bottom_margin; i++)
- {
- memcpy (cp, ls_c_str (&x->ops[OPS_NEWLINE]), nl_len);
- cp += nl_len;
- }
- memcpy (cp, ls_c_str (&x->ops[OPS_FORMFEED]), ff_len);
- if ( x->paginate )
- output_string (this, s, &s[total_len]);
-
- if (line_p != line_buf && !commit_line_buf (this))
- return 0;
-
- this->page_open = 0;
- return 1;
-}
-
-
-
-static void
-ascii_chart_initialise(struct outp_driver *d UNUSED, struct chart *ch )
-{
- msg(MW, _("Charts are unsupported with ascii drivers."));
- ch->lp = 0;
-}
-
-static void
-ascii_chart_finalise(struct outp_driver *d UNUSED, struct chart *ch UNUSED)
-{
-
-}
-
-struct outp_class ascii_class =
-{
- "ascii",
- 0,
- 0,
-
- ascii_open_global,
- ascii_close_global,
- ascii_font_sizes,
-
- ascii_preopen_driver,
- ascii_option,
- ascii_postopen_driver,
- ascii_close_driver,
-
- ascii_open_page,
- ascii_close_page,
-
- NULL,
-
- ascii_line_horz,
- ascii_line_vert,
- ascii_line_intersection,
-
- ascii_box,
- ascii_polyline_begin,
- ascii_polyline_point,
- ascii_polyline_end,
-
- ascii_text_set_font_by_name,
- ascii_text_set_font_by_position,
- ascii_text_set_font_by_family,
- ascii_text_get_font_name,
- ascii_text_get_font_family,
- ascii_text_set_size,
- ascii_text_get_size,
- ascii_text_metrics,
- ascii_text_draw,
-
- ascii_chart_initialise,
- ascii_chart_finalise
-};
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <stdlib.h>
-#include "alloc.h"
-#include "case.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "hash.h"
-#include "lexer.h"
-#include "pool.h"
-#include "str.h"
-#include "var.h"
-#include "vfm.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* FIXME: Implement PRINT subcommand. */
-
-/* Explains how to recode one value. `from' must be first element. */
-struct arc_item
- {
- union value from; /* Original value. */
- double to; /* Recoded value. */
- };
-
-/* Explains how to recode an AUTORECODE variable. */
-struct arc_spec
- {
- struct variable *src; /* Source variable. */
- struct variable *dest; /* Target variable. */
- struct hsh_table *items; /* Hash table of `freq's. */
- };
-
-/* AUTORECODE transformation. */
-struct autorecode_trns
- {
- struct pool *pool; /* Contains AUTORECODE specs. */
- struct arc_spec *specs; /* AUTORECODE specifications. */
- size_t spec_cnt; /* Number of specifications. */
- };
-
-/* Descending or ascending sort order. */
-enum direction
- {
- ASCENDING,
- DESCENDING
- };
-
-/* AUTORECODE data. */
-struct autorecode_pgm
- {
- struct variable **src_vars; /* Source variables. */
- char **dst_names; /* Target variable names. */
- struct variable **dst_vars; /* Target variables. */
- struct hsh_table **src_values; /* `union value's of source vars. */
- size_t var_cnt; /* Number of variables. */
- struct pool *src_values_pool; /* Pool used by src_values. */
- enum direction direction; /* Sort order. */
- int print; /* Print mapping table if nonzero. */
- };
-
-static trns_proc_func autorecode_trns_proc;
-static trns_free_func autorecode_trns_free;
-static int autorecode_proc_func (struct ccase *, void *);
-static hsh_compare_func compare_alpha_value, compare_numeric_value;
-static hsh_hash_func hash_alpha_value, hash_numeric_value;
-
-static void recode (const struct autorecode_pgm *);
-static void arc_free (struct autorecode_pgm *);
-
-/* Performs the AUTORECODE procedure. */
-int
-cmd_autorecode (void)
-{
- struct autorecode_pgm arc;
- size_t dst_cnt;
- size_t i;
-
- arc.src_vars = NULL;
- arc.dst_names = NULL;
- arc.dst_vars = NULL;
- arc.src_values = NULL;
- arc.var_cnt = 0;
- arc.src_values_pool = NULL;
- arc.direction = ASCENDING;
- arc.print = 0;
- dst_cnt = 0;
-
- lex_match_id ("VARIABLES");
- lex_match ('=');
- if (!parse_variables (default_dict, &arc.src_vars, &arc.var_cnt,
- PV_NO_DUPLICATE))
- goto lossage;
- if (!lex_force_match_id ("INTO"))
- goto lossage;
- lex_match ('=');
- if (!parse_DATA_LIST_vars (&arc.dst_names, &dst_cnt, PV_NONE))
- goto lossage;
- if (dst_cnt != arc.var_cnt)
- {
- size_t i;
-
- msg (SE, _("Source variable count (%u) does not match "
- "target variable count (%u)."),
- (unsigned) arc.var_cnt, (unsigned) dst_cnt);
-
- for (i = 0; i < dst_cnt; i++)
- free (arc.dst_names[i]);
- free (arc.dst_names);
- arc.dst_names = NULL;
-
- goto lossage;
- }
- while (lex_match ('/'))
- if (lex_match_id ("DESCENDING"))
- arc.direction = DESCENDING;
- else if (lex_match_id ("PRINT"))
- arc.print = 1;
- if (token != '.')
- {
- lex_error (_("expecting end of command"));
- goto lossage;
- }
-
- for (i = 0; i < arc.var_cnt; i++)
- {
- int j;
-
- if (dict_lookup_var (default_dict, arc.dst_names[i]) != NULL)
- {
- msg (SE, _("Target variable %s duplicates existing variable %s."),
- arc.dst_names[i], arc.dst_names[i]);
- goto lossage;
- }
- for (j = 0; j < i; j++)
- if (!strcasecmp (arc.dst_names[i], arc.dst_names[j]))
- {
- msg (SE, _("Duplicate variable name %s among target variables."),
- arc.dst_names[i]);
- goto lossage;
- }
- }
-
- arc.src_values_pool = pool_create ();
- arc.dst_vars = xnmalloc (arc.var_cnt, sizeof *arc.dst_vars);
- arc.src_values = xnmalloc (arc.var_cnt, sizeof *arc.src_values);
- for (i = 0; i < dst_cnt; i++)
- if (arc.src_vars[i]->type == ALPHA)
- arc.src_values[i] = hsh_create (10, compare_alpha_value,
- hash_alpha_value, NULL, arc.src_vars[i]);
- else
- arc.src_values[i] = hsh_create (10, compare_numeric_value,
- hash_numeric_value, NULL, NULL);
-
- procedure (autorecode_proc_func, &arc);
-
- for (i = 0; i < arc.var_cnt; i++)
- {
- arc.dst_vars[i] = dict_create_var_assert (default_dict,
- arc.dst_names[i], 0);
- arc.dst_vars[i]->init = 0;
- }
-
- recode (&arc);
- arc_free (&arc);
- return CMD_SUCCESS;
-
-lossage:
- arc_free (&arc);
- return CMD_FAILURE;
-}
-
-static void
-arc_free (struct autorecode_pgm *arc)
-{
- free (arc->src_vars);
- if (arc->dst_names != NULL)
- {
- size_t i;
-
- for (i = 0; i < arc->var_cnt; i++)
- free (arc->dst_names[i]);
- free (arc->dst_names);
- }
- free (arc->dst_vars);
- if (arc->src_values != NULL)
- {
- size_t i;
-
- for (i = 0; i < arc->var_cnt; i++)
- hsh_destroy (arc->src_values[i]);
- free (arc->src_values);
- }
- pool_destroy (arc->src_values_pool);
-}
-
-\f
-/* AUTORECODE transformation. */
-
-static void
-recode (const struct autorecode_pgm *arc)
-{
- struct autorecode_trns *trns;
- size_t i;
-
- trns = pool_create_container (struct autorecode_trns, pool);
- trns->specs = pool_nalloc (trns->pool, arc->var_cnt, sizeof *trns->specs);
- trns->spec_cnt = arc->var_cnt;
- for (i = 0; i < arc->var_cnt; i++)
- {
- struct arc_spec *spec = &trns->specs[i];
- void *const *p = hsh_sort (arc->src_values[i]);
- int count = hsh_count (arc->src_values[i]);
- int j;
-
- spec->src = arc->src_vars[i];
- spec->dest = arc->dst_vars[i];
-
- if (arc->src_vars[i]->type == ALPHA)
- spec->items = hsh_create (2 * count, compare_alpha_value,
- hash_alpha_value, NULL, arc->src_vars[i]);
- else
- spec->items = hsh_create (2 * count, compare_numeric_value,
- hash_numeric_value, NULL, NULL);
-
- for (j = 0; *p; p++, j++)
- {
- struct arc_item *item = pool_alloc (trns->pool, sizeof *item);
- union value *vp = *p;
-
- if (arc->src_vars[i]->type == NUMERIC)
- item->from.f = vp->f;
- else
- item->from.c = pool_strdup (trns->pool, vp->c);
- item->to = arc->direction == ASCENDING ? j + 1 : count - j;
- hsh_force_insert (spec->items, item);
- }
- }
- add_transformation (autorecode_trns_proc, autorecode_trns_free, trns);
-}
-
-static int
-autorecode_trns_proc (void *trns_, struct ccase *c, int case_idx UNUSED)
-{
- struct autorecode_trns *trns = trns_;
- size_t i;
-
- for (i = 0; i < trns->spec_cnt; i++)
- {
- struct arc_spec *spec = &trns->specs[i];
- struct arc_item *item;
- union value v;
-
- if (spec->src->type == NUMERIC)
- v.f = case_num (c, spec->src->fv);
- else
- v.c = (char *) case_str (c, spec->src->fv);
- item = hsh_force_find (spec->items, &v);
-
- case_data_rw (c, spec->dest->fv)->f = item->to;
- }
- return -1;
-}
-
-static void
-autorecode_trns_free (void *trns_)
-{
- struct autorecode_trns *trns = trns_;
- size_t i;
-
- for (i = 0; i < trns->spec_cnt; i++)
- hsh_destroy (trns->specs[i].items);
- pool_destroy (trns->pool);
-}
-\f
-/* AUTORECODE procedure. */
-
-static int
-compare_alpha_value (const void *a_, const void *b_, void *v_)
-{
- const union value *a = a_;
- const union value *b = b_;
- const struct variable *v = v_;
-
- return memcmp (a->c, b->c, v->width);
-}
-
-static unsigned
-hash_alpha_value (const void *a_, void *v_)
-{
- const union value *a = a_;
- const struct variable *v = v_;
-
- return hsh_hash_bytes (a->c, v->width);
-}
-
-static int
-compare_numeric_value (const void *a_, const void *b_, void *foo UNUSED)
-{
- const union value *a = a_;
- const union value *b = b_;
-
- return a->f < b->f ? -1 : a->f > b->f;
-}
-
-static unsigned
-hash_numeric_value (const void *a_, void *foo UNUSED)
-{
- const union value *a = a_;
-
- return hsh_hash_double (a->f);
-}
-
-static int
-autorecode_proc_func (struct ccase *c, void *arc_)
-{
- struct autorecode_pgm *arc = arc_;
- size_t i;
-
- for (i = 0; i < arc->var_cnt; i++)
- {
- union value v, *vp, **vpp;
-
- if (arc->src_vars[i]->type == NUMERIC)
- v.f = case_num (c, arc->src_vars[i]->fv);
- else
- v.c = (char *) case_str (c, arc->src_vars[i]->fv);
-
- vpp = (union value **) hsh_probe (arc->src_values[i], &v);
- if (*vpp == NULL)
- {
- vp = pool_alloc (arc->src_values_pool, sizeof *vp);
- if (arc->src_vars[i]->type == NUMERIC)
- vp->f = v.f;
- else
- vp->c = pool_clone (arc->src_values_pool,
- v.c, arc->src_vars[i]->width);
- *vpp = vp;
- }
- }
- return 1;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-
-#include <stdio.h>
-#include <plot.h>
-#include <stdarg.h>
-#include <math.h>
-#include "chart.h"
-
-#define CATAGORIES 6
-#define SUB_CATAGORIES 3
-
-
-
-static const double x_min = 0;
-static const double x_max = 15.0;
-
-static const char *cat_labels[] =
- {
- "Age",
- "Intelligence",
- "Wealth",
- "Emotional",
- "cat 5",
- "cat 6",
- "cat 7",
- "cat 8",
- "cat 9",
- "cat 10",
- "cat 11"
- };
-
-
-
-
-/* Subcatagories */
-static const double data1[] =
-{
- 28,83,
- 34,
- 29,13,
- 9,4,
- 3,3,
- 2,0,
- 1,0,
- 0,
- 1,1
-};
-
-
-static const double data2[] =
-{
- 45,13,
- 9,4,
- 3,43,
- 2,0,
- 1,20,
- 0,0,
- 1,1,
- 0,0
-};
-
-static const double data3[] =
- {
- 23,18,
- 0, 45,23, 9, 40, 24,4, 8
- };
-
-
-static const char subcat_name[]="Gender";
-
-
-struct subcat {
- const double *data;
- const char *label;
-};
-
-static const struct subcat sub_catagory[SUB_CATAGORIES] =
- {
- {data1, "male"},
- {data2, "female"},
- {data3, "47xxy"}
- };
-
-
-
-static const double y_min = 0;
-static const double y_max = 120.0;
-static const double y_tick = 20.0;
-
-
-
-static void write_legend(struct chart *chart) ;
-
-
-void
-draw_barchart(struct chart *ch, const char *title,
- const char *xlabel, const char *ylabel, enum bar_opts opt)
-{
- double d;
- int i;
-
- double interval_size = fabs(ch->data_right - ch->data_left) / ( CATAGORIES );
-
- double bar_width = interval_size / 1.1 ;
-
- double ordinate_scale = fabs(ch->data_top - ch->data_bottom) /
- fabs(y_max - y_min) ;
-
- if ( opt != BAR_STACKED )
- bar_width /= SUB_CATAGORIES;
-
- /* Move to data bottom-left */
- pl_move_r(ch->lp, ch->data_left, ch->data_bottom);
-
- pl_savestate_r(ch->lp);
- pl_filltype_r(ch->lp,1);
-
- /* Draw the data */
- for (i = 0 ; i < CATAGORIES ; ++i )
- {
- int sc;
- double ystart=0.0;
- double x = i * interval_size;
-
- pl_savestate_r(ch->lp);
-
- draw_tick (ch, TICK_ABSCISSA, x + (interval_size/2 ),
- cat_labels[i]);
-
- for(sc = 0 ; sc < SUB_CATAGORIES ; ++sc )
- {
-
- pl_savestate_r(ch->lp);
- pl_fillcolorname_r(ch->lp,data_colour[sc]);
-
- switch ( opt )
- {
- case BAR_GROUPED:
- pl_fboxrel_r(ch->lp,
- x + (sc * bar_width ), 0,
- x + (sc + 1) * bar_width,
- sub_catagory[sc].data[i] * ordinate_scale );
- break;
-
-
- case BAR_STACKED:
-
- pl_fboxrel_r(ch->lp,
- x, ystart,
- x + bar_width,
- ystart + sub_catagory[sc].data[i] * ordinate_scale );
-
- ystart += sub_catagory[sc].data[i] * ordinate_scale ;
-
- break;
-
- default:
- break;
- }
- pl_restorestate_r(ch->lp);
- }
-
- pl_restorestate_r(ch->lp);
- }
- pl_restorestate_r(ch->lp);
-
- for ( d = y_min; d <= y_max ; d += y_tick )
- {
-
- draw_tick (ch, TICK_ORDINATE,
- (d - y_min ) * ordinate_scale, "%g", d);
-
- }
-
- /* Write the abscissa label */
- pl_move_r(ch->lp,ch->data_left, ch->abscissa_top);
- pl_alabel_r(ch->lp,0,'t',xlabel);
-
-
- /* Write the ordinate label */
- pl_savestate_r(ch->lp);
- pl_move_r(ch->lp,ch->data_bottom, ch->ordinate_right);
- pl_textangle_r(ch->lp,90);
- pl_alabel_r(ch->lp,0,0,ylabel);
- pl_restorestate_r(ch->lp);
-
-
- chart_write_title(ch, title);
-
- write_legend(ch);
-
-
-}
-
-
-
-
-
-static void
-write_legend(struct chart *chart)
-{
- int sc;
-
- pl_savestate_r(chart->lp);
-
- pl_filltype_r(chart->lp,1);
-
- pl_move_r(chart->lp, chart->legend_left,
- chart->data_bottom + chart->font_size * SUB_CATAGORIES * 1.5);
-
- pl_alabel_r(chart->lp,0,'b',subcat_name);
-
- for (sc = 0 ; sc < SUB_CATAGORIES ; ++sc )
- {
- pl_fmove_r(chart->lp,
- chart->legend_left,
- chart->data_bottom + chart->font_size * sc * 1.5);
-
- pl_savestate_r(chart->lp);
- pl_fillcolorname_r(chart->lp,data_colour[sc]);
- pl_fboxrel_r (chart->lp,
- 0,0,
- chart->font_size, chart->font_size);
- pl_restorestate_r(chart->lp);
-
- pl_fmove_r(chart->lp,
- chart->legend_left + chart->font_size * 1.5,
- chart->data_bottom + chart->font_size * sc * 1.5);
-
- pl_alabel_r(chart->lp,'l','b',sub_catagory[sc].label);
- }
-
-
- pl_restorestate_r(chart->lp);
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !bitvector_h
-#define bitvector_h 1
-
-#include <limits.h>
-
-/* Sets bit Y starting at address X. */
-#define SET_BIT(X, Y) \
- (((unsigned char *) X)[(Y) / CHAR_BIT] |= 1 << ((Y) % CHAR_BIT))
-
-/* Clears bit Y starting at address X. */
-#define CLEAR_BIT(X, Y) \
- (((unsigned char *) X)[(Y) / CHAR_BIT] &= ~(1 << ((Y) % CHAR_BIT)))
-
-/* Sets bit Y starting at address X to Z, which is zero/nonzero */
-#define SET_BIT_TO(X, Y, Z) \
- ((Z) ? SET_BIT(X, Y) : CLEAR_BIT(X, Y))
-
-/* Nonzero if bit Y starting at address X is set. */
-#define TEST_BIT(X, Y) \
- (((unsigned char *) X)[(Y) / CHAR_BIT] & (1 << ((Y) % CHAR_BIT)))
-
-/* Returns 2**X, 0 <= X < 32. */
-#define BIT_INDEX(X) (1ul << (X))
-
-#endif /* bitvector.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-
-#include "chart.h"
-#include <math.h>
-#include <assert.h>
-#include "misc.h"
-
-#include "factor_stats.h"
-
-
-/* Draw a box-and-whiskers plot
-*/
-
-/* Draw an outlier on the plot CH
- * at CENTRELINE
- * The outlier is in (*wvp)[idx]
- * If EXTREME is non zero, then consider it to be an extreme
- * value
- */
-void
-draw_outlier(struct chart *ch, double centreline,
- struct weighted_value **wvp,
- int idx,
- short extreme);
-
-
-void
-draw_outlier(struct chart *ch, double centreline,
- struct weighted_value **wvp,
- int idx,
- short extreme
- )
-{
- char label[10];
-
-#define MARKER_CIRCLE 4
-#define MARKER_STAR 3
-
- pl_fmarker_r(ch->lp,
- centreline,
- ch->data_bottom +
- (wvp[idx]->v.f - ch->y_min ) * ch->ordinate_scale,
- extreme?MARKER_STAR:MARKER_CIRCLE,
- 20);
-
- pl_moverel_r(ch->lp, 10,0);
-
- snprintf(label, 10, "%d", wvp[idx]->case_nos->num);
-
- pl_alabel_r(ch->lp, 'l', 'c', label);
-
-}
-
-
-void
-boxplot_draw_boxplot(struct chart *ch,
- double box_centre,
- double box_width,
- struct metrics *m,
- const char *name)
-{
- double whisker[2];
- int i;
-
- const double *hinge = m->hinge;
- struct weighted_value **wvp = m->wvp;
- const int n_data = m->n_data;
-
- const double step = (hinge[2] - hinge[0]) * 1.5;
-
-
- const double box_left = box_centre - box_width / 2.0;
-
- const double box_right = box_centre + box_width / 2.0;
-
-
- const double box_bottom =
- ch->data_bottom + ( hinge[0] - ch->y_min ) * ch->ordinate_scale;
-
-
- const double box_top =
- ch->data_bottom + ( hinge[2] - ch->y_min ) * ch->ordinate_scale;
-
- assert(m);
-
- /* Can't really draw a boxplot if there's no data */
- if ( n_data == 0 )
- return ;
-
- whisker[1] = hinge[2];
- whisker[0] = wvp[0]->v.f;
-
- for ( i = 0 ; i < n_data ; ++i )
- {
- if ( hinge[2] + step > wvp[i]->v.f)
- whisker[1] = wvp[i]->v.f;
-
- if ( hinge[0] - step > wvp[i]->v.f)
- whisker[0] = wvp[i]->v.f;
-
- }
-
- {
- const double bottom_whisker =
- ch->data_bottom + ( whisker[0] - ch->y_min ) * ch->ordinate_scale;
-
- const double top_whisker =
- ch->data_bottom + ( whisker[1] - ch->y_min ) * ch->ordinate_scale;
-
-
- pl_savestate_r(ch->lp);
-
-
- /* Draw the box */
- pl_savestate_r(ch->lp);
- pl_fillcolorname_r(ch->lp,ch->fill_colour);
- pl_filltype_r(ch->lp,1);
- pl_fbox_r(ch->lp,
- box_left,
- box_bottom,
- box_right,
- box_top);
-
- pl_restorestate_r(ch->lp);
-
-
-
- /* Draw the median */
- pl_savestate_r(ch->lp);
- pl_linewidth_r(ch->lp,5);
- pl_fline_r(ch->lp,
- box_left,
- ch->data_bottom + ( hinge[1] - ch->y_min ) * ch->ordinate_scale,
- box_right,
- ch->data_bottom + ( hinge[1] - ch->y_min ) * ch->ordinate_scale);
- pl_restorestate_r(ch->lp);
-
-
- /* Draw the bottom whisker */
- pl_fline_r(ch->lp,
- box_left,
- bottom_whisker,
- box_right,
- bottom_whisker);
-
- /* Draw top whisker */
- pl_fline_r(ch->lp,
- box_left,
- top_whisker,
- box_right,
- top_whisker);
-
-
-
- /* Draw centre line.
- (bottom half) */
- pl_fline_r(ch->lp,
- box_centre, bottom_whisker,
- box_centre, box_bottom);
-
- /* (top half) */
- pl_fline_r(ch->lp,
- box_centre, top_whisker,
- box_centre, box_top);
- }
-
- /* Draw outliers */
- for ( i = 0 ; i < n_data ; ++i )
- {
- if ( wvp[i]->v.f >= hinge[2] + step )
- draw_outlier(ch, box_centre, wvp, i,
- ( wvp[i]->v.f > hinge[2] + 2 * step )
- );
-
- if ( wvp[i]->v.f <= hinge[0] - step )
- draw_outlier(ch, box_centre, wvp, i,
- ( wvp[i]->v.f < hinge[0] - 2 * step )
- );
- }
-
-
- /* Draw tick mark on x axis */
- draw_tick(ch, TICK_ABSCISSA, box_centre - ch->data_left, name);
-
- pl_restorestate_r(ch->lp);
-
-}
-
-
-
-void
-boxplot_draw_yscale(struct chart *ch , double y_max, double y_min)
-{
- double y_tick;
- double d;
-
- if ( !ch )
- return ;
-
- ch->y_max = y_max;
- ch->y_min = y_min;
-
- y_tick = chart_rounded_tick(fabs(ch->y_max - ch->y_min) / 5.0);
-
- ch->y_min = (ceil( ch->y_min / y_tick ) - 1.0 ) * y_tick;
-
- ch->y_max = ( floor( ch->y_max / y_tick ) + 1.0 ) * y_tick;
-
- ch->ordinate_scale = fabs(ch->data_top - ch->data_bottom)
- / fabs(ch->y_max - ch->y_min) ;
-
-
- /* Move to data bottom-left */
- pl_move_r(ch->lp,
- ch->data_left, ch->data_bottom);
-
- for ( d = ch->y_min; d <= ch->y_max ; d += y_tick )
- {
- draw_tick (ch, TICK_ORDINATE, (d - ch->y_min ) * ch->ordinate_scale, "%g", d);
- }
-
-}
+++ /dev/null
-#include <config.h>
-#include "calendar.h"
-#include <assert.h>
-#include <stdbool.h>
-#include "settings.h"
-#include "val.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* 14 Oct 1582. */
-#define EPOCH (-577734)
-
-/* Calculates and returns floor(a/b) for integer b > 0. */
-static int
-floor_div (int a, int b)
-{
- assert (b > 0);
- return (a >= 0 ? a : a - b + 1) / b;
-}
-
-/* Calculates floor(a/b) and the corresponding remainder and
- stores them into *Q and *R. */
-static void
-floor_divmod (int a, int b, int *q, int *r)
-{
- *q = floor_div (a, b);
- *r = a - b * *q;
-}
-
-/* Returns true if Y is a leap year, false otherwise. */
-static bool
-is_leap_year (int y)
-{
- return y % 4 == 0 && (y % 100 != 0 || y % 400 == 0);
-}
-
-static int
-raw_gregorian_to_offset (int y, int m, int d)
-{
- return (EPOCH - 1
- + 365 * (y - 1)
- + floor_div (y - 1, 4)
- - floor_div (y - 1, 100)
- + floor_div (y - 1, 400)
- + floor_div (367 * m - 362, 12)
- + (m <= 2 ? 0 : (m >= 2 && is_leap_year (y) ? -1 : -2))
- + d);
-}
-
-/* Returns the number of days from 14 Oct 1582 to (Y,M,D) in the
- Gregorian calendar. Returns SYSMIS for dates before 14 Oct
- 1582. */
-double
-calendar_gregorian_to_offset (int y, int m, int d,
- calendar_error_func *error, void *aux)
-{
- /* Normalize year. */
- if (y >= 0 && y < 100)
- {
- int epoch = get_epoch ();
- int century = epoch / 100 + (y < epoch % 100);
- y += century * 100;
- }
-
- /* Normalize month. */
- if (m < 1 || m > 12)
- {
- if (m == 0)
- {
- y--;
- m = 12;
- }
- else if (m == 13)
- {
- y++;
- m = 1;
- }
- else
- {
- error (aux, _("Month %d is not in acceptable range of 0 to 13."), m);
- return SYSMIS;
- }
- }
-
- /* Normalize day. */
- if (d < 0 || d > 31)
- {
- error (aux, _("Day %d is not in acceptable range of 0 to 31."), d);
- return SYSMIS;
- }
-
- /* Validate date. */
- if (y < 1582 || (y == 1582 && (m < 10 || (m == 10 && d < 15))))
- {
- error (aux, _("Date %04d-%d-%d is before the earliest acceptable "
- "date of 1582-10-15."), y, m, d);
- return SYSMIS;
- }
-
- /* Calculate offset. */
- return raw_gregorian_to_offset (y, m, d);
-}
-
-/* Returns the number of days in the given YEAR from January 1 up
- to (but not including) the first day of MONTH. */
-static int
-cum_month_days (int year, int month)
-{
- static const int cum_month_days[12] =
- {
- 0,
- 31, /* Jan */
- 31 + 28, /* Feb */
- 31 + 28 + 31, /* Mar */
- 31 + 28 + 31 + 30, /* Apr */
- 31 + 28 + 31 + 30 + 31, /* May */
- 31 + 28 + 31 + 30 + 31 + 30, /* Jun */
- 31 + 28 + 31 + 30 + 31 + 30 + 31, /* Jul */
- 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31, /* Aug */
- 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31 + 30, /* Sep */
- 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31, /* Oct */
- 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + 30, /* Nov */
- };
-
- assert (month >= 1 && month <= 12);
- return cum_month_days[month - 1] + (month >= 3 && is_leap_year (year));
-}
-
-/* Takes a count of days from 14 Oct 1582 and returns the
- Gregorian calendar year it is in. Dates both before and after
- the epoch are supported. */
-int
-calendar_offset_to_year (int ofs)
-{
- int d0;
- int n400, d1;
- int n100, d2;
- int n4, d3;
- int n1;
- int y;
-
- d0 = ofs - EPOCH;
- floor_divmod (d0, 365 * 400 + 100 - 3, &n400, &d1);
- floor_divmod (d1, 365 * 100 + 25 - 1, &n100, &d2);
- floor_divmod (d2, 365 * 4 + 1, &n4, &d3);
- n1 = floor_div (d3, 365);
- y = 400 * n400 + 100 * n100 + 4 * n4 + n1;
- if (n100 != 4 && n1 != 4)
- y++;
-
- return y;
-}
-
-/* Takes a count of days from 14 Oct 1582 and translates it into
- a Gregorian calendar date in (*Y,*M,*D). Dates both before
- and after the epoch are supported. */
-void
-calendar_offset_to_gregorian (int ofs, int *y, int *m, int *d)
-{
- int year = *y = calendar_offset_to_year (ofs);
- int january1 = raw_gregorian_to_offset (year, 1, 1);
- int yday = ofs - january1 + 1;
- int march1 = january1 + cum_month_days (year, 3);
- int correction = ofs < march1 ? 0 : (is_leap_year (year) ? 1 : 2);
- int month = *m = (12 * (yday - 1 + correction) + 373) / 367;
- *d = yday - cum_month_days (year, month);
-}
-
-/* Takes a count of days from 14 Oct 1582 and returns the 1-based
- year-relative day number, that is, the number of days from the
- beginning of the year. */
-int
-calendar_offset_to_yday (int ofs)
-{
- int year = calendar_offset_to_year (ofs);
- int january1 = raw_gregorian_to_offset (year, 1, 1);
- int yday = ofs - january1 + 1;
- return yday;
-}
-
-/* Takes a count of days from 14 Oct 1582 and returns the
- corresponding weekday 1...7, with 1=Sunday. */
-int
-calendar_offset_to_wday (int ofs)
-{
- int wday = (ofs - EPOCH + 1) % 7 + 1;
- if (wday <= 0)
- wday += 7;
- return wday;
-}
-
-/* Takes a count of days from 14 Oct 1582 and returns the month
- it is in. */
-int
-calendar_offset_to_month (int ofs)
-{
- int y, m, d;
- calendar_offset_to_gregorian (ofs, &y, &m, &d);
- return m;
-}
-
-/* Takes a count of days from 14 Oct 1582 and returns the
- corresponding day of the month. */
-int
-calendar_offset_to_mday (int ofs)
-{
- int y, m, d;
- calendar_offset_to_gregorian (ofs, &y, &m, &d);
- return d;
-}
+++ /dev/null
-#ifndef CALENDAR_H
-#define CALENDAR_H 1
-
-typedef void calendar_error_func (void *aux, const char *, ...);
-
-double calendar_gregorian_to_offset (int y, int m, int d,
- calendar_error_func *, void *aux);
-void calendar_offset_to_gregorian (int ofs, int *y, int *m, int *d);
-int calendar_offset_to_year (int ofs);
-int calendar_offset_to_month (int ofs);
-int calendar_offset_to_mday (int ofs);
-int calendar_offset_to_yday (int ofs);
-int calendar_offset_to_wday (int ofs);
-
-#endif /* calendar.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-
-#include <math.h>
-#include "chart.h"
-#include <assert.h>
-
-
-
-struct dataset
-{
- int n_data;
- const char *label;
-};
-
-
-
-
-#define DATASETS 2
-
-static const struct dataset dataset[DATASETS] =
- {
- { 13, "male"},
- { 11, "female"},
- };
-
-
-
-
-static void
-write_legend(struct chart *chart, const char *heading, int n);
-
-
-
-/* Write the abscissa label */
-void
-chart_write_xlabel(struct chart *ch, const char *label)
-{
- if ( ! ch )
- return ;
-
- pl_savestate_r(ch->lp);
-
- pl_move_r(ch->lp,ch->data_left, ch->abscissa_top);
- pl_alabel_r(ch->lp,0,'t',label);
-
- pl_restorestate_r(ch->lp);
-
-}
-
-
-
-/* Write the ordinate label */
-void
-chart_write_ylabel(struct chart *ch, const char *label)
-{
- if ( ! ch )
- return ;
-
- pl_savestate_r(ch->lp);
-
- pl_move_r(ch->lp, ch->data_bottom, ch->ordinate_right);
- pl_textangle_r(ch->lp, 90);
- pl_alabel_r(ch->lp, 0, 0, label);
-
- pl_restorestate_r(ch->lp);
-}
-
-
-
-static void
-write_legend(struct chart *chart, const char *heading,
- int n)
-{
- int ds;
-
- if ( ! chart )
- return ;
-
-
- pl_savestate_r(chart->lp);
-
- pl_filltype_r(chart->lp,1);
-
- pl_move_r(chart->lp, chart->legend_left,
- chart->data_bottom + chart->font_size * n * 1.5);
-
- pl_alabel_r(chart->lp,0,'b',heading);
-
- for (ds = 0 ; ds < n ; ++ds )
- {
- pl_fmove_r(chart->lp,
- chart->legend_left,
- chart->data_bottom + chart->font_size * ds * 1.5);
-
- pl_savestate_r(chart->lp);
- pl_fillcolorname_r(chart->lp,data_colour[ds]);
- pl_fboxrel_r (chart->lp,
- 0,0,
- chart->font_size, chart->font_size);
- pl_restorestate_r(chart->lp);
-
- pl_fmove_r(chart->lp,
- chart->legend_left + chart->font_size * 1.5,
- chart->data_bottom + chart->font_size * ds * 1.5);
-
- pl_alabel_r(chart->lp,'l','b',dataset[ds].label);
- }
-
-
- pl_restorestate_r(chart->lp);
-}
-
-
-/* Plot a data point */
-void
-chart_datum(struct chart *ch, int dataset UNUSED, double x, double y)
-{
- if ( ! ch )
- return ;
-
- {
- const double x_pos =
- (x - ch->x_min) * ch->abscissa_scale + ch->data_left ;
-
- const double y_pos =
- (y - ch->y_min) * ch->ordinate_scale + ch->data_bottom ;
-
- pl_savestate_r(ch->lp);
-
- pl_fmarker_r(ch->lp, x_pos, y_pos, 6, 15);
-
- pl_restorestate_r(ch->lp);
- }
-}
-
-/* Draw a line with slope SLOPE and intercept INTERCEPT.
- between the points limit1 and limit2.
- If lim_dim is CHART_DIM_Y then the limit{1,2} are on the
- y axis otherwise the x axis
-*/
-void
-chart_line(struct chart *ch, double slope, double intercept,
- double limit1, double limit2, enum CHART_DIM lim_dim)
-{
- double x1, y1;
- double x2, y2 ;
-
- if ( ! ch )
- return ;
-
-
- if ( lim_dim == CHART_DIM_Y )
- {
- x1 = ( limit1 - intercept ) / slope ;
- x2 = ( limit2 - intercept ) / slope ;
- y1 = limit1;
- y2 = limit2;
- }
- else
- {
- x1 = limit1;
- x2 = limit2;
- y1 = slope * x1 + intercept;
- y2 = slope * x2 + intercept;
- }
-
- y1 = (y1 - ch->y_min) * ch->ordinate_scale + ch->data_bottom ;
- y2 = (y2 - ch->y_min) * ch->ordinate_scale + ch->data_bottom ;
- x1 = (x1 - ch->x_min) * ch->abscissa_scale + ch->data_left ;
- x2 = (x2 - ch->x_min) * ch->abscissa_scale + ch->data_left ;
-
- pl_savestate_r(ch->lp);
-
- pl_fline_r(ch->lp, x1, y1, x2, y2);
-
- pl_restorestate_r(ch->lp);
-
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "case.h"
-#include <limits.h>
-#include <stdlib.h>
-#include "val.h"
-#include "alloc.h"
-#include "str.h"
-#include "var.h"
-
-#ifdef GLOBAL_DEBUGGING
-#undef NDEBUG
-#else
-#ifndef NDEBUG
-#define NDEBUG
-#endif
-#endif
-#include <assert.h>
-
-/* Changes C not to share data with any other case.
- C must be a case with a reference count greater than 1.
- There should be no reason for external code to call this
- function explicitly. It will be called automatically when
- needed. */
-void
-case_unshare (struct ccase *c)
-{
- struct case_data *cd;
-
- assert (c != NULL);
- assert (c->this == c);
- assert (c->case_data != NULL);
- assert (c->case_data->ref_cnt > 1);
-
- cd = c->case_data;
- cd->ref_cnt--;
- case_create (c, c->case_data->value_cnt);
- memcpy (c->case_data->values, cd->values,
- sizeof *cd->values * cd->value_cnt);
-}
-
-/* Returns the number of bytes needed by a case with VALUE_CNT
- values. */
-static inline size_t
-case_size (size_t value_cnt)
-{
- return (offsetof (struct case_data, values)
- + value_cnt * sizeof (union value));
-}
-
-#ifdef GLOBAL_DEBUGGING
-/* Initializes C as a null case. */
-void
-case_nullify (struct ccase *c)
-{
- c->case_data = NULL;
- c->this = c;
-}
-#endif /* GLOBAL_DEBUGGING */
-
-#ifdef GLOBAL_DEBUGGING
-/* Returns true iff C is a null case. */
-int
-case_is_null (const struct ccase *c)
-{
- return c->case_data == NULL;
-}
-#endif /* GLOBAL_DEBUGGING */
-
-/* Initializes C as a new case that can store VALUE_CNT values.
- The values have indeterminate contents until explicitly
- written. */
-void
-case_create (struct ccase *c, size_t value_cnt)
-{
- if (!case_try_create (c, value_cnt))
- xalloc_die ();
-}
-
-#ifdef GLOBAL_DEBUGGING
-/* Initializes CLONE as a copy of ORIG. */
-void
-case_clone (struct ccase *clone, const struct ccase *orig)
-{
- assert (orig != NULL);
- assert (orig->this == orig);
- assert (orig->case_data != NULL);
- assert (orig->case_data->ref_cnt > 0);
- assert (clone != NULL);
-
- if (clone != orig)
- {
- *clone = *orig;
- clone->this = clone;
- }
- orig->case_data->ref_cnt++;
-}
-#endif /* GLOBAL_DEBUGGING */
-
-#ifdef GLOBAL_DEBUGGING
-/* Replaces DST by SRC and nullifies SRC.
- DST and SRC must be initialized cases at entry. */
-void
-case_move (struct ccase *dst, struct ccase *src)
-{
- assert (src != NULL);
- assert (src->this == src);
- assert (src->case_data != NULL);
- assert (src->case_data->ref_cnt > 0);
- assert (dst != NULL);
-
- *dst = *src;
- dst->this = dst;
- case_nullify (src);
-}
-#endif /* GLOBAL_DEBUGGING */
-
-#ifdef GLOBAL_DEBUGGING
-/* Destroys case C. */
-void
-case_destroy (struct ccase *c)
-{
- struct case_data *cd;
-
- assert (c != NULL);
- assert (c->this == c);
-
- cd = c->case_data;
- if (cd != NULL && --cd->ref_cnt == 0)
- {
- memset (cd->values, 0xcc, sizeof *cd->values * cd->value_cnt);
- cd->value_cnt = 0xdeadbeef;
- free (cd);
- }
-}
-#endif /* GLOBAL_DEBUGGING */
-
-/* Resizes case C from OLD_CNT to NEW_CNT values. */
-void
-case_resize (struct ccase *c, size_t old_cnt, size_t new_cnt)
-{
- struct ccase new;
-
- case_create (&new, new_cnt);
- case_copy (&new, 0, c, 0, old_cnt < new_cnt ? old_cnt : new_cnt);
- case_swap (&new, c);
- case_destroy (&new);
-}
-
-/* Swaps cases A and B. */
-void
-case_swap (struct ccase *a, struct ccase *b)
-{
- struct case_data *t = a->case_data;
- a->case_data = b->case_data;
- b->case_data = t;
-}
-
-/* Attempts to create C as a new case that holds VALUE_CNT
- values. Returns nonzero if successful, zero if memory
- allocation failed. */
-int
-case_try_create (struct ccase *c, size_t value_cnt)
-{
- c->case_data = malloc (case_size (value_cnt));
- if (c->case_data != NULL)
- {
-#ifdef GLOBAL_DEBUGGING
- c->this = c;
-#endif
- c->case_data->value_cnt = value_cnt;
- c->case_data->ref_cnt = 1;
- return 1;
- }
- else
- {
-#ifdef GLOBAL_DEBUGGING
- c->this = c;
-#endif
- return 0;
- }
-}
-
-/* Tries to initialize CLONE as a copy of ORIG.
- Returns nonzero if successful, zero if memory allocation
- failed. */
-int
-case_try_clone (struct ccase *clone, const struct ccase *orig)
-{
- case_clone (clone, orig);
- return 1;
-}
-
-#ifdef GLOBAL_DEBUGGING
-/* Copies VALUE_CNT values from SRC (starting at SRC_IDX) to DST
- (starting at DST_IDX). */
-void
-case_copy (struct ccase *dst, size_t dst_idx,
- const struct ccase *src, size_t src_idx,
- size_t value_cnt)
-{
- assert (dst != NULL);
- assert (dst->this == dst);
- assert (dst->case_data != NULL);
- assert (dst->case_data->ref_cnt > 0);
- assert (dst_idx + value_cnt <= dst->case_data->value_cnt);
-
- assert (src != NULL);
- assert (src->this == src);
- assert (src->case_data != NULL);
- assert (src->case_data->ref_cnt > 0);
- assert (src_idx + value_cnt <= dst->case_data->value_cnt);
-
- if (dst->case_data->ref_cnt > 1)
- case_unshare (dst);
- if (dst->case_data != src->case_data || dst_idx != src_idx)
- memmove (dst->case_data->values + dst_idx,
- src->case_data->values + src_idx,
- sizeof *dst->case_data->values * value_cnt);
-}
-#endif /* GLOBAL_DEBUGGING */
-
-#ifdef GLOBAL_DEBUGGING
-/* Copies case C to OUTPUT.
- OUTPUT_SIZE is the number of `union values' in OUTPUT,
- which must match the number of `union values' in C. */
-void
-case_to_values (const struct ccase *c, union value *output,
- size_t output_size UNUSED)
-{
- assert (c != NULL);
- assert (c->this == c);
- assert (c->case_data != NULL);
- assert (c->case_data->ref_cnt > 0);
- assert (output_size == c->case_data->value_cnt);
- assert (output != NULL || output_size == 0);
-
- memcpy (output, c->case_data->values,
- c->case_data->value_cnt * sizeof *output);
-}
-#endif /* GLOBAL_DEBUGGING */
-
-#ifdef GLOBAL_DEBUGGING
-/* Copies INPUT into case C.
- INPUT_SIZE is the number of `union values' in INPUT,
- which must match the number of `union values' in C. */
-void
-case_from_values (struct ccase *c, const union value *input,
- size_t input_size UNUSED)
-{
- assert (c != NULL);
- assert (c->this == c);
- assert (c->case_data != NULL);
- assert (c->case_data->ref_cnt > 0);
- assert (input_size == c->case_data->value_cnt);
- assert (input != NULL || input_size == 0);
-
- if (c->case_data->ref_cnt > 1)
- case_unshare (c);
- memcpy (c->case_data->values, input,
- c->case_data->value_cnt * sizeof *input);
-}
-#endif /* GLOBAL_DEBUGGING */
-
-#ifdef GLOBAL_DEBUGGING
-/* Returns a pointer to the `union value' used for the
- element of C numbered IDX.
- The caller must not modify the returned data. */
-const union value *
-case_data (const struct ccase *c, size_t idx)
-{
- assert (c != NULL);
- assert (c->this == c);
- assert (c->case_data != NULL);
- assert (c->case_data->ref_cnt > 0);
- assert (idx < c->case_data->value_cnt);
-
- return &c->case_data->values[idx];
-}
-#endif /* GLOBAL_DEBUGGING */
-
-#ifdef GLOBAL_DEBUGGING
-/* Returns the numeric value of the `union value' in C numbered
- IDX. */
-double
-case_num (const struct ccase *c, size_t idx)
-{
- assert (c != NULL);
- assert (c->this == c);
- assert (c->case_data != NULL);
- assert (c->case_data->ref_cnt > 0);
- assert (idx < c->case_data->value_cnt);
-
- return c->case_data->values[idx].f;
-}
-#endif /* GLOBAL_DEBUGGING */
-
-#ifdef GLOBAL_DEBUGGING
-/* Returns the string value of the `union value' in C numbered
- IDX.
- (Note that the value is not null-terminated.)
- The caller must not modify the return value. */
-const char *
-case_str (const struct ccase *c, size_t idx)
-{
- assert (c != NULL);
- assert (c->this == c);
- assert (c->case_data != NULL);
- assert (c->case_data->ref_cnt > 0);
- assert (idx < c->case_data->value_cnt);
-
- return c->case_data->values[idx].s;
-}
-#endif /* GLOBAL_DEBUGGING */
-
-#ifdef GLOBAL_DEBUGGING
-/* Returns a pointer to the `union value' used for the
- element of C numbered IDX.
- The caller is allowed to modify the returned data. */
-union value *
-case_data_rw (struct ccase *c, size_t idx)
-{
- assert (c != NULL);
- assert (c->this == c);
- assert (c->case_data != NULL);
- assert (c->case_data->ref_cnt > 0);
- assert (idx < c->case_data->value_cnt);
-
- if (c->case_data->ref_cnt > 1)
- case_unshare (c);
- return &c->case_data->values[idx];
-}
-#endif /* GLOBAL_DEBUGGING */
-
-/* Compares the values of the VAR_CNT variables in VP
- in cases A and B and returns a strcmp()-type result. */
-int
-case_compare (const struct ccase *a, const struct ccase *b,
- struct variable *const *vp, size_t var_cnt)
-{
- return case_compare_2dict (a, b, vp, vp, var_cnt);
-}
-
-/* Compares the values of the VAR_CNT variables in VAP in case CA
- to the values of the VAR_CNT variables in VBP in CB
- and returns a strcmp()-type result. */
-int
-case_compare_2dict (const struct ccase *ca, const struct ccase *cb,
- struct variable *const *vap, struct variable *const *vbp,
- size_t var_cnt)
-{
- for (; var_cnt-- > 0; vap++, vbp++)
- {
- const struct variable *va = *vap;
- const struct variable *vb = *vbp;
-
- assert (va->type == vb->type);
- assert (va->width == vb->width);
-
- if (va->width == 0)
- {
- double af = case_num (ca, va->fv);
- double bf = case_num (cb, vb->fv);
-
- if (af != bf)
- return af > bf ? 1 : -1;
- }
- else
- {
- const char *as = case_str (ca, va->fv);
- const char *bs = case_str (cb, vb->fv);
- int cmp = memcmp (as, bs, va->width);
-
- if (cmp != 0)
- return cmp;
- }
- }
- return 0;
-}
-
-/* Returns a pointer to the array of `union value's used for C.
- The caller must *not* modify the returned data.
-
- NOTE: This function breaks the case abstraction. It should
- *not* be used often. Prefer the other case functions. */
-const union value *
-case_data_all (const struct ccase *c)
-{
- assert (c != NULL);
- assert (c->this == c);
- assert (c->case_data != NULL);
- assert (c->case_data->ref_cnt > 0);
-
- return c->case_data->values;
-}
-
-/* Returns a pointer to the array of `union value's used for C.
- The caller is allowed to modify the returned data.
-
- NOTE: This function breaks the case abstraction. It should
- *not* be used often. Prefer the other case functions. */
-union value *
-case_data_all_rw (struct ccase *c)
-{
- assert (c != NULL);
- assert (c->this == c);
- assert (c->case_data != NULL);
- assert (c->case_data->ref_cnt > 0);
-
- if (c->case_data->ref_cnt > 1)
- case_unshare (c);
- return c->case_data->values;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef HEADER_CASE
-#define HEADER_CASE
-
-#include <stddef.h>
-#include <stdbool.h>
-#include "val.h"
-
-/* Opaque structure that represents a case. Use accessor
- functions instead of accessing any members directly. Use
- case_move() or case_clone() instead of copying. */
-struct ccase
- {
- struct case_data *case_data; /* Actual data. */
-#if GLOBAL_DEBUGGING
- struct ccase *this; /* Detects unauthorized move/copy. */
-#endif
- };
-
-/* Invisible to user code. */
-struct case_data
- {
- size_t value_cnt; /* Number of values. */
- unsigned ref_cnt; /* Reference count. */
- union value values[1]; /* Values. */
- };
-
-#ifdef GLOBAL_DEBUGGING
-#define CASE_INLINE
-#else
-#define CASE_INLINE static
-#endif
-
-CASE_INLINE void case_nullify (struct ccase *);
-CASE_INLINE int case_is_null (const struct ccase *);
-
-void case_create (struct ccase *, size_t value_cnt);
-CASE_INLINE void case_clone (struct ccase *, const struct ccase *);
-CASE_INLINE void case_move (struct ccase *, struct ccase *);
-CASE_INLINE void case_destroy (struct ccase *);
-
-void case_resize (struct ccase *, size_t old_cnt, size_t new_cnt);
-void case_swap (struct ccase *, struct ccase *);
-
-int case_try_create (struct ccase *, size_t value_cnt);
-int case_try_clone (struct ccase *, const struct ccase *);
-
-CASE_INLINE void case_copy (struct ccase *dst, size_t dst_idx,
- const struct ccase *src, size_t src_idx,
- size_t cnt);
-
-CASE_INLINE void case_to_values (const struct ccase *, union value *, size_t);
-CASE_INLINE void case_from_values (struct ccase *,
- const union value *, size_t);
-
-CASE_INLINE const union value *case_data (const struct ccase *, size_t idx);
-CASE_INLINE double case_num (const struct ccase *, size_t idx);
-CASE_INLINE const char *case_str (const struct ccase *, size_t idx);
-
-CASE_INLINE union value *case_data_rw (struct ccase *, size_t idx);
-
-struct variable;
-int case_compare (const struct ccase *, const struct ccase *,
- struct variable *const *, size_t var_cnt);
-int case_compare_2dict (const struct ccase *, const struct ccase *,
- struct variable *const *, struct variable *const *,
- size_t var_cnt);
-
-const union value *case_data_all (const struct ccase *);
-union value *case_data_all_rw (struct ccase *);
-
-void case_unshare (struct ccase *);
-
-#ifndef GLOBAL_DEBUGGING
-#include <stdlib.h>
-#include "str.h"
-
-static inline void
-case_nullify (struct ccase *c)
-{
- c->case_data = NULL;
-}
-
-static inline int
-case_is_null (const struct ccase *c)
-{
- return c->case_data == NULL;
-}
-
-static inline void
-case_clone (struct ccase *clone, const struct ccase *orig)
-{
- *clone = *orig;
- orig->case_data->ref_cnt++;
-}
-
-static inline void
-case_move (struct ccase *dst, struct ccase *src)
-{
- *dst = *src;
- src->case_data = NULL;
-}
-
-static inline void
-case_destroy (struct ccase *c)
-{
- struct case_data *cd = c->case_data;
- if (cd != NULL && --cd->ref_cnt == 0)
- free (cd);
-}
-
-static inline void
-case_copy (struct ccase *dst, size_t dst_idx,
- const struct ccase *src, size_t src_idx,
- size_t value_cnt)
-{
- if (dst->case_data->ref_cnt > 1)
- case_unshare (dst);
- if (dst->case_data != src->case_data || dst_idx != src_idx)
- memmove (dst->case_data->values + dst_idx,
- src->case_data->values + src_idx,
- sizeof *dst->case_data->values * value_cnt);
-}
-
-static inline void
-case_to_values (const struct ccase *c, union value *output,
- size_t output_size )
-{
- memcpy (output, c->case_data->values,
- output_size * sizeof *output);
-}
-
-static inline void
-case_from_values (struct ccase *c, const union value *input,
- size_t input_size UNUSED)
-{
- if (c->case_data->ref_cnt > 1)
- case_unshare (c);
- memcpy (c->case_data->values, input,
- c->case_data->value_cnt * sizeof *input);
-}
-
-static inline const union value *
-case_data (const struct ccase *c, size_t idx)
-{
- return &c->case_data->values[idx];
-}
-
-static inline double
-case_num (const struct ccase *c, size_t idx)
-{
- return c->case_data->values[idx].f;
-}
-
-static inline const char *
-case_str (const struct ccase *c, size_t idx)
-{
- return c->case_data->values[idx].s;
-}
-
-static inline union value *
-case_data_rw (struct ccase *c, size_t idx)
-{
- if (c->case_data->ref_cnt > 1)
- case_unshare (c);
- return &c->case_data->values[idx];
-}
-#endif /* !GLOBAL_DEBUGGING */
-
-#endif /* case.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "casefile.h"
-#include "case.h"
-
-#include <gsl/gsl_rng.h>
-#include <stdarg.h>
-#include "command.h"
-#include "lexer.h"
-
-static void test_casefile (int pattern, size_t value_cnt, size_t case_cnt);
-static void get_random_case (struct ccase *, size_t value_cnt,
- size_t case_idx);
-static void write_random_case (struct casefile *cf, size_t case_idx);
-static void read_and_verify_random_case (struct casefile *cf,
- struct casereader *reader,
- size_t case_idx);
-static void fail_test (const char *message, ...);
-
-int
-cmd_debug_casefile (void)
-{
- static const size_t sizes[] =
- {
- 1, 2, 3, 4, 5, 6, 7, 14, 15, 16, 17, 31, 55, 73,
- 100, 137, 257, 521, 1031, 2053
- };
- int size_max;
- int case_max;
- int pattern;
-
- size_max = sizeof sizes / sizeof *sizes;
- if (lex_match_id ("SMALL"))
- {
- size_max -= 4;
- case_max = 511;
- }
- else
- case_max = 4095;
- if (token != '.')
- return lex_end_of_command ();
-
- for (pattern = 0; pattern < 6; pattern++)
- {
- const size_t *size;
-
- for (size = sizes; size < sizes + size_max; size++)
- {
- size_t case_cnt;
-
- for (case_cnt = 0; case_cnt <= case_max;
- case_cnt = (case_cnt * 2) + 1)
- test_casefile (pattern, *size, case_cnt);
- }
- }
- printf ("Casefile tests succeeded.\n");
- return CMD_SUCCESS;
-}
-
-static void
-test_casefile (int pattern, size_t value_cnt, size_t case_cnt)
-{
- struct casefile *cf;
- struct casereader *r1, *r2;
- struct ccase c;
- gsl_rng *rng;
- size_t i, j;
-
- rng = gsl_rng_alloc (gsl_rng_mt19937);
- cf = casefile_create (value_cnt);
- if (pattern == 5)
- casefile_to_disk (cf);
- for (i = 0; i < case_cnt; i++)
- write_random_case (cf, i);
- if (pattern == 5)
- casefile_sleep (cf);
- r1 = casefile_get_reader (cf);
- r2 = casefile_get_reader (cf);
- switch (pattern)
- {
- case 0:
- case 5:
- for (i = 0; i < case_cnt; i++)
- {
- read_and_verify_random_case (cf, r1, i);
- read_and_verify_random_case (cf, r2, i);
- }
- break;
- case 1:
- for (i = 0; i < case_cnt; i++)
- read_and_verify_random_case (cf, r1, i);
- for (i = 0; i < case_cnt; i++)
- read_and_verify_random_case (cf, r2, i);
- break;
- case 2:
- case 3:
- case 4:
- for (i = j = 0; i < case_cnt; i++)
- {
- read_and_verify_random_case (cf, r1, i);
- if (gsl_rng_get (rng) % pattern == 0)
- read_and_verify_random_case (cf, r2, j++);
- if (i == case_cnt / 2)
- casefile_to_disk (cf);
- }
- for (; j < case_cnt; j++)
- read_and_verify_random_case (cf, r2, j);
- break;
- }
- if (casereader_read (r1, &c))
- fail_test ("Casereader 1 not at end of file.");
- if (casereader_read (r2, &c))
- fail_test ("Casereader 2 not at end of file.");
- if (pattern != 1)
- casereader_destroy (r1);
- if (pattern != 2)
- casereader_destroy (r2);
- if (pattern > 2)
- {
- r1 = casefile_get_destructive_reader (cf);
- for (i = 0; i < case_cnt; i++)
- {
- struct ccase read_case, expected_case;
-
- get_random_case (&expected_case, value_cnt, i);
- if (!casereader_read_xfer (r1, &read_case))
- fail_test ("Premature end of casefile.");
- for (j = 0; j < value_cnt; j++)
- {
- double a = case_num (&read_case, j);
- double b = case_num (&expected_case, j);
- if (a != b)
- fail_test ("Case %lu fails comparison.", (unsigned long) i);
- }
- case_destroy (&expected_case);
- case_destroy (&read_case);
- }
- casereader_destroy (r1);
- }
- casefile_destroy (cf);
- gsl_rng_free (rng);
-}
-
-static void
-get_random_case (struct ccase *c, size_t value_cnt, size_t case_idx)
-{
- int i;
- case_create (c, value_cnt);
- for (i = 0; i < value_cnt; i++)
- case_data_rw (c, i)->f = case_idx % 257 + i;
-}
-
-static void
-write_random_case (struct casefile *cf, size_t case_idx)
-{
- struct ccase c;
- get_random_case (&c, casefile_get_value_cnt (cf), case_idx);
- casefile_append_xfer (cf, &c);
-}
-
-static void
-read_and_verify_random_case (struct casefile *cf,
- struct casereader *reader, size_t case_idx)
-{
- struct ccase read_case, expected_case;
- size_t value_cnt;
- size_t i;
-
- value_cnt = casefile_get_value_cnt (cf);
- get_random_case (&expected_case, value_cnt, case_idx);
- if (!casereader_read (reader, &read_case))
- fail_test ("Premature end of casefile.");
- for (i = 0; i < value_cnt; i++)
- {
- double a = case_num (&read_case, i);
- double b = case_num (&expected_case, i);
- if (a != b)
- fail_test ("Case %lu fails comparison.", (unsigned long) case_idx);
- }
- case_destroy (&read_case);
- case_destroy (&expected_case);
-}
-
-static void
-fail_test (const char *message, ...)
-{
- va_list args;
-
- va_start (args, message);
- vprintf (message, args);
- putchar ('\n');
- va_end (args);
-
- exit (1);
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "casefile.h"
-#include <assert.h>
-#include <errno.h>
-#include <fcntl.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <unistd.h>
-#include "alloc.h"
-#include "case.h"
-#include "error.h"
-#include "full-read.h"
-#include "full-write.h"
-#include "misc.h"
-#include "mkfile.h"
-#include "settings.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#define IO_BUF_SIZE (8192 / sizeof (union value))
-
-/* A casefile represents a sequentially accessible stream of
- immutable cases.
-
- If workspace allows, a casefile is maintained in memory. If
- workspace overflows, then the casefile is pushed to disk. In
- either case the interface presented to callers is kept the
- same.
-
- The life cycle of a casefile consists of up to three phases:
-
- 1. Writing. The casefile initially contains no cases. In
- this phase, any number of cases may be appended to the
- end of a casefile. (Cases are never inserted in the
- middle or before the beginning of a casefile.)
-
- Use casefile_append() or casefile_append_xfer() to
- append a case to a casefile.
-
- 2. Reading. The casefile may be read sequentially,
- starting from the beginning, by "casereaders". Any
- number of casereaders may be created, at any time,
- during the reading phase. Each casereader has an
- independent position in the casefile.
-
- Casereaders may only move forward. They cannot move
- backward to arbitrary records or seek randomly.
- Cloning casereaders is possible, but it is not yet
- implemented.
-
- Use casefile_get_reader() to create a casereader for
- use in phase 2. This also transitions from phase 1 to
- phase 2. Calling casefile_mode_reader() makes the same
- transition, without creating a casereader.
-
- Use casereader_read(), casereader_read_xfer(), or
- casereader_read_xfer_assert() to read a case from a
- casereader. Use casereader_destroy() to discard a
- casereader when it is no longer needed.
-
- 3. Destruction. This phase is optional. The casefile is
- also read with casereaders in this phase, but the
- ability to create new casereaders is curtailed.
-
- In this phase, casereaders could still be cloned (once
- we eventually implement cloning).
-
- To transition from phase 1 or 2 to phase 3 and create a
- casereader, call casefile_get_destructive_reader().
- The same functions apply to the casereader obtained
- this way as apply to casereaders obtained in phase 2.
-
- After casefile_get_destructive_reader() is called, no
- more casereaders may be created with
- casefile_get_reader() or
- casefile_get_destructive_reader(). (If cloning of
- casereaders were implemented, it would still be
- possible.)
-
- The purpose of the limitations applied to casereaders
- in phase 3 is to allow in-memory casefiles to fully
- transfer ownership of cases to the casereaders,
- avoiding the need for extra copies of case data. For
- relatively static data sets with many variables, I
- suspect (without evidence) that this may be a big
- performance boost.
-
- When a casefile is no longer needed, it may be destroyed with
- casefile_destroy(). This function will also destroy any
- remaining casereaders. */
-
-/* In-memory cases are arranged in an array of arrays. The top
- level is variable size and the size of each bottom level array
- is fixed at the number of cases defined here. */
-#define CASES_PER_BLOCK 128
-
-/* A casefile. */
-struct casefile
- {
- /* Basic data. */
- struct casefile *next, *prev; /* Next, prev in global list. */
- size_t value_cnt; /* Case size in `union value's. */
- size_t case_acct_size; /* Case size for accounting. */
- unsigned long case_cnt; /* Number of cases stored. */
- enum { MEMORY, DISK } storage; /* Where cases are stored. */
- enum { WRITE, READ } mode; /* Is writing or reading allowed? */
- struct casereader *readers; /* List of our readers. */
- int being_destroyed; /* Does a destructive reader exist? */
-
- /* Memory storage. */
- struct ccase **cases; /* Pointer to array of cases. */
-
- /* Disk storage. */
- int fd; /* File descriptor, -1 if none. */
- char *filename; /* Filename. */
- union value *buffer; /* I/O buffer, NULL if none. */
- size_t buffer_used; /* Number of values used in buffer. */
- size_t buffer_size; /* Buffer size in values. */
- };
-
-/* For reading out the cases in a casefile. */
-struct casereader
- {
- struct casereader *next, *prev; /* Next, prev in casefile's list. */
- struct casefile *cf; /* Our casefile. */
- unsigned long case_idx; /* Case number of current case. */
- int destructive; /* Is this a destructive reader? */
-
- /* Disk storage. */
- int fd; /* File descriptor. */
- union value *buffer; /* I/O buffer. */
- size_t buffer_pos; /* Offset of buffer position. */
- struct ccase c; /* Current case. */
- };
-
-/* Return the case number of the current case */
-unsigned long
-casereader_cnum(const struct casereader *r)
-{
- return r->case_idx;
-}
-
-/* Doubly linked list of all casefiles. */
-static struct casefile *casefiles;
-
-/* Number of bytes of case allocated in in-memory casefiles. */
-static size_t case_bytes;
-
-static void register_atexit (void);
-static void exit_handler (void);
-
-static void reader_open_file (struct casereader *reader);
-static void write_case_to_disk (struct casefile *cf, const struct ccase *c);
-static void flush_buffer (struct casefile *cf);
-static void fill_buffer (struct casereader *reader);
-
-static int safe_open (const char *filename, int flags);
-static int safe_close (int fd);
-
-/* Creates and returns a casefile to store cases of VALUE_CNT
- `union value's each. */
-struct casefile *
-casefile_create (size_t value_cnt)
-{
- struct casefile *cf = xmalloc (sizeof *cf);
- cf->next = casefiles;
- cf->prev = NULL;
- if (cf->next != NULL)
- cf->next->prev = cf;
- casefiles = cf;
- cf->value_cnt = value_cnt;
- cf->case_acct_size = (cf->value_cnt + 4) * sizeof *cf->buffer;
- cf->case_cnt = 0;
- cf->storage = MEMORY;
- cf->mode = WRITE;
- cf->readers = NULL;
- cf->being_destroyed = 0;
- cf->cases = NULL;
- cf->fd = -1;
- cf->filename = NULL;
- cf->buffer = NULL;
- cf->buffer_size = ROUND_UP (cf->value_cnt, IO_BUF_SIZE);
- if (cf->value_cnt > 0 && cf->buffer_size % cf->value_cnt > 64)
- cf->buffer_size = cf->value_cnt;
- cf->buffer_used = 0;
- register_atexit ();
- return cf;
-}
-
-/* Destroys casefile CF. */
-void
-casefile_destroy (struct casefile *cf)
-{
- if (cf != NULL)
- {
- if (cf->next != NULL)
- cf->next->prev = cf->prev;
- if (cf->prev != NULL)
- cf->prev->next = cf->next;
- if (casefiles == cf)
- casefiles = cf->next;
-
- while (cf->readers != NULL)
- casereader_destroy (cf->readers);
-
- if (cf->cases != NULL)
- {
- size_t idx, block_cnt;
-
- case_bytes -= cf->case_cnt * cf->case_acct_size;
- for (idx = 0; idx < cf->case_cnt; idx++)
- {
- size_t block_idx = idx / CASES_PER_BLOCK;
- size_t case_idx = idx % CASES_PER_BLOCK;
- struct ccase *c = &cf->cases[block_idx][case_idx];
- case_destroy (c);
- }
-
- block_cnt = DIV_RND_UP (cf->case_cnt, CASES_PER_BLOCK);
- for (idx = 0; idx < block_cnt; idx++)
- free (cf->cases[idx]);
-
- free (cf->cases);
- }
-
- if (cf->fd != -1)
- safe_close (cf->fd);
-
- if (cf->filename != NULL && remove (cf->filename) == -1)
- msg (ME, _("%s: Removing temporary file: %s."),
- cf->filename, strerror (errno));
- free (cf->filename);
-
- free (cf->buffer);
-
- free (cf);
- }
-}
-
-/* Returns nonzero only if casefile CF is stored in memory (instead of on
- disk). */
-int
-casefile_in_core (const struct casefile *cf)
-{
- assert (cf != NULL);
-
- return cf->storage == MEMORY;
-}
-
-/* Puts a casefile to "sleep", that is, minimizes the resources
- needed for it by closing its file descriptor and freeing its
- buffer. This is useful if we need so many casefiles that we
- might not have enough memory and file descriptors to go
- around.
-
- For simplicity, this implementation always converts the
- casefile to reader mode. If this turns out to be a problem,
- with a little extra work we could also support sleeping
- writers. */
-void
-casefile_sleep (const struct casefile *cf_)
-{
- struct casefile *cf = (struct casefile *) cf_;
- assert (cf != NULL);
-
- casefile_mode_reader (cf);
- casefile_to_disk (cf);
- flush_buffer (cf);
-
- if (cf->fd != -1)
- {
- safe_close (cf->fd);
- cf->fd = -1;
- }
- if (cf->buffer != NULL)
- {
- free (cf->buffer);
- cf->buffer = NULL;
- }
-}
-
-/* Returns the number of `union value's in a case for CF. */
-size_t
-casefile_get_value_cnt (const struct casefile *cf)
-{
- assert (cf != NULL);
-
- return cf->value_cnt;
-}
-
-/* Returns the number of cases in casefile CF. */
-unsigned long
-casefile_get_case_cnt (const struct casefile *cf)
-{
- assert (cf != NULL);
-
- return cf->case_cnt;
-}
-
-/* Appends a copy of case C to casefile CF. Not valid after any
- reader for CF has been created. */
-void
-casefile_append (struct casefile *cf, const struct ccase *c)
-{
- assert (cf != NULL);
- assert (c != NULL);
- assert (cf->mode == WRITE);
-
- /* Try memory first. */
- if (cf->storage == MEMORY)
- {
- if (case_bytes < get_workspace ())
- {
- size_t block_idx = cf->case_cnt / CASES_PER_BLOCK;
- size_t case_idx = cf->case_cnt % CASES_PER_BLOCK;
- struct ccase new_case;
-
- case_bytes += cf->case_acct_size;
- case_clone (&new_case, c);
- if (case_idx == 0)
- {
- if ((block_idx & (block_idx - 1)) == 0)
- {
- size_t block_cap = block_idx == 0 ? 1 : block_idx * 2;
- cf->cases = xnrealloc (cf->cases,
- block_cap, sizeof *cf->cases);
- }
-
- cf->cases[block_idx] = xnmalloc (CASES_PER_BLOCK,
- sizeof **cf->cases);
- }
-
- case_move (&cf->cases[block_idx][case_idx], &new_case);
- }
- else
- {
- casefile_to_disk (cf);
- assert (cf->storage == DISK);
- write_case_to_disk (cf, c);
- }
- }
- else
- write_case_to_disk (cf, c);
-
- cf->case_cnt++;
-}
-
-/* Appends case C to casefile CF, which takes over ownership of
- C. Not valid after any reader for CF has been created. */
-void
-casefile_append_xfer (struct casefile *cf, struct ccase *c)
-{
- casefile_append (cf, c);
- case_destroy (c);
-}
-
-/* Writes case C to casefile CF's disk buffer, first flushing the buffer to
- disk if it would otherwise overflow. */
-static void
-write_case_to_disk (struct casefile *cf, const struct ccase *c)
-{
- case_to_values (c, cf->buffer + cf->buffer_used, cf->value_cnt);
- cf->buffer_used += cf->value_cnt;
- if (cf->buffer_used + cf->value_cnt > cf->buffer_size)
- flush_buffer (cf);
-}
-
-/* If any bytes in CF's output buffer are used, flush them to
- disk. */
-static void
-flush_buffer (struct casefile *cf)
-{
- if (cf->buffer_used > 0)
- {
- if (!full_write (cf->fd, cf->buffer,
- cf->buffer_size * sizeof *cf->buffer))
- msg (FE, _("Error writing temporary file: %s."), strerror (errno));
-
- cf->buffer_used = 0;
- }
-}
-
-
-/* If CF is currently stored in memory, writes it to disk. Readers, if any,
- retain their current positions. */
-void
-casefile_to_disk (const struct casefile *cf_)
-{
- struct casefile *cf = (struct casefile *) cf_;
- struct casereader *reader;
-
- assert (cf != NULL);
-
- if (cf->storage == MEMORY)
- {
- size_t idx, block_cnt;
-
- assert (cf->filename == NULL);
- assert (cf->fd == -1);
- assert (cf->buffer_used == 0);
-
- cf->storage = DISK;
- if (!make_temp_file (&cf->fd, &cf->filename))
- err_failure ();
- cf->buffer = xnmalloc (cf->buffer_size, sizeof *cf->buffer);
- memset (cf->buffer, 0, cf->buffer_size * sizeof *cf->buffer);
-
- case_bytes -= cf->case_cnt * cf->case_acct_size;
- for (idx = 0; idx < cf->case_cnt; idx++)
- {
- size_t block_idx = idx / CASES_PER_BLOCK;
- size_t case_idx = idx % CASES_PER_BLOCK;
- struct ccase *c = &cf->cases[block_idx][case_idx];
- write_case_to_disk (cf, c);
- case_destroy (c);
- }
-
- block_cnt = DIV_RND_UP (cf->case_cnt, CASES_PER_BLOCK);
- for (idx = 0; idx < block_cnt; idx++)
- free (cf->cases[idx]);
-
- free (cf->cases);
- cf->cases = NULL;
-
- if (cf->mode == READ)
- flush_buffer (cf);
-
- for (reader = cf->readers; reader != NULL; reader = reader->next)
- reader_open_file (reader);
- }
-}
-
-/* Changes CF to reader mode, ensuring that no more cases may be
- added. Creating a casereader for CF has the same effect. */
-void
-casefile_mode_reader (struct casefile *cf)
-{
- assert (cf != NULL);
- cf->mode = READ;
-}
-
-/* Creates and returns a casereader for CF. A casereader can be used to
- sequentially read the cases in a casefile. */
-struct casereader *
-casefile_get_reader (const struct casefile *cf_)
-{
- struct casefile *cf = (struct casefile *) cf_;
- struct casereader *reader;
-
- assert (cf != NULL);
- assert (!cf->being_destroyed);
-
- /* Flush the buffer to disk if it's not empty. */
- if (cf->mode == WRITE && cf->storage == DISK)
- flush_buffer (cf);
-
- cf->mode = READ;
-
- reader = xmalloc (sizeof *reader);
- reader->next = cf->readers;
- if (cf->readers != NULL)
- reader->next->prev = reader;
- cf->readers = reader;
- reader->prev = NULL;
- reader->cf = cf;
- reader->case_idx = 0;
- reader->destructive = 0;
- reader->fd = -1;
- reader->buffer = NULL;
- reader->buffer_pos = 0;
- case_nullify (&reader->c);
-
- if (reader->cf->storage == DISK)
- reader_open_file (reader);
-
- return reader;
-}
-
-/* Creates and returns a destructive casereader for CF. Like a
- normal casereader, a destructive casereader sequentially reads
- the cases in a casefile. Unlike a normal casereader, a
- destructive reader cannot operate concurrently with any other
- reader. (This restriction could be relaxed in a few ways, but
- it is so far unnecessary for other code.) */
-struct casereader *
-casefile_get_destructive_reader (struct casefile *cf)
-{
- struct casereader *reader;
-
- assert (cf->readers == NULL);
- reader = casefile_get_reader (cf);
- reader->destructive = 1;
- cf->being_destroyed = 1;
- return reader;
-}
-
-/* Opens a disk file for READER and seeks to the current position as indicated
- by case_idx. Normally the current position is the beginning of the file,
- but casefile_to_disk may cause the file to be opened at a different
- position. */
-static void
-reader_open_file (struct casereader *reader)
-{
- struct casefile *cf = reader->cf;
- off_t file_ofs;
-
- if (reader->case_idx >= cf->case_cnt)
- return;
-
- if (cf->fd != -1)
- {
- reader->fd = cf->fd;
- cf->fd = -1;
- }
- else
- {
- reader->fd = safe_open (cf->filename, O_RDONLY);
- if (reader->fd < 0)
- msg (FE, _("%s: Opening temporary file: %s."),
- cf->filename, strerror (errno));
- }
-
- if (cf->buffer != NULL)
- {
- reader->buffer = cf->buffer;
- cf->buffer = NULL;
- }
- else
- {
- reader->buffer = xnmalloc (cf->buffer_size, sizeof *cf->buffer);
- memset (reader->buffer, 0, cf->buffer_size * sizeof *cf->buffer);
- }
-
- if (cf->value_cnt != 0)
- {
- size_t buffer_case_cnt = cf->buffer_size / cf->value_cnt;
- file_ofs = ((off_t) reader->case_idx / buffer_case_cnt
- * cf->buffer_size * sizeof *cf->buffer);
- reader->buffer_pos = (reader->case_idx % buffer_case_cnt
- * cf->value_cnt);
- }
- else
- file_ofs = 0;
- if (lseek (reader->fd, file_ofs, SEEK_SET) != file_ofs)
- msg (FE, _("%s: Seeking temporary file: %s."),
- cf->filename, strerror (errno));
-
- if (cf->case_cnt > 0 && cf->value_cnt > 0)
- fill_buffer (reader);
-
- case_create (&reader->c, cf->value_cnt);
-}
-
-/* Fills READER's buffer by reading a block from disk. */
-static void
-fill_buffer (struct casereader *reader)
-{
- int retval = full_read (reader->fd, reader->buffer,
- reader->cf->buffer_size * sizeof *reader->buffer);
- if (retval < 0)
- msg (FE, _("%s: Reading temporary file: %s."),
- reader->cf->filename, strerror (errno));
- else if (retval != reader->cf->buffer_size * sizeof *reader->buffer)
- msg (FE, _("%s: Temporary file ended unexpectedly."),
- reader->cf->filename);
-}
-
-/* Returns the casefile that READER reads. */
-const struct casefile *
-casereader_get_casefile (const struct casereader *reader)
-{
- assert (reader != NULL);
-
- return reader->cf;
-}
-
-/* Reads a copy of the next case from READER into C.
- Caller is responsible for destroying C.
- Returns true if successful, false at end of file. */
-int
-casereader_read (struct casereader *reader, struct ccase *c)
-{
- assert (reader != NULL);
-
- if (reader->case_idx >= reader->cf->case_cnt)
- return 0;
-
- if (reader->cf->storage == MEMORY)
- {
- size_t block_idx = reader->case_idx / CASES_PER_BLOCK;
- size_t case_idx = reader->case_idx % CASES_PER_BLOCK;
-
- case_clone (c, &reader->cf->cases[block_idx][case_idx]);
- reader->case_idx++;
- return 1;
- }
- else
- {
- if (reader->buffer_pos + reader->cf->value_cnt > reader->cf->buffer_size)
- {
- fill_buffer (reader);
- reader->buffer_pos = 0;
- }
-
- case_from_values (&reader->c, reader->buffer + reader->buffer_pos,
- reader->cf->value_cnt);
- reader->buffer_pos += reader->cf->value_cnt;
- reader->case_idx++;
-
- case_clone (c, &reader->c);
- return 1;
- }
-}
-
-/* Reads the next case from READER into C and transfers ownership
- to the caller. Caller is responsible for destroying C.
- Returns true if successful, false at end of file. */
-int
-casereader_read_xfer (struct casereader *reader, struct ccase *c)
-{
- assert (reader != NULL);
-
- if (reader->destructive == 0
- || reader->case_idx >= reader->cf->case_cnt
- || reader->cf->storage == DISK)
- return casereader_read (reader, c);
- else
- {
- size_t block_idx = reader->case_idx / CASES_PER_BLOCK;
- size_t case_idx = reader->case_idx % CASES_PER_BLOCK;
- struct ccase *read_case = &reader->cf->cases[block_idx][case_idx];
-
- case_move (c, read_case);
- reader->case_idx++;
- return 1;
- }
-}
-
-/* Reads the next case from READER into C and transfers ownership
- to the caller. Caller is responsible for destroying C.
- Assert-fails at end of file. */
-void
-casereader_read_xfer_assert (struct casereader *reader, struct ccase *c)
-{
- bool success = casereader_read_xfer (reader, c);
- assert (success);
-}
-
-/* Destroys READER. */
-void
-casereader_destroy (struct casereader *reader)
-{
- assert (reader != NULL);
-
- if (reader->next != NULL)
- reader->next->prev = reader->prev;
- if (reader->prev != NULL)
- reader->prev->next = reader->next;
- if (reader->cf->readers == reader)
- reader->cf->readers = reader->next;
-
- if (reader->cf->buffer == NULL)
- reader->cf->buffer = reader->buffer;
- else
- free (reader->buffer);
-
- if (reader->fd != -1)
- {
- if (reader->cf->fd == -1)
- reader->cf->fd = reader->fd;
- else
- safe_close (reader->fd);
- }
-
- case_destroy (&reader->c);
-
- free (reader);
-}
-
-/* Calls open(), passing FILENAME and FLAGS, repeating as necessary
- to deal with interrupted calls. */
-static int
-safe_open (const char *filename, int flags)
-{
- int fd;
-
- do
- {
- fd = open (filename, flags);
- }
- while (fd == -1 && errno == EINTR);
-
- return fd;
-}
-
-/* Calls close(), passing FD, repeating as necessary to deal with
- interrupted calls. */
-static int safe_close (int fd)
-{
- int retval;
-
- do
- {
- retval = close (fd);
- }
- while (retval == -1 && errno == EINTR);
-
- return retval;
-}
-
-/* Registers our exit handler with atexit() if it has not already
- been registered. */
-static void
-register_atexit (void)
-{
- static int registered = 0;
- if (!registered)
- {
- registered = 1;
- atexit (exit_handler);
- }
-}
-
-
-
-/* atexit() handler that closes and deletes our temporary
- files. */
-static void
-exit_handler (void)
-{
- while (casefiles != NULL)
- casefile_destroy (casefiles);
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef HEADER_CASEFILE
-#define HEADER_CASEFILE
-
-#include <stddef.h>
-#include <stdbool.h>
-
-struct ccase;
-struct casefile;
-struct casereader;
-
-struct casefile *casefile_create (size_t value_cnt);
-void casefile_destroy (struct casefile *);
-
-int casefile_in_core (const struct casefile *);
-void casefile_to_disk (const struct casefile *);
-void casefile_sleep (const struct casefile *);
-
-size_t casefile_get_value_cnt (const struct casefile *);
-unsigned long casefile_get_case_cnt (const struct casefile *);
-
-void casefile_append (struct casefile *, const struct ccase *);
-void casefile_append_xfer (struct casefile *, struct ccase *);
-
-void casefile_mode_reader (struct casefile *);
-struct casereader *casefile_get_reader (const struct casefile *);
-struct casereader *casefile_get_destructive_reader (struct casefile *);
-
-const struct casefile *casereader_get_casefile (const struct casereader *);
-int casereader_read (struct casereader *, struct ccase *);
-int casereader_read_xfer (struct casereader *, struct ccase *);
-void casereader_read_xfer_assert (struct casereader *, struct ccase *);
-void casereader_destroy (struct casereader *);
-
-unsigned long casereader_cnum(const struct casereader *);
-
-#endif /* casefile.h */
+++ /dev/null
-/* PSPP - Binary encodings for categorical variables.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Written by Jason H Stover <jason@sakla.net>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-/*
- Functions and data structures to recode categorical variables into
- vectors and sub-rows of matrices.
-
- To fit many types of statistical models, it is necessary
- to change each value of a categorical variable to a vector with binary
- entries. These vectors are then stored as sub-rows within a matrix
- during model-fitting. We need functions and data strucutres to,
- e.g., map a value, say 'a', of a variable named 'cat_var', to a
- vector, say (0 1 0 0 0), and vice versa. We also need to be able
- to map the vector back to the value 'a', and if the vector is a
- sub-row of a matrix, we need to know which sub-row corresponds to
- the variable 'cat_var'.
-
- */
-
-#ifndef CAT_ROUTINES_H
-#define CAT_ROUTINES_H
-#define CAT_VALUE_NOT_FOUND -2
-#include <stdbool.h>
-#include "cat.h"
-
-size_t cat_value_find (const struct variable *, const union value *);
-
-union value *cat_subscript_to_value (const size_t, struct variable *);
-
-void cat_stored_values_create (struct variable *);
-
-void cat_value_update (struct variable *, const union value *);
-
-void cat_create_value_matrix (struct variable *);
-
-void cat_stored_values_destroy (struct variable *);
-#endif
+++ /dev/null
-/* PSPP - binary encodings for categorical variables.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Written by Jason H Stover <jason@sakla.net>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-/*
- Functions and data structures to store values of a categorical
- variable, and to recode those values into binary vectors.
-
- For some statistical models, it is necessary to change each value
- of a categorical variable to a vector with binary entries. These
- vectors are then stored as sub-rows within a matrix during
- model-fitting. For example, we need functions and data strucutres to map a
- value, say 'a', of a variable named 'cat_var', to a vector, say (0
- 1 0 0 0), and vice versa. We also need to be able to map the
- vector back to the value 'a', and if the vector is a sub-row of a
- matrix, we need to know which sub-row corresponds to the variable
- 'cat_var'.
-*/
-#include <config.h>
-#include <stdlib.h>
-#include <error.h>
-#include "alloc.h"
-#include "error.h"
-#include "cat.h"
-#include "cat-routines.h"
-#include <string.h>
-
-#define N_INITIAL_CATEGORIES 1
-
-void
-cat_stored_values_create (struct variable *v)
-{
- if (v->obs_vals == NULL)
- {
- v->obs_vals = xmalloc (sizeof (*v->obs_vals));
- v->obs_vals->n_categories = 0;
- v->obs_vals->n_allocated_categories = N_INITIAL_CATEGORIES;
- v->obs_vals->vals =
- xnmalloc (N_INITIAL_CATEGORIES, sizeof *v->obs_vals->vals);
- }
-}
-
-void
-cat_stored_values_destroy (struct variable *v)
-{
- assert (v != NULL);
- if (v->obs_vals != NULL)
- {
- free (v->obs_vals);
- }
-}
-
-/*
- Which subscript corresponds to val?
- */
-size_t
-cat_value_find (const struct variable *v, const union value *val)
-{
- size_t i;
- const union value *candidate;
-
- assert (val != NULL);
- assert (v != NULL);
- assert (v->obs_vals != NULL);
- for (i = 0; i < v->obs_vals->n_categories; i++)
- {
- candidate = v->obs_vals->vals + i;
- assert (candidate != NULL);
- if (!compare_values (candidate, val, v->width))
- {
- return i;
- }
- }
- return CAT_VALUE_NOT_FOUND;
-}
-
-/*
- Add the new value unless it is already present.
- */
-void
-cat_value_update (struct variable *v, const union value *val)
-{
- struct cat_vals *cv;
-
- if (v->type == ALPHA)
- {
- assert (val != NULL);
- assert (v != NULL);
- cv = v->obs_vals;
- if (cat_value_find (v, val) == CAT_VALUE_NOT_FOUND)
- {
- if (cv->n_categories >= cv->n_allocated_categories)
- {
- cv->n_allocated_categories *= 2;
- cv->vals = xnrealloc (cv->vals,
- cv->n_allocated_categories,
- sizeof *cv->vals);
- }
- cv->vals[cv->n_categories] = *val;
- cv->n_categories++;
- }
- }
-}
-
-union value *
-cat_subscript_to_value (const size_t s, struct variable *v)
-{
- assert (v->obs_vals != NULL);
- if (s < v->obs_vals->n_categories)
- {
- return (v->obs_vals->vals + s);
- }
- else
- {
- return NULL;
- }
-}
-
-/*
- Return the number of categories of a categorical variable.
- */
-size_t
-cat_get_n_categories (const struct variable *v)
-{
- return v->obs_vals->n_categories;
-}
-
+++ /dev/null
-/* PSPP - Binary encodings for categorical variables.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Written by Jason H Stover <jason@sakla.net>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-/*
- Functions and data structures to recode categorical variables into
- vectors and sub-rows of matrices.
-
- To fit many types of statistical models, it is necessary
- to change each value of a categorical variable to a vector with binary
- entries. These vectors are then stored as sub-rows within a matrix
- during model-fitting. We need functions and data strucutres to,
- e.g., map a value, say 'a', of a variable named 'cat_var', to a
- vector, say (0 1 0 0 0), and vice versa. We also need to be able
- to map the vector back to the value 'a', and if the vector is a
- sub-row of a matrix, we need to know which sub-row corresponds to
- the variable 'cat_var'.
-
- */
-
-#ifndef CAT_H
-#define CAT_H
-#define CAT_VALUE_NOT_FOUND -2
-#include <stdbool.h>
-#include "val.h"
-#include "var.h"
-/*
- This structure contains the observed values of a
- categorical variable.
- */
-struct cat_vals
-{
- union value *vals;
- size_t n_categories;
- size_t n_allocated_categories; /* This is used only during
- initialization to keep
- track of the number of
- values stored.
- */
-};
-
-#endif
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-
-#include <math.h>
-#include <float.h>
-
-#include "chart.h"
-
-/* Adjust tick to be a sensible value
- ie: ... 0.1,0.2,0.5, 1,2,5, 10,20,50 ... */
-double
-chart_rounded_tick(double tick)
-{
-
- int i;
-
- double diff = DBL_MAX;
- double t = tick;
-
- static const double standard_ticks[] = {1, 2, 5, 10};
-
- const double factor = pow(10,ceil(log10(standard_ticks[0] / tick))) ;
-
- for (i = 3 ; i >= 0 ; --i)
- {
- const double d = fabs( tick - standard_ticks[i] / factor ) ;
-
- if ( d < diff )
- {
- diff = d;
- t = standard_ticks[i] / factor ;
- }
- }
-
- return t;
-
-}
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-
-#ifndef CHART_H
-#define CHART_H
-
-#include <config.h>
-#include <stdio.h>
-#include <gsl/gsl_histogram.h>
-#include "var.h"
-
-#ifndef NO_CHARTS
-#include <plot.h>
-#endif
-
-
-/* Array of standard colour names */
-extern const char *data_colour[];
-
-
-struct chart {
-
-#ifndef NO_CHARTS
- plPlotter *lp ;
- plPlotterParams *pl_params;
-#else
- void *lp;
-#endif
- char *filename;
- FILE *file;
-
- /* The geometry of the chart
- See diagram at the foot of this file.
- */
-
- int data_top ;
- int data_right ;
- int data_bottom;
- int data_left ;
-
- int abscissa_top;
-
- int ordinate_right ;
-
- int title_bottom ;
-
- int legend_left ;
- int legend_right ;
-
-
- /* Default font size for the plot (if zero, then use plotter default) */
- int font_size;
-
- char fill_colour[10];
-
- /* Stuff Particular to Cartesians (and Boxplots ) */
- double ordinate_scale;
- double abscissa_scale;
- double x_min;
- double x_max;
- double y_min;
- double y_max;
-
-};
-
-
-struct chart * chart_create(void);
-void chart_submit(struct chart *ch);
-
-double chart_rounded_tick(double tick);
-
-void chart_write_xlabel(struct chart *ch, const char *label);
-void chart_write_ylabel(struct chart *ch, const char *label);
-
-void chart_write_title(struct chart *ch, const char *title, ...);
-
-enum tick_orientation {
- TICK_ABSCISSA=0,
- TICK_ORDINATE
-};
-
-void draw_tick(struct chart *ch, enum tick_orientation orientation,
- double position, const char *label, ...);
-
-
-
-enum bar_opts {
- BAR_GROUPED = 0,
- BAR_STACKED,
- BAR_RANGE
-};
-
-
-void draw_barchart(struct chart *ch, const char *title,
- const char *xlabel, const char *ylabel, enum bar_opts opt);
-
-void draw_box_whisker_chart(struct chart *ch, const char *title);
-
-
-
-struct normal_curve
-{
- double N ;
- double mean ;
- double stddev ;
-};
-
-
-void histogram_write_legend(struct chart *ch, const struct normal_curve *norm);
-
-
-/* Plot a gsl_histogram */
-void histogram_plot(const gsl_histogram *hist, const char *factorname,
- const struct normal_curve *norm, short show_normal);
-
-
-/* Create a gsl_histogram and set it's parameters based upon
- x_min, x_max and bins.
- The caller is responsible for freeing the histogram.
-*/
-gsl_histogram * histogram_create(double bins, double x_min, double x_max) ;
-
-
-
-
-
-struct slice {
- const char *label;
- double magnetude;
-};
-
-
-
-
-/* Draw a piechart */
-void piechart_plot(const char *title,
- const struct slice *slices, int n_slices);
-
-void draw_scatterplot(struct chart *ch);
-
-
-void draw_lineplot(struct chart *ch);
-
-
-/* Set the scale on chart CH.
- The scale extends from MIN to MAX .
- TICK is the approximate number of tick marks.
-*/
-
-void chart_write_xscale(struct chart *ch,
- double min, double max, int ticks);
-
-void chart_write_yscale(struct chart *ch,
- double min, double max, int ticks);
-
-
-void chart_datum(struct chart *ch, int dataset, double x, double y);
-
-struct metrics;
-
-
-void boxplot_draw_boxplot(struct chart *ch,
- double box_centre,
- double box_width,
- struct metrics *m,
- const char *name);
-
-
-void boxplot_draw_yscale(struct chart *ch , double y_max, double y_min);
-
-
-enum CHART_DIM
- {
- CHART_DIM_X,
- CHART_DIM_Y
- };
-
-
-void chart_line(struct chart *ch, double slope, double intercept,
- double limit1, double limit2, enum CHART_DIM limit_d);
-
-
-#endif
-
-#if 0
-The anatomy of a chart is as follows.
-
-+-------------------------------------------------------------+
-| +----------------------------------+ |
-| | | |
-| | Title | |
-| | | |
-| +----------------------------------+ |
-|+----------++----------------------------------++-----------+|
-|| || || ||
-|| || || ||
-|| || || ||
-|| || || ||
-|| || || ||
-|| || || ||
-|| || || ||
-|| || || ||
-|| || || ||
-|| || || ||
-|| Ordinate || Data || Legend ||
-|| || || ||
-|| || || ||
-|| || || ||
-|| || || ||
-|| || || ||
-|| || || ||
-|| || || ||
-|| || || ||
-|| || || ||
-|| || || ||
-|+----------++----------------------------------++-----------+| --
-| +----------------------------------+ | - ^ data_bottom
-| | Abscissa | | ^ |
-| | | | | abscissa_top
-| +----------------------------------+ | v v
-+-------------------------------------------------------------+ ----
-
-ordinate_right || |
-| | || |
-|<--------->| || |
-| | || |
-| data_left | || |
-|<---------->| || |
-| || |
-| data_right || |
-|<--------------------------------------------->|| |
-| legend_left | |
-|<---------------------------------------------->| |
-| legend_right |
-|<---------------------------------------------------------->|
-
-#endif
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "cmdline.h"
-#include "error.h"
-#include <ctype.h>
-#include <stdio.h>
-#include <errno.h>
-#include <getopt.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "copyleft.h"
-#include "error.h"
-#include "filename.h"
-#include "getl.h"
-#include "glob.h"
-#include "main.h"
-#include "output.h"
-#include "progname.h"
-#include "settings.h"
-#include "str.h"
-#include "var.h"
-#include "version.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-#define N_(msgid) msgid
-
-void welcome (void);
-static void usage (void);
-
-char *subst_vars (char *);
-
-/* Parses the command line specified by ARGC and ARGV as received by
- main(). */
-void
-parse_command_line (int argc, char **argv)
-{
- static struct option long_options[] =
- {
- {"algorithm", required_argument, NULL, 'a'},
- {"command", required_argument, NULL, 'c'},
- {"config-directory", required_argument, NULL, 'B'},
- {"device", required_argument, NULL, 'o'},
- {"dry-run", no_argument, NULL, 'n'},
- {"edit", no_argument, NULL, 'n'},
- {"help", no_argument, NULL, 'h'},
- {"include-directory", required_argument, NULL, 'I'},
- {"interactive", no_argument, NULL, 'i'},
- {"just-print", no_argument, NULL, 'n'},
- {"list", no_argument, NULL, 'l'},
- {"no-include", no_argument, NULL, 'I'},
- {"no-statrc", no_argument, NULL, 'r'},
- {"out-file", required_argument, NULL, 'f'},
- {"pipe", no_argument, NULL, 'p'},
- {"recon", no_argument, NULL, 'n'},
- {"safer", no_argument, NULL, 's'},
- {"syntax", required_argument, NULL, 'x'},
- {"testing-mode", no_argument, NULL, 'T'},
- {"verbose", no_argument, NULL, 'v'},
- {"version", no_argument, NULL, 'V'},
- {0, 0, 0, 0},
- };
-
- int c, i;
-
- bool cleared_device_defaults = false;
- bool no_statrc = false;
-
- for (;;)
- {
- c = getopt_long (argc, argv, "a:x:B:c:f:hiI:lno:prsvV", long_options, NULL);
- if (c == -1)
- break;
-
- switch (c)
- {
- /* Compatibility options */
- case 'a':
- if ( 0 == strcmp(optarg,"compatible") )
- set_algorithm(COMPATIBLE);
- else if ( 0 == strcmp(optarg,"enhanced"))
- set_algorithm(ENHANCED);
- else
- {
- usage();
- assert(0);
- }
- break;
-
- case 'x':
- if ( 0 == strcmp(optarg,"compatible") )
- set_syntax(COMPATIBLE);
- else if ( 0 == strcmp(optarg,"enhanced"))
- set_syntax(ENHANCED);
- else
- {
- usage();
- assert(0);
- }
- break;
-
- case 'c':
- {
- static int n_cmds;
-
- struct getl_script *script = xmalloc (sizeof *script);
-
- {
- struct getl_line_list *line;
-
- script->first_line = line = xmalloc (sizeof *line);
- line->line = xstrdup ("commandline");
- line->len = --n_cmds;
- line = line->next = xmalloc (sizeof *line);
- line->line = xstrdup (optarg);
- line->len = strlen (optarg);
- line->next = NULL;
- }
-
- getl_add_virtual_file (script);
- }
- break;
- case 'B':
- config_path = optarg;
- break;
- case 'f':
- printf (_("%s is not yet implemented."), "-f");
- putchar('\n');
- break;
- case 'h':
- usage ();
- assert (0);
- case 'i':
- getl_interactive = 2;
- break;
- case 'I':
- if (optarg == NULL || !strcmp (optarg, "-"))
- getl_clear_include_path ();
- else
- getl_add_include_dir (optarg);
- break;
- case 'l':
- outp_list_classes ();
- terminate (true);
- case 'n':
- printf (_("%s is not yet implemented."),"-n");
- putchar('\n');
- break;
- case 'o':
- if (!cleared_device_defaults)
- {
- outp_configure_clear ();
- cleared_device_defaults = true;
- }
- outp_configure_add (optarg);
- break;
- case 'p':
- printf (_("%s is not yet implemented."),"-p");
- putchar('\n');
- break;
- case 'r':
- no_statrc = true;
- break;
- case 's':
- set_safer_mode ();
- break;
- case 'v':
- err_verbosity++;
- break;
- case 'V':
- puts (version);
- puts (legal);
- terminate (true);
- case 'T':
- force_long_view ();
- set_testing_mode (true);
- break;
- case '?':
- usage ();
- assert (0);
- case 0:
- break;
- default:
- assert (0);
- }
- }
-
- for (i = optind; i < argc; i++)
- {
- int separate = 1;
-
- if (!strcmp (argv[i], "+"))
- {
- separate = 0;
- if (++i >= argc)
- usage ();
- }
- else if (strchr (argv[i], '='))
- {
- outp_configure_macro (argv[i]);
- continue;
- }
- getl_add_file (argv[i], separate, 0);
- }
- if (getl_head)
- getl_head->separate = 0;
-
- if (getl_am_interactive)
- getl_interactive = 1;
-
- if (!no_statrc)
- {
- char *pspprc_fn = fn_search_path ("rc", config_path, NULL);
-
- if (pspprc_fn)
- getl_add_file (pspprc_fn, 0, 1);
-
- free (pspprc_fn);
- }
-}
-
-/* Message that describes PSPP command-line syntax. */
-static const char pre_syntax_message[] =
-N_("PSPP, a program for statistical analysis of sample data.\n"
-"\nUsage: %s [OPTION]... FILE...\n"
-"\nIf a long option shows an argument as mandatory, then it is mandatory\n"
-"for the equivalent short option also. Similarly for optional arguments.\n"
-"\nConfiguration:\n"
-" -a, --algorithm={compatible|enhanced}\n"
-" set to `compatible' if you want output\n"
-" calculated from broken algorithms\n"
-" -B, --config-dir=DIR set configuration directory to DIR\n"
-" -o, --device=DEVICE select output driver DEVICE and disable defaults\n"
-" -d, --define=VAR[=VALUE] set environment variable VAR to VALUE, or empty\n"
-" -u, --undef=VAR undefine environment variable VAR\n"
-"\nInput and output:\n"
-" -f, --out-file=FILE send output to FILE (overwritten)\n"
-" -p, --pipe read script from stdin, send output to stdout\n"
-" -I-, --no-include clear include path\n"
-" -I, --include=DIR append DIR to include path\n"
-" -c, --command=COMMAND execute COMMAND before .pspp/rc at startup\n"
-"\nLanguage modifiers:\n"
-" -i, --interactive interpret scripts in interactive mode\n"
-" -n, --edit just check syntax; don't actually run the code\n"
-" -r, --no-statrc disable execution of .pspp/rc at startup\n"
-" -s, --safer don't allow some unsafe operations\n"
-" -x, --syntax={compatible|enhanced}\n"
-" set to `compatible' if you want only to accept\n"
-" spss compatible syntax\n"
-"\nInformative output:\n"
-" -h, --help print this help, then exit\n"
-" -l, --list print a list of known driver classes, then exit\n"
-" -V, --version show PSPP version, then exit\n"
-" -v, --verbose increments verbosity level\n"
-"\nNon-option arguments:\n"
-" FILE1 FILE2 run FILE1, clear the dictionary, run FILE2\n"
-" FILE1 + FILE2 run FILE1 then FILE2 without clearing dictionary\n"
-" KEY=VALUE overrides macros in output initialization file\n"
-"\n");
-
-/* Message that describes PSPP command-line syntax, continued. */
-static const char post_syntax_message[] = N_("\nReport bugs to <%s>.\n");
-
-/* Writes a syntax description to stdout and terminates. */
-static void
-usage (void)
-{
- printf (gettext (pre_syntax_message), program_name);
- outp_list_classes ();
- printf (gettext (post_syntax_message), PACKAGE_BUGREPORT);
-
- terminate (true);
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !INCLUDED_CMDLINE_H
-#define INCLUDED_CMDLINE_H 1
-
-void parse_command_line (int argc, char **argv);
-
-#endif /* cmdline.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include "command.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include <ctype.h>
-#include <errno.h>
-#include "alloc.h"
-#include "dictionary.h"
-#include "error.h"
-#include "glob.h"
-#include "getl.h"
-#include "lexer.h"
-#include "main.h"
-#include "settings.h"
-#include "som.h"
-#include "str.h"
-#include "tab.h"
-#include "var.h"
-#include "vfm.h"
-
-#if HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
-#if HAVE_SYS_WAIT_H
-#include <sys/wait.h>
-#endif
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-#define N_(msgid) msgid
-\f
-/* Global variables. */
-
-/* A STATE_* constant giving the current program state. */
-int pgm_state;
-
-/* The name of the procedure currently executing, if any. */
-const char *cur_proc;
-\f
-/* Static variables. */
-
-/* A single command. */
-struct command
- {
- const char *name; /* Command name. */
- int transition[4]; /* Transitions to make from each state. */
- int (*func) (void); /* Function to call. */
- int skip_entire_name; /* If zero, we don't skip the
- final token in the command name. */
- short debug; /* Set if this cmd available only in test mode*/
- };
-
-/* Define the command array. */
-#define DEFCMD(NAME, T1, T2, T3, T4, FUNC) \
- {NAME, {T1, T2, T3, T4}, FUNC, 1, 0},
-#define DBGCMD(NAME, T1, T2, T3, T4, FUNC) \
- {NAME, {T1, T2, T3, T4}, FUNC, 1, 1},
-#define SPCCMD(NAME, T1, T2, T3, T4, FUNC) \
- {NAME, {T1, T2, T3, T4}, FUNC, 0, 0},
-#define UNIMPL(NAME, T1, T2, T3, T4, DESC) \
- {NAME, {T1, T2, T3, T4}, NULL, 1, 0},
-static const struct command commands[] =
- {
-#include "command.def"
- };
-#undef DEFCMD
-#undef DBGCMD
-#undef UNIMPL
-
-
-/* Complete the line using the name of a command,
- * based upon the current prg_state
- */
-char *
-pspp_completion_function (const char *text, int state)
-{
- static int skip=0;
- const struct command *cmd = 0;
-
- for(;;)
- {
- if ( state + skip >= sizeof(commands)/ sizeof(struct command))
- {
- skip = 0;
- return 0;
- }
-
- cmd = &commands[state + skip];
-
- if ( cmd->transition[pgm_state] == STATE_ERROR || ( cmd->debug && ! get_testing_mode () ) )
- {
- skip++;
- continue;
- }
-
- if ( text == 0 || 0 == strncasecmp (cmd->name, text, strlen(text)))
- {
- break;
- }
-
- skip++;
- }
-
-
- return xstrdup(cmd->name);
-
-}
-
-
-
-#define COMMAND_CNT (sizeof commands / sizeof *commands)
-\f
-/* Command parser. */
-
-static const struct command *parse_command_name (void);
-
-/* Determines whether command C is appropriate to call in this
- part of a FILE TYPE structure. */
-static int
-FILE_TYPE_okay (const struct command *c UNUSED)
-#if 0
-{
- int okay = 0;
-
- if (c->func != cmd_record_type
- && c->func != cmd_data_list
- && c->func != cmd_repeating_data
- && c->func != cmd_end_file_type)
- msg (SE, _("%s not allowed inside FILE TYPE/END FILE TYPE."), c->name);
- /* FIXME */
- else if (c->func == cmd_repeating_data && fty.type == FTY_GROUPED)
- msg (SE, _("%s not allowed inside FILE TYPE GROUPED/END FILE TYPE."),
- c->name);
- else if (!fty.had_rec_type && c->func != cmd_record_type)
- msg (SE, _("RECORD TYPE must be the first command inside a "
- "FILE TYPE structure."));
- else
- okay = 1;
-
- if (c->func == cmd_record_type)
- fty.had_rec_type = 1;
-
- return okay;
-}
-#else
-{
- return 1;
-}
-#endif
-
-/* Parses an entire PSPP command. This includes everything from the
- command name to the terminating dot. Does most of its work by
- passing it off to the respective command dispatchers. Only called
- by parse() in main.c. */
-int
-cmd_parse (void)
-{
- const struct command *cp; /* Iterator used to find the proper command. */
-
-#if C_ALLOCA
- /* The generic alloca package performs garbage collection when it is
- called with an argument of zero. */
- alloca (0);
-#endif /* C_ALLOCA */
-
- /* Null commands can result from extra empty lines. */
- if (token == '.')
- return CMD_SUCCESS;
-
- /* Parse comments. */
- if ((token == T_ID && !strcasecmp (tokid, "COMMENT"))
- || token == T_EXP || token == '*' || token == '[')
- {
- lex_skip_comment ();
- return CMD_SUCCESS;
- }
-
- /* Otherwise the line must begin with a command name, which is
- always an ID token. */
- if (token != T_ID)
- {
- lex_error (_("expecting command name"));
- return CMD_FAILURE;
- }
-
- /* Parse the command name. */
- cp = parse_command_name ();
- if (cp == NULL)
- return CMD_FAILURE;
- if (cp->func == NULL)
- {
- msg (SE, _("%s is not yet implemented."), cp->name);
- while (token && token != '.')
- lex_get ();
- return CMD_SUCCESS;
- }
-
- /* If we're in a FILE TYPE structure, only certain commands can be
- allowed. */
- if (pgm_state == STATE_INPUT
- && case_source_is_class (vfm_source, &file_type_source_class)
- && !FILE_TYPE_okay (cp))
- return CMD_FAILURE;
-
- /* Certain state transitions are not allowed. Check for these. */
- assert (pgm_state >= 0 && pgm_state < STATE_ERROR);
- if (cp->transition[pgm_state] == STATE_ERROR)
- {
- static const char *state_name[4] =
- {
- N_("%s is not allowed (1) before a command to specify the "
- "input program, such as DATA LIST, (2) between FILE TYPE "
- "and END FILE TYPE, (3) between INPUT PROGRAM and END "
- "INPUT PROGRAM."),
- N_("%s is not allowed within an input program."),
- N_("%s is only allowed within an input program."),
- N_("%s is only allowed within an input program."),
- };
-
- msg (SE, gettext (state_name[pgm_state]), cp->name);
- return CMD_FAILURE;
- }
-
- /* The structured output manager numbers all its tables. Increment
- the major table number for each separate procedure. */
- som_new_series ();
-
- {
- int result;
-
- /* Call the command dispatcher. Save and restore the name of
- the current command around this call. */
- {
- const char *prev_proc;
-
- prev_proc = cur_proc;
- cur_proc = cp->name;
- result = cp->func ();
- cur_proc = prev_proc;
- }
-
- /* Perform the state transition if the command completed
- successfully (at least in part). */
- if (result != CMD_FAILURE)
- {
- pgm_state = cp->transition[pgm_state];
-
- if (pgm_state == STATE_ERROR)
- {
- discard_variables ();
- pgm_state = STATE_INIT;
- }
- }
-
- /* Pass the command's success value up to the caller. */
- return result;
- }
-}
-
-static size_t
-match_strings (const char *a, size_t a_len,
- const char *b, size_t b_len)
-{
- size_t match_len = 0;
-
- while (a_len > 0 && b_len > 0)
- {
- /* Mismatch always returns zero. */
- if (toupper ((unsigned char) *a++) != toupper ((unsigned char) *b++))
- return 0;
-
- /* Advance. */
- a_len--;
- b_len--;
- match_len++;
- }
-
- return match_len;
-}
-
-/* Returns the first character in the first word in STRING,
- storing the word's length in *WORD_LEN. If no words remain,
- returns a null pointer and stores 0 in *WORD_LEN. Words are
- sequences of alphanumeric characters or single
- non-alphanumeric characters. Words are delimited by
- spaces. */
-static const char *
-find_word (const char *string, size_t *word_len)
-{
- /* Skip whitespace and asterisks. */
- while (isspace ((unsigned char) *string))
- string++;
-
- /* End of string? */
- if (*string == '\0')
- {
- *word_len = 0;
- return NULL;
- }
-
- /* Special one-character word? */
- if (!isalnum ((unsigned char) *string))
- {
- *word_len = 1;
- return string;
- }
-
- /* Alphanumeric word. */
- *word_len = 1;
- while (isalnum ((unsigned char) string[*word_len]))
- (*word_len)++;
-
- return string;
-}
-
-/* Returns nonzero if strings A and B can be confused based on
- their first three letters. */
-static int
-conflicting_3char_prefixes (const char *a, const char *b)
-{
- size_t aw_len, bw_len;
- const char *aw, *bw;
-
- aw = find_word (a, &aw_len);
- bw = find_word (b, &bw_len);
- assert (aw != NULL && bw != NULL);
-
- /* Words that are the same don't conflict. */
- if (aw_len == bw_len && !buf_compare_case (aw, bw, aw_len))
- return 0;
-
- /* Words that are otherwise the same in the first three letters
- do conflict. */
- return ((aw_len > 3 && bw_len > 3)
- || (aw_len == 3 && bw_len > 3)
- || (bw_len == 3 && aw_len > 3)) && !buf_compare_case (aw, bw, 3);
-}
-
-/* Returns nonzero if CMD can be confused with another command
- based on the first three letters of its first word. */
-static int
-conflicting_3char_prefix_command (const struct command *cmd)
-{
- assert (cmd >= commands && cmd < commands + COMMAND_CNT);
-
- return ((cmd > commands
- && conflicting_3char_prefixes (cmd[-1].name, cmd[0].name))
- || (cmd < commands + COMMAND_CNT
- && conflicting_3char_prefixes (cmd[0].name, cmd[1].name)));
-}
-
-/* Ways that a set of words can match a command name. */
-enum command_match
- {
- MISMATCH, /* Not a match. */
- PARTIAL_MATCH, /* The words begin the command name. */
- COMPLETE_MATCH /* The words are the command name. */
- };
-
-/* Figures out how well the WORD_CNT words in WORDS match CMD,
- and returns the appropriate enum value. If WORDS are a
- partial match for CMD and the next word in CMD is a dash, then
- *DASH_POSSIBLE is set to 1 if DASH_POSSIBLE is non-null;
- otherwise, *DASH_POSSIBLE is unchanged. */
-static enum command_match
-cmd_match_words (const struct command *cmd,
- char *const words[], size_t word_cnt,
- int *dash_possible)
-{
- const char *word;
- size_t word_len;
- size_t word_idx;
-
- for (word = find_word (cmd->name, &word_len), word_idx = 0;
- word != NULL && word_idx < word_cnt;
- word = find_word (word + word_len, &word_len), word_idx++)
- if (word_len != strlen (words[word_idx])
- || buf_compare_case (word, words[word_idx], word_len))
- {
- size_t match_chars = match_strings (word, word_len,
- words[word_idx],
- strlen (words[word_idx]));
- if (match_chars == 0)
- {
- /* Mismatch. */
- return MISMATCH;
- }
- else if (match_chars == 1 || match_chars == 2)
- {
- /* One- and two-character abbreviations are not
- acceptable. */
- return MISMATCH;
- }
- else if (match_chars == 3)
- {
- /* Three-character abbreviations are acceptable
- in the first word of a command if there are
- no name conflicts. They are always
- acceptable after the first word. */
- if (word_idx == 0 && conflicting_3char_prefix_command (cmd))
- return MISMATCH;
- }
- else /* match_chars > 3 */
- {
- /* Four-character and longer abbreviations are
- always acceptable. */
- }
- }
-
- if (word == NULL && word_idx == word_cnt)
- {
- /* cmd->name = "FOO BAR", words[] = {"FOO", "BAR"}. */
- return COMPLETE_MATCH;
- }
- else if (word == NULL)
- {
- /* cmd->name = "FOO BAR", words[] = {"FOO", "BAR", "BAZ"}. */
- return MISMATCH;
- }
- else
- {
- /* cmd->name = "FOO BAR BAZ", words[] = {"FOO", "BAR"}. */
- if (word[0] == '-' && dash_possible != NULL)
- *dash_possible = 1;
- return PARTIAL_MATCH;
- }
-}
-
-/* Returns the number of commands for which the WORD_CNT words in
- WORDS are a partial or complete match. If some partial match
- has a dash as the next word, then *DASH_POSSIBLE is set to 1,
- otherwise it is set to 0. */
-static int
-count_matching_commands (char *const words[], size_t word_cnt,
- int *dash_possible)
-{
- const struct command *cmd;
- int cmd_match_count;
-
- cmd_match_count = 0;
- *dash_possible = 0;
- for (cmd = commands; cmd < commands + COMMAND_CNT; cmd++)
- if (cmd_match_words (cmd, words, word_cnt, dash_possible) != MISMATCH)
- cmd_match_count++;
-
- return cmd_match_count;
-}
-
-/* Returns the command for which the WORD_CNT words in WORDS are
- a complete match. Returns a null pointer if no such command
- exists. */
-static const struct command *
-get_complete_match (char *const words[], size_t word_cnt)
-{
- const struct command *cmd;
-
- for (cmd = commands; cmd < commands + COMMAND_CNT; cmd++)
- if (cmd_match_words (cmd, words, word_cnt, NULL) == COMPLETE_MATCH)
- return cmd;
-
- return NULL;
-}
-
-/* Frees the WORD_CNT words in WORDS. */
-static void
-free_words (char *words[], size_t word_cnt)
-{
- size_t idx;
-
- for (idx = 0; idx < word_cnt; idx++)
- free (words[idx]);
-}
-
-/* Flags an error that the command whose name is given by the
- WORD_CNT words in WORDS is unknown. */
-static void
-unknown_command_error (char *const words[], size_t word_cnt)
-{
- size_t idx;
- size_t words_len;
- char *name, *cp;
-
- words_len = 0;
- for (idx = 0; idx < word_cnt; idx++)
- words_len += strlen (words[idx]);
-
- cp = name = xmalloc (words_len + word_cnt + 16);
- for (idx = 0; idx < word_cnt; idx++)
- {
- if (idx != 0)
- *cp++ = ' ';
- cp = stpcpy (cp, words[idx]);
- }
- *cp = '\0';
-
- msg (SE, _("Unknown command %s."), name);
-
- free (name);
-}
-
-
-/* Parse the command name and return a pointer to the corresponding
- struct command if successful.
- If not successful, return a null pointer. */
-static const struct command *
-parse_command_name (void)
-{
- char *words[16];
- int word_cnt;
- int complete_word_cnt;
- int dash_possible;
-
- dash_possible = 0;
- word_cnt = complete_word_cnt = 0;
- while (token == T_ID || (dash_possible && token == '-'))
- {
- int cmd_match_cnt;
-
- assert (word_cnt < sizeof words / sizeof *words);
- if (token == T_ID)
- words[word_cnt++] = xstrdup (ds_c_str (&tokstr));
- else
- words[word_cnt++] = xstrdup ("-");
-
- cmd_match_cnt = count_matching_commands (words, word_cnt,
- &dash_possible);
- if (cmd_match_cnt == 0)
- break;
- else if (cmd_match_cnt == 1)
- {
- const struct command *command = get_complete_match (words, word_cnt);
- if (command != NULL)
- {
- if (command->skip_entire_name)
- lex_get ();
- if ( command->debug & !get_testing_mode () )
- goto error;
- free_words (words, word_cnt);
- return command;
- }
- }
- else /* cmd_match_cnt > 1 */
- {
- /* Do we have a complete command name so far? */
- if (get_complete_match (words, word_cnt) != NULL)
- complete_word_cnt = word_cnt;
- }
- lex_get ();
- }
-
- /* If we saw a complete command name earlier, drop back to
- it. */
- if (complete_word_cnt)
- {
- int pushback_word_cnt;
- const struct command *command;
-
- /* Get the command. */
- command = get_complete_match (words, complete_word_cnt);
- assert (command != NULL);
-
- /* Figure out how many words we want to keep.
- We normally want to swallow the entire command. */
- pushback_word_cnt = complete_word_cnt + 1;
- if (!command->skip_entire_name)
- pushback_word_cnt--;
-
- /* FIXME: We only support one-token pushback. */
- assert (pushback_word_cnt + 1 >= word_cnt);
-
- while (word_cnt > pushback_word_cnt)
- {
- word_cnt--;
- if (strcmp (words[word_cnt], "-"))
- lex_put_back_id (words[word_cnt]);
- else
- lex_put_back ('-');
- free (words[word_cnt]);
- }
-
- if ( command->debug && !get_testing_mode () )
- goto error;
-
- free_words (words, word_cnt);
- return command;
- }
-
-error:
- unknown_command_error (words, word_cnt);
- free_words (words, word_cnt);
- return NULL;
-}
-\f
-/* Simple commands. */
-
-/* Parse and execute EXIT command. */
-int
-cmd_exit (void)
-{
- if (getl_reading_script())
- {
- msg (SE, _("This command is not accepted in a syntax file. "
- "Instead, use FINISH to terminate a syntax file."));
- lex_get ();
- }
- else
- finished = 1;
-
- return CMD_SUCCESS;
-}
-
-/* Parse and execute FINISH command. */
-int
-cmd_finish (void)
-{
- /* Do not check for `.'
- Do not fetch any extra tokens. */
- if (getl_interactive)
- {
- msg (SM, _("This command is not executed "
- "in interactive mode. Instead, PSPP drops "
- "down to the command prompt. Use EXIT if you really want "
- "to quit."));
- getl_close_all ();
- }
- else
- finished = 1;
-
- return CMD_SUCCESS;
-}
-
-/* Parses the N command. */
-int
-cmd_n_of_cases (void)
-{
- /* Value for N. */
- int x;
-
- if (!lex_force_int ())
- return CMD_FAILURE;
- x = lex_integer ();
- lex_get ();
- if (!lex_match_id ("ESTIMATED"))
- dict_set_case_limit (default_dict, x);
-
- return lex_end_of_command ();
-}
-
-/* Parses, performs the EXECUTE procedure. */
-int
-cmd_execute (void)
-{
- procedure (NULL, NULL);
- return lex_end_of_command ();
-}
-
-/* Parses, performs the ERASE command. */
-int
-cmd_erase (void)
-{
- if (get_safer_mode ())
- {
- msg (SE, _("This command not allowed when the SAFER option is set."));
- return CMD_FAILURE;
- }
-
- if (!lex_force_match_id ("FILE"))
- return CMD_FAILURE;
- lex_match ('=');
- if (!lex_force_string ())
- return CMD_FAILURE;
-
- if (remove (ds_c_str (&tokstr)) == -1)
- {
- msg (SW, _("Error removing `%s': %s."),
- ds_c_str (&tokstr), strerror (errno));
- return CMD_FAILURE;
- }
-
- return CMD_SUCCESS;
-}
-
-#ifdef unix
-/* Spawn a shell process. */
-static int
-shell (void)
-{
- int pid;
-
- pid = fork ();
- switch (pid)
- {
- case 0:
- {
- const char *shell_fn;
- char *shell_process;
-
- {
- int i;
-
- for (i = 3; i < 20; i++)
- close (i);
- }
-
- shell_fn = getenv ("SHELL");
- if (shell_fn == NULL)
- shell_fn = "/bin/sh";
-
- {
- const char *cp = strrchr (shell_fn, '/');
- cp = cp ? &cp[1] : shell_fn;
- shell_process = local_alloc (strlen (cp) + 8);
- strcpy (shell_process, "-");
- strcat (shell_process, cp);
- if (strcmp (cp, "sh"))
- shell_process[0] = '+';
- }
-
- execl (shell_fn, shell_process, NULL);
-
- _exit (1);
- }
-
- case -1:
- msg (SE, _("Couldn't fork: %s."), strerror (errno));
- return 0;
-
- default:
- assert (pid > 0);
- while (wait (NULL) != pid)
- ;
- return 1;
- }
-}
-#endif /* unix */
-
-/* Parses the HOST command argument and executes the specified
- command. Returns a suitable command return code. */
-static int
-run_command (void)
-{
- const char *cmd;
- int string;
-
- /* Handle either a string argument or a full-line argument. */
- {
- int c = lex_look_ahead ();
-
- if (c == '\'' || c == '"')
- {
- lex_get ();
- if (!lex_force_string ())
- return CMD_FAILURE;
- cmd = ds_c_str (&tokstr);
- string = 1;
- }
- else
- {
- cmd = lex_rest_of_line (NULL);
- lex_discard_line ();
- string = 0;
- }
- }
-
- /* Execute the command. */
- if (system (cmd) == -1)
- msg (SE, _("Error executing command: %s."), strerror (errno));
-
- /* Finish parsing. */
- if (string)
- {
- lex_get ();
-
- if (token != '.')
- {
- lex_error (_("expecting end of command"));
- return CMD_TRAILING_GARBAGE;
- }
- }
- else
- token = '.';
-
- return CMD_SUCCESS;
-}
-
-/* Parses, performs the HOST command. */
-int
-cmd_host (void)
-{
- int code;
-
- if (get_safer_mode ())
- {
- msg (SE, _("This command not allowed when the SAFER option is set."));
- return CMD_FAILURE;
- }
-
-#ifdef unix
- /* Figure out whether to invoke an interactive shell or to execute a
- single shell command. */
- if (lex_look_ahead () == '.')
- {
- lex_get ();
- code = shell () ? CMD_PART_SUCCESS_MAYBE : CMD_SUCCESS;
- }
- else
- code = run_command ();
-#else /* !unix */
- /* Make sure that the system has a command interpreter, then run a
- command. */
- if (system (NULL) != 0)
- code = run_command ();
- else
- {
- msg (SE, _("No operating system support for this command."));
- code = CMD_FAILURE;
- }
-#endif /* !unix */
-
- return code ? CMD_FAILURE : CMD_SUCCESS;
-}
-
-/* Parses, performs the NEW FILE command. */
-int
-cmd_new_file (void)
-{
- discard_variables ();
-
- return lex_end_of_command ();
-}
-
-/* Parses, performs the CLEAR TRANSFORMATIONS command. */
-int
-cmd_clear_transformations (void)
-{
- if (getl_reading_script ())
- {
- msg (SW, _("This command is not valid in a syntax file."));
- return CMD_FAILURE;
- }
-
- cancel_transformations ();
- /* FIXME: what about variables created by transformations?
- They need to be properly initialized. */
-
- return CMD_SUCCESS;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !command_h
-#define command_h 1
-
-/* Current program state. */
-enum
- {
- STATE_INIT, /* Initialization state. */
- STATE_INPUT, /* Input state. */
- STATE_TRANS, /* Transformation state. */
- STATE_PROC, /* Procedure state. */
- STATE_ERROR /* Invalid state transition. */
- };
-
-/* Command return values. */
-enum
- {
- CMD_FAILURE = 0x1000, /* Command not executed. */
- CMD_SUCCESS, /* Command successfully parsed and executed. */
- CMD_PART_SUCCESS_MAYBE, /* Command may have been partially executed. */
- CMD_PART_SUCCESS, /* Command fully executed up to error. */
- CMD_TRAILING_GARBAGE /* Command followed by garbage. */
- };
-
-extern int pgm_state;
-extern const char *cur_proc;
-
-char *pspp_completion_function (const char *text, int state);
-
-int cmd_parse (void);
-
-/* Prototype all the command functions. */
-#define DEFCMD(NAME, T1, T2, T3, T4, FUNC) \
- int FUNC (void);
-#define SPCCMD(NAME, T1, T2, T3, T4, FUNC) \
- int FUNC (void);
-#define DBGCMD(NAME, T1, T2, T3, T4, FUNC) \
- int FUNC (void);
-#define UNIMPL(NAME, T1, T2, T3, T4, DESC)
-#include "command.def"
-#undef DEFCMD
-#undef SPCCMD
-#undef UNIMPL
-#undef DBGCMD
-
-#endif /* !command_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <stdlib.h>
-#include "alloc.h"
-#include "case.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "expressions/public.h"
-#include "lexer.h"
-#include "misc.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-struct compute_trns;
-struct lvalue;
-
-/* Target of a COMPUTE or IF assignment, either a variable or a
- vector element. */
-static struct lvalue *lvalue_parse (void);
-static int lvalue_get_type (const struct lvalue *);
-static bool lvalue_is_vector (const struct lvalue *);
-static void lvalue_finalize (struct lvalue *,
- struct compute_trns *);
-static void lvalue_destroy (struct lvalue *);
-
-/* COMPUTE and IF transformation. */
-struct compute_trns
- {
- /* Test expression (IF only). */
- struct expression *test; /* Test expression. */
-
- /* Variable lvalue, if variable != NULL. */
- struct variable *variable; /* Destination variable, if any. */
- int fv; /* `value' index of destination variable. */
- int width; /* Lvalue string width; 0=numeric. */
-
- /* Vector lvalue, if vector != NULL. */
- const struct vector *vector; /* Destination vector, if any. */
- struct expression *element; /* Destination vector element expr. */
-
- /* Rvalue. */
- struct expression *rvalue; /* Rvalue expression. */
- };
-
-static struct expression *parse_rvalue (const struct lvalue *);
-static struct compute_trns *compute_trns_create (void);
-static trns_proc_func *get_proc_func (const struct lvalue *);
-static trns_free_func compute_trns_free;
-\f
-/* COMPUTE. */
-
-int
-cmd_compute (void)
-{
- struct lvalue *lvalue = NULL;
- struct compute_trns *compute = NULL;
-
- compute = compute_trns_create ();
-
- lvalue = lvalue_parse ();
- if (lvalue == NULL)
- goto fail;
-
- if (!lex_force_match ('='))
- goto fail;
- compute->rvalue = parse_rvalue (lvalue);
- if (compute->rvalue == NULL)
- goto fail;
-
- add_transformation (get_proc_func (lvalue), compute_trns_free, compute);
-
- lvalue_finalize (lvalue, compute);
-
- return lex_end_of_command ();
-
- fail:
- lvalue_destroy (lvalue);
- compute_trns_free (compute);
- return CMD_FAILURE;
-}
-\f
-/* Transformation functions. */
-
-/* Handle COMPUTE or IF with numeric target variable. */
-static int
-compute_num (void *compute_, struct ccase *c, int case_num)
-{
- struct compute_trns *compute = compute_;
-
- if (compute->test == NULL
- || expr_evaluate_num (compute->test, c, case_num) == 1.0)
- case_data_rw (c, compute->fv)->f = expr_evaluate_num (compute->rvalue, c,
- case_num);
-
- return -1;
-}
-
-/* Handle COMPUTE or IF with numeric vector element target
- variable. */
-static int
-compute_num_vec (void *compute_, struct ccase *c, int case_num)
-{
- struct compute_trns *compute = compute_;
-
- if (compute->test == NULL
- || expr_evaluate_num (compute->test, c, case_num) == 1.0)
- {
- double index; /* Index into the vector. */
- int rindx; /* Rounded index value. */
-
- index = expr_evaluate_num (compute->element, c, case_num);
- rindx = floor (index + EPSILON);
- if (index == SYSMIS || rindx < 1 || rindx > compute->vector->cnt)
- {
- if (index == SYSMIS)
- msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value as "
- "an index into vector %s."), compute->vector->name);
- else
- msg (SW, _("When executing COMPUTE: %g is not a valid value as "
- "an index into vector %s."),
- index, compute->vector->name);
- return -1;
- }
- case_data_rw (c, compute->vector->var[rindx - 1]->fv)->f
- = expr_evaluate_num (compute->rvalue, c, case_num);
- }
-
- return -1;
-}
-
-/* Handle COMPUTE or IF with string target variable. */
-static int
-compute_str (void *compute_, struct ccase *c, int case_num)
-{
- struct compute_trns *compute = compute_;
-
- if (compute->test == NULL
- || expr_evaluate_num (compute->test, c, case_num) == 1.0)
- expr_evaluate_str (compute->rvalue, c, case_num,
- case_data_rw (c, compute->fv)->s, compute->width);
-
- return -1;
-}
-
-/* Handle COMPUTE or IF with string vector element target
- variable. */
-static int
-compute_str_vec (void *compute_, struct ccase *c, int case_num)
-{
- struct compute_trns *compute = compute_;
-
- if (compute->test == NULL
- || expr_evaluate_num (compute->test, c, case_num) == 1.0)
- {
- double index; /* Index into the vector. */
- int rindx; /* Rounded index value. */
- struct variable *vr; /* Variable reference by indexed vector. */
-
- index = expr_evaluate_num (compute->element, c, case_num);
- rindx = floor (index + EPSILON);
- if (index == SYSMIS)
- {
- msg (SW, _("When executing COMPUTE: SYSMIS is not a valid "
- "value as an index into vector %s."),
- compute->vector->name);
- return -1;
- }
- else if (rindx < 1 || rindx > compute->vector->cnt)
- {
- msg (SW, _("When executing COMPUTE: %g is not a valid value as "
- "an index into vector %s."),
- index, compute->vector->name);
- return -1;
- }
-
- vr = compute->vector->var[rindx - 1];
- expr_evaluate_str (compute->rvalue, c, case_num,
- case_data_rw (c, vr->fv)->s, vr->width);
- }
-
- return -1;
-}
-\f
-/* IF. */
-
-int
-cmd_if (void)
-{
- struct compute_trns *compute = NULL;
- struct lvalue *lvalue = NULL;
-
- compute = compute_trns_create ();
-
- /* Test expression. */
- compute->test = expr_parse (default_dict, EXPR_BOOLEAN);
- if (compute->test == NULL)
- goto fail;
-
- /* Lvalue variable. */
- lvalue = lvalue_parse ();
- if (lvalue == NULL)
- goto fail;
-
- /* Rvalue expression. */
- if (!lex_force_match ('='))
- goto fail;
- compute->rvalue = parse_rvalue (lvalue);
- if (compute->rvalue == NULL)
- goto fail;
-
- add_transformation (get_proc_func (lvalue), compute_trns_free, compute);
-
- lvalue_finalize (lvalue, compute);
-
- return lex_end_of_command ();
-
- fail:
- lvalue_destroy (lvalue);
- compute_trns_free (compute);
- return CMD_FAILURE;
-}
-\f
-/* Code common to COMPUTE and IF. */
-
-static trns_proc_func *
-get_proc_func (const struct lvalue *lvalue)
-{
- bool is_numeric = lvalue_get_type (lvalue) == NUMERIC;
- bool is_vector = lvalue_is_vector (lvalue);
-
- return (is_numeric
- ? (is_vector ? compute_num_vec : compute_num)
- : (is_vector ? compute_str_vec : compute_str));
-}
-
-/* Parses and returns an rvalue expression of the same type as
- LVALUE, or a null pointer on failure. */
-static struct expression *
-parse_rvalue (const struct lvalue *lvalue)
-{
- bool is_numeric = lvalue_get_type (lvalue) == NUMERIC;
-
- return expr_parse (default_dict, is_numeric ? EXPR_NUMBER : EXPR_STRING);
-}
-
-/* Returns a new struct compute_trns after initializing its fields. */
-static struct compute_trns *
-compute_trns_create (void)
-{
- struct compute_trns *compute = xmalloc (sizeof *compute);
- compute->test = NULL;
- compute->variable = NULL;
- compute->vector = NULL;
- compute->element = NULL;
- compute->rvalue = NULL;
- return compute;
-}
-
-/* Deletes all the fields in COMPUTE. */
-static void
-compute_trns_free (void *compute_)
-{
- struct compute_trns *compute = compute_;
-
- if (compute != NULL)
- {
- expr_free (compute->test);
- expr_free (compute->element);
- expr_free (compute->rvalue);
- free (compute);
- }
-}
-\f
-/* COMPUTE or IF target variable or vector element. */
-struct lvalue
- {
- char var_name[LONG_NAME_LEN + 1]; /* Destination variable name, or "". */
- const struct vector *vector; /* Destination vector, if any, or NULL. */
- struct expression *element; /* Destination vector element, or NULL. */
- };
-
-/* Parses the target variable or vector element into a new
- `struct lvalue', which is returned. */
-static struct lvalue *
-lvalue_parse (void)
-{
- struct lvalue *lvalue;
-
- lvalue = xmalloc (sizeof *lvalue);
- lvalue->var_name[0] = '\0';
- lvalue->vector = NULL;
- lvalue->element = NULL;
-
- if (!lex_force_id ())
- goto lossage;
-
- if (lex_look_ahead () == '(')
- {
- /* Vector. */
- lvalue->vector = dict_lookup_vector (default_dict, tokid);
- if (lvalue->vector == NULL)
- {
- msg (SE, _("There is no vector named %s."), tokid);
- goto lossage;
- }
-
- /* Vector element. */
- lex_get ();
- if (!lex_force_match ('('))
- goto lossage;
- lvalue->element = expr_parse (default_dict, EXPR_NUMBER);
- if (lvalue->element == NULL)
- goto lossage;
- if (!lex_force_match (')'))
- goto lossage;
- }
- else
- {
- /* Variable name. */
- str_copy_trunc (lvalue->var_name, sizeof lvalue->var_name, tokid);
- lex_get ();
- }
- return lvalue;
-
- lossage:
- lvalue_destroy (lvalue);
- return NULL;
-}
-
-/* Returns the type (NUMERIC or ALPHA) of the target variable or
- vector in LVALUE. */
-static int
-lvalue_get_type (const struct lvalue *lvalue)
-{
- if (lvalue->vector == NULL)
- {
- struct variable *var = dict_lookup_var (default_dict, lvalue->var_name);
- if (var == NULL)
- return NUMERIC;
- else
- return var->type;
- }
- else
- return lvalue->vector->var[0]->type;
-}
-
-/* Returns nonzero if LVALUE has a vector as its target. */
-static bool
-lvalue_is_vector (const struct lvalue *lvalue)
-{
- return lvalue->vector != NULL;
-}
-
-/* Finalizes making LVALUE the target of COMPUTE, by creating the
- target variable if necessary and setting fields in COMPUTE. */
-static void
-lvalue_finalize (struct lvalue *lvalue, struct compute_trns *compute)
-{
- if (lvalue->vector == NULL)
- {
- compute->variable = dict_lookup_var (default_dict, lvalue->var_name);
- if (compute->variable == NULL)
- compute->variable = dict_create_var_assert (default_dict,
- lvalue->var_name, 0);
-
- compute->fv = compute->variable->fv;
- compute->width = compute->variable->width;
-
- /* Goofy behavior, but compatible: Turn off LEAVE. */
- if (dict_class_from_id (compute->variable->name) != DC_SCRATCH)
- compute->variable->reinit = 1;
- }
- else
- {
- compute->vector = lvalue->vector;
- compute->element = lvalue->element;
- lvalue->element = NULL;
- }
-
- lvalue_destroy (lvalue);
-}
-
-/* Destroys LVALUE. */
-static void
-lvalue_destroy (struct lvalue *lvalue)
-{
- if (lvalue == NULL)
- return;
-
- expr_free (lvalue->element);
- free (lvalue);
-}
+++ /dev/null
-const char legal[]=""
-"Copyright (C) 1997-9, 2000, 2005 Free Software Foundation, Inc.\n"
-"GNU PSPP comes with NO WARRANTY,\n"
-"to the extent permitted by law.\n"
-"You may redistribute copies of GNU PSPP\n"
-"under the terms of the GNU General Public License.\n"
-"For more information about these matters,\n"
-"see the file named COPYING.\n";
-
-const char lack_of_warranty[]=""
-" NO WARRANTY\n"
-"\n"
-"BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY "
-"FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN "
-"OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES "
-"PROVIDE THE PROGRAM \"AS IS\" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED "
-"OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF "
-"MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS "
-"TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE "
-"PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, "
-"REPAIR OR CORRECTION.\n"
-"\n"
-"IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING "
-"WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR "
-"REDISTRIBUTE THE PROGRAM, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY "
-"GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE "
-"OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA "
-"OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD "
-"PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), "
-"EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY "
-"OF SUCH DAMAGES.";
-
-const char copyleft[]=""
-" GNU GENERAL PUBLIC LICENSE\n "
-" Version 2, June 1991\n "
-" \n"
-" Copyright (C) 1989, 1991 Free Software Foundation, Inc. \n"
-" 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n "
-" Everyone is permitted to copy and distribute verbatim copies "
-" of this license document, but changing it is not allowed. "
-" \n"
-" Preamble \n"
-"\n"
-" The licenses for most software are designed to take away your "
-"freedom to share and change it. By contrast, the GNU General Public "
-"License is intended to guarantee your freedom to share and change free "
-"software--to make sure the software is free for all its users. This "
-"General Public License applies to most of the Free Software "
-"Foundation\'s software and to any other program whose authors commit to "
-"using it. (Some other Free Software Foundation software is covered by "
-"the GNU Library General Public License instead.) You can apply it to "
-"your programs, too. "
-"\n"
-" When we speak of free software, we are referring to freedom, not "
-"price. Our General Public Licenses are designed to make sure that you "
-"have the freedom to distribute copies of free software (and charge for "
-"this service if you wish), that you receive source code or can get it "
-"if you want it, that you can change the software or use pieces of it "
-"in new free programs; and that you know you can do these things. "
-" \n"
-" To protect your rights, we need to make restrictions that forbid "
-"anyone to deny you these rights or to ask you to surrender the rights. "
-"These restrictions translate to certain responsibilities for you if you "
-"distribute copies of the software, or if you modify it. "
-" \n"
-" For example, if you distribute copies of such a program, whether "
-"gratis or for a fee, you must give the recipients all the rights that "
-"you have. You must make sure that they, too, receive or can get the "
-"source code. And you must show them these terms so they know their "
-"rights. "
-" \n"
-" We protect your rights with two steps: (1) copyright the software, and "
-"(2) offer you this license which gives you legal permission to copy, "
-"distribute and/or modify the software. "
-" \n"
-" Also, for each author's protection and ours, we want to make certain "
-"that everyone understands that there is no warranty for this free "
-"software. If the software is modified by someone else and passed on, we "
-"want its recipients to know that what they have is not the original, so "
-"that any problems introduced by others will not reflect on the original "
-"authors' reputations. "
-" \n"
-" Finally, any free program is threatened constantly by software "
-"patents. We wish to avoid the danger that redistributors of a free "
-"program will individually obtain patent licenses, in effect making the "
-"program proprietary. To prevent this, we have made it clear that any "
-"patent must be licensed for everyone's free use or not licensed at all. "
-" \n"
-" The precise terms and conditions for copying, distribution and "
-"modification follow. "
-"\n "
-" GNU GENERAL PUBLIC LICENSE \n"
-" TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION \n"
-" \n"
-" 0. This License applies to any program or other work which contains "
-"a notice placed by the copyright holder saying it may be distributed "
-"under the terms of this General Public License. The \"Program\", below, "
-"refers to any such program or work, and a \"work based on the Program\" "
-"means either the Program or any derivative work under copyright law: "
-"that is to say, a work containing the Program or a portion of it, "
-"either verbatim or with modifications and/or translated into another "
-"language. (Hereinafter, translation is included without limitation in "
-"the term \"modification\".) Each licensee is addressed as \"you\". "
-" \n"
-"Activities other than copying, distribution and modification are not "
-"covered by this License; they are outside its scope. The act of "
-"running the Program is not restricted, and the output from the Program "
-"is covered only if its contents constitute a work based on the "
-"Program (independent of having been made by running the Program). "
-"Whether that is true depends on what the Program does. "
-"\n"
-" 1. You may copy and distribute verbatim copies of the Program's "
-"source code as you receive it, in any medium, provided that you "
-"conspicuously and appropriately publish on each copy an appropriate "
-"copyright notice and disclaimer of warranty; keep intact all the "
-"notices that refer to this License and to the absence of any warranty; "
-"and give any other recipients of the Program a copy of this License "
-"along with the Program. "
-"\n"
-"You may charge a fee for the physical act of transferring a copy, and "
-"you may at your option offer warranty protection in exchange for a fee. "
-"\n"
-" 2. You may modify your copy or copies of the Program or any portion "
-"of it, thus forming a work based on the Program, and copy and "
-"distribute such modifications or work under the terms of Section 1 "
-"above, provided that you also meet all of these conditions: "
-"\n"
-" a) You must cause the modified files to carry prominent notices "
-" stating that you changed the files and the date of any change. "
-"\n"
-" b) You must cause any work that you distribute or publish, that in "
-" whole or in part contains or is derived from the Program or any "
-" part thereof, to be licensed as a whole at no charge to all third "
-" parties under the terms of this License. "
-"\n"
-" c) If the modified program normally reads commands interactively "
-" when run, you must cause it, when started running for such "
-" interactive use in the most ordinary way, to print or display an "
-" announcement including an appropriate copyright notice and a "
-" notice that there is no warranty (or else, saying that you provide "
-" a warranty) and that users may redistribute the program under "
-" these conditions, and telling the user how to view a copy of this "
-" License. (Exception: if the Program itself is interactive but "
-" does not normally print such an announcement, your work based on "
-" the Program is not required to print an announcement.) "
-"\n "
-"These requirements apply to the modified work as a whole. If "
-"identifiable sections of that work are not derived from the Program, "
-"and can be reasonably considered independent and separate works in "
-"themselves, then this License, and its terms, do not apply to those "
-"sections when you distribute them as separate works. But when you "
-"distribute the same sections as part of a whole which is a work based "
-"on the Program, the distribution of the whole must be on the terms of "
-"this License, whose permissions for other licensees extend to the "
-"entire whole, and thus to each and every part regardless of who wrote it. "
-"\n"
-"Thus, it is not the intent of this section to claim rights or contest "
-"your rights to work written entirely by you; rather, the intent is to "
-"exercise the right to control the distribution of derivative or "
-"collective works based on the Program. "
-"\n"
-"In addition, mere aggregation of another work not based on the Program "
-"with the Program (or with a work based on the Program) on a volume of "
-"a storage or distribution medium does not bring the other work under "
-"the scope of this License. "
-"\n"
-" 3. You may copy and distribute the Program (or a work based on it, "
-"under Section 2) in object code or executable form under the terms of "
-"Sections 1 and 2 above provided that you also do one of the following: "
-"\n"
-" a) Accompany it with the complete corresponding machine-readable "
-" source code, which must be distributed under the terms of Sections "
-" 1 and 2 above on a medium customarily used for software interchange; or, "
-"\n"
-" b) Accompany it with a written offer, valid for at least three "
-" years, to give any third party, for a charge no more than your "
-" cost of physically performing source distribution, a complete "
-" machine-readable copy of the corresponding source code, to be "
-" distributed under the terms of Sections 1 and 2 above on a medium "
-" customarily used for software interchange; or, "
-"\n"
-" c) Accompany it with the information you received as to the offer "
-" to distribute corresponding source code. (This alternative is "
-" allowed only for noncommercial distribution and only if you "
-" received the program in object code or executable form with such "
-" an offer, in accord with Subsection b above.) "
-"\n"
-"The source code for a work means the preferred form of the work for "
-"making modifications to it. For an executable work, complete source "
-"code means all the source code for all modules it contains, plus any "
-"associated interface definition files, plus the scripts used to "
-"control compilation and installation of the executable. However, as a "
-"special exception, the source code distributed need not include "
-"anything that is normally distributed (in either source or binary "
-"form) with the major components (compiler, kernel, and so on) of the "
-"operating system on which the executable runs, unless that component "
-"itself accompanies the executable. "
-"\n"
-"If distribution of executable or object code is made by offering "
-"access to copy from a designated place, then offering equivalent "
-"access to copy the source code from the same place counts as "
-"distribution of the source code, even though third parties are not "
-"compelled to copy the source along with the object code. "
-"\n "
-" 4. You may not copy, modify, sublicense, or distribute the Program "
-"except as expressly provided under this License. Any attempt "
-"otherwise to copy, modify, sublicense or distribute the Program is "
-"void, and will automatically terminate your rights under this License. "
-"However, parties who have received copies, or rights, from you under "
-"this License will not have their licenses terminated so long as such "
-"parties remain in full compliance. "
-"\n"
-" 5. You are not required to accept this License, since you have not "
-"signed it. However, nothing else grants you permission to modify or "
-"distribute the Program or its derivative works. These actions are "
-"prohibited by law if you do not accept this License. Therefore, by "
-"modifying or distributing the Program (or any work based on the "
-"Program), you indicate your acceptance of this License to do so, and "
-"all its terms and conditions for copying, distributing or modifying "
-"the Program or works based on it. "
-"\n"
-" 6. Each time you redistribute the Program (or any work based on the "
-"Program), the recipient automatically receives a license from the "
-"original licensor to copy, distribute or modify the Program subject to "
-"these terms and conditions. You may not impose any further "
-"restrictions on the recipients' exercise of the rights granted herein. "
-"You are not responsible for enforcing compliance by third parties to "
-"this License. "
-"\n"
-" 7. If, as a consequence of a court judgment or allegation of patent "
-"infringement or for any other reason (not limited to patent issues), "
-"conditions are imposed on you (whether by court order, agreement or "
-"otherwise) that contradict the conditions of this License, they do not "
-"excuse you from the conditions of this License. If you cannot "
-"distribute so as to satisfy simultaneously your obligations under this "
-"License and any other pertinent obligations, then as a consequence you "
-"may not distribute the Program at all. For example, if a patent "
-"license would not permit royalty-free redistribution of the Program by "
-"all those who receive copies directly or indirectly through you, then "
-"the only way you could satisfy both it and this License would be to "
-"refrain entirely from distribution of the Program. "
-"\n"
-"If any portion of this section is held invalid or unenforceable under "
-"any particular circumstance, the balance of the section is intended to "
-"apply and the section as a whole is intended to apply in other "
-"circumstances. "
-"\n"
-"It is not the purpose of this section to induce you to infringe any "
-"patents or other property right claims or to contest validity of any "
-"such claims; this section has the sole purpose of protecting the "
-"integrity of the free software distribution system, which is "
-"implemented by public license practices. Many people have made "
-"generous contributions to the wide range of software distributed "
-"through that system in reliance on consistent application of that "
-"system; it is up to the author/donor to decide if he or she is willing "
-"to distribute software through any other system and a licensee cannot "
-"impose that choice. "
-"\n"
-"This section is intended to make thoroughly clear what is believed to "
-"be a consequence of the rest of this License. "
-"\n "
-" 8. If the distribution and/or use of the Program is restricted in "
-"certain countries either by patents or by copyrighted interfaces, the "
-"original copyright holder who places the Program under this License "
-"may add an explicit geographical distribution limitation excluding "
-"those countries, so that distribution is permitted only in or among "
-"countries not thus excluded. In such case, this License incorporates "
-"the limitation as if written in the body of this License. "
-"\n"
-" 9. The Free Software Foundation may publish revised and/or new versions "
-"of the General Public License from time to time. Such new versions will "
-"be similar in spirit to the present version, but may differ in detail to "
-"address new problems or concerns. "
-"\n"
-"Each version is given a distinguishing version number. If the Program "
-"specifies a version number of this License which applies to it and \"any "
-"later version\", you have the option of following the terms and conditions "
-"either of that version or of any later version published by the Free "
-"Software Foundation. If the Program does not specify a version number of "
-"this License, you may choose any version ever published by the Free Software "
-"Foundation. "
-"\n"
-" 10. If you wish to incorporate parts of the Program into other free "
-"programs whose distribution conditions are different, write to the author "
-"to ask for permission. For software which is copyrighted by the Free "
-"Software Foundation, write to the Free Software Foundation; we sometimes "
-"make exceptions for this. Our decision will be guided by the two goals "
-"of preserving the free status of all derivatives of our free software and "
-"of promoting the sharing and reuse of software generally. "
-"\n"
-" NO WARRANTY "
-"\n"
-" 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY "
-"FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN "
-"OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES "
-"PROVIDE THE PROGRAM \"AS IS\" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED "
-"OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF "
-"MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS "
-"TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE "
-"PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, "
-"REPAIR OR CORRECTION. "
-"\n"
-" 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING "
-"WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR "
-"REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, "
-"INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING "
-"OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED "
-"TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY "
-"YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER "
-"PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE "
-"POSSIBILITY OF SUCH DAMAGES. "
-"\n"
-" END OF TERMS AND CONDITIONS "
-"\n "
-" How to Apply These Terms to Your New Programs "
-"\n"
-" If you develop a new program, and you want it to be of the greatest "
-"possible use to the public, the best way to achieve this is to make it "
-"free software which everyone can redistribute and change under these terms. "
-"\n"
-" To do so, attach the following notices to the program. It is safest "
-"to attach them to the start of each source file to most effectively "
-"convey the exclusion of warranty; and each file should have at least "
-"the \"copyright\" line and a pointer to where the full notice is found. "
-"\n"
-" <one line to give the program's name and a brief idea of what it does.>\n"
-" Copyright (C) <year> <name of author>\n"
-"\n"
-" 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"
-" the Free Software Foundation; either version 2 of the License, or"
-" (at your option) any later version.\n"
-"\n"
-" This program is distributed in the hope that it will be useful,"
-" but WITHOUT ANY WARRANTY; without even the implied warranty of"
-" MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the"
-" GNU General Public License for more details.\n"
-"\n"
-" You should have received a copy of the GNU General Public License"
-" along with this program; if not, write to the Free Software"
-" Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n"
-"\n"
-"\n"
-"Also add information on how to contact you by electronic and paper mail. "
-"\n"
-"If the program is interactive, make it output a short notice like this "
-"when it starts in an interactive mode: "
-"\n"
-" Gnomovision version 69, Copyright (C) year name of author\n"
-" Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.\n"
-" This is free software, and you are welcome to redistribute it\n"
-" under certain conditions; type `show c' for details.\n"
-"\n"
-"The hypothetical commands `show w' and `show c' should show the appropriate "
-"parts of the General Public License. Of course, the commands you use may "
-"be called something other than `show w' and `show c'; they could even be "
-"mouse-clicks or menu items--whatever suits your program. "
-"\n"
-"You should also get your employer (if you work as a programmer) or your "
-"school, if any, to sign a \"copyright disclaimer\" for the program, if "
-"necessary. Here is a sample; alter the names: "
-"\n"
-" Yoyodyne, Inc., hereby disclaims all copyright interest in the program"
-" `Gnomovision' (which makes passes at compilers) written by James Hacker.\n"
-"\n"
-" <signature of Ty Coon>, 1 April 1989\n"
-" Ty Coon, President of Vice\n"
-"\n"
-"This General Public License does not permit incorporating your program into "
-"proprietary programs. If your program is a subroutine library, you may "
-"consider it more useful to permit linking proprietary applications with the "
-"library. If this is what you want to do, use the GNU Library General "
-"Public License instead of this License. "
-"";
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !copyleft_h
-#define copyleft_h 1
-
-extern const char lack_of_warranty[];
-extern const char copyleft[];
-extern const char legal[];
-
-#endif
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "dictionary.h"
-#include "file-handle.h"
-#include "command.h"
-#include "lexer.h"
-#include "var.h"
-/* (headers) */
-
-#include "debug-print.h"
-
-struct cor_set
- {
- struct cor_set *next;
- struct variable **v1, **v2;
- size_t nv1, nv2;
- };
-
-struct cor_set *cor_list, *cor_last;
-
-struct file_handle *matrix_file;
-
-static void free_correlations_state (void);
-static int internal_cmd_correlations (void);
-
-int
-cmd_correlations (void)
-{
- int result = internal_cmd_correlations ();
- free_correlations_state ();
- return result;
-}
-
-/* (specification)
- "CORRELATIONS" (cor_):
- *variables=custom;
- +missing=miss:!pairwise/listwise,
- inc:include/exclude;
- +print=tail:!twotail/onetail,
- sig:!sig/nosig;
- +format=fmt:!matrix/serial;
- +matrix=custom;
- +statistics[st_]=descriptives,xprod,all.
-*/
-/* (declarations) */
-/* (functions) */
-
-int
-internal_cmd_correlations (void)
-{
- struct cmd_correlations cmd;
-
- cor_list = cor_last = NULL;
- matrix_file = NULL;
-
- if (!parse_correlations (&cmd))
- return CMD_FAILURE;
- free_correlations (&cmd);
-
- return CMD_SUCCESS;
-}
-
-static int
-cor_custom_variables (struct cmd_correlations *cmd UNUSED)
-{
- struct variable **v1, **v2;
- size_t nv1, nv2;
- struct cor_set *cor;
-
- /* Ensure that this is a VARIABLES subcommand. */
- if (!lex_match_id ("VARIABLES")
- && (token != T_ID || dict_lookup_var (default_dict, tokid) != NULL)
- && token != T_ALL)
- return 2;
- lex_match ('=');
-
- if (!parse_variables (default_dict, &v1, &nv1,
- PV_NO_DUPLICATE | PV_NUMERIC))
- return 0;
-
- if (lex_match (T_WITH))
- {
- if (!parse_variables (default_dict, &v2, &nv2,
- PV_NO_DUPLICATE | PV_NUMERIC))
- {
- free (v1);
- return 0;
- }
- }
- else
- {
- nv2 = nv1;
- v2 = v1;
- }
-
- cor = xmalloc (sizeof *cor);
- cor->next = NULL;
- cor->v1 = v1;
- cor->v2 = v2;
- cor->nv1 = nv1;
- cor->nv2 = nv2;
- if (cor_list)
- cor_last = cor_last->next = cor;
- else
- cor_list = cor_last = cor;
-
- return 1;
-}
-
-static int
-cor_custom_matrix (struct cmd_correlations *cmd UNUSED)
-{
- if (!lex_force_match ('('))
- return 0;
-
- if (lex_match ('*'))
- matrix_file = NULL;
- else
- {
- matrix_file = fh_parse (FH_REF_FILE);
- if (matrix_file == NULL)
- return 0;
- }
-
- if (!lex_force_match (')'))
- return 0;
-
- return 1;
-}
-
-static void
-free_correlations_state (void)
-{
- struct cor_set *cor, *next;
-
- for (cor = cor_list; cor != NULL; cor = next)
- {
- next = cor->next;
- if (cor->v1 != cor->v2)
- free (cor->v2);
- free (cor->v1);
- free (cor);
- }
-}
-
-/*
- Local Variables:
- mode: c
- End:
-*/
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <stdlib.h>
-#include "alloc.h"
-#include "case.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "lexer.h"
-#include "pool.h"
-#include "range-prs.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* Value or range? */
-enum value_type
- {
- CNT_SINGLE, /* Single value. */
- CNT_RANGE /* a <= x <= b. */
- };
-
-/* Numeric count criteria. */
-struct num_value
- {
- enum value_type type; /* How to interpret a, b. */
- double a, b; /* Values to count. */
- };
-
-struct criteria
- {
- struct criteria *next;
-
- /* Variables to count. */
- struct variable **vars;
- size_t var_cnt;
-
- /* Count special values?. */
- bool count_system_missing; /* Count system missing? */
- bool count_user_missing; /* Count user missing? */
-
- /* Criterion values. */
- size_t value_cnt;
- union
- {
- struct num_value *num;
- char **str;
- }
- values;
- };
-
-struct dst_var
- {
- struct dst_var *next;
- struct variable *var; /* Destination variable. */
- char *name; /* Name of dest var. */
- struct criteria *crit; /* The criteria specifications. */
- };
-
-struct count_trns
- {
- struct dst_var *dst_vars;
- struct pool *pool;
- };
-
-static trns_proc_func count_trns_proc;
-static trns_free_func count_trns_free;
-
-static bool parse_numeric_criteria (struct pool *, struct criteria *);
-static bool parse_string_criteria (struct pool *, struct criteria *);
-\f
-int
-cmd_count (void)
-{
- struct dst_var *dv; /* Destination var being parsed. */
- struct count_trns *trns; /* Transformation. */
-
- /* Parses each slash-delimited specification. */
- trns = pool_create_container (struct count_trns, pool);
- trns->dst_vars = dv = pool_alloc (trns->pool, sizeof *dv);
- for (;;)
- {
- struct criteria *crit;
-
- /* Initialize this struct dst_var to ensure proper cleanup. */
- dv->next = NULL;
- dv->var = NULL;
- dv->crit = NULL;
-
- /* Get destination variable, or at least its name. */
- if (!lex_force_id ())
- goto fail;
- dv->var = dict_lookup_var (default_dict, tokid);
- if (dv->var != NULL)
- {
- if (dv->var->type == ALPHA)
- {
- msg (SE, _("Destination cannot be a string variable."));
- goto fail;
- }
- }
- else
- dv->name = pool_strdup (trns->pool, tokid);
-
- lex_get ();
- if (!lex_force_match ('='))
- goto fail;
-
- crit = dv->crit = pool_alloc (trns->pool, sizeof *crit);
- for (;;)
- {
- bool ok;
-
- crit->next = NULL;
- crit->vars = NULL;
- if (!parse_variables (default_dict, &crit->vars, &crit->var_cnt,
- PV_DUPLICATE | PV_SAME_TYPE))
- goto fail;
- pool_register (trns->pool, free, crit->vars);
-
- if (!lex_force_match ('('))
- goto fail;
-
- crit->value_cnt = 0;
- if (crit->vars[0]->type == NUMERIC)
- ok = parse_numeric_criteria (trns->pool, crit);
- else
- ok = parse_string_criteria (trns->pool, crit);
- if (!ok)
- goto fail;
-
- if (token == '/' || token == '.')
- break;
-
- crit = crit->next = pool_alloc (trns->pool, sizeof *crit);
- }
-
- if (token == '.')
- break;
-
- if (!lex_force_match ('/'))
- goto fail;
- dv = dv->next = pool_alloc (trns->pool, sizeof *dv);
- }
-
- /* Create all the nonexistent destination variables. */
- for (dv = trns->dst_vars; dv; dv = dv->next)
- if (dv->var == NULL)
- {
- /* It's valid, though motivationally questionable, to count to
- the same dest var more than once. */
- dv->var = dict_lookup_var (default_dict, dv->name);
-
- if (dv->var == NULL)
- dv->var = dict_create_var_assert (default_dict, dv->name, 0);
- }
-
- add_transformation (count_trns_proc, count_trns_free, trns);
- return CMD_SUCCESS;
-
-fail:
- count_trns_free (trns);
- return CMD_FAILURE;
-}
-
-/* Parses a set of numeric criterion values. Returns success. */
-static bool
-parse_numeric_criteria (struct pool *pool, struct criteria *crit)
-{
- size_t allocated = 0;
-
- crit->values.num = NULL;
- crit->count_system_missing = false;
- crit->count_user_missing = false;
- for (;;)
- {
- double low, high;
-
- if (lex_match_id ("SYSMIS"))
- crit->count_system_missing = true;
- else if (lex_match_id ("MISSING"))
- crit->count_user_missing = true;
- else if (parse_num_range (&low, &high, NULL))
- {
- struct num_value *cur;
-
- if (crit->value_cnt >= allocated)
- crit->values.num = pool_2nrealloc (pool, crit->values.num,
- &allocated,
- sizeof *crit->values.num);
- cur = &crit->values.num[crit->value_cnt++];
- cur->type = low == high ? CNT_SINGLE : CNT_RANGE;
- cur->a = low;
- cur->b = high;
- }
- else
- return false;
-
- lex_match (',');
- if (lex_match (')'))
- break;
- }
- return true;
-}
-
-/* Parses a set of string criteria values. Returns success. */
-static bool
-parse_string_criteria (struct pool *pool, struct criteria *crit)
-{
- int len = 0;
- size_t allocated = 0;
- size_t i;
-
- for (i = 0; i < crit->var_cnt; i++)
- if (crit->vars[i]->width > len)
- len = crit->vars[i]->width;
-
- crit->values.str = NULL;
- for (;;)
- {
- char **cur;
- if (crit->value_cnt >= allocated)
- crit->values.str = pool_2nrealloc (pool, crit->values.str,
- &allocated,
- sizeof *crit->values.str);
-
- if (!lex_force_string ())
- return false;
- cur = &crit->values.str[crit->value_cnt++];
- *cur = pool_alloc (pool, len + 1);
- str_copy_rpad (*cur, len + 1, ds_c_str (&tokstr));
- lex_get ();
-
- lex_match (',');
- if (lex_match (')'))
- break;
- }
-
- return true;
-}
-\f
-/* Transformation. */
-
-/* Counts the number of values in case C matching CRIT. */
-static inline int
-count_numeric (struct criteria *crit, struct ccase *c)
-{
- int counter = 0;
- size_t i;
-
- for (i = 0; i < crit->var_cnt; i++)
- {
- double x = case_num (c, crit->vars[i]->fv);
- if (x == SYSMIS)
- counter += crit->count_system_missing;
- else if (crit->count_user_missing
- && mv_is_num_user_missing (&crit->vars[i]->miss, x))
- counter++;
- else
- {
- struct num_value *v;
-
- for (v = crit->values.num; v < crit->values.num + crit->value_cnt;
- v++)
- if (v->type == CNT_SINGLE ? x == v->a : x >= v->a && x <= v->b)
- {
- counter++;
- break;
- }
- }
- }
-
- return counter;
-}
-
-/* Counts the number of values in case C matching CRIT. */
-static inline int
-count_string (struct criteria *crit, struct ccase *c)
-{
- int counter = 0;
- size_t i;
-
- for (i = 0; i < crit->var_cnt; i++)
- {
- char **v;
- for (v = crit->values.str; v < crit->values.str + crit->value_cnt; v++)
- if (!memcmp (case_str (c, crit->vars[i]->fv), *v,
- crit->vars[i]->width))
- {
- counter++;
- break;
- }
- }
-
- return counter;
-}
-
-/* Performs the COUNT transformation T on case C. */
-static int
-count_trns_proc (void *trns_, struct ccase *c,
- int case_num UNUSED)
-{
- struct count_trns *trns = trns_;
- struct dst_var *dv;
-
- for (dv = trns->dst_vars; dv; dv = dv->next)
- {
- struct criteria *crit;
- int counter;
-
- counter = 0;
- for (crit = dv->crit; crit; crit = crit->next)
- if (crit->vars[0]->type == NUMERIC)
- counter += count_numeric (crit, c);
- else
- counter += count_string (crit, c);
- case_data_rw (c, dv->var->fv)->f = counter;
- }
- return -1;
-}
-
-/* Destroys all dynamic data structures associated with TRNS. */
-static void
-count_trns_free (void *trns_)
-{
- struct count_trns *trns = (struct count_trns *) trns_;
- pool_destroy (trns->pool);
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-/* FIXME:
-
- - Pearson's R (but not Spearman!) is off a little.
- - T values for Spearman's R and Pearson's R are wrong.
- - How to calculate significance of symmetric and directional measures?
- - Asymmetric ASEs and T values for lambda are wrong.
- - ASE of Goodman and Kruskal's tau is not calculated.
- - ASE of symmetric somers' d is wrong.
- - Approx. T of uncertainty coefficient is wrong.
-
-*/
-
-#include <config.h>
-#include "error.h"
-#include <ctype.h>
-#include <stdlib.h>
-#include <stdio.h>
-#include <gsl/gsl_cdf.h>
-#include "algorithm.h"
-#include "alloc.h"
-#include "case.h"
-#include "dictionary.h"
-#include "hash.h"
-#include "pool.h"
-#include "command.h"
-#include "lexer.h"
-#include "error.h"
-#include "magic.h"
-#include "misc.h"
-#include "output.h"
-#include "str.h"
-#include "tab.h"
-#include "value-labels.h"
-#include "var.h"
-#include "vfm.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-#define N_(msgid) msgid
-
-/* (headers) */
-
-#include "debug-print.h"
-
-/* (specification)
- crosstabs (crs_):
- *^tables=custom;
- +variables=custom;
- +missing=miss:!table/include/report;
- +write[wr_]=none,cells,all;
- +format=fmt:!labels/nolabels/novallabs,
- val:!avalue/dvalue,
- indx:!noindex/index,
- tabl:!tables/notables,
- box:!box/nobox,
- pivot:!pivot/nopivot;
- +cells[cl_]=count,none,expected,row,column,total,residual,sresidual,
- asresidual,all;
- +statistics[st_]=chisq,phi,cc,lambda,uc,none,btau,ctau,risk,gamma,d,
- kappa,eta,corr,all.
-*/
-/* (declarations) */
-/* (functions) */
-
-/* Number of chi-square statistics. */
-#define N_CHISQ 5
-
-/* Number of symmetric statistics. */
-#define N_SYMMETRIC 9
-
-/* Number of directional statistics. */
-#define N_DIRECTIONAL 13
-
-/* A single table entry for general mode. */
-struct table_entry
- {
- int table; /* Flattened table number. */
- union
- {
- double freq; /* Frequency count. */
- double *data; /* Crosstabulation table for integer mode. */
- }
- u;
- union value values[1]; /* Values. */
- };
-
-/* A crosstabulation. */
-struct crosstab
- {
- int nvar; /* Number of variables. */
- double missing; /* Missing cases count. */
- int ofs; /* Integer mode: Offset into sorted_tab[]. */
- struct variable *vars[2]; /* At least two variables; sorted by
- larger indices first. */
- };
-
-/* Integer mode variable info. */
-struct var_range
- {
- int min; /* Minimum value. */
- int max; /* Maximum value + 1. */
- int count; /* max - min. */
- };
-
-static inline struct var_range *
-get_var_range (struct variable *v)
-{
- assert (v != NULL);
- assert (v->aux != NULL);
- return v->aux;
-}
-
-/* Indexes into crosstab.v. */
-enum
- {
- ROW_VAR = 0,
- COL_VAR = 1
- };
-
-/* General mode crosstabulation table. */
-static struct hsh_table *gen_tab; /* Hash table. */
-static int n_sorted_tab; /* Number of entries in sorted_tab. */
-static struct table_entry **sorted_tab; /* Sorted table. */
-
-/* Variables specifies on VARIABLES. */
-static struct variable **variables;
-static size_t variables_cnt;
-
-/* TABLES. */
-static struct crosstab **xtab;
-static int nxtab;
-
-/* Integer or general mode? */
-enum
- {
- INTEGER,
- GENERAL
- };
-static int mode;
-
-/* CELLS. */
-static int num_cells; /* Number of cells requested. */
-static int cells[8]; /* Cells requested. */
-
-/* WRITE. */
-static int write; /* One of WR_* that specifies the WRITE style. */
-
-/* Command parsing info. */
-static struct cmd_crosstabs cmd;
-
-/* Pools. */
-static struct pool *pl_tc; /* For table cells. */
-static struct pool *pl_col; /* For column data. */
-
-static int internal_cmd_crosstabs (void);
-static void precalc (void *);
-static int calc_general (struct ccase *, void *);
-static int calc_integer (struct ccase *, void *);
-static void postcalc (void *);
-static void submit (struct tab_table *);
-
-static void format_short (char *s, const struct fmt_spec *fp,
- const union value *v);
-
-/* Parse and execute CROSSTABS, then clean up. */
-int
-cmd_crosstabs (void)
-{
- int result = internal_cmd_crosstabs ();
-
- free (variables);
- pool_destroy (pl_tc);
- pool_destroy (pl_col);
-
- return result;
-}
-
-/* Parses and executes the CROSSTABS procedure. */
-static int
-internal_cmd_crosstabs (void)
-{
- int i;
-
- variables = NULL;
- variables_cnt = 0;
- xtab = NULL;
- nxtab = 0;
- pl_tc = pool_create ();
- pl_col = pool_create ();
-
- if (!parse_crosstabs (&cmd))
- return CMD_FAILURE;
-
- mode = variables ? INTEGER : GENERAL;
-
- /* CELLS. */
- if (!cmd.sbc_cells)
- {
- cmd.a_cells[CRS_CL_COUNT] = 1;
- }
- else
- {
- int count = 0;
-
- for (i = 0; i < CRS_CL_count; i++)
- if (cmd.a_cells[i])
- count++;
- if (count == 0)
- {
- cmd.a_cells[CRS_CL_COUNT] = 1;
- cmd.a_cells[CRS_CL_ROW] = 1;
- cmd.a_cells[CRS_CL_COLUMN] = 1;
- cmd.a_cells[CRS_CL_TOTAL] = 1;
- }
- if (cmd.a_cells[CRS_CL_ALL])
- {
- for (i = 0; i < CRS_CL_count; i++)
- cmd.a_cells[i] = 1;
- cmd.a_cells[CRS_CL_ALL] = 0;
- }
- cmd.a_cells[CRS_CL_NONE] = 0;
- }
- for (num_cells = i = 0; i < CRS_CL_count; i++)
- if (cmd.a_cells[i])
- cells[num_cells++] = i;
-
- /* STATISTICS. */
- if (cmd.sbc_statistics)
- {
- int i;
- int count = 0;
-
- for (i = 0; i < CRS_ST_count; i++)
- if (cmd.a_statistics[i])
- count++;
- if (count == 0)
- cmd.a_statistics[CRS_ST_CHISQ] = 1;
- if (cmd.a_statistics[CRS_ST_ALL])
- for (i = 0; i < CRS_ST_count; i++)
- cmd.a_statistics[i] = 1;
- }
-
- /* MISSING. */
- if (cmd.miss == CRS_REPORT && mode == GENERAL)
- {
- msg (SE, _("Missing mode REPORT not allowed in general mode. "
- "Assuming MISSING=TABLE."));
- cmd.miss = CRS_TABLE;
- }
-
- /* WRITE. */
- if (cmd.a_write[CRS_WR_ALL] && cmd.a_write[CRS_WR_CELLS])
- cmd.a_write[CRS_WR_ALL] = 0;
- if (cmd.a_write[CRS_WR_ALL] && mode == GENERAL)
- {
- msg (SE, _("Write mode ALL not allowed in general mode. "
- "Assuming WRITE=CELLS."));
- cmd.a_write[CRS_WR_CELLS] = 1;
- }
- if (cmd.sbc_write
- && (cmd.a_write[CRS_WR_NONE]
- + cmd.a_write[CRS_WR_ALL]
- + cmd.a_write[CRS_WR_CELLS] == 0))
- cmd.a_write[CRS_WR_CELLS] = 1;
- if (cmd.a_write[CRS_WR_CELLS])
- write = CRS_WR_CELLS;
- else if (cmd.a_write[CRS_WR_ALL])
- write = CRS_WR_ALL;
- else
- write = CRS_WR_NONE;
-
- procedure_with_splits (precalc,
- mode == GENERAL ? calc_general : calc_integer,
- postcalc, NULL);
-
- return CMD_SUCCESS;
-}
-
-/* Parses the TABLES subcommand. */
-static int
-crs_custom_tables (struct cmd_crosstabs *cmd UNUSED)
-{
- struct var_set *var_set;
- int n_by;
- struct variable ***by = NULL;
- size_t *by_nvar = NULL;
- size_t nx = 1;
- int success = 0;
-
- /* Ensure that this is a TABLES subcommand. */
- if (!lex_match_id ("TABLES")
- && (token != T_ID || dict_lookup_var (default_dict, tokid) == NULL)
- && token != T_ALL)
- return 2;
- lex_match ('=');
-
- if (variables != NULL)
- var_set = var_set_create_from_array (variables, variables_cnt);
- else
- var_set = var_set_create_from_dict (default_dict);
- assert (var_set != NULL);
-
- for (n_by = 0; ;)
- {
- by = xnrealloc (by, n_by + 1, sizeof *by);
- by_nvar = xnrealloc (by_nvar, n_by + 1, sizeof *by_nvar);
- if (!parse_var_set_vars (var_set, &by[n_by], &by_nvar[n_by],
- PV_NO_DUPLICATE | PV_NO_SCRATCH))
- goto done;
- if (xalloc_oversized (nx, by_nvar[n_by]))
- {
- msg (SE, _("Too many crosstabulation variables or dimensions."));
- goto done;
- }
- nx *= by_nvar[n_by];
- n_by++;
-
- if (!lex_match (T_BY))
- {
- if (n_by < 2)
- {
- lex_error (_("expecting BY"));
- goto done;
- }
- else
- break;
- }
- }
-
- {
- int *by_iter = xcalloc (n_by, sizeof *by_iter);
- int i;
-
- xtab = xnrealloc (xtab, nxtab + nx, sizeof *xtab);
- for (i = 0; i < nx; i++)
- {
- struct crosstab *x;
-
- x = xmalloc (sizeof *x + sizeof (struct variable *) * (n_by - 2));
- x->nvar = n_by;
- x->missing = 0.;
-
- {
- int i;
-
- for (i = 0; i < n_by; i++)
- x->vars[i] = by[i][by_iter[i]];
- }
-
- {
- int i;
-
- for (i = n_by - 1; i >= 0; i--)
- {
- if (++by_iter[i] < by_nvar[i])
- break;
- by_iter[i] = 0;
- }
- }
-
- xtab[nxtab++] = x;
- }
- free (by_iter);
- }
- success = 1;
-
- done:
- /* All return paths lead here. */
- {
- int i;
-
- for (i = 0; i < n_by; i++)
- free (by[i]);
- free (by);
- free (by_nvar);
- }
-
- var_set_destroy (var_set);
-
- return success;
-}
-
-/* Parses the VARIABLES subcommand. */
-static int
-crs_custom_variables (struct cmd_crosstabs *cmd UNUSED)
-{
- if (nxtab)
- {
- msg (SE, _("VARIABLES must be specified before TABLES."));
- return 0;
- }
-
- lex_match ('=');
-
- for (;;)
- {
- size_t orig_nv = variables_cnt;
- size_t i;
-
- long min, max;
-
- if (!parse_variables (default_dict, &variables, &variables_cnt,
- (PV_APPEND | PV_NUMERIC
- | PV_NO_DUPLICATE | PV_NO_SCRATCH)))
- return 0;
-
- if (token != '(')
- {
- lex_error ("expecting `('");
- goto lossage;
- }
- lex_get ();
-
- if (!lex_force_int ())
- goto lossage;
- min = lex_integer ();
- lex_get ();
-
- lex_match (',');
-
- if (!lex_force_int ())
- goto lossage;
- max = lex_integer ();
- if (max < min)
- {
- msg (SE, _("Maximum value (%ld) less than minimum value (%ld)."),
- max, min);
- goto lossage;
- }
- lex_get ();
-
- if (token != ')')
- {
- lex_error ("expecting `)'");
- goto lossage;
- }
- lex_get ();
-
- for (i = orig_nv; i < variables_cnt; i++)
- {
- struct var_range *vr = xmalloc (sizeof *vr);
- vr->min = min;
- vr->max = max + 1.;
- vr->count = max - min + 1;
- var_attach_aux (variables[i], vr, var_dtor_free);
- }
-
- if (token == '/')
- break;
- }
-
- return 1;
-
- lossage:
- free (variables);
- variables = NULL;
- return 0;
-}
-\f
-/* Data file processing. */
-
-static int compare_table_entry (const void *, const void *, void *);
-static unsigned hash_table_entry (const void *, void *);
-
-/* Set up the crosstabulation tables for processing. */
-static void
-precalc (void *aux UNUSED)
-{
- if (mode == GENERAL)
- {
- gen_tab = hsh_create (512, compare_table_entry, hash_table_entry,
- NULL, NULL);
- }
- else
- {
- int i;
-
- sorted_tab = NULL;
- n_sorted_tab = 0;
-
- for (i = 0; i < nxtab; i++)
- {
- struct crosstab *x = xtab[i];
- int count = 1;
- int *v;
- int j;
-
- x->ofs = n_sorted_tab;
-
- for (j = 2; j < x->nvar; j++)
- count *= get_var_range (x->vars[j - 2])->count;
-
- sorted_tab = xnrealloc (sorted_tab,
- n_sorted_tab + count, sizeof *sorted_tab);
- v = local_alloc (sizeof *v * x->nvar);
- for (j = 2; j < x->nvar; j++)
- v[j] = get_var_range (x->vars[j])->min;
- for (j = 0; j < count; j++)
- {
- struct table_entry *te;
- int k;
-
- te = sorted_tab[n_sorted_tab++]
- = xmalloc (sizeof *te + sizeof (union value) * (x->nvar - 1));
- te->table = i;
-
- {
- int row_cnt = get_var_range (x->vars[0])->count;
- int col_cnt = get_var_range (x->vars[1])->count;
- const int mat_size = row_cnt * col_cnt;
- int m;
-
- te->u.data = xnmalloc (mat_size, sizeof *te->u.data);
- for (m = 0; m < mat_size; m++)
- te->u.data[m] = 0.;
- }
-
- for (k = 2; k < x->nvar; k++)
- te->values[k].f = v[k];
- for (k = 2; k < x->nvar; k++)
- {
- struct var_range *vr = get_var_range (x->vars[k]);
- if (++v[k] >= vr->max)
- v[k] = vr->min;
- else
- break;
- }
- }
- local_free (v);
- }
-
- sorted_tab = xnrealloc (sorted_tab,
- n_sorted_tab + 1, sizeof *sorted_tab);
- sorted_tab[n_sorted_tab] = NULL;
- }
-}
-
-/* Form crosstabulations for general mode. */
-static int
-calc_general (struct ccase *c, void *aux UNUSED)
-{
- int bad_warn = 1;
-
- /* Case weight. */
- double weight = dict_get_case_weight (default_dict, c, &bad_warn);
-
- /* Flattened current table index. */
- int t;
-
- for (t = 0; t < nxtab; t++)
- {
- struct crosstab *x = xtab[t];
- const size_t entry_size = (sizeof (struct table_entry)
- + sizeof (union value) * (x->nvar - 1));
- struct table_entry *te = local_alloc (entry_size);
-
- /* Construct table entry for the current record and table. */
- te->table = t;
- {
- int j;
-
- assert (x != NULL);
- for (j = 0; j < x->nvar; j++)
- {
- const union value *v = case_data (c, x->vars[j]->fv);
- const struct missing_values *mv = &x->vars[j]->miss;
- if ((cmd.miss == CRS_TABLE && mv_is_value_missing (mv, v))
- || (cmd.miss == CRS_INCLUDE
- && mv_is_value_system_missing (mv, v)))
- {
- x->missing += weight;
- goto next_crosstab;
- }
-
- if (x->vars[j]->type == NUMERIC)
- te->values[j].f = case_num (c, x->vars[j]->fv);
- else
- {
- memcpy (te->values[j].s, case_str (c, x->vars[j]->fv),
- x->vars[j]->width);
-
- /* Necessary in order to simplify comparisons. */
- memset (&te->values[j].s[x->vars[j]->width], 0,
- sizeof (union value) - x->vars[j]->width);
- }
- }
- }
-
- /* Add record to hash table. */
- {
- struct table_entry **tepp
- = (struct table_entry **) hsh_probe (gen_tab, te);
- if (*tepp == NULL)
- {
- struct table_entry *tep = pool_alloc (pl_tc, entry_size);
-
- te->u.freq = weight;
- memcpy (tep, te, entry_size);
-
- *tepp = tep;
- }
- else
- (*tepp)->u.freq += weight;
- }
-
- next_crosstab:
- local_free (te);
- }
-
- return 1;
-}
-
-static int
-calc_integer (struct ccase *c, void *aux UNUSED)
-{
- int bad_warn = 1;
-
- /* Case weight. */
- double weight = dict_get_case_weight (default_dict, c, &bad_warn);
-
- /* Flattened current table index. */
- int t;
-
- for (t = 0; t < nxtab; t++)
- {
- struct crosstab *x = xtab[t];
- int i, fact, ofs;
-
- fact = i = 1;
- ofs = x->ofs;
- for (i = 0; i < x->nvar; i++)
- {
- struct variable *const v = x->vars[i];
- struct var_range *vr = get_var_range (v);
- double value = case_num (c, v->fv);
-
- /* Note that the first test also rules out SYSMIS. */
- if ((value < vr->min || value >= vr->max)
- || (cmd.miss == CRS_TABLE
- && mv_is_num_user_missing (&v->miss, value)))
- {
- x->missing += weight;
- goto next_crosstab;
- }
-
- if (i > 1)
- {
- ofs += fact * ((int) value - vr->min);
- fact *= vr->count;
- }
- }
-
- {
- struct variable *row_var = x->vars[ROW_VAR];
- const int row = case_num (c, row_var->fv) - get_var_range (row_var)->min;
-
- struct variable *col_var = x->vars[COL_VAR];
- const int col = case_num (c, col_var->fv) - get_var_range (col_var)->min;
-
- const int col_dim = get_var_range (col_var)->count;
-
- sorted_tab[ofs]->u.data[col + row * col_dim] += weight;
- }
-
- next_crosstab: ;
- }
-
- return 1;
-}
-
-/* Compare the table_entry's at A and B and return a strcmp()-type
- result. */
-static int
-compare_table_entry (const void *a_, const void *b_, void *foo UNUSED)
-{
- const struct table_entry *a = a_;
- const struct table_entry *b = b_;
-
- if (a->table > b->table)
- return 1;
- else if (a->table < b->table)
- return -1;
-
- {
- const struct crosstab *x = xtab[a->table];
- int i;
-
- for (i = x->nvar - 1; i >= 0; i--)
- if (x->vars[i]->type == NUMERIC)
- {
- const double diffnum = a->values[i].f - b->values[i].f;
- if (diffnum < 0)
- return -1;
- else if (diffnum > 0)
- return 1;
- }
- else
- {
- assert (x->vars[i]->type == ALPHA);
- {
- const int diffstr = strncmp (a->values[i].s, b->values[i].s,
- x->vars[i]->width);
- if (diffstr)
- return diffstr;
- }
- }
- }
-
- return 0;
-}
-
-/* Calculate a hash value from table_entry A. */
-static unsigned
-hash_table_entry (const void *a_, void *foo UNUSED)
-{
- const struct table_entry *a = a_;
- unsigned long hash;
- int i;
-
- hash = a->table;
- for (i = 0; i < xtab[a->table]->nvar; i++)
- hash ^= hsh_hash_bytes (&a->values[i], sizeof a->values[i]);
-
- return hash;
-}
-\f
-/* Post-data reading calculations. */
-
-static struct table_entry **find_pivot_extent (struct table_entry **,
- int *cnt, int pivot);
-static void enum_var_values (struct table_entry **entries, int entry_cnt,
- int var_idx,
- union value **values, int *value_cnt);
-static void output_pivot_table (struct table_entry **, struct table_entry **,
- double **, double **, double **,
- int *, int *, int *);
-static void make_summary_table (void);
-
-static void
-postcalc (void *aux UNUSED)
-{
- if (mode == GENERAL)
- {
- n_sorted_tab = hsh_count (gen_tab);
- sorted_tab = (struct table_entry **) hsh_sort (gen_tab);
- }
-
- make_summary_table ();
-
- /* Identify all the individual crosstabulation tables, and deal with
- them. */
- {
- struct table_entry **pb = sorted_tab, **pe; /* Pivot begin, pivot end. */
- int pc = n_sorted_tab; /* Pivot count. */
-
- double *mat = NULL, *row_tot = NULL, *col_tot = NULL;
- int maxrows = 0, maxcols = 0, maxcells = 0;
-
- for (;;)
- {
- pe = find_pivot_extent (pb, &pc, cmd.pivot == CRS_PIVOT);
- if (pe == NULL)
- break;
-
- output_pivot_table (pb, pe, &mat, &row_tot, &col_tot,
- &maxrows, &maxcols, &maxcells);
-
- pb = pe;
- }
- free (mat);
- free (row_tot);
- free (col_tot);
- }
-
- hsh_destroy (gen_tab);
-}
-
-static void insert_summary (struct tab_table *, int tab_index, double valid);
-
-/* Output a table summarizing the cases processed. */
-static void
-make_summary_table (void)
-{
- struct tab_table *summary;
-
- struct table_entry **pb = sorted_tab, **pe;
- int pc = n_sorted_tab;
- int cur_tab = 0;
-
- summary = tab_create (7, 3 + nxtab, 1);
- tab_title (summary, 0, _("Summary."));
- tab_headers (summary, 1, 0, 3, 0);
- tab_joint_text (summary, 1, 0, 6, 0, TAB_CENTER, _("Cases"));
- tab_joint_text (summary, 1, 1, 2, 1, TAB_CENTER, _("Valid"));
- tab_joint_text (summary, 3, 1, 4, 1, TAB_CENTER, _("Missing"));
- tab_joint_text (summary, 5, 1, 6, 1, TAB_CENTER, _("Total"));
- tab_hline (summary, TAL_1, 1, 6, 1);
- tab_hline (summary, TAL_1, 1, 6, 2);
- tab_vline (summary, TAL_1, 3, 1, 1);
- tab_vline (summary, TAL_1, 5, 1, 1);
- {
- int i;
-
- for (i = 0; i < 3; i++)
- {
- tab_text (summary, 1 + i * 2, 2, TAB_RIGHT, _("N"));
- tab_text (summary, 2 + i * 2, 2, TAB_RIGHT, _("Percent"));
- }
- }
- tab_offset (summary, 0, 3);
-
- for (;;)
- {
- double valid;
-
- pe = find_pivot_extent (pb, &pc, cmd.pivot == CRS_PIVOT);
- if (pe == NULL)
- break;
-
- while (cur_tab < (*pb)->table)
- insert_summary (summary, cur_tab++, 0.);
-
- if (mode == GENERAL)
- for (valid = 0.; pb < pe; pb++)
- valid += (*pb)->u.freq;
- else
- {
- const struct crosstab *const x = xtab[(*pb)->table];
- const int n_cols = get_var_range (x->vars[COL_VAR])->count;
- const int n_rows = get_var_range (x->vars[ROW_VAR])->count;
- const int count = n_cols * n_rows;
-
- for (valid = 0.; pb < pe; pb++)
- {
- const double *data = (*pb)->u.data;
- int i;
-
- for (i = 0; i < count; i++)
- valid += *data++;
- }
- }
- insert_summary (summary, cur_tab++, valid);
-
- pb = pe;
- }
-
- while (cur_tab < nxtab)
- insert_summary (summary, cur_tab++, 0.);
-
- submit (summary);
-}
-
-/* Inserts a line into T describing the crosstabulation at index
- TAB_INDEX, which has VALID valid observations. */
-static void
-insert_summary (struct tab_table *t, int tab_index, double valid)
-{
- struct crosstab *x = xtab[tab_index];
-
- tab_hline (t, TAL_1, 0, 6, 0);
-
- /* Crosstabulation name. */
- {
- char *buf = local_alloc (128 * x->nvar);
- char *cp = buf;
- int i;
-
- for (i = 0; i < x->nvar; i++)
- {
- if (i > 0)
- cp = stpcpy (cp, " * ");
-
- cp = stpcpy (cp,
- x->vars[i]->label ? x->vars[i]->label : x->vars[i]->name);
- }
- tab_text (t, 0, 0, TAB_LEFT, buf);
-
- local_free (buf);
- }
-
- /* Counts and percentages. */
- {
- double n[3];
- int i;
-
- n[0] = valid;
- n[1] = x->missing;
- n[2] = n[0] + n[1];
-
-
- for (i = 0; i < 3; i++)
- {
- tab_float (t, i * 2 + 1, 0, TAB_RIGHT, n[i], 8, 0);
- tab_text (t, i * 2 + 2, 0, TAB_RIGHT | TAT_PRINTF, "%.1f%%",
- n[i] / n[2] * 100.);
- }
- }
-
- tab_next_row (t);
-}
-\f
-/* Output. */
-
-/* Tables. */
-static struct tab_table *table; /* Crosstabulation table. */
-static struct tab_table *chisq; /* Chi-square table. */
-static struct tab_table *sym; /* Symmetric measures table. */
-static struct tab_table *risk; /* Risk estimate table. */
-static struct tab_table *direct; /* Directional measures table. */
-
-/* Statistics. */
-static int chisq_fisher; /* Did any rows include Fisher's exact test? */
-
-/* Column values, number of columns. */
-static union value *cols;
-static int n_cols;
-
-/* Row values, number of rows. */
-static union value *rows;
-static int n_rows;
-
-/* Number of statistically interesting columns/rows (columns/rows with
- data in them). */
-static int ns_cols, ns_rows;
-
-/* Crosstabulation. */
-static struct crosstab *x;
-
-/* Number of variables from the crosstabulation to consider. This is
- either x->nvar, if pivoting is on, or 2, if pivoting is off. */
-static int nvar;
-
-/* Matrix contents. */
-static double *mat; /* Matrix proper. */
-static double *row_tot; /* Row totals. */
-static double *col_tot; /* Column totals. */
-static double W; /* Grand total. */
-
-static void display_dimensions (struct tab_table *, int first_difference,
- struct table_entry *);
-static void display_crosstabulation (void);
-static void display_chisq (void);
-static void display_symmetric (void);
-static void display_risk (void);
-static void display_directional (void);
-static void crosstabs_dim (struct tab_table *, struct outp_driver *);
-static void table_value_missing (struct tab_table *table, int c, int r,
- unsigned char opt, const union value *v,
- const struct variable *var);
-static void delete_missing (void);
-
-/* Output pivot table beginning at PB and continuing until PE,
- exclusive. For efficiency, *MATP is a pointer to a matrix that can
- hold *MAXROWS entries. */
-static void
-output_pivot_table (struct table_entry **pb, struct table_entry **pe,
- double **matp, double **row_totp, double **col_totp,
- int *maxrows, int *maxcols, int *maxcells)
-{
- /* Subtable. */
- struct table_entry **tb = pb, **te; /* Table begin, table end. */
- int tc = pe - pb; /* Table count. */
-
- /* Table entry for header comparison. */
- struct table_entry *cmp = NULL;
-
- x = xtab[(*pb)->table];
- enum_var_values (pb, pe - pb, COL_VAR, &cols, &n_cols);
-
- nvar = cmd.pivot == CRS_PIVOT ? x->nvar : 2;
-
- /* Crosstabulation table initialization. */
- if (num_cells)
- {
- table = tab_create (nvar + n_cols,
- (pe - pb) / n_cols * 3 / 2 * num_cells + 10, 1);
- tab_headers (table, nvar - 1, 0, 2, 0);
-
- /* First header line. */
- tab_joint_text (table, nvar - 1, 0, (nvar - 1) + (n_cols - 1), 0,
- TAB_CENTER | TAT_TITLE, x->vars[COL_VAR]->name);
-
- tab_hline (table, TAL_1, nvar - 1, nvar + n_cols - 2, 1);
-
- /* Second header line. */
- {
- int i;
-
- for (i = 2; i < nvar; i++)
- tab_joint_text (table, nvar - i - 1, 0, nvar - i - 1, 1,
- TAB_RIGHT | TAT_TITLE,
- (x->vars[i]->label
- ? x->vars[i]->label : x->vars[i]->name));
- tab_text (table, nvar - 2, 1, TAB_RIGHT | TAT_TITLE,
- x->vars[ROW_VAR]->name);
- for (i = 0; i < n_cols; i++)
- table_value_missing (table, nvar + i - 1, 1, TAB_RIGHT, &cols[i],
- x->vars[COL_VAR]);
- tab_text (table, nvar + n_cols - 1, 1, TAB_CENTER, _("Total"));
- }
-
- tab_hline (table, TAL_1, 0, nvar + n_cols - 1, 2);
- tab_vline (table, TAL_1, nvar + n_cols - 1, 0, 1);
-
- /* Title. */
- {
- char *title = local_alloc (x->nvar * 64 + 128);
- char *cp = title;
- int i;
-
- if (cmd.pivot == CRS_PIVOT)
- for (i = 0; i < nvar; i++)
- {
- if (i)
- cp = stpcpy (cp, " by ");
- cp = stpcpy (cp, x->vars[i]->name);
- }
- else
- {
- cp = spprintf (cp, "%s by %s for",
- x->vars[0]->name, x->vars[1]->name);
- for (i = 2; i < nvar; i++)
- {
- char buf[64], *bufp;
-
- if (i > 2)
- *cp++ = ',';
- *cp++ = ' ';
- cp = stpcpy (cp, x->vars[i]->name);
- *cp++ = '=';
- format_short (buf, &x->vars[i]->print, &(*pb)->values[i]);
- for (bufp = buf; isspace ((unsigned char) *bufp); bufp++)
- ;
- cp = stpcpy (cp, bufp);
- }
- }
-
- cp = stpcpy (cp, " [");
- for (i = 0; i < num_cells; i++)
- {
- struct tuple
- {
- int value;
- const char *name;
- };
-
- static const struct tuple cell_names[] =
- {
- {CRS_CL_COUNT, N_("count")},
- {CRS_CL_ROW, N_("row %")},
- {CRS_CL_COLUMN, N_("column %")},
- {CRS_CL_TOTAL, N_("total %")},
- {CRS_CL_EXPECTED, N_("expected")},
- {CRS_CL_RESIDUAL, N_("residual")},
- {CRS_CL_SRESIDUAL, N_("std. resid.")},
- {CRS_CL_ASRESIDUAL, N_("adj. resid.")},
- {-1, NULL},
- };
-
- const struct tuple *t;
-
- for (t = cell_names; t->value != cells[i]; t++)
- assert (t->value != -1);
- if (i)
- cp = stpcpy (cp, ", ");
- cp = stpcpy (cp, gettext (t->name));
- }
- strcpy (cp, "].");
-
- tab_title (table, 0, title);
- local_free (title);
- }
-
- tab_offset (table, 0, 2);
- }
- else
- table = NULL;
-
- /* Chi-square table initialization. */
- if (cmd.a_statistics[CRS_ST_CHISQ])
- {
- chisq = tab_create (6 + (nvar - 2),
- (pe - pb) / n_cols * 3 / 2 * N_CHISQ + 10, 1);
- tab_headers (chisq, 1 + (nvar - 2), 0, 1, 0);
-
- tab_title (chisq, 0, "Chi-square tests.");
-
- tab_offset (chisq, nvar - 2, 0);
- tab_text (chisq, 0, 0, TAB_LEFT | TAT_TITLE, _("Statistic"));
- tab_text (chisq, 1, 0, TAB_RIGHT | TAT_TITLE, _("Value"));
- tab_text (chisq, 2, 0, TAB_RIGHT | TAT_TITLE, _("df"));
- tab_text (chisq, 3, 0, TAB_RIGHT | TAT_TITLE,
- _("Asymp. Sig. (2-sided)"));
- tab_text (chisq, 4, 0, TAB_RIGHT | TAT_TITLE,
- _("Exact. Sig. (2-sided)"));
- tab_text (chisq, 5, 0, TAB_RIGHT | TAT_TITLE,
- _("Exact. Sig. (1-sided)"));
- chisq_fisher = 0;
- tab_offset (chisq, 0, 1);
- }
- else
- chisq = NULL;
-
- /* Symmetric measures. */
- if (cmd.a_statistics[CRS_ST_PHI] || cmd.a_statistics[CRS_ST_CC]
- || cmd.a_statistics[CRS_ST_BTAU] || cmd.a_statistics[CRS_ST_CTAU]
- || cmd.a_statistics[CRS_ST_GAMMA] || cmd.a_statistics[CRS_ST_CORR]
- || cmd.a_statistics[CRS_ST_KAPPA])
- {
- sym = tab_create (6 + (nvar - 2), (pe - pb) / n_cols * 7 + 10, 1);
- tab_headers (sym, 2 + (nvar - 2), 0, 1, 0);
- tab_title (sym, 0, "Symmetric measures.");
-
- tab_offset (sym, nvar - 2, 0);
- tab_text (sym, 0, 0, TAB_LEFT | TAT_TITLE, _("Category"));
- tab_text (sym, 1, 0, TAB_LEFT | TAT_TITLE, _("Statistic"));
- tab_text (sym, 2, 0, TAB_RIGHT | TAT_TITLE, _("Value"));
- tab_text (sym, 3, 0, TAB_RIGHT | TAT_TITLE, _("Asymp. Std. Error"));
- tab_text (sym, 4, 0, TAB_RIGHT | TAT_TITLE, _("Approx. T"));
- tab_text (sym, 5, 0, TAB_RIGHT | TAT_TITLE, _("Approx. Sig."));
- tab_offset (sym, 0, 1);
- }
- else
- sym = NULL;
-
- /* Risk estimate. */
- if (cmd.a_statistics[CRS_ST_RISK])
- {
- risk = tab_create (4 + (nvar - 2), (pe - pb) / n_cols * 4 + 10, 1);
- tab_headers (risk, 1 + nvar - 2, 0, 2, 0);
- tab_title (risk, 0, "Risk estimate.");
-
- tab_offset (risk, nvar - 2, 0);
- tab_joint_text (risk, 2, 0, 3, 0, TAB_CENTER | TAT_TITLE | TAT_PRINTF,
- _(" 95%% Confidence Interval"));
- tab_text (risk, 0, 1, TAB_LEFT | TAT_TITLE, _("Statistic"));
- tab_text (risk, 1, 1, TAB_RIGHT | TAT_TITLE, _("Value"));
- tab_text (risk, 2, 1, TAB_RIGHT | TAT_TITLE, _("Lower"));
- tab_text (risk, 3, 1, TAB_RIGHT | TAT_TITLE, _("Upper"));
- tab_hline (risk, TAL_1, 2, 3, 1);
- tab_vline (risk, TAL_1, 2, 0, 1);
- tab_offset (risk, 0, 2);
- }
- else
- risk = NULL;
-
- /* Directional measures. */
- if (cmd.a_statistics[CRS_ST_LAMBDA] || cmd.a_statistics[CRS_ST_UC]
- || cmd.a_statistics[CRS_ST_D] || cmd.a_statistics[CRS_ST_ETA])
- {
- direct = tab_create (7 + (nvar - 2), (pe - pb) / n_cols * 7 + 10, 1);
- tab_headers (direct, 3 + (nvar - 2), 0, 1, 0);
- tab_title (direct, 0, "Directional measures.");
-
- tab_offset (direct, nvar - 2, 0);
- tab_text (direct, 0, 0, TAB_LEFT | TAT_TITLE, _("Category"));
- tab_text (direct, 1, 0, TAB_LEFT | TAT_TITLE, _("Statistic"));
- tab_text (direct, 2, 0, TAB_LEFT | TAT_TITLE, _("Type"));
- tab_text (direct, 3, 0, TAB_RIGHT | TAT_TITLE, _("Value"));
- tab_text (direct, 4, 0, TAB_RIGHT | TAT_TITLE, _("Asymp. Std. Error"));
- tab_text (direct, 5, 0, TAB_RIGHT | TAT_TITLE, _("Approx. T"));
- tab_text (direct, 6, 0, TAB_RIGHT | TAT_TITLE, _("Approx. Sig."));
- tab_offset (direct, 0, 1);
- }
- else
- direct = NULL;
-
- for (;;)
- {
- /* Find pivot subtable if applicable. */
- te = find_pivot_extent (tb, &tc, 0);
- if (te == NULL)
- break;
-
- /* Find all the row variable values. */
- enum_var_values (tb, te - tb, ROW_VAR, &rows, &n_rows);
-
- /* Allocate memory space for the column and row totals. */
- if (n_rows > *maxrows)
- {
- *row_totp = xnrealloc (*row_totp, n_rows, sizeof **row_totp);
- row_tot = *row_totp;
- *maxrows = n_rows;
- }
- if (n_cols > *maxcols)
- {
- *col_totp = xnrealloc (*col_totp, n_cols, sizeof **col_totp);
- col_tot = *col_totp;
- *maxcols = n_cols;
- }
-
- /* Allocate table space for the matrix. */
- if (table && tab_row (table) + (n_rows + 1) * num_cells > tab_nr (table))
- tab_realloc (table, -1,
- max (tab_nr (table) + (n_rows + 1) * num_cells,
- tab_nr (table) * (pe - pb) / (te - tb)));
-
- if (mode == GENERAL)
- {
- /* Allocate memory space for the matrix. */
- if (n_cols * n_rows > *maxcells)
- {
- *matp = xnrealloc (*matp, n_cols * n_rows, sizeof **matp);
- *maxcells = n_cols * n_rows;
- }
-
- mat = *matp;
-
- /* Build the matrix and calculate column totals. */
- {
- union value *cur_col = cols;
- union value *cur_row = rows;
- double *mp = mat;
- double *cp = col_tot;
- struct table_entry **p;
-
- *cp = 0.;
- for (p = &tb[0]; p < te; p++)
- {
- for (; memcmp (cur_col, &(*p)->values[COL_VAR], sizeof *cur_col);
- cur_row = rows)
- {
- *++cp = 0.;
- for (; cur_row < &rows[n_rows]; cur_row++)
- {
- *mp = 0.;
- mp += n_cols;
- }
- cur_col++;
- mp = &mat[cur_col - cols];
- }
-
- for (; memcmp (cur_row, &(*p)->values[ROW_VAR], sizeof *cur_row);
- cur_row++)
- {
- *mp = 0.;
- mp += n_cols;
- }
-
- *cp += *mp = (*p)->u.freq;
- mp += n_cols;
- cur_row++;
- }
-
- /* Zero out the rest of the matrix. */
- for (; cur_row < &rows[n_rows]; cur_row++)
- {
- *mp = 0.;
- mp += n_cols;
- }
- cur_col++;
- if (cur_col < &cols[n_cols])
- {
- const int rem_cols = n_cols - (cur_col - cols);
- int c, r;
-
- for (c = 0; c < rem_cols; c++)
- *++cp = 0.;
- mp = &mat[cur_col - cols];
- for (r = 0; r < n_rows; r++)
- {
- for (c = 0; c < rem_cols; c++)
- *mp++ = 0.;
- mp += n_cols - rem_cols;
- }
- }
- }
- }
- else
- {
- int r, c;
- double *tp = col_tot;
-
- assert (mode == INTEGER);
- mat = (*tb)->u.data;
- ns_cols = n_cols;
-
- /* Calculate column totals. */
- for (c = 0; c < n_cols; c++)
- {
- double cum = 0.;
- double *cp = &mat[c];
-
- for (r = 0; r < n_rows; r++)
- cum += cp[r * n_cols];
- *tp++ = cum;
- }
- }
-
- {
- double *cp;
-
- for (ns_cols = 0, cp = col_tot; cp < &col_tot[n_cols]; cp++)
- ns_cols += *cp != 0.;
- }
-
- /* Calculate row totals. */
- {
- double *mp = mat;
- double *rp = row_tot;
- int r, c;
-
- for (ns_rows = 0, r = n_rows; r--; )
- {
- double cum = 0.;
- for (c = n_cols; c--; )
- cum += *mp++;
- *rp++ = cum;
- if (cum != 0.)
- ns_rows++;
- }
- }
-
- /* Calculate grand total. */
- {
- double *tp;
- double cum = 0.;
- int n;
-
- if (n_rows < n_cols)
- tp = row_tot, n = n_rows;
- else
- tp = col_tot, n = n_cols;
- while (n--)
- cum += *tp++;
- W = cum;
- }
-
- /* Find the first variable that differs from the last subtable,
- then display the values of the dimensioning variables for
- each table that needs it. */
- {
- int first_difference = nvar - 1;
-
- if (tb != pb)
- for (; ; first_difference--)
- {
- assert (first_difference >= 2);
- if (memcmp (&cmp->values[first_difference],
- &(*tb)->values[first_difference],
- sizeof *cmp->values))
- break;
- }
- cmp = *tb;
-
- if (table)
- display_dimensions (table, first_difference, *tb);
- if (chisq)
- display_dimensions (chisq, first_difference, *tb);
- if (sym)
- display_dimensions (sym, first_difference, *tb);
- if (risk)
- display_dimensions (risk, first_difference, *tb);
- if (direct)
- display_dimensions (direct, first_difference, *tb);
- }
-
- if (table)
- display_crosstabulation ();
- if (cmd.miss == CRS_REPORT)
- delete_missing ();
- if (chisq)
- display_chisq ();
- if (sym)
- display_symmetric ();
- if (risk)
- display_risk ();
- if (direct)
- display_directional ();
-
- tb = te;
- free (rows);
- }
-
- submit (table);
-
- if (chisq)
- {
- if (!chisq_fisher)
- tab_resize (chisq, 4 + (nvar - 2), -1);
- submit (chisq);
- }
-
- submit (sym);
- submit (risk);
- submit (direct);
-
- free (cols);
-}
-
-/* Delete missing rows and columns for statistical analysis when
- /MISSING=REPORT. */
-static void
-delete_missing (void)
-{
- {
- int r;
-
- for (r = 0; r < n_rows; r++)
- if (mv_is_num_user_missing (&x->vars[ROW_VAR]->miss, rows[r].f))
- {
- int c;
-
- for (c = 0; c < n_cols; c++)
- mat[c + r * n_cols] = 0.;
- ns_rows--;
- }
- }
-
- {
- int c;
-
- for (c = 0; c < n_cols; c++)
- if (mv_is_num_user_missing (&x->vars[COL_VAR]->miss, cols[c].f))
- {
- int r;
-
- for (r = 0; r < n_rows; r++)
- mat[c + r * n_cols] = 0.;
- ns_cols--;
- }
- }
-}
-
-/* Prepare table T for submission, and submit it. */
-static void
-submit (struct tab_table *t)
-{
- int i;
-
- if (t == NULL)
- return;
-
- tab_resize (t, -1, 0);
- if (tab_nr (t) == tab_t (t))
- {
- tab_destroy (t);
- return;
- }
- tab_offset (t, 0, 0);
- if (t != table)
- for (i = 2; i < nvar; i++)
- tab_text (t, nvar - i - 1, 0, TAB_RIGHT | TAT_TITLE,
- x->vars[i]->label ? x->vars[i]->label : x->vars[i]->name);
- tab_box (t, TAL_2, TAL_2, -1, -1, 0, 0, tab_nc (t) - 1, tab_nr (t) - 1);
- tab_box (t, -1, -1, -1, TAL_1, tab_l (t), tab_t (t) - 1, tab_nc (t) - 1,
- tab_nr (t) - 1);
- tab_box (t, -1, -1, -1, TAL_1 | TAL_SPACING, 0, tab_t (t), tab_l (t) - 1,
- tab_nr (t) - 1);
- tab_vline (t, TAL_2, tab_l (t), 0, tab_nr (t) - 1);
- tab_dim (t, crosstabs_dim);
- tab_submit (t);
-}
-
-/* Sets the widths of all the columns and heights of all the rows in
- table T for driver D. */
-static void
-crosstabs_dim (struct tab_table *t, struct outp_driver *d)
-{
- int i;
-
- /* Width of a numerical column. */
- int c = outp_string_width (d, "0.000000");
- if (cmd.miss == CRS_REPORT)
- c += outp_string_width (d, "M");
-
- /* Set width for header columns. */
- if (t->l != 0)
- {
- int w = (d->width - t->vr_tot - c * (t->nc - t->l)) / t->l;
-
- if (w < d->prop_em_width * 8)
- w = d->prop_em_width * 8;
-
- if (w > d->prop_em_width * 15)
- w = d->prop_em_width * 15;
-
- for (i = 0; i < t->l; i++)
- t->w[i] = w;
- }
-
- for (i = t->l; i < t->nc; i++)
- t->w[i] = c;
-
- for (i = 0; i < t->nr; i++)
- t->h[i] = tab_natural_height (t, d, i);
-}
-
-static struct table_entry **find_pivot_extent_general (struct table_entry **tp,
- int *cnt, int pivot);
-static struct table_entry **find_pivot_extent_integer (struct table_entry **tp,
- int *cnt, int pivot);
-
-/* Calls find_pivot_extent_general or find_pivot_extent_integer, as
- appropriate. */
-static struct table_entry **
-find_pivot_extent (struct table_entry **tp, int *cnt, int pivot)
-{
- return (mode == GENERAL
- ? find_pivot_extent_general (tp, cnt, pivot)
- : find_pivot_extent_integer (tp, cnt, pivot));
-}
-
-/* Find the extent of a region in TP that contains one table. If
- PIVOT != 0 that means a set of table entries with identical table
- number; otherwise they also have to have the same values for every
- dimension after the row and column dimensions. The table that is
- searched starts at TP and has length CNT. Returns the first entry
- after the last one in the table; sets *CNT to the number of
- remaining values. If there are no entries in TP at all, returns
- NULL. A yucky interface, admittedly, but it works. */
-static struct table_entry **
-find_pivot_extent_general (struct table_entry **tp, int *cnt, int pivot)
-{
- struct table_entry *fp = *tp;
- struct crosstab *x;
-
- if (*cnt == 0)
- return NULL;
- x = xtab[(*tp)->table];
- for (;;)
- {
- tp++;
- if (--*cnt == 0)
- break;
- assert (*cnt > 0);
-
- if ((*tp)->table != fp->table)
- break;
- if (pivot)
- continue;
-
- if (memcmp (&(*tp)->values[2], &fp->values[2], sizeof (union value) * (x->nvar - 2)))
- break;
- }
-
- return tp;
-}
-
-/* Integer mode correspondent to find_pivot_extent_general(). This
- could be optimized somewhat, but I just don't give a crap about
- CROSSTABS performance in integer mode, which is just a
- CROSSTABS wart as far as I'm concerned.
-
- That said, feel free to send optimization patches to me. */
-static struct table_entry **
-find_pivot_extent_integer (struct table_entry **tp, int *cnt, int pivot)
-{
- struct table_entry *fp = *tp;
- struct crosstab *x;
-
- if (*cnt == 0)
- return NULL;
- x = xtab[(*tp)->table];
- for (;;)
- {
- tp++;
- if (--*cnt == 0)
- break;
- assert (*cnt > 0);
-
- if ((*tp)->table != fp->table)
- break;
- if (pivot)
- continue;
-
- if (memcmp (&(*tp)->values[2], &fp->values[2],
- sizeof (union value) * (x->nvar - 2)))
- break;
- }
-
- return tp;
-}
-
-/* Compares `union value's A_ and B_ and returns a strcmp()-like
- result. WIDTH_ points to an int which is either 0 for a
- numeric value or a string width for a string value. */
-static int
-compare_value (const void *a_, const void *b_, void *width_)
-{
- const union value *a = a_;
- const union value *b = b_;
- const int *pwidth = width_;
- const int width = *pwidth;
-
- if (width == 0)
- return (a->f < b->f) ? -1 : (a->f > b->f);
- else
- return strncmp (a->s, b->s, width);
-}
-
-/* Given an array of ENTRY_CNT table_entry structures starting at
- ENTRIES, creates a sorted list of the values that the variable
- with index VAR_IDX takes on. The values are returned as a
- malloc()'darray stored in *VALUES, with the number of values
- stored in *VALUE_CNT.
- */
-static void
-enum_var_values (struct table_entry **entries, int entry_cnt, int var_idx,
- union value **values, int *value_cnt)
-{
- struct variable *v = xtab[(*entries)->table]->vars[var_idx];
-
- if (mode == GENERAL)
- {
- int width = v->width;
- int i;
-
- *values = xnmalloc (entry_cnt, sizeof **values);
- for (i = 0; i < entry_cnt; i++)
- (*values)[i] = entries[i]->values[var_idx];
- *value_cnt = sort_unique (*values, entry_cnt, sizeof **values,
- compare_value, &width);
- }
- else
- {
- struct var_range *vr = get_var_range (v);
- int i;
-
- assert (mode == INTEGER);
- *values = xnmalloc (vr->count, sizeof **values);
- for (i = 0; i < vr->count; i++)
- (*values)[i].f = i + vr->min;
- *value_cnt = vr->count;
- }
-}
-
-/* Sets cell (C,R) in TABLE, with options OPT, to have a value taken
- from V, displayed with print format spec from variable VAR. When
- in REPORT missing-value mode, missing values have an M appended. */
-static void
-table_value_missing (struct tab_table *table, int c, int r, unsigned char opt,
- const union value *v, const struct variable *var)
-{
- struct fixed_string s;
-
- const char *label = val_labs_find (var->val_labs, *v);
- if (label)
- {
- tab_text (table, c, r, TAB_LEFT, label);
- return;
- }
-
- s.string = tab_alloc (table, var->print.w);
- format_short (s.string, &var->print, v);
- s.length = strlen (s.string);
- if (cmd.miss == CRS_REPORT && mv_is_num_user_missing (&var->miss, v->f))
- s.string[s.length++] = 'M';
- while (s.length && *s.string == ' ')
- {
- s.length--;
- s.string++;
- }
- tab_raw (table, c, r, opt, &s);
-}
-
-/* Draws a line across TABLE at the current row to indicate the most
- major dimension variable with index FIRST_DIFFERENCE out of NVAR
- that changed, and puts the values that changed into the table. TB
- and X must be the corresponding table_entry and crosstab,
- respectively. */
-static void
-display_dimensions (struct tab_table *table, int first_difference, struct table_entry *tb)
-{
- tab_hline (table, TAL_1, nvar - first_difference - 1, tab_nc (table) - 1, 0);
-
- for (; first_difference >= 2; first_difference--)
- table_value_missing (table, nvar - first_difference - 1, 0,
- TAB_RIGHT, &tb->values[first_difference],
- x->vars[first_difference]);
-}
-
-/* Put VALUE into cell (C,R) of TABLE, suffixed with character
- SUFFIX if nonzero. If MARK_MISSING is nonzero the entry is
- additionally suffixed with a letter `M'. */
-static void
-format_cell_entry (struct tab_table *table, int c, int r, double value,
- char suffix, int mark_missing)
-{
- const struct fmt_spec f = {FMT_F, 10, 1};
- union value v;
- struct fixed_string s;
-
- s.length = 10;
- s.string = tab_alloc (table, 16);
- v.f = value;
- data_out (s.string, &f, &v);
- while (*s.string == ' ')
- {
- s.length--;
- s.string++;
- }
- if (suffix != 0)
- s.string[s.length++] = suffix;
- if (mark_missing)
- s.string[s.length++] = 'M';
-
- tab_raw (table, c, r, TAB_RIGHT, &s);
-}
-
-/* Displays the crosstabulation table. */
-static void
-display_crosstabulation (void)
-{
- {
- int r;
-
- for (r = 0; r < n_rows; r++)
- table_value_missing (table, nvar - 2, r * num_cells,
- TAB_RIGHT, &rows[r], x->vars[ROW_VAR]);
- }
- tab_text (table, nvar - 2, n_rows * num_cells,
- TAB_LEFT, _("Total"));
-
- /* Put in the actual cells. */
- {
- double *mp = mat;
- int r, c, i;
-
- tab_offset (table, nvar - 1, -1);
- for (r = 0; r < n_rows; r++)
- {
- if (num_cells > 1)
- tab_hline (table, TAL_1, -1, n_cols, 0);
- for (c = 0; c < n_cols; c++)
- {
- int mark_missing = 0;
- double expected_value = row_tot[r] * col_tot[c] / W;
- if (cmd.miss == CRS_REPORT
- && (mv_is_num_user_missing (&x->vars[COL_VAR]->miss, cols[c].f)
- || mv_is_num_user_missing (&x->vars[ROW_VAR]->miss,
- rows[r].f)))
- mark_missing = 1;
- for (i = 0; i < num_cells; i++)
- {
- double v;
- int suffix = 0;
-
- switch (cells[i])
- {
- case CRS_CL_COUNT:
- v = *mp;
- break;
- case CRS_CL_ROW:
- v = *mp / row_tot[r] * 100.;
- suffix = '%';
- break;
- case CRS_CL_COLUMN:
- v = *mp / col_tot[c] * 100.;
- suffix = '%';
- break;
- case CRS_CL_TOTAL:
- v = *mp / W * 100.;
- suffix = '%';
- break;
- case CRS_CL_EXPECTED:
- v = expected_value;
- break;
- case CRS_CL_RESIDUAL:
- v = *mp - expected_value;
- break;
- case CRS_CL_SRESIDUAL:
- v = (*mp - expected_value) / sqrt (expected_value);
- break;
- case CRS_CL_ASRESIDUAL:
- v = ((*mp - expected_value)
- / sqrt (expected_value
- * (1. - row_tot[r] / W)
- * (1. - col_tot[c] / W)));
- break;
- default:
- assert (0);
- abort ();
- }
-
- format_cell_entry (table, c, i, v, suffix, mark_missing);
- }
-
- mp++;
- }
-
- tab_offset (table, -1, tab_row (table) + num_cells);
- }
- }
-
- /* Row totals. */
- {
- int r, i;
-
- tab_offset (table, -1, tab_row (table) - num_cells * n_rows);
- for (r = 0; r < n_rows; r++)
- {
- char suffix = 0;
- int mark_missing = 0;
-
- if (cmd.miss == CRS_REPORT
- && mv_is_num_user_missing (&x->vars[ROW_VAR]->miss, rows[r].f))
- mark_missing = 1;
-
- for (i = 0; i < num_cells; i++)
- {
- double v;
-
- switch (cells[i])
- {
- case CRS_CL_COUNT:
- v = row_tot[r];
- break;
- case CRS_CL_ROW:
- v = 100.;
- suffix = '%';
- break;
- case CRS_CL_COLUMN:
- v = row_tot[r] / W * 100.;
- suffix = '%';
- break;
- case CRS_CL_TOTAL:
- v = row_tot[r] / W * 100.;
- suffix = '%';
- break;
- case CRS_CL_EXPECTED:
- case CRS_CL_RESIDUAL:
- case CRS_CL_SRESIDUAL:
- case CRS_CL_ASRESIDUAL:
- v = 0.;
- break;
- default:
- assert (0);
- abort ();
- }
-
- format_cell_entry (table, n_cols, 0, v, suffix, mark_missing);
- tab_next_row (table);
- }
- }
- }
-
- /* Column totals, grand total. */
- {
- int c;
- int last_row = 0;
-
- if (num_cells > 1)
- tab_hline (table, TAL_1, -1, n_cols, 0);
- for (c = 0; c <= n_cols; c++)
- {
- double ct = c < n_cols ? col_tot[c] : W;
- int mark_missing = 0;
- char suffix = 0;
- int i;
-
- if (cmd.miss == CRS_REPORT && c < n_cols
- && mv_is_num_user_missing (&x->vars[COL_VAR]->miss, cols[c].f))
- mark_missing = 1;
-
- for (i = 0; i < num_cells; i++)
- {
- double v;
-
- switch (cells[i])
- {
- case CRS_CL_COUNT:
- v = ct;
- suffix = '%';
- break;
- case CRS_CL_ROW:
- v = ct / W * 100.;
- suffix = '%';
- break;
- case CRS_CL_COLUMN:
- v = 100.;
- suffix = '%';
- break;
- case CRS_CL_TOTAL:
- v = ct / W * 100.;
- suffix = '%';
- break;
- case CRS_CL_EXPECTED:
- case CRS_CL_RESIDUAL:
- case CRS_CL_SRESIDUAL:
- case CRS_CL_ASRESIDUAL:
- continue;
- default:
- assert (0);
- abort ();
- }
-
- format_cell_entry (table, c, i, v, suffix, mark_missing);
- }
- last_row = i;
- }
-
- tab_offset (table, -1, tab_row (table) + last_row);
- }
-
- tab_offset (table, 0, -1);
-}
-
-static void calc_r (double *X, double *Y, double *, double *, double *);
-static void calc_chisq (double[N_CHISQ], int[N_CHISQ], double *, double *);
-
-/* Display chi-square statistics. */
-static void
-display_chisq (void)
-{
- static const char *chisq_stats[N_CHISQ] =
- {
- N_("Pearson Chi-Square"),
- N_("Likelihood Ratio"),
- N_("Fisher's Exact Test"),
- N_("Continuity Correction"),
- N_("Linear-by-Linear Association"),
- };
- double chisq_v[N_CHISQ];
- double fisher1, fisher2;
- int df[N_CHISQ];
- int s = 0;
-
- int i;
-
- calc_chisq (chisq_v, df, &fisher1, &fisher2);
-
- tab_offset (chisq, nvar - 2, -1);
-
- for (i = 0; i < N_CHISQ; i++)
- {
- if ((i != 2 && chisq_v[i] == SYSMIS)
- || (i == 2 && fisher1 == SYSMIS))
- continue;
- s = 1;
-
- tab_text (chisq, 0, 0, TAB_LEFT, gettext (chisq_stats[i]));
- if (i != 2)
- {
- tab_float (chisq, 1, 0, TAB_RIGHT, chisq_v[i], 8, 3);
- tab_float (chisq, 2, 0, TAB_RIGHT, df[i], 8, 0);
- tab_float (chisq, 3, 0, TAB_RIGHT,
- gsl_cdf_chisq_Q (chisq_v[i], df[i]), 8, 3);
- }
- else
- {
- chisq_fisher = 1;
- tab_float (chisq, 4, 0, TAB_RIGHT, fisher2, 8, 3);
- tab_float (chisq, 5, 0, TAB_RIGHT, fisher1, 8, 3);
- }
- tab_next_row (chisq);
- }
-
- tab_text (chisq, 0, 0, TAB_LEFT, _("N of Valid Cases"));
- tab_float (chisq, 1, 0, TAB_RIGHT, W, 8, 0);
- tab_next_row (chisq);
-
- tab_offset (chisq, 0, -1);
-}
-
-static int calc_symmetric (double[N_SYMMETRIC], double[N_SYMMETRIC],
- double[N_SYMMETRIC]);
-
-/* Display symmetric measures. */
-static void
-display_symmetric (void)
-{
- static const char *categories[] =
- {
- N_("Nominal by Nominal"),
- N_("Ordinal by Ordinal"),
- N_("Interval by Interval"),
- N_("Measure of Agreement"),
- };
-
- static const char *stats[N_SYMMETRIC] =
- {
- N_("Phi"),
- N_("Cramer's V"),
- N_("Contingency Coefficient"),
- N_("Kendall's tau-b"),
- N_("Kendall's tau-c"),
- N_("Gamma"),
- N_("Spearman Correlation"),
- N_("Pearson's R"),
- N_("Kappa"),
- };
-
- static const int stats_categories[N_SYMMETRIC] =
- {
- 0, 0, 0, 1, 1, 1, 1, 2, 3,
- };
-
- int last_cat = -1;
- double sym_v[N_SYMMETRIC], sym_ase[N_SYMMETRIC], sym_t[N_SYMMETRIC];
- int i;
-
- if (!calc_symmetric (sym_v, sym_ase, sym_t))
- return;
-
- tab_offset (sym, nvar - 2, -1);
-
- for (i = 0; i < N_SYMMETRIC; i++)
- {
- if (sym_v[i] == SYSMIS)
- continue;
-
- if (stats_categories[i] != last_cat)
- {
- last_cat = stats_categories[i];
- tab_text (sym, 0, 0, TAB_LEFT, gettext (categories[last_cat]));
- }
-
- tab_text (sym, 1, 0, TAB_LEFT, gettext (stats[i]));
- tab_float (sym, 2, 0, TAB_RIGHT, sym_v[i], 8, 3);
- if (sym_ase[i] != SYSMIS)
- tab_float (sym, 3, 0, TAB_RIGHT, sym_ase[i], 8, 3);
- if (sym_t[i] != SYSMIS)
- tab_float (sym, 4, 0, TAB_RIGHT, sym_t[i], 8, 3);
- /*tab_float (sym, 5, 0, TAB_RIGHT, normal_sig (sym_v[i]), 8, 3);*/
- tab_next_row (sym);
- }
-
- tab_text (sym, 0, 0, TAB_LEFT, _("N of Valid Cases"));
- tab_float (sym, 2, 0, TAB_RIGHT, W, 8, 0);
- tab_next_row (sym);
-
- tab_offset (sym, 0, -1);
-}
-
-static int calc_risk (double[], double[], double[], union value *);
-
-/* Display risk estimate. */
-static void
-display_risk (void)
-{
- char buf[256];
- double risk_v[3], lower[3], upper[3];
- union value c[2];
- int i;
-
- if (!calc_risk (risk_v, upper, lower, c))
- return;
-
- tab_offset (risk, nvar - 2, -1);
-
- for (i = 0; i < 3; i++)
- {
- if (risk_v[i] == SYSMIS)
- continue;
-
- switch (i)
- {
- case 0:
- if (x->vars[COL_VAR]->type == NUMERIC)
- sprintf (buf, _("Odds Ratio for %s (%g / %g)"),
- x->vars[COL_VAR]->name, c[0].f, c[1].f);
- else
- sprintf (buf, _("Odds Ratio for %s (%.*s / %.*s)"),
- x->vars[COL_VAR]->name,
- x->vars[COL_VAR]->width, c[0].s,
- x->vars[COL_VAR]->width, c[1].s);
- break;
- case 1:
- case 2:
- if (x->vars[ROW_VAR]->type == NUMERIC)
- sprintf (buf, _("For cohort %s = %g"),
- x->vars[ROW_VAR]->name, rows[i - 1].f);
- else
- sprintf (buf, _("For cohort %s = %.*s"),
- x->vars[ROW_VAR]->name,
- x->vars[ROW_VAR]->width, rows[i - 1].s);
- break;
- }
-
- tab_text (risk, 0, 0, TAB_LEFT, buf);
- tab_float (risk, 1, 0, TAB_RIGHT, risk_v[i], 8, 3);
- tab_float (risk, 2, 0, TAB_RIGHT, lower[i], 8, 3);
- tab_float (risk, 3, 0, TAB_RIGHT, upper[i], 8, 3);
- tab_next_row (risk);
- }
-
- tab_text (risk, 0, 0, TAB_LEFT, _("N of Valid Cases"));
- tab_float (risk, 1, 0, TAB_RIGHT, W, 8, 0);
- tab_next_row (risk);
-
- tab_offset (risk, 0, -1);
-}
-
-static int calc_directional (double[N_DIRECTIONAL], double[N_DIRECTIONAL],
- double[N_DIRECTIONAL]);
-
-/* Display directional measures. */
-static void
-display_directional (void)
-{
- static const char *categories[] =
- {
- N_("Nominal by Nominal"),
- N_("Ordinal by Ordinal"),
- N_("Nominal by Interval"),
- };
-
- static const char *stats[] =
- {
- N_("Lambda"),
- N_("Goodman and Kruskal tau"),
- N_("Uncertainty Coefficient"),
- N_("Somers' d"),
- N_("Eta"),
- };
-
- static const char *types[] =
- {
- N_("Symmetric"),
- N_("%s Dependent"),
- N_("%s Dependent"),
- };
-
- static const int stats_categories[N_DIRECTIONAL] =
- {
- 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 2, 2,
- };
-
- static const int stats_stats[N_DIRECTIONAL] =
- {
- 0, 0, 0, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4,
- };
-
- static const int stats_types[N_DIRECTIONAL] =
- {
- 0, 1, 2, 1, 2, 0, 1, 2, 0, 1, 2, 1, 2,
- };
-
- static const int *stats_lookup[] =
- {
- stats_categories,
- stats_stats,
- stats_types,
- };
-
- static const char **stats_names[] =
- {
- categories,
- stats,
- types,
- };
-
- int last[3] =
- {
- -1, -1, -1,
- };
-
- double direct_v[N_DIRECTIONAL];
- double direct_ase[N_DIRECTIONAL];
- double direct_t[N_DIRECTIONAL];
-
- int i;
-
- if (!calc_directional (direct_v, direct_ase, direct_t))
- return;
-
- tab_offset (direct, nvar - 2, -1);
-
- for (i = 0; i < N_DIRECTIONAL; i++)
- {
- if (direct_v[i] == SYSMIS)
- continue;
-
- {
- int j;
-
- for (j = 0; j < 3; j++)
- if (last[j] != stats_lookup[j][i])
- {
- if (j < 2)
- tab_hline (direct, TAL_1, j, 6, 0);
-
- for (; j < 3; j++)
- {
- char *string;
- int k = last[j] = stats_lookup[j][i];
-
- if (k == 0)
- string = NULL;
- else if (k == 1)
- string = x->vars[0]->name;
- else
- string = x->vars[1]->name;
-
- tab_text (direct, j, 0, TAB_LEFT | TAT_PRINTF,
- gettext (stats_names[j][k]), string);
- }
- }
- }
-
- tab_float (direct, 3, 0, TAB_RIGHT, direct_v[i], 8, 3);
- if (direct_ase[i] != SYSMIS)
- tab_float (direct, 4, 0, TAB_RIGHT, direct_ase[i], 8, 3);
- if (direct_t[i] != SYSMIS)
- tab_float (direct, 5, 0, TAB_RIGHT, direct_t[i], 8, 3);
- /*tab_float (direct, 6, 0, TAB_RIGHT, normal_sig (direct_v[i]), 8, 3);*/
- tab_next_row (direct);
- }
-
- tab_offset (direct, 0, -1);
-}
-\f
-/* Statistical calculations. */
-
-/* Returns the value of the gamma (factorial) function for an integer
- argument X. */
-static double
-gamma_int (double x)
-{
- double r = 1;
- int i;
-
- for (i = 2; i < x; i++)
- r *= i;
- return r;
-}
-
-/* Calculate P_r as specified in _SPSS Statistical Algorithms_,
- Appendix 5. */
-static inline double
-Pr (int a, int b, int c, int d)
-{
- return (gamma_int (a + b + 1.) / gamma_int (a + 1.)
- * gamma_int (c + d + 1.) / gamma_int (b + 1.)
- * gamma_int (a + c + 1.) / gamma_int (c + 1.)
- * gamma_int (b + d + 1.) / gamma_int (d + 1.)
- / gamma_int (a + b + c + d + 1.));
-}
-
-/* Swap the contents of A and B. */
-static inline void
-swap (int *a, int *b)
-{
- int t = *a;
- *a = *b;
- *b = t;
-}
-
-/* Calculate significance for Fisher's exact test as specified in
- _SPSS Statistical Algorithms_, Appendix 5. */
-static void
-calc_fisher (int a, int b, int c, int d, double *fisher1, double *fisher2)
-{
- int x;
-
- if (min (c, d) < min (a, b))
- swap (&a, &c), swap (&b, &d);
- if (min (b, d) < min (a, c))
- swap (&a, &b), swap (&c, &d);
- if (b * c < a * d)
- {
- if (b < c)
- swap (&a, &b), swap (&c, &d);
- else
- swap (&a, &c), swap (&b, &d);
- }
-
- *fisher1 = 0.;
- for (x = 0; x <= a; x++)
- *fisher1 += Pr (a - x, b + x, c + x, d - x);
-
- *fisher2 = *fisher1;
- for (x = 1; x <= b; x++)
- *fisher2 += Pr (a + x, b - x, c - x, d + x);
-}
-
-/* Calculates chi-squares into CHISQ. MAT is a matrix with N_COLS
- columns with values COLS and N_ROWS rows with values ROWS. Values
- in the matrix sum to W. */
-static void
-calc_chisq (double chisq[N_CHISQ], int df[N_CHISQ],
- double *fisher1, double *fisher2)
-{
- int r, c;
-
- chisq[0] = chisq[1] = 0.;
- chisq[2] = chisq[3] = chisq[4] = SYSMIS;
- *fisher1 = *fisher2 = SYSMIS;
-
- df[0] = df[1] = (ns_cols - 1) * (ns_rows - 1);
-
- if (ns_rows <= 1 || ns_cols <= 1)
- {
- chisq[0] = chisq[1] = SYSMIS;
- return;
- }
-
- for (r = 0; r < n_rows; r++)
- for (c = 0; c < n_cols; c++)
- {
- const double expected = row_tot[r] * col_tot[c] / W;
- const double freq = mat[n_cols * r + c];
- const double residual = freq - expected;
-
- chisq[0] += residual * residual / expected;
- if (freq)
- chisq[1] += freq * log (expected / freq);
- }
-
- if (chisq[0] == 0.)
- chisq[0] = SYSMIS;
-
- if (chisq[1] != 0.)
- chisq[1] *= -2.;
- else
- chisq[1] = SYSMIS;
-
- /* Calculate Yates and Fisher exact test. */
- if (ns_cols == 2 && ns_rows == 2)
- {
- double f11, f12, f21, f22;
-
- {
- int nz_cols[2];
- int i, j;
-
- for (i = j = 0; i < n_cols; i++)
- if (col_tot[i] != 0.)
- {
- nz_cols[j++] = i;
- if (j == 2)
- break;
- }
-
- assert (j == 2);
-
- f11 = mat[nz_cols[0]];
- f12 = mat[nz_cols[1]];
- f21 = mat[nz_cols[0] + n_cols];
- f22 = mat[nz_cols[1] + n_cols];
- }
-
- /* Yates. */
- {
- const double x = fabs (f11 * f22 - f12 * f21) - 0.5 * W;
-
- if (x > 0.)
- chisq[3] = (W * x * x
- / (f11 + f12) / (f21 + f22)
- / (f11 + f21) / (f12 + f22));
- else
- chisq[3] = 0.;
-
- df[3] = 1.;
- }
-
- /* Fisher. */
- if (f11 < 5. || f12 < 5. || f21 < 5. || f22 < 5.)
- calc_fisher (f11 + .5, f12 + .5, f21 + .5, f22 + .5, fisher1, fisher2);
- }
-
- /* Calculate Mantel-Haenszel. */
- if (x->vars[ROW_VAR]->type == NUMERIC && x->vars[COL_VAR]->type == NUMERIC)
- {
- double r, ase_0, ase_1;
- calc_r ((double *) rows, (double *) cols, &r, &ase_0, &ase_1);
-
- chisq[4] = (W - 1.) * r * r;
- df[4] = 1;
- }
-}
-
-/* Calculate the value of Pearson's r. r is stored into R, ase_1 into
- ASE_1, and ase_0 into ASE_0. The row and column values must be
- passed in X and Y. */
-static void
-calc_r (double *X, double *Y, double *r, double *ase_0, double *ase_1)
-{
- double SX, SY, S, T;
- double Xbar, Ybar;
- double sum_XYf, sum_X2Y2f;
- double sum_Xr, sum_X2r;
- double sum_Yc, sum_Y2c;
- int i, j;
-
- for (sum_X2Y2f = sum_XYf = 0., i = 0; i < n_rows; i++)
- for (j = 0; j < n_cols; j++)
- {
- double fij = mat[j + i * n_cols];
- double product = X[i] * Y[j];
- double temp = fij * product;
- sum_XYf += temp;
- sum_X2Y2f += temp * product;
- }
-
- for (sum_Xr = sum_X2r = 0., i = 0; i < n_rows; i++)
- {
- sum_Xr += X[i] * row_tot[i];
- sum_X2r += X[i] * X[i] * row_tot[i];
- }
- Xbar = sum_Xr / W;
-
- for (sum_Yc = sum_Y2c = 0., i = 0; i < n_cols; i++)
- {
- sum_Yc += Y[i] * col_tot[i];
- sum_Y2c += Y[i] * Y[i] * col_tot[i];
- }
- Ybar = sum_Yc / W;
-
- S = sum_XYf - sum_Xr * sum_Yc / W;
- SX = sum_X2r - sum_Xr * sum_Xr / W;
- SY = sum_Y2c - sum_Yc * sum_Yc / W;
- T = sqrt (SX * SY);
- *r = S / T;
- *ase_0 = sqrt ((sum_X2Y2f - (sum_XYf * sum_XYf) / W) / (sum_X2r * sum_Y2c));
-
- {
- double s, c, y, t;
-
- for (s = c = 0., i = 0; i < n_rows; i++)
- for (j = 0; j < n_cols; j++)
- {
- double Xresid, Yresid;
- double temp;
-
- Xresid = X[i] - Xbar;
- Yresid = Y[j] - Ybar;
- temp = (T * Xresid * Yresid
- - ((S / (2. * T))
- * (Xresid * Xresid * SY + Yresid * Yresid * SX)));
- y = mat[j + i * n_cols] * temp * temp - c;
- t = s + y;
- c = (t - s) - y;
- s = t;
- }
- *ase_1 = sqrt (s) / (T * T);
- }
-}
-
-static double somers_d_v[3];
-static double somers_d_ase[3];
-static double somers_d_t[3];
-
-/* Calculate symmetric statistics and their asymptotic standard
- errors. Returns 0 if none could be calculated. */
-static int
-calc_symmetric (double v[N_SYMMETRIC], double ase[N_SYMMETRIC],
- double t[N_SYMMETRIC])
-{
- int q = min (ns_rows, ns_cols);
-
- if (q <= 1)
- return 0;
-
- {
- int i;
-
- if (v)
- for (i = 0; i < N_SYMMETRIC; i++)
- v[i] = ase[i] = t[i] = SYSMIS;
- }
-
- /* Phi, Cramer's V, contingency coefficient. */
- if (cmd.a_statistics[CRS_ST_PHI] || cmd.a_statistics[CRS_ST_CC])
- {
- double Xp = 0.; /* Pearson chi-square. */
-
- {
- int r, c;
-
- for (r = 0; r < n_rows; r++)
- for (c = 0; c < n_cols; c++)
- {
- const double expected = row_tot[r] * col_tot[c] / W;
- const double freq = mat[n_cols * r + c];
- const double residual = freq - expected;
-
- Xp += residual * residual / expected;
- }
- }
-
- if (cmd.a_statistics[CRS_ST_PHI])
- {
- v[0] = sqrt (Xp / W);
- v[1] = sqrt (Xp / (W * (q - 1)));
- }
- if (cmd.a_statistics[CRS_ST_CC])
- v[2] = sqrt (Xp / (Xp + W));
- }
-
- if (cmd.a_statistics[CRS_ST_BTAU] || cmd.a_statistics[CRS_ST_CTAU]
- || cmd.a_statistics[CRS_ST_GAMMA] || cmd.a_statistics[CRS_ST_D])
- {
- double *cum;
- double Dr, Dc;
- double P, Q;
- double btau_cum, ctau_cum, gamma_cum, d_yx_cum, d_xy_cum;
- double btau_var;
-
- {
- int r, c;
-
- Dr = Dc = W * W;
- for (r = 0; r < n_rows; r++)
- Dr -= row_tot[r] * row_tot[r];
- for (c = 0; c < n_cols; c++)
- Dc -= col_tot[c] * col_tot[c];
- }
-
- {
- int r, c;
-
- cum = xnmalloc (n_cols * n_rows, sizeof *cum);
- for (c = 0; c < n_cols; c++)
- {
- double ct = 0.;
-
- for (r = 0; r < n_rows; r++)
- cum[c + r * n_cols] = ct += mat[c + r * n_cols];
- }
- }
-
- /* P and Q. */
- {
- int i, j;
- double Cij, Dij;
-
- P = Q = 0.;
- for (i = 0; i < n_rows; i++)
- {
- Cij = Dij = 0.;
-
- for (j = 1; j < n_cols; j++)
- Cij += col_tot[j] - cum[j + i * n_cols];
-
- if (i > 0)
- for (j = 1; j < n_cols; j++)
- Dij += cum[j + (i - 1) * n_cols];
-
- for (j = 0;;)
- {
- double fij = mat[j + i * n_cols];
- P += fij * Cij;
- Q += fij * Dij;
-
- if (++j == n_cols)
- break;
- assert (j < n_cols);
-
- Cij -= col_tot[j] - cum[j + i * n_cols];
- Dij += col_tot[j - 1] - cum[j - 1 + i * n_cols];
-
- if (i > 0)
- {
- Cij += cum[j - 1 + (i - 1) * n_cols];
- Dij -= cum[j + (i - 1) * n_cols];
- }
- }
- }
- }
-
- if (cmd.a_statistics[CRS_ST_BTAU])
- v[3] = (P - Q) / sqrt (Dr * Dc);
- if (cmd.a_statistics[CRS_ST_CTAU])
- v[4] = (q * (P - Q)) / ((W * W) * (q - 1));
- if (cmd.a_statistics[CRS_ST_GAMMA])
- v[5] = (P - Q) / (P + Q);
-
- /* ASE for tau-b, tau-c, gamma. Calculations could be
- eliminated here, at expense of memory. */
- {
- int i, j;
- double Cij, Dij;
-
- btau_cum = ctau_cum = gamma_cum = d_yx_cum = d_xy_cum = 0.;
- for (i = 0; i < n_rows; i++)
- {
- Cij = Dij = 0.;
-
- for (j = 1; j < n_cols; j++)
- Cij += col_tot[j] - cum[j + i * n_cols];
-
- if (i > 0)
- for (j = 1; j < n_cols; j++)
- Dij += cum[j + (i - 1) * n_cols];
-
- for (j = 0;;)
- {
- double fij = mat[j + i * n_cols];
-
- if (cmd.a_statistics[CRS_ST_BTAU])
- {
- const double temp = (2. * sqrt (Dr * Dc) * (Cij - Dij)
- + v[3] * (row_tot[i] * Dc
- + col_tot[j] * Dr));
- btau_cum += fij * temp * temp;
- }
-
- {
- const double temp = Cij - Dij;
- ctau_cum += fij * temp * temp;
- }
-
- if (cmd.a_statistics[CRS_ST_GAMMA])
- {
- const double temp = Q * Cij - P * Dij;
- gamma_cum += fij * temp * temp;
- }
-
- if (cmd.a_statistics[CRS_ST_D])
- {
- d_yx_cum += fij * pow2 (Dr * (Cij - Dij)
- - (P - Q) * (W - row_tot[i]));
- d_xy_cum += fij * pow2 (Dc * (Dij - Cij)
- - (Q - P) * (W - col_tot[j]));
- }
-
- if (++j == n_cols)
- break;
- assert (j < n_cols);
-
- Cij -= col_tot[j] - cum[j + i * n_cols];
- Dij += col_tot[j - 1] - cum[j - 1 + i * n_cols];
-
- if (i > 0)
- {
- Cij += cum[j - 1 + (i - 1) * n_cols];
- Dij -= cum[j + (i - 1) * n_cols];
- }
- }
- }
- }
-
- btau_var = ((btau_cum
- - (W * pow2 (W * (P - Q) / sqrt (Dr * Dc) * (Dr + Dc))))
- / pow2 (Dr * Dc));
- if (cmd.a_statistics[CRS_ST_BTAU])
- {
- ase[3] = sqrt (btau_var);
- t[3] = v[3] / (2 * sqrt ((ctau_cum - (P - Q) * (P - Q) / W)
- / (Dr * Dc)));
- }
- if (cmd.a_statistics[CRS_ST_CTAU])
- {
- ase[4] = ((2 * q / ((q - 1) * W * W))
- * sqrt (ctau_cum - (P - Q) * (P - Q) / W));
- t[4] = v[4] / ase[4];
- }
- if (cmd.a_statistics[CRS_ST_GAMMA])
- {
- ase[5] = ((4. / ((P + Q) * (P + Q))) * sqrt (gamma_cum));
- t[5] = v[5] / (2. / (P + Q)
- * sqrt (ctau_cum - (P - Q) * (P - Q) / W));
- }
- if (cmd.a_statistics[CRS_ST_D])
- {
- somers_d_v[0] = (P - Q) / (.5 * (Dc + Dr));
- somers_d_ase[0] = 2. * btau_var / (Dr + Dc) * sqrt (Dr * Dc);
- somers_d_t[0] = (somers_d_v[0]
- / (4 / (Dc + Dr)
- * sqrt (ctau_cum - pow2 (P - Q) / W)));
- somers_d_v[1] = (P - Q) / Dc;
- somers_d_ase[1] = 2. / pow2 (Dc) * sqrt (d_xy_cum);
- somers_d_t[1] = (somers_d_v[1]
- / (2. / Dc
- * sqrt (ctau_cum - pow2 (P - Q) / W)));
- somers_d_v[2] = (P - Q) / Dr;
- somers_d_ase[2] = 2. / pow2 (Dr) * sqrt (d_yx_cum);
- somers_d_t[2] = (somers_d_v[2]
- / (2. / Dr
- * sqrt (ctau_cum - pow2 (P - Q) / W)));
- }
-
- free (cum);
- }
-
- /* Spearman correlation, Pearson's r. */
- if (cmd.a_statistics[CRS_ST_CORR])
- {
- double *R = local_alloc (sizeof *R * n_rows);
- double *C = local_alloc (sizeof *C * n_cols);
-
- {
- double y, t, c = 0., s = 0.;
- int i = 0;
-
- for (;;)
- {
- R[i] = s + (row_tot[i] + 1.) / 2.;
- y = row_tot[i] - c;
- t = s + y;
- c = (t - s) - y;
- s = t;
- if (++i == n_rows)
- break;
- assert (i < n_rows);
- }
- }
-
- {
- double y, t, c = 0., s = 0.;
- int j = 0;
-
- for (;;)
- {
- C[j] = s + (col_tot[j] + 1.) / 2;
- y = col_tot[j] - c;
- t = s + y;
- c = (t - s) - y;
- s = t;
- if (++j == n_cols)
- break;
- assert (j < n_cols);
- }
- }
-
- calc_r (R, C, &v[6], &t[6], &ase[6]);
- t[6] = v[6] / t[6];
-
- local_free (R);
- local_free (C);
-
- calc_r ((double *) rows, (double *) cols, &v[7], &t[7], &ase[7]);
- t[7] = v[7] / t[7];
- }
-
- /* Cohen's kappa. */
- if (cmd.a_statistics[CRS_ST_KAPPA] && ns_rows == ns_cols)
- {
- double sum_fii, sum_rici, sum_fiiri_ci, sum_fijri_ci2, sum_riciri_ci;
- int i, j;
-
- for (sum_fii = sum_rici = sum_fiiri_ci = sum_riciri_ci = 0., i = j = 0;
- i < ns_rows; i++, j++)
- {
- double prod, sum;
-
- while (col_tot[j] == 0.)
- j++;
-
- prod = row_tot[i] * col_tot[j];
- sum = row_tot[i] + col_tot[j];
-
- sum_fii += mat[j + i * n_cols];
- sum_rici += prod;
- sum_fiiri_ci += mat[j + i * n_cols] * sum;
- sum_riciri_ci += prod * sum;
- }
- for (sum_fijri_ci2 = 0., i = 0; i < ns_rows; i++)
- for (j = 0; j < ns_cols; j++)
- {
- double sum = row_tot[i] + col_tot[j];
- sum_fijri_ci2 += mat[j + i * n_cols] * sum * sum;
- }
-
- v[8] = (W * sum_fii - sum_rici) / (W * W - sum_rici);
-
- ase[8] = sqrt ((W * W * sum_rici
- + sum_rici * sum_rici
- - W * sum_riciri_ci)
- / (W * (W * W - sum_rici) * (W * W - sum_rici)));
-#if 0
- t[8] = v[8] / sqrt (W * (((sum_fii * (W - sum_fii))
- / pow2 (W * W - sum_rici))
- + ((2. * (W - sum_fii)
- * (2. * sum_fii * sum_rici
- - W * sum_fiiri_ci))
- / cube (W * W - sum_rici))
- + (pow2 (W - sum_fii)
- * (W * sum_fijri_ci2 - 4.
- * sum_rici * sum_rici)
- / pow4 (W * W - sum_rici))));
-#else
- t[8] = v[8] / ase[8];
-#endif
- }
-
- return 1;
-}
-
-/* Calculate risk estimate. */
-static int
-calc_risk (double *value, double *upper, double *lower, union value *c)
-{
- double f11, f12, f21, f22;
- double v;
-
- {
- int i;
-
- for (i = 0; i < 3; i++)
- value[i] = upper[i] = lower[i] = SYSMIS;
- }
-
- if (ns_rows != 2 || ns_cols != 2)
- return 0;
-
- {
- int nz_cols[2];
- int i, j;
-
- for (i = j = 0; i < n_cols; i++)
- if (col_tot[i] != 0.)
- {
- nz_cols[j++] = i;
- if (j == 2)
- break;
- }
-
- assert (j == 2);
-
- f11 = mat[nz_cols[0]];
- f12 = mat[nz_cols[1]];
- f21 = mat[nz_cols[0] + n_cols];
- f22 = mat[nz_cols[1] + n_cols];
-
- c[0] = cols[nz_cols[0]];
- c[1] = cols[nz_cols[1]];
- }
-
- value[0] = (f11 * f22) / (f12 * f21);
- v = sqrt (1. / f11 + 1. / f12 + 1. / f21 + 1. / f22);
- lower[0] = value[0] * exp (-1.960 * v);
- upper[0] = value[0] * exp (1.960 * v);
-
- value[1] = (f11 * (f21 + f22)) / (f21 * (f11 + f12));
- v = sqrt ((f12 / (f11 * (f11 + f12)))
- + (f22 / (f21 * (f21 + f22))));
- lower[1] = value[1] * exp (-1.960 * v);
- upper[1] = value[1] * exp (1.960 * v);
-
- value[2] = (f12 * (f21 + f22)) / (f22 * (f11 + f12));
- v = sqrt ((f11 / (f12 * (f11 + f12)))
- + (f21 / (f22 * (f21 + f22))));
- lower[2] = value[2] * exp (-1.960 * v);
- upper[2] = value[2] * exp (1.960 * v);
-
- return 1;
-}
-
-/* Calculate directional measures. */
-static int
-calc_directional (double v[N_DIRECTIONAL], double ase[N_DIRECTIONAL],
- double t[N_DIRECTIONAL])
-{
- {
- int i;
-
- for (i = 0; i < N_DIRECTIONAL; i++)
- v[i] = ase[i] = t[i] = SYSMIS;
- }
-
- /* Lambda. */
- if (cmd.a_statistics[CRS_ST_LAMBDA])
- {
- double *fim = xnmalloc (n_rows, sizeof *fim);
- int *fim_index = xnmalloc (n_rows, sizeof *fim_index);
- double *fmj = xnmalloc (n_cols, sizeof *fmj);
- int *fmj_index = xnmalloc (n_cols, sizeof *fmj_index);
- double sum_fim, sum_fmj;
- double rm, cm;
- int rm_index, cm_index;
- int i, j;
-
- /* Find maximum for each row and their sum. */
- for (sum_fim = 0., i = 0; i < n_rows; i++)
- {
- double max = mat[i * n_cols];
- int index = 0;
-
- for (j = 1; j < n_cols; j++)
- if (mat[j + i * n_cols] > max)
- {
- max = mat[j + i * n_cols];
- index = j;
- }
-
- sum_fim += fim[i] = max;
- fim_index[i] = index;
- }
-
- /* Find maximum for each column. */
- for (sum_fmj = 0., j = 0; j < n_cols; j++)
- {
- double max = mat[j];
- int index = 0;
-
- for (i = 1; i < n_rows; i++)
- if (mat[j + i * n_cols] > max)
- {
- max = mat[j + i * n_cols];
- index = i;
- }
-
- sum_fmj += fmj[j] = max;
- fmj_index[j] = index;
- }
-
- /* Find maximum row total. */
- rm = row_tot[0];
- rm_index = 0;
- for (i = 1; i < n_rows; i++)
- if (row_tot[i] > rm)
- {
- rm = row_tot[i];
- rm_index = i;
- }
-
- /* Find maximum column total. */
- cm = col_tot[0];
- cm_index = 0;
- for (j = 1; j < n_cols; j++)
- if (col_tot[j] > cm)
- {
- cm = col_tot[j];
- cm_index = j;
- }
-
- v[0] = (sum_fim + sum_fmj - cm - rm) / (2. * W - rm - cm);
- v[1] = (sum_fmj - rm) / (W - rm);
- v[2] = (sum_fim - cm) / (W - cm);
-
- /* ASE1 for Y given X. */
- {
- double accum;
-
- for (accum = 0., i = 0; i < n_rows; i++)
- for (j = 0; j < n_cols; j++)
- {
- const int deltaj = j == cm_index;
- accum += (mat[j + i * n_cols]
- * pow2 ((j == fim_index[i])
- - deltaj
- + v[0] * deltaj));
- }
-
- ase[2] = sqrt (accum - W * v[0]) / (W - cm);
- }
-
- /* ASE0 for Y given X. */
- {
- double accum;
-
- for (accum = 0., i = 0; i < n_rows; i++)
- if (cm_index != fim_index[i])
- accum += (mat[i * n_cols + fim_index[i]]
- + mat[i * n_cols + cm_index]);
- t[2] = v[2] / (sqrt (accum - pow2 (sum_fim - cm) / W) / (W - cm));
- }
-
- /* ASE1 for X given Y. */
- {
- double accum;
-
- for (accum = 0., i = 0; i < n_rows; i++)
- for (j = 0; j < n_cols; j++)
- {
- const int deltaj = i == rm_index;
- accum += (mat[j + i * n_cols]
- * pow2 ((i == fmj_index[j])
- - deltaj
- + v[0] * deltaj));
- }
-
- ase[1] = sqrt (accum - W * v[0]) / (W - rm);
- }
-
- /* ASE0 for X given Y. */
- {
- double accum;
-
- for (accum = 0., j = 0; j < n_cols; j++)
- if (rm_index != fmj_index[j])
- accum += (mat[j + n_cols * fmj_index[j]]
- + mat[j + n_cols * rm_index]);
- t[1] = v[1] / (sqrt (accum - pow2 (sum_fmj - rm) / W) / (W - rm));
- }
-
- /* Symmetric ASE0 and ASE1. */
- {
- double accum0;
- double accum1;
-
- for (accum0 = accum1 = 0., i = 0; i < n_rows; i++)
- for (j = 0; j < n_cols; j++)
- {
- int temp0 = (fmj_index[j] == i) + (fim_index[i] == j);
- int temp1 = (i == rm_index) + (j == cm_index);
- accum0 += mat[j + i * n_cols] * pow2 (temp0 - temp1);
- accum1 += (mat[j + i * n_cols]
- * pow2 (temp0 + (v[0] - 1.) * temp1));
- }
- ase[0] = sqrt (accum1 - 4. * W * v[0] * v[0]) / (2. * W - rm - cm);
- t[0] = v[0] / (sqrt (accum0 - pow2 ((sum_fim + sum_fmj - cm - rm) / W))
- / (2. * W - rm - cm));
- }
-
- free (fim);
- free (fim_index);
- free (fmj);
- free (fmj_index);
-
- {
- double sum_fij2_ri, sum_fij2_ci;
- double sum_ri2, sum_cj2;
-
- for (sum_fij2_ri = sum_fij2_ci = 0., i = 0; i < n_rows; i++)
- for (j = 0; j < n_cols; j++)
- {
- double temp = pow2 (mat[j + i * n_cols]);
- sum_fij2_ri += temp / row_tot[i];
- sum_fij2_ci += temp / col_tot[j];
- }
-
- for (sum_ri2 = 0., i = 0; i < n_rows; i++)
- sum_ri2 += row_tot[i] * row_tot[i];
-
- for (sum_cj2 = 0., j = 0; j < n_cols; j++)
- sum_cj2 += col_tot[j] * col_tot[j];
-
- v[3] = (W * sum_fij2_ci - sum_ri2) / (W * W - sum_ri2);
- v[4] = (W * sum_fij2_ri - sum_cj2) / (W * W - sum_cj2);
- }
- }
-
- if (cmd.a_statistics[CRS_ST_UC])
- {
- double UX, UY, UXY, P;
- double ase1_yx, ase1_xy, ase1_sym;
- int i, j;
-
- for (UX = 0., i = 0; i < n_rows; i++)
- if (row_tot[i] > 0.)
- UX -= row_tot[i] / W * log (row_tot[i] / W);
-
- for (UY = 0., j = 0; j < n_cols; j++)
- if (col_tot[j] > 0.)
- UY -= col_tot[j] / W * log (col_tot[j] / W);
-
- for (UXY = P = 0., i = 0; i < n_rows; i++)
- for (j = 0; j < n_cols; j++)
- {
- double entry = mat[j + i * n_cols];
-
- if (entry <= 0.)
- continue;
-
- P += entry * pow2 (log (col_tot[j] * row_tot[i] / (W * entry)));
- UXY -= entry / W * log (entry / W);
- }
-
- for (ase1_yx = ase1_xy = ase1_sym = 0., i = 0; i < n_rows; i++)
- for (j = 0; j < n_cols; j++)
- {
- double entry = mat[j + i * n_cols];
-
- if (entry <= 0.)
- continue;
-
- ase1_yx += entry * pow2 (UY * log (entry / row_tot[i])
- + (UX - UXY) * log (col_tot[j] / W));
- ase1_xy += entry * pow2 (UX * log (entry / col_tot[j])
- + (UY - UXY) * log (row_tot[i] / W));
- ase1_sym += entry * pow2 ((UXY
- * log (row_tot[i] * col_tot[j] / (W * W)))
- - (UX + UY) * log (entry / W));
- }
-
- v[5] = 2. * ((UX + UY - UXY) / (UX + UY));
- ase[5] = (2. / (W * pow2 (UX + UY))) * sqrt (ase1_sym);
- t[5] = v[5] / ((2. / (W * (UX + UY)))
- * sqrt (P - pow2 (UX + UY - UXY) / W));
-
- v[6] = (UX + UY - UXY) / UX;
- ase[6] = sqrt (ase1_xy) / (W * UX * UX);
- t[6] = v[6] / (sqrt (P - W * pow2 (UX + UY - UXY)) / (W * UX));
-
- v[7] = (UX + UY - UXY) / UY;
- ase[7] = sqrt (ase1_yx) / (W * UY * UY);
- t[7] = v[7] / (sqrt (P - W * pow2 (UX + UY - UXY)) / (W * UY));
- }
-
- /* Somers' D. */
- if (cmd.a_statistics[CRS_ST_D])
- {
- int i;
-
- if (!sym)
- calc_symmetric (NULL, NULL, NULL);
- for (i = 0; i < 3; i++)
- {
- v[8 + i] = somers_d_v[i];
- ase[8 + i] = somers_d_ase[i];
- t[8 + i] = somers_d_t[i];
- }
- }
-
- /* Eta. */
- if (cmd.a_statistics[CRS_ST_ETA])
- {
- {
- double sum_Xr, sum_X2r;
- double SX, SXW;
- int i, j;
-
- for (sum_Xr = sum_X2r = 0., i = 0; i < n_rows; i++)
- {
- sum_Xr += rows[i].f * row_tot[i];
- sum_X2r += rows[i].f * rows[i].f * row_tot[i];
- }
- SX = sum_X2r - sum_Xr * sum_Xr / W;
-
- for (SXW = 0., j = 0; j < n_cols; j++)
- {
- double cum;
-
- for (cum = 0., i = 0; i < n_rows; i++)
- {
- SXW += rows[i].f * rows[i].f * mat[j + i * n_cols];
- cum += rows[i].f * mat[j + i * n_cols];
- }
-
- SXW -= cum * cum / col_tot[j];
- }
- v[11] = sqrt (1. - SXW / SX);
- }
-
- {
- double sum_Yc, sum_Y2c;
- double SY, SYW;
- int i, j;
-
- for (sum_Yc = sum_Y2c = 0., i = 0; i < n_cols; i++)
- {
- sum_Yc += cols[i].f * col_tot[i];
- sum_Y2c += cols[i].f * cols[i].f * col_tot[i];
- }
- SY = sum_Y2c - sum_Yc * sum_Yc / W;
-
- for (SYW = 0., i = 0; i < n_rows; i++)
- {
- double cum;
-
- for (cum = 0., j = 0; j < n_cols; j++)
- {
- SYW += cols[j].f * cols[j].f * mat[j + i * n_cols];
- cum += cols[j].f * mat[j + i * n_cols];
- }
-
- SYW -= cum * cum / row_tot[i];
- }
- v[12] = sqrt (1. - SYW / SY);
- }
- }
-
- return 1;
-}
-
-/* A wrapper around data_out() that limits string output to short
- string width and null terminates the result. */
-static void
-format_short (char *s, const struct fmt_spec *fp, const union value *v)
-{
- struct fmt_spec fmt_subst;
-
- /* Limit to short string width. */
- if (formats[fp->type].cat & FCAT_STRING)
- {
- fmt_subst = *fp;
-
- assert (fmt_subst.type == FMT_A || fmt_subst.type == FMT_AHEX);
- if (fmt_subst.type == FMT_A)
- fmt_subst.w = min (8, fmt_subst.w);
- else
- fmt_subst.w = min (16, fmt_subst.w);
-
- fp = &fmt_subst;
- }
-
- /* Format. */
- data_out (s, fp, v);
-
- /* Null terminate. */
- s[fp->w] = '\0';
-}
-
-/*
- Local Variables:
- mode: c
- End:
-*/
+++ /dev/null
-#include <config.h>
-#include "ctl-stack.h"
-#include <assert.h>
-#include <stdlib.h>
-#include "error.h"
-#include "xalloc.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-struct ctl_struct
- {
- struct ctl_class *class; /* Class of control structure. */
- struct ctl_struct *down; /* Points toward the bottom of ctl_stack. */
- void *private; /* Private data. */
- };
-
-struct ctl_struct *ctl_stack;
-
-void
-ctl_stack_clear (void)
-{
- while (ctl_stack != NULL)
- {
- struct ctl_struct *top = ctl_stack;
- msg (SE, _("%s without %s."),
- top->class->start_name, top->class->end_name);
- ctl_stack_pop (top->private);
- }
-}
-
-void
-ctl_stack_push (struct ctl_class *class, void *private)
-{
- struct ctl_struct *ctl;
-
- assert (private != NULL);
- ctl = xmalloc (sizeof *ctl);
- ctl->class = class;
- ctl->down = ctl_stack;
- ctl->private = private;
- ctl_stack = ctl;
-}
-
-void *
-ctl_stack_top (struct ctl_class *class)
-{
- struct ctl_struct *top = ctl_stack;
- if (top != NULL && top->class == class)
- return top->private;
- else
- {
- if (ctl_stack_search (class) != NULL)
- msg (SE, _("This command must appear inside %s...%s, "
- "without intermediate %s...%s."),
- class->start_name, class->end_name,
- top->class->start_name, top->class->end_name);
- return NULL;
- }
-}
-
-void *
-ctl_stack_search (struct ctl_class *class)
-{
- struct ctl_struct *ctl;
-
- for (ctl = ctl_stack; ctl != NULL; ctl = ctl->down)
- if (ctl->class == class)
- return ctl->private;
-
- msg (SE, _("This command cannot appear outside %s...%s."),
- class->start_name, class->end_name);
- return NULL;
-}
-
-void
-ctl_stack_pop (void *private UNUSED)
-{
- struct ctl_struct *top = ctl_stack;
-
- assert (top != NULL);
- assert (top->private == private);
-
- top->class->close (top->private);
- ctl_stack = top->down;
- free (top);
-}
-
-bool
-ctl_stack_is_empty (void)
-{
- return ctl_stack == NULL;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef CTL_STACK_H
-#define CTL_STACK_H 1
-
-#include <stdbool.h>
-
-struct ctl_class
- {
- const char *start_name; /* e.g. LOOP. */
- const char *end_name; /* e.g. END LOOP. */
- void (*close) (void *); /* Closes the control structure. */
- };
-
-void ctl_stack_clear (void);
-void ctl_stack_push (struct ctl_class *, void *private);
-void *ctl_stack_top (struct ctl_class *);
-void *ctl_stack_search (struct ctl_class *);
-void ctl_stack_pop (void *);
-bool ctl_stack_is_empty (void);
-
-#endif /* ctl_stack.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "data-in.h"
-#include "error.h"
-#include <math.h>
-#include <ctype.h>
-#include <stdarg.h>
-#include <stddef.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <stdbool.h>
-#include "error.h"
-#include "getl.h"
-#include "calendar.h"
-#include "lexer.h"
-#include "magic.h"
-#include "misc.h"
-#include "settings.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-\f
-/* Specialized error routine. */
-
-static void dls_error (const struct data_in *, const char *format, ...)
- PRINTF_FORMAT (2, 3);
-
-static void
-vdls_error (const struct data_in *i, const char *format, va_list args)
-{
- struct error e;
- struct string title;
-
- if (i->flags & DI_IGNORE_ERROR)
- return;
-
- ds_init (&title, 64);
- if (!getl_reading_script())
- ds_puts (&title, _("data-file error: "));
- if (i->f1 == i->f2)
- ds_printf (&title, _("(column %d"), i->f1);
- else
- ds_printf (&title, _("(columns %d-%d"), i->f1, i->f2);
- ds_printf (&title, _(", field type %s) "), fmt_to_string (&i->format));
-
- e.class = DE;
- err_location (&e.where);
- e.title = ds_c_str (&title);
-
- err_vmsg (&e, format, args);
-
- ds_destroy (&title);
-}
-
-static void
-dls_error (const struct data_in *i, const char *format, ...)
-{
- va_list args;
-
- va_start (args, format);
- vdls_error (i, format, args);
- va_end (args);
-}
-\f
-/* Parsing utility functions. */
-
-/* Excludes leading and trailing whitespace from I by adjusting
- pointers. */
-static void
-trim_whitespace (struct data_in *i)
-{
- while (i->s < i->e && isspace ((unsigned char) i->s[0]))
- i->s++;
-
- while (i->s < i->e && isspace ((unsigned char) i->e[-1]))
- i->e--;
-}
-
-/* Returns nonzero if we're not at the end of the string being
- parsed. */
-static inline bool
-have_char (struct data_in *i)
-{
- return i->s < i->e;
-}
-
-/* If implied decimal places are enabled, apply them to
- I->v->f. */
-static void
-apply_implied_decimals (struct data_in *i)
-{
- if ((i->flags & DI_IMPLIED_DECIMALS) && i->format.d > 0)
- i->v->f /= pow (10., i->format.d);
-}
-\f
-/* Format parsers. */
-
-static bool parse_int (struct data_in *i, long *result);
-
-/* This function is based on strtod() from the GNU C library. */
-static bool
-parse_numeric (struct data_in *i)
-{
- int sign; /* +1 or -1. */
- double num; /* The number so far. */
-
- bool got_dot; /* Found a decimal point. */
- size_t digit_cnt; /* Count of digits. */
-
- int decimal; /* Decimal point character. */
- int grouping; /* Grouping character. */
-
- long int exponent; /* Number's exponent. */
- int type; /* Usually same as i->format.type. */
-
- trim_whitespace (i);
-
- type = i->format.type;
- if (type == FMT_DOLLAR && have_char (i) && *i->s == '$')
- {
- i->s++;
- type = FMT_COMMA;
- }
-
- /* Get the sign. */
- if (have_char (i))
- {
- sign = *i->s == '-' ? -1 : 1;
- if (*i->s == '-' || *i->s == '+')
- i->s++;
- }
- else
- sign = 1;
-
- if (type != FMT_DOT)
- {
- decimal = get_decimal();
- grouping = get_grouping();
- }
- else
- {
- decimal = get_grouping();
- grouping = get_decimal();
- }
-
- i->v->f = SYSMIS;
- num = 0.0;
- got_dot = false;
- digit_cnt = 0;
- exponent = 0;
- for (; have_char (i); i->s++)
- {
- if (isdigit ((unsigned char) *i->s))
- {
- digit_cnt++;
-
- /* Make sure that multiplication by 10 will not overflow. */
- if (num > DBL_MAX * 0.1)
- /* The value of the digit doesn't matter, since we have already
- gotten as many digits as can be represented in a `double'.
- This doesn't necessarily mean the result will overflow.
- The exponent may reduce it to within range.
-
- We just need to record that there was another
- digit so that we can multiply by 10 later. */
- ++exponent;
- else
- num = (num * 10.0) + (*i->s - '0');
-
- /* Keep track of the number of digits after the decimal point.
- If we just divided by 10 here, we would lose precision. */
- if (got_dot)
- --exponent;
- }
- else if (!got_dot && *i->s == decimal)
- /* Record that we have found the decimal point. */
- got_dot = true;
- else if ((type != FMT_COMMA && type != FMT_DOT) || *i->s != grouping)
- /* Any other character terminates the number. */
- break;
- }
-
- if (!digit_cnt)
- {
- if (got_dot)
- {
- i->v->f = SYSMIS;
- return true;
- }
- dls_error (i, _("Field does not form a valid floating-point constant."));
- i->v->f = SYSMIS;
- return false;
- }
-
- if (have_char (i) && strchr ("eEdD-+", *i->s))
- {
- /* Get the exponent specified after the `e' or `E'. */
- long exp;
-
- if (isalpha ((unsigned char) *i->s))
- i->s++;
- if (!parse_int (i, &exp))
- {
- i->v->f = SYSMIS;
- return false;
- }
-
- exponent += exp;
- }
- else if (!got_dot && (i->flags & DI_IMPLIED_DECIMALS))
- exponent -= i->format.d;
-
- if (type == FMT_PCT && have_char (i) && *i->s == '%')
- i->s++;
- if (i->s < i->e)
- {
- dls_error (i, _("Field contents followed by garbage."));
- i->v->f = SYSMIS;
- return false;
- }
-
- if (num == 0.0)
- {
- i->v->f = 0.0;
- return true;
- }
-
- /* Multiply NUM by 10 to the EXPONENT power, checking for overflow
- and underflow. */
- if (exponent < 0)
- {
- if (-exponent + digit_cnt > -(DBL_MIN_10_EXP) + 5
- || num < DBL_MIN * pow (10.0, (double) -exponent))
- {
- dls_error (i, _("Underflow in floating-point constant."));
- i->v->f = 0.0;
- return false;
- }
-
- num *= pow (10.0, (double) exponent);
- }
- else if (exponent > 0)
- {
- if (num > DBL_MAX * pow (10.0, (double) -exponent))
- {
- dls_error (i, _("Overflow in floating-point constant."));
- i->v->f = SYSMIS;
- return false;
- }
-
- num *= pow (10.0, (double) exponent);
- }
-
- i->v->f = sign > 0 ? num : -num;
- return true;
-}
-
-/* Returns the integer value of hex digit C. */
-static inline int
-hexit_value (int c)
-{
- const char s[] = "0123456789abcdef";
- const char *cp = strchr (s, tolower ((unsigned char) c));
-
- assert (cp != NULL);
- return cp - s;
-}
-
-static inline bool
-parse_N (struct data_in *i)
-{
- const char *cp;
-
- i->v->f = 0;
- for (cp = i->s; cp < i->e; cp++)
- {
- if (!isdigit ((unsigned char) *cp))
- {
- dls_error (i, _("All characters in field must be digits."));
- return false;
- }
-
- i->v->f = i->v->f * 10.0 + (*cp - '0');
- }
-
- apply_implied_decimals (i);
- return true;
-}
-
-static inline bool
-parse_PIBHEX (struct data_in *i)
-{
- double n;
- const char *cp;
-
- trim_whitespace (i);
-
- n = 0.0;
- for (cp = i->s; cp < i->e; cp++)
- {
- if (!isxdigit ((unsigned char) *cp))
- {
- dls_error (i, _("Unrecognized character in field."));
- return false;
- }
-
- n = n * 16.0 + hexit_value (*cp);
- }
-
- i->v->f = n;
- return true;
-}
-
-static inline bool
-parse_RBHEX (struct data_in *i)
-{
- /* Validate input. */
- trim_whitespace (i);
- if ((i->e - i->s) % 2)
- {
- dls_error (i, _("Field must have even length."));
- return false;
- }
-
- {
- const char *cp;
-
- for (cp = i->s; cp < i->e; cp++)
- if (!isxdigit ((unsigned char) *cp))
- {
- dls_error (i, _("Field must contain only hex digits."));
- return false;
- }
- }
-
- /* Parse input. */
- {
- union
- {
- double d;
- unsigned char c[sizeof (double)];
- }
- u;
-
- int j;
-
- memset (u.c, 0, sizeof u.c);
- for (j = 0; j < min ((i->e - i->s) / 2, sizeof u.d); j++)
- u.c[j] = 16 * hexit_value (i->s[j * 2]) + hexit_value (i->s[j * 2 + 1]);
-
- i->v->f = u.d;
- }
-
- return true;
-}
-
-static inline bool
-parse_Z (struct data_in *i)
-{
- char buf[64];
- bool got_dot = false;
-
- /* Warn user that we suck. */
- {
- static bool warned;
-
- if (!warned)
- {
- msg (MW,
- _("Quality of zoned decimal (Z) input format code is "
- "suspect. Check your results three times. Report bugs "
- "to %s."),PACKAGE_BUGREPORT);
- warned = true;
- }
- }
-
- /* Validate input. */
- trim_whitespace (i);
-
- if (i->e - i->s < 2)
- {
- dls_error (i, _("Zoned decimal field contains fewer than 2 "
- "characters."));
- return false;
- }
-
- /* Copy sign into buf[0]. */
- if ((i->e[-1] & 0xc0) != 0xc0)
- {
- dls_error (i, _("Bad sign byte in zoned decimal number."));
- return false;
- }
- buf[0] = (i->e[-1] ^ (i->e[-1] >> 1)) & 0x10 ? '-' : '+';
-
- /* Copy digits into buf[1 ... len - 1] and terminate string. */
- {
- const char *sp;
- char *dp;
-
- for (sp = i->s, dp = buf + 1; sp < i->e - 1; sp++, dp++)
- if (*sp == '.')
- {
- *dp = '.';
- got_dot = true;
- }
- else if ((*sp & 0xf0) == 0xf0 && (*sp & 0xf) < 10)
- *dp = (*sp & 0xf) + '0';
- else
- {
- dls_error (i, _("Format error in zoned decimal number."));
- return false;
- }
-
- *dp = '\0';
- }
-
- /* Parse as number. */
- {
- char *tail;
-
- i->v->f = strtod (buf, &tail);
- if (tail != i->e)
- {
- dls_error (i, _("Error in syntax of zoned decimal number."));
- return false;
- }
- }
-
- if (!got_dot)
- apply_implied_decimals (i);
-
- return true;
-}
-
-static inline bool
-parse_IB (struct data_in *i)
-{
-#ifndef WORDS_BIGENDIAN
- char buf[64];
-#endif
- const unsigned char *p;
-
- unsigned char xor;
-
- /* We want the data to be in big-endian format. If this is a
- little-endian machine, reverse the byte order. */
-#ifdef WORDS_BIGENDIAN
- p = (const unsigned char *) i->s;
-#else
- memcpy (buf, i->s, i->e - i->s);
- buf_reverse (buf, i->e - i->s);
- p = (const unsigned char *) buf;
-#endif
-
- /* If the value is negative, we need to logical-NOT each value
- before adding it. */
- if (p[0] & 0x80)
- xor = 0xff;
- else
- xor = 0x00;
-
- {
- int j;
-
- i->v->f = 0.0;
- for (j = 0; j < i->e - i->s; j++)
- i->v->f = i->v->f * 256.0 + (p[j] ^ xor);
- }
-
- /* If the value is negative, add 1 and set the sign, to complete a
- two's-complement negation. */
- if (p[0] & 0x80)
- i->v->f = -(i->v->f + 1.0);
-
- apply_implied_decimals (i);
-
- return true;
-}
-
-static inline bool
-parse_PIB (struct data_in *i)
-{
- int j;
-
- i->v->f = 0.0;
-#if WORDS_BIGENDIAN
- for (j = 0; j < i->e - i->s; j++)
- i->v->f = i->v->f * 256.0 + (unsigned char) i->s[j];
-#else
- for (j = i->e - i->s - 1; j >= 0; j--)
- i->v->f = i->v->f * 256.0 + (unsigned char) i->s[j];
-#endif
-
- apply_implied_decimals (i);
-
- return true;
-}
-
-static inline bool
-parse_P (struct data_in *i)
-{
- const char *cp;
-
- i->v->f = 0.0;
- for (cp = i->s; cp < i->e - 1; cp++)
- {
- i->v->f = i->v->f * 10 + ((*cp >> 4) & 15);
- i->v->f = i->v->f * 10 + (*cp & 15);
- }
- i->v->f = i->v->f * 10 + ((*cp >> 4) & 15);
- if ((*cp ^ (*cp >> 1)) & 0x10)
- i->v->f = -i->v->f;
-
- apply_implied_decimals (i);
-
- return true;
-}
-
-static inline bool
-parse_PK (struct data_in *i)
-{
- const char *cp;
-
- i->v->f = 0.0;
- for (cp = i->s; cp < i->e; cp++)
- {
- i->v->f = i->v->f * 10 + ((*cp >> 4) & 15);
- i->v->f = i->v->f * 10 + (*cp & 15);
- }
-
- apply_implied_decimals (i);
-
- return true;
-}
-
-static inline bool
-parse_RB (struct data_in *i)
-{
- union
- {
- double d;
- unsigned char c[sizeof (double)];
- }
- u;
-
- memset (u.c, 0, sizeof u.c);
- memcpy (u.c, i->s, min (sizeof u.c, (size_t) (i->e - i->s)));
- i->v->f = u.d;
-
- return true;
-}
-
-static inline bool
-parse_A (struct data_in *i)
-{
- buf_copy_rpad (i->v->s, i->format.w, i->s, i->e - i->s);
- return true;
-}
-
-static inline bool
-parse_AHEX (struct data_in *i)
-{
- /* Validate input. */
- trim_whitespace (i);
- if ((i->e - i->s) % 2)
- {
- dls_error (i, _("Field must have even length."));
- return false;
- }
-
- {
- const char *cp;
-
- for (cp = i->s; cp < i->e; cp++)
- if (!isxdigit ((unsigned char) *cp))
- {
- dls_error (i, _("Field must contain only hex digits."));
- return false;
- }
- }
-
- {
- int j;
-
- /* Parse input. */
- for (j = 0; j < min (i->e - i->s, i->format.w); j += 2)
- i->v->s[j / 2] = hexit_value (i->s[j]) * 16 + hexit_value (i->s[j + 1]);
- memset (i->v->s + (i->e - i->s) / 2, ' ', (i->format.w - (i->e - i->s)) / 2);
- }
-
- return true;
-}
-\f
-/* Date & time format components. */
-
-/* Advances *CP past any whitespace characters. */
-static inline void
-skip_whitespace (struct data_in *i)
-{
- while (isspace ((unsigned char) *i->s))
- i->s++;
-}
-
-static inline bool
-parse_leader (struct data_in *i)
-{
- skip_whitespace (i);
- return true;
-}
-
-static inline bool
-force_have_char (struct data_in *i)
-{
- if (have_char (i))
- return true;
-
- dls_error (i, _("Unexpected end of field."));
- return false;
-}
-
-static bool
-parse_int (struct data_in *i, long *result)
-{
- bool negative = false;
-
- if (!force_have_char (i))
- return false;
-
- if (*i->s == '+')
- {
- i->s++;
- force_have_char (i);
- }
- else if (*i->s == '-')
- {
- negative = true;
- i->s++;
- force_have_char (i);
- }
-
- if (!isdigit ((unsigned char) *i->s))
- {
- dls_error (i, _("Digit expected in field."));
- return false;
- }
-
- *result = 0;
- for (;;)
- {
- *result = *result * 10 + (*i->s++ - '0');
- if (!have_char (i) || !isdigit ((unsigned char) *i->s))
- break;
- }
-
- if (negative)
- *result = -*result;
- return true;
-}
-
-static bool
-parse_day (struct data_in *i, long *day)
-{
- if (!parse_int (i, day))
- return false;
- if (*day >= 1 && *day <= 31)
- return true;
-
- dls_error (i, _("Day (%ld) must be between 1 and 31."), *day);
- return false;
-}
-
-static bool
-parse_day_count (struct data_in *i, long *day_count)
-{
- return parse_int (i, day_count);
-}
-
-static bool
-parse_date_delimiter (struct data_in *i)
-{
- bool delim = false;
-
- while (have_char (i)
- && (*i->s == '-' || *i->s == '/' || isspace ((unsigned char) *i->s)
- || *i->s == '.' || *i->s == ','))
- {
- delim = true;
- i->s++;
- }
- if (delim)
- return true;
-
- dls_error (i, _("Delimiter expected between fields in date."));
- return false;
-}
-
-/* Association between a name and a value. */
-struct enum_name
- {
- const char *name; /* Name. */
- bool can_abbreviate; /* True if name may be abbreviated. */
- int value; /* Value associated with name. */
- };
-
-/* Reads a name from I and sets *OUTPUT to the value associated
- with that name. Returns true if successful, false otherwise. */
-static bool
-parse_enum (struct data_in *i, const char *what,
- const struct enum_name *enum_names,
- long *output)
-{
- const char *name;
- size_t length;
- const struct enum_name *ep;
-
- /* Consume alphabetic characters. */
- name = i->s;
- length = 0;
- while (have_char (i) && isalpha ((unsigned char) *i->s))
- {
- length++;
- i->s++;
- }
- if (length == 0)
- {
- dls_error (i, _("Parse error at `%c' expecting %s."), *i->s, what);
- return false;
- }
-
- for (ep = enum_names; ep->name != NULL; ep++)
- if ((ep->can_abbreviate
- && lex_id_match_len (ep->name, strlen (ep->name), name, length))
- || (!ep->can_abbreviate && length == strlen (ep->name)
- && !buf_compare_case (name, ep->name, length)))
- {
- *output = ep->value;
- return true;
- }
-
- dls_error (i, _("Unknown %s `%.*s'."), what, (int) length, name);
- return false;
-}
-
-static bool
-parse_month (struct data_in *i, long *month)
-{
- static const struct enum_name month_names[] =
- {
- {"january", true, 1},
- {"february", true, 2},
- {"march", true, 3},
- {"april", true, 4},
- {"may", true, 5},
- {"june", true, 6},
- {"july", true, 7},
- {"august", true, 8},
- {"september", true, 9},
- {"october", true, 10},
- {"november", true, 11},
- {"december", true, 12},
-
- {"i", false, 1},
- {"ii", false, 2},
- {"iii", false, 3},
- {"iv", false, 4},
- {"iiii", false, 4},
- {"v", false, 5},
- {"vi", false, 6},
- {"vii", false, 7},
- {"viii", false, 8},
- {"ix", false, 9},
- {"viiii", false, 9},
- {"x", false, 10},
- {"xi", false, 11},
- {"xii", false, 12},
-
- {NULL, false, 0},
- };
-
- if (!force_have_char (i))
- return false;
-
- if (isdigit ((unsigned char) *i->s))
- {
- if (!parse_int (i, month))
- return false;
- if (*month >= 1 && *month <= 12)
- return true;
-
- dls_error (i, _("Month (%ld) must be between 1 and 12."), *month);
- return false;
- }
- else
- return parse_enum (i, _("month"), month_names, month);
-}
-
-static bool
-parse_year (struct data_in *i, long *year)
-{
- if (!parse_int (i, year))
- return false;
-
- if (*year >= 0 && *year <= 199)
- *year += 1900;
- if (*year >= 1582 || *year <= 19999)
- return true;
-
- dls_error (i, _("Year (%ld) must be between 1582 and 19999."), *year);
- return false;
-}
-
-static bool
-parse_trailer (struct data_in *i)
-{
- skip_whitespace (i);
- if (!have_char (i))
- return true;
-
- dls_error (i, _("Trailing garbage \"%s\" following date."), i->s);
- return false;
-}
-
-static bool
-parse_julian (struct data_in *i, long *julian)
-{
- if (!parse_int (i, julian))
- return false;
-
- {
- int day = *julian % 1000;
-
- if (day < 1 || day > 366)
- {
- dls_error (i, _("Julian day (%d) must be between 1 and 366."), day);
- return false;
- }
- }
-
- {
- int year = *julian / 1000;
-
- if (year >= 0 && year <= 199)
- *julian += 1900000L;
- else if (year < 1582 || year > 19999)
- {
- dls_error (i, _("Year (%d) must be between 1582 and 19999."), year);
- return false;
- }
- }
-
- return true;
-}
-
-static bool
-parse_quarter (struct data_in *i, long *quarter)
-{
- if (!parse_int (i, quarter))
- return false;
- if (*quarter >= 1 && *quarter <= 4)
- return true;
-
- dls_error (i, _("Quarter (%ld) must be between 1 and 4."), *quarter);
- return false;
-}
-
-static bool
-parse_q_delimiter (struct data_in *i)
-{
- skip_whitespace (i);
- if (!have_char (i) || tolower ((unsigned char) *i->s) != 'q')
- {
- dls_error (i, _("`Q' expected between quarter and year."));
- return false;
- }
- i->s++;
- skip_whitespace (i);
- return true;
-}
-
-static bool
-parse_week (struct data_in *i, long *week)
-{
- if (!parse_int (i, week))
- return false;
- if (*week >= 1 && *week <= 53)
- return true;
-
- dls_error (i, _("Week (%ld) must be between 1 and 53."), *week);
- return false;
-}
-
-static bool
-parse_wk_delimiter (struct data_in *i)
-{
- skip_whitespace (i);
- if (i->s + 1 >= i->e
- || tolower ((unsigned char) i->s[0]) != 'w'
- || tolower ((unsigned char) i->s[1]) != 'k')
- {
- dls_error (i, _("`WK' expected between week and year."));
- return false;
- }
- i->s += 2;
- skip_whitespace (i);
- return true;
-}
-
-static bool
-parse_time_delimiter (struct data_in *i)
-{
- bool delim = false;
-
- while (have_char (i) && (*i->s == ':' || *i->s == '.'
- || isspace ((unsigned char) *i->s)))
- {
- delim = true;
- i->s++;
- }
-
- if (delim)
- return true;
-
- dls_error (i, _("Delimiter expected between fields in time."));
- return false;
-}
-
-static bool
-parse_hour (struct data_in *i, long *hour)
-{
- if (!parse_int (i, hour))
- return false;
- if (*hour >= 0)
- return true;
-
- dls_error (i, _("Hour (%ld) must be positive."), *hour);
- return false;
-}
-
-static bool
-parse_minute (struct data_in *i, long *minute)
-{
- if (!parse_int (i, minute))
- return false;
- if (*minute >= 0 && *minute <= 59)
- return true;
-
- dls_error (i, _("Minute (%ld) must be between 0 and 59."), *minute);
- return false;
-}
-
-static bool
-parse_opt_second (struct data_in *i, double *second)
-{
- bool delim = false;
-
- char buf[64];
- char *cp;
-
- while (have_char (i)
- && (*i->s == ':' || *i->s == '.' || isspace ((unsigned char) *i->s)))
- {
- delim = true;
- i->s++;
- }
-
- if (!delim || !isdigit ((unsigned char) *i->s))
- {
- *second = 0.0;
- return true;
- }
-
- cp = buf;
- while (have_char (i) && isdigit ((unsigned char) *i->s))
- *cp++ = *i->s++;
- if (have_char (i) && *i->s == '.')
- *cp++ = *i->s++;
- while (have_char (i) && isdigit ((unsigned char) *i->s))
- *cp++ = *i->s++;
- *cp = '\0';
-
- *second = strtod (buf, NULL);
-
- return true;
-}
-
-static bool
-parse_hour24 (struct data_in *i, long *hour24)
-{
- if (!parse_int (i, hour24))
- return false;
- if (*hour24 >= 0 && *hour24 <= 23)
- return true;
-
- dls_error (i, _("Hour (%ld) must be between 0 and 23."), *hour24);
- return false;
-}
-
-
-static bool
-parse_weekday (struct data_in *i, long *weekday)
-{
- static const struct enum_name weekday_names[] =
- {
- {"sunday", true, 1},
- {"su", true, 1},
- {"monday", true, 2},
- {"mo", true, 2},
- {"tuesday", true, 3},
- {"tu", true, 3},
- {"wednesday", true, 4},
- {"we", true, 4},
- {"thursday", true, 5},
- {"th", true, 5},
- {"friday", true, 6},
- {"fr", true, 6},
- {"saturday", true, 7},
- {"sa", true, 7},
-
- {NULL, false, 0},
- };
-
- return parse_enum (i, _("weekday"), weekday_names, weekday);
-}
-
-static bool
-parse_spaces (struct data_in *i)
-{
- skip_whitespace (i);
- return true;
-}
-
-static bool
-parse_sign (struct data_in *i, int *sign)
-{
- if (!force_have_char (i))
- return false;
-
- switch (*i->s)
- {
- case '-':
- i->s++;
- *sign = -1;
- break;
-
- case '+':
- i->s++;
- /* fall through */
-
- default:
- *sign = 1;
- break;
- }
-
- return true;
-}
-\f
-/* Date & time formats. */
-
-static void
-calendar_error (void *i_, const char *format, ...)
-{
- struct data_in *i = i_;
- va_list args;
-
- va_start (args, format);
- vdls_error (i, format, args);
- va_end (args);
-}
-
-static bool
-ymd_to_ofs (struct data_in *i, int year, int month, int day, double *ofs)
-{
- *ofs = calendar_gregorian_to_offset (year, month, day, calendar_error, i);
- return *ofs != SYSMIS;
-}
-
-static bool
-ymd_to_date (struct data_in *i, int year, int month, int day, double *date)
-{
- if (ymd_to_ofs (i, year, month, day, date))
- {
- *date *= 60. * 60. * 24.;
- return true;
- }
- else
- return false;
-}
-
-static bool
-parse_DATE (struct data_in *i)
-{
- long day, month, year;
-
- return (parse_leader (i)
- && parse_day (i, &day)
- && parse_date_delimiter (i)
- && parse_month (i, &month)
- && parse_date_delimiter (i)
- && parse_year (i, &year)
- && parse_trailer (i)
- && ymd_to_date (i, year, month, day, &i->v->f));
-}
-
-static bool
-parse_ADATE (struct data_in *i)
-{
- long month, day, year;
-
- return (parse_leader (i)
- && parse_month (i, &month)
- && parse_date_delimiter (i)
- && parse_day (i, &day)
- && parse_date_delimiter (i)
- && parse_year (i, &year)
- && parse_trailer (i)
- && ymd_to_date (i, year, month, day, &i->v->f));
-}
-
-static bool
-parse_EDATE (struct data_in *i)
-{
- long month, day, year;
-
- return (parse_leader (i)
- && parse_day (i, &day)
- && parse_date_delimiter (i)
- && parse_month (i, &month)
- && parse_date_delimiter (i)
- && parse_year (i, &year)
- && parse_trailer (i)
- && ymd_to_date (i, year, month, day, &i->v->f));
-}
-
-static bool
-parse_SDATE (struct data_in *i)
-{
- long month, day, year;
-
- return (parse_leader (i)
- && parse_year (i, &year)
- && parse_date_delimiter (i)
- && parse_month (i, &month)
- && parse_date_delimiter (i)
- && parse_day (i, &day)
- && parse_trailer (i)
- && ymd_to_date (i, year, month, day, &i->v->f));
-}
-
-static bool
-parse_JDATE (struct data_in *i)
-{
- long julian;
- double ofs;
-
- if (!parse_leader (i)
- || !parse_julian (i, &julian)
- || !parse_trailer (i)
- || !ymd_to_ofs (i, julian / 1000, 1, 1, &ofs))
- return false;
-
- i->v->f = (ofs + julian % 1000 - 1) * 60. * 60. * 24.;
- return true;
-}
-
-static bool
-parse_QYR (struct data_in *i)
-{
- long quarter, year;
-
- return (parse_leader (i)
- && parse_quarter (i, &quarter)
- && parse_q_delimiter (i)
- && parse_year (i, &year)
- && parse_trailer (i)
- && ymd_to_date (i, year, (quarter - 1) * 3 + 1, 1, &i->v->f));
-}
-
-static bool
-parse_MOYR (struct data_in *i)
-{
- long month, year;
-
- return (parse_leader (i)
- && parse_month (i, &month)
- && parse_date_delimiter (i)
- && parse_year (i, &year)
- && parse_trailer (i)
- && ymd_to_date (i, year, month, 1, &i->v->f));
-}
-
-static bool
-parse_WKYR (struct data_in *i)
-{
- long week, year;
- double ofs;
-
- if (!parse_leader (i)
- || !parse_week (i, &week)
- || !parse_wk_delimiter (i)
- || !parse_year (i, &year)
- || !parse_trailer (i))
- return false;
-
- if (year != 1582)
- {
- if (!ymd_to_ofs (i, year, 1, 1, &ofs))
- return false;
- }
- else
- {
- if (ymd_to_ofs (i, 1583, 1, 1, &ofs))
- return false;
- ofs -= 365;
- }
-
- i->v->f = (ofs + (week - 1) * 7) * 60. * 60. * 24.;
- return true;
-}
-
-static bool
-parse_TIME (struct data_in *i)
-{
- int sign;
- double second;
- long hour, minute;
-
- if (!parse_leader (i)
- || !parse_sign (i, &sign)
- || !parse_spaces (i)
- || !parse_hour (i, &hour)
- || !parse_time_delimiter (i)
- || !parse_minute (i, &minute)
- || !parse_opt_second (i, &second))
- return false;
-
- i->v->f = (hour * 60. * 60. + minute * 60. + second) * sign;
- return true;
-}
-
-static bool
-parse_DTIME (struct data_in *i)
-{
- int sign;
- long day_count, hour;
- double second;
- long minute;
-
- if (!parse_leader (i)
- || !parse_sign (i, &sign)
- || !parse_spaces (i)
- || !parse_day_count (i, &day_count)
- || !parse_time_delimiter (i)
- || !parse_hour (i, &hour)
- || !parse_time_delimiter (i)
- || !parse_minute (i, &minute)
- || !parse_opt_second (i, &second))
- return false;
-
- i->v->f = (day_count * 60. * 60. * 24.
- + hour * 60. * 60.
- + minute * 60.
- + second) * sign;
- return true;
-}
-
-static bool
-parse_DATETIME (struct data_in *i)
-{
- long day, month, year;
- long hour24;
- double second;
- long minute;
-
- if (!parse_leader (i)
- || !parse_day (i, &day)
- || !parse_date_delimiter (i)
- || !parse_month (i, &month)
- || !parse_date_delimiter (i)
- || !parse_year (i, &year)
- || !parse_time_delimiter (i)
- || !parse_hour24 (i, &hour24)
- || !parse_time_delimiter (i)
- || !parse_minute (i, &minute)
- || !parse_opt_second (i, &second)
- || !ymd_to_date (i, year, month, day, &i->v->f))
- return false;
-
- i->v->f += hour24 * 60. * 60. + minute * 60. + second;
- return true;
-}
-
-static bool
-parse_WKDAY (struct data_in *i)
-{
- long weekday;
-
- if (!parse_leader (i)
- || !parse_weekday (i, &weekday)
- || !parse_trailer (i))
- return false;
-
- i->v->f = weekday;
- return true;
-}
-
-static bool
-parse_MONTH (struct data_in *i)
-{
- long month;
-
- if (!parse_leader (i)
- || !parse_month (i, &month)
- || !parse_trailer (i))
- return false;
-
- i->v->f = month;
- return true;
-}
-\f
-/* Main dispatcher. */
-
-static void
-default_result (struct data_in *i)
-{
- const struct fmt_desc *const fmt = &formats[i->format.type];
-
- /* Default to SYSMIS or blanks. */
- if (fmt->cat & FCAT_STRING)
- memset (i->v->s, ' ', i->format.w);
- else
- i->v->f = get_blanks();
-}
-
-bool
-data_in (struct data_in *i)
-{
- const struct fmt_desc *const fmt = &formats[i->format.type];
-
- assert (check_input_specifier (&i->format, 0));
-
- /* Check that we've got a string to work with. */
- if (i->e == i->s || i->format.w <= 0)
- {
- default_result (i);
- return true;
- }
-
- i->f2 = i->f1 + (i->e - i->s) - 1;
-
- /* Make sure that the string isn't too long. */
- if (i->format.w > fmt->Imax_w)
- {
- dls_error (i, _("Field too long (%d characters). Truncated after "
- "character %d."),
- i->format.w, fmt->Imax_w);
- i->format.w = fmt->Imax_w;
- }
-
- if (fmt->cat & FCAT_BLANKS_SYSMIS)
- {
- const char *cp;
-
- cp = i->s;
- for (;;)
- {
- if (!isspace ((unsigned char) *cp))
- break;
-
- if (++cp == i->e)
- {
- i->v->f = get_blanks();
- return true;
- }
- }
- }
-
- {
- static bool (*const handlers[FMT_NUMBER_OF_FORMATS])(struct data_in *) =
- {
- parse_numeric, parse_N, parse_numeric, parse_numeric,
- parse_numeric, parse_numeric, parse_numeric,
- parse_Z, parse_A, parse_AHEX, parse_IB, parse_P, parse_PIB,
- parse_PIBHEX, parse_PK, parse_RB, parse_RBHEX,
- NULL, NULL, NULL, NULL, NULL,
- parse_DATE, parse_EDATE, parse_SDATE, parse_ADATE, parse_JDATE,
- parse_QYR, parse_MOYR, parse_WKYR,
- parse_DATETIME, parse_TIME, parse_DTIME,
- parse_WKDAY, parse_MONTH,
- };
-
- bool (*handler)(struct data_in *);
- bool success;
-
- handler = handlers[i->format.type];
- assert (handler != NULL);
-
- success = handler (i);
- if (!success)
- default_result (i);
-
- return success;
- }
-}
-\f
-/* Utility function. */
-
-/* Sets DI->{s,e} appropriately given that LINE has length LEN and the
- field starts at one-based column FC and ends at one-based column
- LC, inclusive. */
-void
-data_in_finite_line (struct data_in *di, const char *line, size_t len,
- int fc, int lc)
-{
- di->s = line + ((size_t) fc <= len ? fc - 1 : len);
- di->e = line + ((size_t) lc <= len ? lc : len);
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !data_in_h
-#define data_in_h 1
-
-#include <stddef.h>
-#include <stdbool.h>
-#include "format.h"
-
-/* Flags. */
-enum
- {
- DI_IGNORE_ERROR = 01, /* Don't report errors to the user. */
- DI_IMPLIED_DECIMALS = 02 /* Insert decimals if no '.' in input. */
- };
-
-/* Information about parsing one data field. */
-struct data_in
- {
- const char *s; /* Source start. */
- const char *e; /* Source end. */
-
- union value *v; /* Destination. */
-
- int flags; /* Zero or more of DI_*. */
- int f1, f2; /* Columns the field was taken from. */
- struct fmt_spec format; /* Format specification to use. */
- };
-
-bool data_in (struct data_in *);
-
-void data_in_finite_line (struct data_in *di, const char *line, size_t len,
- int fc, int lc);
-
-#endif /* data-in.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "data-list.h"
-#include "error.h"
-#include <ctype.h>
-#include <float.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "case.h"
-#include "command.h"
-#include "data-in.h"
-#include "debug-print.h"
-#include "dfm-read.h"
-#include "dictionary.h"
-#include "error.h"
-#include "file-handle.h"
-#include "format.h"
-#include "lexer.h"
-#include "misc.h"
-#include "settings.h"
-#include "str.h"
-#include "tab.h"
-#include "var.h"
-#include "vfm.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-\f
-/* Utility function. */
-
-/* FIXME: Either REPEATING DATA must be the last transformation, or we
- must multiplex the transformations that follow (i.e., perform them
- for every case that we produce from a repetition instance).
- Currently we do neither. We should do one or the other. */
-
-/* Describes how to parse one variable. */
-struct dls_var_spec
- {
- struct dls_var_spec *next; /* Next specification in list. */
-
- /* Both free and fixed formats. */
- struct fmt_spec input; /* Input format of this field. */
- struct variable *v; /* Associated variable. Used only in
- parsing. Not safe later. */
- int fv; /* First value in case. */
-
- /* Fixed format only. */
- int rec; /* Record number (1-based). */
- int fc, lc; /* Column numbers in record. */
-
- /* Free format only. */
- char name[LONG_NAME_LEN + 1]; /* Name of variable. */
- };
-
-/* Constants for DATA LIST type. */
-/* Must match table in cmd_data_list(). */
-enum
- {
- DLS_FIXED,
- DLS_FREE,
- DLS_LIST
- };
-
-/* DATA LIST private data structure. */
-struct data_list_pgm
- {
- struct dls_var_spec *first, *last; /* Variable parsing specifications. */
- struct dfm_reader *reader; /* Data file reader. */
-
- int type; /* A DLS_* constant. */
- struct variable *end; /* Variable specified on END subcommand. */
- int eof; /* End of file encountered. */
- int rec_cnt; /* Number of records. */
- size_t case_size; /* Case size in bytes. */
- char *delims; /* Delimiters if any; not null-terminated. */
- size_t delim_cnt; /* Number of delimiter, or 0 for spaces. */
- };
-
-static const struct case_source_class data_list_source_class;
-
-static int parse_fixed (struct data_list_pgm *);
-static int parse_free (struct dls_var_spec **, struct dls_var_spec **);
-static void dump_fixed_table (const struct dls_var_spec *,
- const struct file_handle *, int rec_cnt);
-static void dump_free_table (const struct data_list_pgm *,
- const struct file_handle *);
-static void destroy_dls_var_spec (struct dls_var_spec *);
-static trns_free_func data_list_trns_free;
-static trns_proc_func data_list_trns_proc;
-
-/* Message title for REPEATING DATA. */
-#define RPD_ERR "REPEATING DATA: "
-
-int
-cmd_data_list (void)
-{
- struct data_list_pgm *dls;
- int table = -1; /* Print table if nonzero, -1=undecided. */
- struct file_handle *fh = fh_inline_file ();
-
- if (!case_source_is_complex (vfm_source))
- discard_variables ();
-
- dls = xmalloc (sizeof *dls);
- dls->reader = NULL;
- dls->type = -1;
- dls->end = NULL;
- dls->eof = 0;
- dls->rec_cnt = 0;
- dls->delims = NULL;
- dls->delim_cnt = 0;
- dls->first = dls->last = NULL;
-
- while (token != '/')
- {
- if (lex_match_id ("FILE"))
- {
- lex_match ('=');
- fh = fh_parse (FH_REF_FILE | FH_REF_INLINE);
- if (fh == NULL)
- goto error;
- if (case_source_is_class (vfm_source, &file_type_source_class)
- && fh != fh_get_default_handle ())
- {
- msg (SE, _("DATA LIST must use the same file "
- "as the enclosing FILE TYPE."));
- goto error;
- }
- }
- else if (lex_match_id ("RECORDS"))
- {
- lex_match ('=');
- lex_match ('(');
- if (!lex_force_int ())
- goto error;
- dls->rec_cnt = lex_integer ();
- lex_get ();
- lex_match (')');
- }
- else if (lex_match_id ("END"))
- {
- if (dls->end)
- {
- msg (SE, _("The END subcommand may only be specified once."));
- goto error;
- }
-
- lex_match ('=');
- if (!lex_force_id ())
- goto error;
- dls->end = dict_lookup_var (default_dict, tokid);
- if (!dls->end)
- dls->end = dict_create_var_assert (default_dict, tokid, 0);
- lex_get ();
- }
- else if (token == T_ID)
- {
- if (lex_match_id ("NOTABLE"))
- table = 0;
- else if (lex_match_id ("TABLE"))
- table = 1;
- else
- {
- int type;
- if (lex_match_id ("FIXED"))
- type = DLS_FIXED;
- else if (lex_match_id ("FREE"))
- type = DLS_FREE;
- else if (lex_match_id ("LIST"))
- type = DLS_LIST;
- else
- {
- lex_error (NULL);
- goto error;
- }
-
- if (dls->type != -1)
- {
- msg (SE, _("Only one of FIXED, FREE, or LIST may "
- "be specified."));
- goto error;
- }
- dls->type = type;
-
- if ((dls->type == DLS_FREE || dls->type == DLS_LIST)
- && lex_match ('('))
- {
- while (!lex_match (')'))
- {
- int delim;
-
- if (lex_match_id ("TAB"))
- delim = '\t';
- else if (token == T_STRING && tokstr.length == 1)
- {
- delim = tokstr.string[0];
- lex_get();
- }
- else
- {
- lex_error (NULL);
- goto error;
- }
-
- dls->delims = xrealloc (dls->delims, dls->delim_cnt + 1);
- dls->delims[dls->delim_cnt++] = delim;
-
- lex_match (',');
- }
- }
- }
- }
- else
- {
- lex_error (NULL);
- goto error;
- }
- }
-
- dls->case_size = dict_get_case_size (default_dict);
- fh_set_default_handle (fh);
-
- if (dls->type == -1)
- dls->type = DLS_FIXED;
-
- if (table == -1)
- {
- if (dls->type == DLS_FREE)
- table = 0;
- else
- table = 1;
- }
-
- if (dls->type == DLS_FIXED)
- {
- if (!parse_fixed (dls))
- goto error;
- if (table)
- dump_fixed_table (dls->first, fh, dls->rec_cnt);
- }
- else
- {
- if (!parse_free (&dls->first, &dls->last))
- goto error;
- if (table)
- dump_free_table (dls, fh);
- }
-
- dls->reader = dfm_open_reader (fh);
- if (dls->reader == NULL)
- goto error;
-
- if (vfm_source != NULL)
- add_transformation (data_list_trns_proc, data_list_trns_free, dls);
- else
- vfm_source = create_case_source (&data_list_source_class, dls);
-
- return CMD_SUCCESS;
-
- error:
- data_list_trns_free (dls);
- return CMD_FAILURE;
-}
-
-/* Adds SPEC to the linked list with head at FIRST and tail at
- LAST. */
-static void
-append_var_spec (struct dls_var_spec **first, struct dls_var_spec **last,
- struct dls_var_spec *spec)
-{
- spec->next = NULL;
-
- if (*first == NULL)
- *first = spec;
- else
- (*last)->next = spec;
- *last = spec;
-}
-\f
-/* Fixed-format parsing. */
-
-/* Used for chaining together fortran-like format specifiers. */
-struct fmt_list
- {
- struct fmt_list *next;
- int count;
- struct fmt_spec f;
- struct fmt_list *down;
- };
-
-/* State of parsing DATA LIST. */
-struct fixed_parsing_state
- {
- char **name; /* Variable names. */
- size_t name_cnt; /* Number of names. */
-
- int recno; /* Index of current record. */
- int sc; /* 1-based column number of starting column for
- next field to output. */
- };
-
-static int fixed_parse_compatible (struct fixed_parsing_state *,
- struct dls_var_spec **,
- struct dls_var_spec **);
-static int fixed_parse_fortran (struct fixed_parsing_state *,
- struct dls_var_spec **,
- struct dls_var_spec **);
-
-/* Parses all the variable specifications for DATA LIST FIXED,
- storing them into DLS. Returns nonzero if successful. */
-static int
-parse_fixed (struct data_list_pgm *dls)
-{
- struct fixed_parsing_state fx;
- size_t i;
-
- fx.recno = 0;
- fx.sc = 1;
-
- while (token != '.')
- {
- while (lex_match ('/'))
- {
- fx.recno++;
- if (lex_is_integer ())
- {
- if (lex_integer () < fx.recno)
- {
- msg (SE, _("The record number specified, %ld, is "
- "before the previous record, %d. Data "
- "fields must be listed in order of "
- "increasing record number."),
- lex_integer (), fx.recno - 1);
- return 0;
- }
-
- fx.recno = lex_integer ();
- lex_get ();
- }
- fx.sc = 1;
- }
-
- if (!parse_DATA_LIST_vars (&fx.name, &fx.name_cnt, PV_NONE))
- return 0;
-
- if (lex_is_number ())
- {
- if (!fixed_parse_compatible (&fx, &dls->first, &dls->last))
- goto fail;
- }
- else if (token == '(')
- {
- if (!fixed_parse_fortran (&fx, &dls->first, &dls->last))
- goto fail;
- }
- else
- {
- msg (SE, _("SPSS-like or FORTRAN-like format "
- "specification expected after variable names."));
- goto fail;
- }
-
- for (i = 0; i < fx.name_cnt; i++)
- free (fx.name[i]);
- free (fx.name);
- }
- if (dls->first == NULL)
- {
- msg (SE, _("At least one variable must be specified."));
- return 0;
- }
- if (dls->rec_cnt && dls->last->rec > dls->rec_cnt)
- {
- msg (SE, _("Variables are specified on records that "
- "should not exist according to RECORDS subcommand."));
- return 0;
- }
- else if (!dls->rec_cnt)
- dls->rec_cnt = dls->last->rec;
- return lex_end_of_command () == CMD_SUCCESS;
-
-fail:
- for (i = 0; i < fx.name_cnt; i++)
- free (fx.name[i]);
- free (fx.name);
- return 0;
-}
-
-/* Parses a variable specification in the form 1-10 (A) based on
- FX and adds specifications to the linked list with head at
- FIRST and tail at LAST. */
-static int
-fixed_parse_compatible (struct fixed_parsing_state *fx,
- struct dls_var_spec **first, struct dls_var_spec **last)
-{
- struct fmt_spec input;
- int fc, lc;
- int width;
- int i;
-
- /* First column. */
- if (!lex_force_int ())
- return 0;
- fc = lex_integer ();
- if (fc < 1)
- {
- msg (SE, _("Column positions for fields must be positive."));
- return 0;
- }
- lex_get ();
-
- /* Last column. */
- lex_negative_to_dash ();
- if (lex_match ('-'))
- {
- if (!lex_force_int ())
- return 0;
- lc = lex_integer ();
- if (lc < 1)
- {
- msg (SE, _("Column positions for fields must be positive."));
- return 0;
- }
- else if (lc < fc)
- {
- msg (SE, _("The ending column for a field must be "
- "greater than the starting column."));
- return 0;
- }
-
- lex_get ();
- }
- else
- lc = fc;
-
- /* Divide columns evenly. */
- input.w = (lc - fc + 1) / fx->name_cnt;
- if ((lc - fc + 1) % fx->name_cnt)
- {
- msg (SE, _("The %d columns %d-%d "
- "can't be evenly divided into %d fields."),
- lc - fc + 1, fc, lc, fx->name_cnt);
- return 0;
- }
-
- /* Format specifier. */
- if (lex_match ('('))
- {
- struct fmt_desc *fdp;
-
- if (token == T_ID)
- {
- const char *cp;
-
- input.type = parse_format_specifier_name (&cp, 0);
- if (input.type == -1)
- return 0;
- if (*cp)
- {
- msg (SE, _("A format specifier on this line "
- "has extra characters on the end."));
- return 0;
- }
-
- lex_get ();
- lex_match (',');
- }
- else
- input.type = FMT_F;
-
- if (lex_is_integer ())
- {
- if (lex_integer () < 1)
- {
- msg (SE, _("The value for number of decimal places "
- "must be at least 1."));
- return 0;
- }
-
- input.d = lex_integer ();
- lex_get ();
- }
- else
- input.d = 0;
-
- fdp = &formats[input.type];
- if (fdp->n_args < 2 && input.d)
- {
- msg (SE, _("Input format %s doesn't accept decimal places."),
- fdp->name);
- return 0;
- }
-
- if (input.d > 16)
- input.d = 16;
-
- if (!lex_force_match (')'))
- return 0;
- }
- else
- {
- input.type = FMT_F;
- input.d = 0;
- }
- if (!check_input_specifier (&input, 1))
- return 0;
-
- /* Start column for next specification. */
- fx->sc = lc + 1;
-
- /* Width of variables to create. */
- if (input.type == FMT_A || input.type == FMT_AHEX)
- width = input.w;
- else
- width = 0;
-
- /* Create variables and var specs. */
- for (i = 0; i < fx->name_cnt; i++)
- {
- struct dls_var_spec *spec;
- struct variable *v;
-
- v = dict_create_var (default_dict, fx->name[i], width);
- if (v != NULL)
- {
- convert_fmt_ItoO (&input, &v->print);
- v->write = v->print;
- if (!case_source_is_complex (vfm_source))
- v->init = 0;
- }
- else
- {
- v = dict_lookup_var_assert (default_dict, fx->name[i]);
- if (vfm_source == NULL)
- {
- msg (SE, _("%s is a duplicate variable name."), fx->name[i]);
- return 0;
- }
- if ((width != 0) != (v->width != 0))
- {
- msg (SE, _("There is already a variable %s of a "
- "different type."),
- fx->name[i]);
- return 0;
- }
- if (width != 0 && width != v->width)
- {
- msg (SE, _("There is already a string variable %s of a "
- "different width."), fx->name[i]);
- return 0;
- }
- }
-
- spec = xmalloc (sizeof *spec);
- spec->input = input;
- spec->v = v;
- spec->fv = v->fv;
- spec->rec = fx->recno;
- spec->fc = fc + input.w * i;
- spec->lc = spec->fc + input.w - 1;
- append_var_spec (first, last, spec);
- }
- return 1;
-}
-
-/* Destroy format list F and, if RECURSE is nonzero, all its
- sublists. */
-static void
-destroy_fmt_list (struct fmt_list *f, int recurse)
-{
- struct fmt_list *next;
-
- for (; f; f = next)
- {
- next = f->next;
- if (recurse && f->f.type == FMT_DESCEND)
- destroy_fmt_list (f->down, 1);
- free (f);
- }
-}
-
-/* Takes a hierarchically structured fmt_list F as constructed by
- fixed_parse_fortran(), and flattens it, adding the variable
- specifications to the linked list with head FIRST and tail
- LAST. NAME_IDX is used to take values from the list of names
- in FX; it should initially point to a value of 0. */
-static int
-dump_fmt_list (struct fixed_parsing_state *fx, struct fmt_list *f,
- struct dls_var_spec **first, struct dls_var_spec **last,
- int *name_idx)
-{
- int i;
-
- for (; f; f = f->next)
- if (f->f.type == FMT_X)
- fx->sc += f->count;
- else if (f->f.type == FMT_T)
- fx->sc = f->f.w;
- else if (f->f.type == FMT_NEWREC)
- {
- fx->recno += f->count;
- fx->sc = 1;
- }
- else
- for (i = 0; i < f->count; i++)
- if (f->f.type == FMT_DESCEND)
- {
- if (!dump_fmt_list (fx, f->down, first, last, name_idx))
- return 0;
- }
- else
- {
- struct dls_var_spec *spec;
- int width;
- struct variable *v;
-
- if (formats[f->f.type].cat & FCAT_STRING)
- width = f->f.w;
- else
- width = 0;
- if (*name_idx >= fx->name_cnt)
- {
- msg (SE, _("The number of format "
- "specifications exceeds the given number of "
- "variable names."));
- return 0;
- }
-
- v = dict_create_var (default_dict, fx->name[(*name_idx)++], width);
- if (!v)
- {
- msg (SE, _("%s is a duplicate variable name."), fx->name[i]);
- return 0;
- }
-
- if (!case_source_is_complex (vfm_source))
- v->init = 0;
-
- spec = xmalloc (sizeof *spec);
- spec->v = v;
- spec->input = f->f;
- spec->fv = v->fv;
- spec->rec = fx->recno;
- spec->fc = fx->sc;
- spec->lc = fx->sc + f->f.w - 1;
- append_var_spec (first, last, spec);
-
- convert_fmt_ItoO (&spec->input, &v->print);
- v->write = v->print;
-
- fx->sc += f->f.w;
- }
- return 1;
-}
-
-/* Recursively parses a FORTRAN-like format specification into
- the linked list with head FIRST and tail TAIL. LEVEL is the
- level of recursion, starting from 0. Returns the parsed
- specification if successful, or a null pointer on failure. */
-static struct fmt_list *
-fixed_parse_fortran_internal (struct fixed_parsing_state *fx,
- struct dls_var_spec **first,
- struct dls_var_spec **last)
-{
- struct fmt_list *head = NULL;
- struct fmt_list *tail = NULL;
-
- lex_force_match ('(');
- while (token != ')')
- {
- /* New fmt_list. */
- struct fmt_list *new = xmalloc (sizeof *new);
- new->next = NULL;
-
- /* Append new to list. */
- if (head != NULL)
- tail->next = new;
- else
- head = new;
- tail = new;
-
- /* Parse count. */
- if (lex_is_integer ())
- {
- new->count = lex_integer ();
- lex_get ();
- }
- else
- new->count = 1;
-
- /* Parse format specifier. */
- if (token == '(')
- {
- new->f.type = FMT_DESCEND;
- new->down = fixed_parse_fortran_internal (fx, first, last);
- if (new->down == NULL)
- goto fail;
- }
- else if (lex_match ('/'))
- new->f.type = FMT_NEWREC;
- else if (!parse_format_specifier (&new->f, FMTP_ALLOW_XT)
- || !check_input_specifier (&new->f, 1))
- goto fail;
-
- lex_match (',');
- }
- lex_force_match (')');
-
- return head;
-
-fail:
- destroy_fmt_list (head, 0);
-
- return NULL;
-}
-
-/* Parses a FORTRAN-like format specification into the linked
- list with head FIRST and tail LAST. Returns nonzero if
- successful. */
-static int
-fixed_parse_fortran (struct fixed_parsing_state *fx,
- struct dls_var_spec **first, struct dls_var_spec **last)
-{
- struct fmt_list *list;
- int name_idx;
-
- list = fixed_parse_fortran_internal (fx, first, last);
- if (list == NULL)
- return 0;
-
- name_idx = 0;
- dump_fmt_list (fx, list, first, last, &name_idx);
- destroy_fmt_list (list, 1);
- if (name_idx < fx->name_cnt)
- {
- msg (SE, _("There aren't enough format specifications "
- "to match the number of variable names given."));
- return 0;
- }
-
- return 1;
-}
-
-/* Displays a table giving information on fixed-format variable
- parsing on DATA LIST. */
-/* FIXME: The `Columns' column should be divided into three columns,
- one for the starting column, one for the dash, one for the ending
- column; then right-justify the starting column and left-justify the
- ending column. */
-static void
-dump_fixed_table (const struct dls_var_spec *specs,
- const struct file_handle *fh, int rec_cnt)
-{
- const struct dls_var_spec *spec;
- struct tab_table *t;
- int i;
-
- for (i = 0, spec = specs; spec; spec = spec->next)
- i++;
- t = tab_create (4, i + 1, 0);
- tab_columns (t, TAB_COL_DOWN, 1);
- tab_headers (t, 0, 0, 1, 0);
- tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
- tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
- tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
- tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
- tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, i);
- tab_hline (t, TAL_2, 0, 3, 1);
- tab_dim (t, tab_natural_dimensions);
-
- for (i = 1, spec = specs; spec; spec = spec->next, i++)
- {
- tab_text (t, 0, i, TAB_LEFT, spec->v->name);
- tab_text (t, 1, i, TAT_PRINTF, "%d", spec->rec);
- tab_text (t, 2, i, TAT_PRINTF, "%3d-%3d",
- spec->fc, spec->lc);
- tab_text (t, 3, i, TAB_LEFT | TAT_FIX,
- fmt_to_string (&spec->input));
- }
-
- tab_title (t, 1, ngettext ("Reading %d record from %s.",
- "Reading %d records from %s.", rec_cnt),
- rec_cnt, fh_get_name (fh));
- tab_submit (t);
-}
-\f
-/* Free-format parsing. */
-
-/* Parses variable specifications for DATA LIST FREE and adds
- them to the linked list with head FIRST and tail LAST.
- Returns nonzero only if successful. */
-static int
-parse_free (struct dls_var_spec **first, struct dls_var_spec **last)
-{
- lex_get ();
- while (token != '.')
- {
- struct fmt_spec input, output;
- char **name;
- size_t name_cnt;
- int width;
- size_t i;
-
- if (!parse_DATA_LIST_vars (&name, &name_cnt, PV_NONE))
- return 0;
-
- if (lex_match ('('))
- {
- if (!parse_format_specifier (&input, 0)
- || !check_input_specifier (&input, 1)
- || !lex_force_match (')'))
- {
- for (i = 0; i < name_cnt; i++)
- free (name[i]);
- free (name);
- return 0;
- }
- convert_fmt_ItoO (&input, &output);
- }
- else
- {
- lex_match ('*');
- input = make_input_format (FMT_F, 8, 0);
- output = *get_format ();
- }
-
- if (input.type == FMT_A || input.type == FMT_AHEX)
- width = input.w;
- else
- width = 0;
- for (i = 0; i < name_cnt; i++)
- {
- struct dls_var_spec *spec;
- struct variable *v;
-
- v = dict_create_var (default_dict, name[i], width);
-
- if (!v)
- {
- msg (SE, _("%s is a duplicate variable name."), name[i]);
- return 0;
- }
- v->print = v->write = output;
-
- if (!case_source_is_complex (vfm_source))
- v->init = 0;
-
- spec = xmalloc (sizeof *spec);
- spec->input = input;
- spec->v = v;
- spec->fv = v->fv;
- str_copy_trunc (spec->name, sizeof spec->name, v->name);
- append_var_spec (first, last, spec);
- }
- for (i = 0; i < name_cnt; i++)
- free (name[i]);
- free (name);
- }
-
- return lex_end_of_command () == CMD_SUCCESS;
-}
-
-/* Displays a table giving information on free-format variable parsing
- on DATA LIST. */
-static void
-dump_free_table (const struct data_list_pgm *dls,
- const struct file_handle *fh)
-{
- struct tab_table *t;
- int i;
-
- {
- struct dls_var_spec *spec;
- for (i = 0, spec = dls->first; spec; spec = spec->next)
- i++;
- }
-
- t = tab_create (2, i + 1, 0);
- tab_columns (t, TAB_COL_DOWN, 1);
- tab_headers (t, 0, 0, 1, 0);
- tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
- tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Format"));
- tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 1, i);
- tab_hline (t, TAL_2, 0, 1, 1);
- tab_dim (t, tab_natural_dimensions);
-
- {
- struct dls_var_spec *spec;
-
- for (i = 1, spec = dls->first; spec; spec = spec->next, i++)
- {
- tab_text (t, 0, i, TAB_LEFT, spec->v->name);
- tab_text (t, 1, i, TAB_LEFT | TAT_FIX, fmt_to_string (&spec->input));
- }
- }
-
- tab_title (t, 1, _("Reading free-form data from %s."), fh_get_name (fh));
-
- tab_submit (t);
-}
-\f
-/* Input procedure. */
-
-/* Extracts a field from the current position in the current
- record. Fields can be unquoted or quoted with single- or
- double-quote characters. *FIELD is set to the field content.
- After parsing the field, sets the current position in the
- record to just past the field and any trailing delimiter.
- END_BLANK is used internally; it should be initialized by the
- caller to 0 and left alone afterward. Returns 0 on failure or
- a 1-based column number indicating the beginning of the field
- on success. */
-static int
-cut_field (const struct data_list_pgm *dls, struct fixed_string *field,
- int *end_blank)
-{
- struct fixed_string line;
- char *cp;
- size_t column_start;
-
- if (dfm_eof (dls->reader))
- return 0;
- if (dls->delim_cnt == 0)
- dfm_expand_tabs (dls->reader);
- dfm_get_record (dls->reader, &line);
-
- cp = ls_c_str (&line);
- if (dls->delim_cnt == 0)
- {
- /* Skip leading whitespace. */
- while (cp < ls_end (&line) && isspace ((unsigned char) *cp))
- cp++;
- if (cp >= ls_end (&line))
- return 0;
-
- /* Handle actual data, whether quoted or unquoted. */
- if (*cp == '\'' || *cp == '"')
- {
- int quote = *cp;
-
- field->string = ++cp;
- while (cp < ls_end (&line) && *cp != quote)
- cp++;
- field->length = cp - field->string;
- if (cp < ls_end (&line))
- cp++;
- else
- msg (SW, _("Quoted string missing terminating `%c'."), quote);
- }
- else
- {
- field->string = cp;
- while (cp < ls_end (&line)
- && !isspace ((unsigned char) *cp) && *cp != ',')
- cp++;
- field->length = cp - field->string;
- }
-
- /* Skip trailing whitespace and a single comma if present. */
- while (cp < ls_end (&line) && isspace ((unsigned char) *cp))
- cp++;
- if (cp < ls_end (&line) && *cp == ',')
- cp++;
- }
- else
- {
- if (cp >= ls_end (&line))
- {
- int column = dfm_column_start (dls->reader);
- /* A blank line or a line that ends in \t has a
- trailing blank field. */
- if (column == 1 || (column > 1 && cp[-1] == '\t'))
- {
- if (*end_blank == 0)
- {
- *end_blank = 1;
- field->string = ls_end (&line);
- field->length = 0;
- dfm_forward_record (dls->reader);
- return column;
- }
- else
- {
- *end_blank = 0;
- return 0;
- }
- }
- else
- return 0;
- }
- else
- {
- field->string = cp;
- while (cp < ls_end (&line)
- && memchr (dls->delims, *cp, dls->delim_cnt) == NULL)
- cp++;
- field->length = cp - field->string;
- if (cp < ls_end (&line))
- cp++;
- }
- }
-
- dfm_forward_columns (dls->reader, field->string - line.string);
- column_start = dfm_column_start (dls->reader);
-
- dfm_forward_columns (dls->reader, cp - field->string);
-
- return column_start;
-}
-
-typedef int data_list_read_func (const struct data_list_pgm *, struct ccase *);
-static data_list_read_func read_from_data_list_fixed;
-static data_list_read_func read_from_data_list_free;
-static data_list_read_func read_from_data_list_list;
-
-/* Returns the proper function to read the kind of DATA LIST
- data specified by DLS. */
-static data_list_read_func *
-get_data_list_read_func (const struct data_list_pgm *dls)
-{
- switch (dls->type)
- {
- case DLS_FIXED:
- return read_from_data_list_fixed;
-
- case DLS_FREE:
- return read_from_data_list_free;
-
- case DLS_LIST:
- return read_from_data_list_list;
-
- default:
- assert (0);
- abort ();
- }
-}
-
-/* Reads a case from the data file into C, parsing it according
- to fixed-format syntax rules in DLS. Returns -1 on success,
- -2 at end of file. */
-static int
-read_from_data_list_fixed (const struct data_list_pgm *dls,
- struct ccase *c)
-{
- struct dls_var_spec *var_spec = dls->first;
- int i;
-
- if (dfm_eof (dls->reader))
- return -2;
- for (i = 1; i <= dls->rec_cnt; i++)
- {
- struct fixed_string line;
-
- if (dfm_eof (dls->reader))
- {
- /* Note that this can't occur on the first record. */
- msg (SW, _("Partial case of %d of %d records discarded."),
- i - 1, dls->rec_cnt);
- return -2;
- }
- dfm_expand_tabs (dls->reader);
- dfm_get_record (dls->reader, &line);
-
- for (; var_spec && i == var_spec->rec; var_spec = var_spec->next)
- {
- struct data_in di;
-
- data_in_finite_line (&di, ls_c_str (&line), ls_length (&line),
- var_spec->fc, var_spec->lc);
- di.v = case_data_rw (c, var_spec->fv);
- di.flags = DI_IMPLIED_DECIMALS;
- di.f1 = var_spec->fc;
- di.format = var_spec->input;
-
- data_in (&di);
- }
-
- dfm_forward_record (dls->reader);
- }
-
- return -1;
-}
-
-/* Reads a case from the data file into C, parsing it according
- to free-format syntax rules in DLS. Returns -1 on success,
- -2 at end of file. */
-static int
-read_from_data_list_free (const struct data_list_pgm *dls,
- struct ccase *c)
-{
- struct dls_var_spec *var_spec;
- int end_blank = 0;
-
- for (var_spec = dls->first; var_spec; var_spec = var_spec->next)
- {
- struct fixed_string field;
- int column;
-
- /* Cut out a field and read in a new record if necessary. */
- for (;;)
- {
- column = cut_field (dls, &field, &end_blank);
- if (column != 0)
- break;
-
- if (!dfm_eof (dls->reader))
- dfm_forward_record (dls->reader);
- if (dfm_eof (dls->reader))
- {
- if (var_spec != dls->first)
- msg (SW, _("Partial case discarded. The first variable "
- "missing was %s."), var_spec->name);
- return -2;
- }
- }
-
- {
- struct data_in di;
-
- di.s = ls_c_str (&field);
- di.e = ls_end (&field);
- di.v = case_data_rw (c, var_spec->fv);
- di.flags = 0;
- di.f1 = column;
- di.format = var_spec->input;
- data_in (&di);
- }
- }
- return -1;
-}
-
-/* Reads a case from the data file and parses it according to
- list-format syntax rules. Returns -1 on success, -2 at end of
- file. */
-static int
-read_from_data_list_list (const struct data_list_pgm *dls,
- struct ccase *c)
-{
- struct dls_var_spec *var_spec;
- int end_blank = 0;
-
- if (dfm_eof (dls->reader))
- return -2;
-
- for (var_spec = dls->first; var_spec; var_spec = var_spec->next)
- {
- struct fixed_string field;
- int column;
-
- /* Cut out a field and check for end-of-line. */
- column = cut_field (dls, &field, &end_blank);
- if (column == 0)
- {
- if (get_undefined ())
- msg (SW, _("Missing value(s) for all variables from %s onward. "
- "These will be filled with the system-missing value "
- "or blanks, as appropriate."),
- var_spec->name);
- for (; var_spec; var_spec = var_spec->next)
- {
- int width = get_format_var_width (&var_spec->input);
- if (width == 0)
- case_data_rw (c, var_spec->fv)->f = SYSMIS;
- else
- memset (case_data_rw (c, var_spec->fv)->s, ' ', width);
- }
- break;
- }
-
- {
- struct data_in di;
-
- di.s = ls_c_str (&field);
- di.e = ls_end (&field);
- di.v = case_data_rw (c, var_spec->fv);
- di.flags = 0;
- di.f1 = column;
- di.format = var_spec->input;
- data_in (&di);
- }
- }
-
- dfm_forward_record (dls->reader);
- return -1;
-}
-
-/* Destroys SPEC. */
-static void
-destroy_dls_var_spec (struct dls_var_spec *spec)
-{
- struct dls_var_spec *next;
-
- while (spec != NULL)
- {
- next = spec->next;
- free (spec);
- spec = next;
- }
-}
-
-/* Destroys DATA LIST transformation DLS. */
-static void
-data_list_trns_free (void *dls_)
-{
- struct data_list_pgm *dls = dls_;
- free (dls->delims);
- destroy_dls_var_spec (dls->first);
- dfm_close_reader (dls->reader);
- free (dls);
-}
-
-/* Handle DATA LIST transformation DLS, parsing data into C. */
-static int
-data_list_trns_proc (void *dls_, struct ccase *c, int case_num UNUSED)
-{
- struct data_list_pgm *dls = dls_;
- data_list_read_func *read_func;
- int retval;
-
- dfm_push (dls->reader);
-
- read_func = get_data_list_read_func (dls);
- retval = read_func (dls, c);
-
- /* Handle end of file. */
- if (retval == -2)
- {
- /* If we already encountered end of file then this is an
- error. */
- if (dls->eof == 1)
- {
- msg (SE, _("Attempt to read past end of file."));
- err_failure ();
- dfm_pop (dls->reader);
- return -2;
- }
-
- /* Otherwise simply note it. */
- dls->eof = 1;
- }
- else
- dls->eof = 0;
-
- /* If there was an END subcommand handle it. */
- if (dls->end != NULL)
- {
- if (retval == -2)
- {
- case_data_rw (c, dls->end->fv)->f = 1.0;
- retval = -1;
- }
- else
- case_data_rw (c, dls->end->fv)->f = 0.0;
- }
-
- dfm_pop (dls->reader);
-
- return retval;
-}
-\f
-/* Reads all the records from the data file and passes them to
- write_case(). */
-static void
-data_list_source_read (struct case_source *source,
- struct ccase *c,
- write_case_func *write_case, write_case_data wc_data)
-{
- struct data_list_pgm *dls = source->aux;
- data_list_read_func *read_func = get_data_list_read_func (dls);
-
- dfm_push (dls->reader);
- while (read_func (dls, c) != -2)
- if (!write_case (wc_data))
- break;
- dfm_pop (dls->reader);
-}
-
-/* Destroys the source's internal data. */
-static void
-data_list_source_destroy (struct case_source *source)
-{
- data_list_trns_free (source->aux);
-}
-
-static const struct case_source_class data_list_source_class =
- {
- "DATA LIST",
- NULL,
- data_list_source_read,
- data_list_source_destroy,
- };
-\f
-/* REPEATING DATA. */
-
-/* Represents a number or a variable. */
-struct rpd_num_or_var
- {
- int num; /* Value, or 0. */
- struct variable *var; /* Variable, if number==0. */
- };
-
-/* REPEATING DATA private data structure. */
-struct repeating_data_trns
- {
- struct dls_var_spec *first, *last; /* Variable parsing specifications. */
- struct dfm_reader *reader; /* Input file, never NULL. */
-
- struct rpd_num_or_var starts_beg; /* STARTS=, before the dash. */
- struct rpd_num_or_var starts_end; /* STARTS=, after the dash. */
- struct rpd_num_or_var occurs; /* OCCURS= subcommand. */
- struct rpd_num_or_var length; /* LENGTH= subcommand. */
- struct rpd_num_or_var cont_beg; /* CONTINUED=, before the dash. */
- struct rpd_num_or_var cont_end; /* CONTINUED=, after the dash. */
-
- /* ID subcommand. */
- int id_beg, id_end; /* Beginning & end columns. */
- struct variable *id_var; /* DATA LIST variable. */
- struct fmt_spec id_spec; /* Input format spec. */
- union value *id_value; /* ID value. */
-
- write_case_func *write_case;
- write_case_data wc_data;
- };
-
-static trns_free_func repeating_data_trns_free;
-static int parse_num_or_var (struct rpd_num_or_var *, const char *);
-static int parse_repeating_data (struct dls_var_spec **,
- struct dls_var_spec **);
-static void find_variable_input_spec (struct variable *v,
- struct fmt_spec *spec);
-
-/* Parses the REPEATING DATA command. */
-int
-cmd_repeating_data (void)
-{
- struct repeating_data_trns *rpd;
- int table = 1; /* Print table? */
- bool saw_starts = false; /* Saw STARTS subcommand? */
- bool saw_occurs = false; /* Saw OCCURS subcommand? */
- bool saw_length = false; /* Saw LENGTH subcommand? */
- bool saw_continued = false; /* Saw CONTINUED subcommand? */
- bool saw_id = false; /* Saw ID subcommand? */
- struct file_handle *const fh = fh_get_default_handle ();
-
- assert (case_source_is_complex (vfm_source));
-
- rpd = xmalloc (sizeof *rpd);
- rpd->reader = dfm_open_reader (fh);
- rpd->first = rpd->last = NULL;
- rpd->starts_beg.num = 0;
- rpd->starts_beg.var = NULL;
- rpd->starts_end = rpd->occurs = rpd->length = rpd->cont_beg
- = rpd->cont_end = rpd->starts_beg;
- rpd->id_beg = rpd->id_end = 0;
- rpd->id_var = NULL;
- rpd->id_value = NULL;
-
- lex_match ('/');
-
- for (;;)
- {
- if (lex_match_id ("FILE"))
- {
- struct file_handle *file;
- lex_match ('=');
- file = fh_parse (FH_REF_FILE | FH_REF_INLINE);
- if (file == NULL)
- goto error;
- if (file != fh)
- {
- msg (SE, _("REPEATING DATA must use the same file as its "
- "corresponding DATA LIST or FILE TYPE."));
- goto error;
- }
- }
- else if (lex_match_id ("STARTS"))
- {
- lex_match ('=');
- if (saw_starts)
- {
- msg (SE, _("%s subcommand given multiple times."),"STARTS");
- goto error;
- }
- saw_starts = true;
-
- if (!parse_num_or_var (&rpd->starts_beg, "STARTS beginning column"))
- goto error;
-
- lex_negative_to_dash ();
- if (lex_match ('-'))
- {
- if (!parse_num_or_var (&rpd->starts_end, "STARTS ending column"))
- goto error;
- } else {
- /* Otherwise, rpd->starts_end is uninitialized. We
- will initialize it later from the record length
- of the file. We can't do so now because the
- file handle may not be specified yet. */
- }
-
- if (rpd->starts_beg.num != 0 && rpd->starts_end.num != 0
- && rpd->starts_beg.num > rpd->starts_end.num)
- {
- msg (SE, _("STARTS beginning column (%d) exceeds "
- "STARTS ending column (%d)."),
- rpd->starts_beg.num, rpd->starts_end.num);
- goto error;
- }
- }
- else if (lex_match_id ("OCCURS"))
- {
- lex_match ('=');
- if (saw_occurs)
- {
- msg (SE, _("%s subcommand given multiple times."),"OCCURS");
- goto error;
- }
- saw_occurs = true;
-
- if (!parse_num_or_var (&rpd->occurs, "OCCURS"))
- goto error;
- }
- else if (lex_match_id ("LENGTH"))
- {
- lex_match ('=');
- if (saw_length)
- {
- msg (SE, _("%s subcommand given multiple times."),"LENGTH");
- goto error;
- }
- saw_length = true;
-
- if (!parse_num_or_var (&rpd->length, "LENGTH"))
- goto error;
- }
- else if (lex_match_id ("CONTINUED"))
- {
- lex_match ('=');
- if (saw_continued)
- {
- msg (SE, _("%s subcommand given multiple times."),"CONTINUED");
- goto error;
- }
- saw_continued = true;
-
- if (!lex_match ('/'))
- {
- if (!parse_num_or_var (&rpd->cont_beg,
- "CONTINUED beginning column"))
- goto error;
-
- lex_negative_to_dash ();
- if (lex_match ('-')
- && !parse_num_or_var (&rpd->cont_end,
- "CONTINUED ending column"))
- goto error;
-
- if (rpd->cont_beg.num != 0 && rpd->cont_end.num != 0
- && rpd->cont_beg.num > rpd->cont_end.num)
- {
- msg (SE, _("CONTINUED beginning column (%d) exceeds "
- "CONTINUED ending column (%d)."),
- rpd->cont_beg.num, rpd->cont_end.num);
- goto error;
- }
- }
- else
- rpd->cont_beg.num = 1;
- }
- else if (lex_match_id ("ID"))
- {
- lex_match ('=');
- if (saw_id)
- {
- msg (SE, _("%s subcommand given multiple times."),"ID");
- goto error;
- }
- saw_id = true;
-
- if (!lex_force_int ())
- goto error;
- if (lex_integer () < 1)
- {
- msg (SE, _("ID beginning column (%ld) must be positive."),
- lex_integer ());
- goto error;
- }
- rpd->id_beg = lex_integer ();
-
- lex_get ();
- lex_negative_to_dash ();
-
- if (lex_match ('-'))
- {
- if (!lex_force_int ())
- goto error;
- if (lex_integer () < 1)
- {
- msg (SE, _("ID ending column (%ld) must be positive."),
- lex_integer ());
- goto error;
- }
- if (lex_integer () < rpd->id_end)
- {
- msg (SE, _("ID ending column (%ld) cannot be less than "
- "ID beginning column (%d)."),
- lex_integer (), rpd->id_beg);
- goto error;
- }
-
- rpd->id_end = lex_integer ();
- lex_get ();
- }
- else rpd->id_end = rpd->id_beg;
-
- if (!lex_force_match ('='))
- goto error;
- rpd->id_var = parse_variable ();
- if (rpd->id_var == NULL)
- goto error;
-
- find_variable_input_spec (rpd->id_var, &rpd->id_spec);
- rpd->id_value = xnmalloc (rpd->id_var->nv, sizeof *rpd->id_value);
- }
- else if (lex_match_id ("TABLE"))
- table = 1;
- else if (lex_match_id ("NOTABLE"))
- table = 0;
- else if (lex_match_id ("DATA"))
- break;
- else
- {
- lex_error (NULL);
- goto error;
- }
-
- if (!lex_force_match ('/'))
- goto error;
- }
-
- /* Comes here when DATA specification encountered. */
- if (!saw_starts || !saw_occurs)
- {
- if (!saw_starts)
- msg (SE, _("Missing required specification STARTS."));
- if (!saw_occurs)
- msg (SE, _("Missing required specification OCCURS."));
- goto error;
- }
-
- /* Enforce ID restriction. */
- if (saw_id && !saw_continued)
- {
- msg (SE, _("ID specified without CONTINUED."));
- goto error;
- }
-
- /* Calculate and check starts_end, cont_end if necessary. */
- if (rpd->starts_end.num == 0 && rpd->starts_end.var == NULL)
- {
- rpd->starts_end.num = fh_get_record_width (fh);
- if (rpd->starts_beg.num != 0
- && rpd->starts_beg.num > rpd->starts_end.num)
- {
- msg (SE, _("STARTS beginning column (%d) exceeds "
- "default STARTS ending column taken from file's "
- "record width (%d)."),
- rpd->starts_beg.num, rpd->starts_end.num);
- goto error;
- }
- }
- if (rpd->cont_end.num == 0 && rpd->cont_end.var == NULL)
- {
- rpd->cont_end.num = fh_get_record_width (fh);
- if (rpd->cont_beg.num != 0
- && rpd->cont_beg.num > rpd->cont_end.num)
- {
- msg (SE, _("CONTINUED beginning column (%d) exceeds "
- "default CONTINUED ending column taken from file's "
- "record width (%d)."),
- rpd->cont_beg.num, rpd->cont_end.num);
- goto error;
- }
- }
-
- lex_match ('=');
- if (!parse_repeating_data (&rpd->first, &rpd->last))
- goto error;
-
- /* Calculate length if necessary. */
- if (!saw_length)
- {
- struct dls_var_spec *iter;
-
- for (iter = rpd->first; iter; iter = iter->next)
- if (iter->lc > rpd->length.num)
- rpd->length.num = iter->lc;
- assert (rpd->length.num != 0);
- }
-
- if (table)
- dump_fixed_table (rpd->first, fh, rpd->last->rec);
-
- add_transformation (repeating_data_trns_proc, repeating_data_trns_free, rpd);
-
- return lex_end_of_command ();
-
- error:
- repeating_data_trns_free (rpd);
- return CMD_FAILURE;
-}
-
-/* Finds the input format specification for variable V and puts
- it in SPEC. Because of the way that DATA LIST is structured,
- this is nontrivial. */
-static void
-find_variable_input_spec (struct variable *v, struct fmt_spec *spec)
-{
- size_t i;
-
- for (i = 0; i < n_trns; i++)
- {
- struct transformation *trns = &t_trns[i];
-
- if (trns->proc == data_list_trns_proc)
- {
- struct data_list_pgm *pgm = trns->private;
- struct dls_var_spec *iter;
-
- for (iter = pgm->first; iter; iter = iter->next)
- if (iter->v == v)
- {
- *spec = iter->input;
- return;
- }
- }
- }
-
- assert (0);
-}
-
-/* Parses a number or a variable name from the syntax file and puts
- the results in VALUE. Ensures that the number is at least 1; else
- emits an error based on MESSAGE. Returns nonzero only if
- successful. */
-static int
-parse_num_or_var (struct rpd_num_or_var *value, const char *message)
-{
- if (token == T_ID)
- {
- value->num = 0;
- value->var = parse_variable ();
- if (value->var == NULL)
- return 0;
- if (value->var->type == ALPHA)
- {
- msg (SE, _("String variable not allowed here."));
- return 0;
- }
- }
- else if (lex_is_integer ())
- {
- value->num = lex_integer ();
-
- if (value->num < 1)
- {
- msg (SE, _("%s (%d) must be at least 1."), message, value->num);
- return 0;
- }
-
- lex_get ();
- } else {
- msg (SE, _("Variable or integer expected for %s."), message);
- return 0;
- }
- return 1;
-}
-
-/* Parses data specifications for repeating data groups, adding
- them to the linked list with head FIRST and tail LAST.
- Returns nonzero only if successful. */
-static int
-parse_repeating_data (struct dls_var_spec **first, struct dls_var_spec **last)
-{
- struct fixed_parsing_state fx;
- size_t i;
-
- fx.recno = 0;
- fx.sc = 1;
-
- while (token != '.')
- {
- if (!parse_DATA_LIST_vars (&fx.name, &fx.name_cnt, PV_NONE))
- return 0;
-
- if (lex_is_number ())
- {
- if (!fixed_parse_compatible (&fx, first, last))
- goto fail;
- }
- else if (token == '(')
- {
- if (!fixed_parse_fortran (&fx, first, last))
- goto fail;
- }
- else
- {
- msg (SE, _("SPSS-like or FORTRAN-like format "
- "specification expected after variable names."));
- goto fail;
- }
-
- for (i = 0; i < fx.name_cnt; i++)
- free (fx.name[i]);
- free (fx.name);
- }
-
- return 1;
-
- fail:
- for (i = 0; i < fx.name_cnt; i++)
- free (fx.name[i]);
- free (fx.name);
- return 0;
-}
-
-/* Obtains the real value for rpd_num_or_var N in case C and returns
- it. The valid range is nonnegative numbers, but numbers outside
- this range can be returned and should be handled by the caller as
- invalid. */
-static int
-realize_value (struct rpd_num_or_var *n, struct ccase *c)
-{
- if (n->var != NULL)
- {
- double v = case_num (c, n->var->fv);
- return v != SYSMIS && v >= INT_MIN && v <= INT_MAX ? v : -1;
- }
- else
- return n->num;
-}
-
-/* Parameter record passed to rpd_parse_record(). */
-struct rpd_parse_info
- {
- struct repeating_data_trns *trns; /* REPEATING DATA transformation. */
- const char *line; /* Line being parsed. */
- size_t len; /* Line length. */
- int beg, end; /* First and last column of first occurrence. */
- int ofs; /* Column offset between repeated occurrences. */
- struct ccase *c; /* Case to fill in. */
- int verify_id; /* Zero to initialize ID, nonzero to verify it. */
- int max_occurs; /* Max number of occurrences to parse. */
- };
-
-/* Parses one record of repeated data and outputs corresponding
- cases. Returns number of occurrences parsed up to the
- maximum specified in INFO. */
-static int
-rpd_parse_record (const struct rpd_parse_info *info)
-{
- struct repeating_data_trns *t = info->trns;
- int cur = info->beg;
- int occurrences;
-
- /* Handle record ID values. */
- if (t->id_beg != 0)
- {
- union value id_temp[MAX_ELEMS_PER_VALUE];
-
- /* Parse record ID into V. */
- {
- struct data_in di;
-
- data_in_finite_line (&di, info->line, info->len, t->id_beg, t->id_end);
- di.v = info->verify_id ? id_temp : t->id_value;
- di.flags = 0;
- di.f1 = t->id_beg;
- di.format = t->id_spec;
-
- if (!data_in (&di))
- return 0;
- }
-
- if (info->verify_id
- && compare_values (id_temp, t->id_value, t->id_var->width) != 0)
- {
- char expected_str [MAX_FORMATTED_LEN + 1];
- char actual_str [MAX_FORMATTED_LEN + 1];
-
- data_out (expected_str, &t->id_var->print, t->id_value);
- expected_str[t->id_var->print.w] = '\0';
-
- data_out (actual_str, &t->id_var->print, id_temp);
- actual_str[t->id_var->print.w] = '\0';
-
- tmsg (SE, RPD_ERR,
- _("Encountered mismatched record ID \"%s\" expecting \"%s\"."),
- actual_str, expected_str);
-
- return 0;
- }
- }
-
- /* Iterate over the set of expected occurrences and record each of
- them as a separate case. FIXME: We need to execute any
- transformations that follow the current one. */
- {
- int warned = 0;
-
- for (occurrences = 0; occurrences < info->max_occurs; )
- {
- if (cur + info->ofs > info->end + 1)
- break;
- occurrences++;
-
- {
- struct dls_var_spec *var_spec = t->first;
-
- for (; var_spec; var_spec = var_spec->next)
- {
- int fc = var_spec->fc - 1 + cur;
- int lc = var_spec->lc - 1 + cur;
-
- if (fc > info->len && !warned && var_spec->input.type != FMT_A)
- {
- warned = 1;
-
- tmsg (SW, RPD_ERR,
- _("Variable %s starting in column %d extends "
- "beyond physical record length of %d."),
- var_spec->v->name, fc, info->len);
- }
-
- {
- struct data_in di;
-
- data_in_finite_line (&di, info->line, info->len, fc, lc);
- di.v = case_data_rw (info->c, var_spec->fv);
- di.flags = 0;
- di.f1 = fc + 1;
- di.format = var_spec->input;
-
- if (!data_in (&di))
- return 0;
- }
- }
- }
-
- cur += info->ofs;
-
- if (!t->write_case (t->wc_data))
- return 0;
- }
- }
-
- return occurrences;
-}
-
-/* Reads one set of repetitions of the elements in the REPEATING
- DATA structure. Returns -1 on success, -2 on end of file or
- on failure. */
-int
-repeating_data_trns_proc (void *trns_, struct ccase *c, int case_num UNUSED)
-{
- struct repeating_data_trns *t = trns_;
-
- struct fixed_string line; /* Current record. */
-
- int starts_beg; /* Starting column. */
- int starts_end; /* Ending column. */
- int occurs; /* Number of repetitions. */
- int length; /* Length of each occurrence. */
- int cont_beg; /* Starting column for continuation lines. */
- int cont_end; /* Ending column for continuation lines. */
-
- int occurs_left; /* Number of occurrences remaining. */
-
- int code; /* Return value from rpd_parse_record(). */
-
- int skip_first_record = 0;
-
- dfm_push (t->reader);
-
- /* Read the current record. */
- dfm_reread_record (t->reader, 1);
- dfm_expand_tabs (t->reader);
- if (dfm_eof (t->reader))
- return -2;
- dfm_get_record (t->reader, &line);
- dfm_forward_record (t->reader);
-
- /* Calculate occurs, length. */
- occurs_left = occurs = realize_value (&t->occurs, c);
- if (occurs <= 0)
- {
- tmsg (SE, RPD_ERR, _("Invalid value %d for OCCURS."), occurs);
- return -3;
- }
- starts_beg = realize_value (&t->starts_beg, c);
- if (starts_beg <= 0)
- {
- tmsg (SE, RPD_ERR, _("Beginning column for STARTS (%d) must be "
- "at least 1."),
- starts_beg);
- return -3;
- }
- starts_end = realize_value (&t->starts_end, c);
- if (starts_end < starts_beg)
- {
- tmsg (SE, RPD_ERR, _("Ending column for STARTS (%d) is less than "
- "beginning column (%d)."),
- starts_end, starts_beg);
- skip_first_record = 1;
- }
- length = realize_value (&t->length, c);
- if (length < 0)
- {
- tmsg (SE, RPD_ERR, _("Invalid value %d for LENGTH."), length);
- length = 1;
- occurs = occurs_left = 1;
- }
- cont_beg = realize_value (&t->cont_beg, c);
- if (cont_beg < 0)
- {
- tmsg (SE, RPD_ERR, _("Beginning column for CONTINUED (%d) must be "
- "at least 1."),
- cont_beg);
- return -2;
- }
- cont_end = realize_value (&t->cont_end, c);
- if (cont_end < cont_beg)
- {
- tmsg (SE, RPD_ERR, _("Ending column for CONTINUED (%d) is less than "
- "beginning column (%d)."),
- cont_end, cont_beg);
- return -2;
- }
-
- /* Parse the first record. */
- if (!skip_first_record)
- {
- struct rpd_parse_info info;
- info.trns = t;
- info.line = ls_c_str (&line);
- info.len = ls_length (&line);
- info.beg = starts_beg;
- info.end = starts_end;
- info.ofs = length;
- info.c = c;
- info.verify_id = 0;
- info.max_occurs = occurs_left;
- code = rpd_parse_record (&info);
- if (!code)
- return -2;
- occurs_left -= code;
- }
- else if (cont_beg == 0)
- return -3;
-
- /* Make sure, if some occurrences are left, that we have
- continuation records. */
- if (occurs_left > 0 && cont_beg == 0)
- {
- tmsg (SE, RPD_ERR,
- _("Number of repetitions specified on OCCURS (%d) "
- "exceed number of repetitions available in "
- "space on STARTS (%d), and CONTINUED not specified."),
- occurs, (starts_end - starts_beg + 1) / length);
- return -2;
- }
-
- /* Go on to additional records. */
- while (occurs_left != 0)
- {
- struct rpd_parse_info info;
-
- assert (occurs_left >= 0);
-
- /* Read in another record. */
- if (dfm_eof (t->reader))
- {
- tmsg (SE, RPD_ERR,
- _("Unexpected end of file with %d repetitions "
- "remaining out of %d."),
- occurs_left, occurs);
- return -2;
- }
- dfm_expand_tabs (t->reader);
- dfm_get_record (t->reader, &line);
- dfm_forward_record (t->reader);
-
- /* Parse this record. */
- info.trns = t;
- info.line = ls_c_str (&line);
- info.len = ls_length (&line);
- info.beg = cont_beg;
- info.end = cont_end;
- info.ofs = length;
- info.c = c;
- info.verify_id = 1;
- info.max_occurs = occurs_left;
- code = rpd_parse_record (&info);;
- if (!code)
- return -2;
- occurs_left -= code;
- }
-
- dfm_pop (t->reader);
-
- /* FIXME: This is a kluge until we've implemented multiplexing of
- transformations. */
- return -3;
-}
-
-/* Frees a REPEATING DATA transformation. */
-void
-repeating_data_trns_free (void *rpd_)
-{
- struct repeating_data_trns *rpd = rpd_;
-
- destroy_dls_var_spec (rpd->first);
- dfm_close_reader (rpd->reader);
- free (rpd->id_value);
- free (rpd);
-}
-
-/* Lets repeating_data_trns_proc() know how to write the cases
- that it composes. Not elegant. */
-void
-repeating_data_set_write_case (struct transformation *trns_,
- write_case_func *write_case,
- write_case_data wc_data)
-{
- struct repeating_data_trns *t = trns_->private;
-
- assert (trns_->proc == repeating_data_trns_proc);
- t->write_case = write_case;
- t->wc_data = wc_data;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef INCLUDED_DATA_LIST_H
-#define INCLUDED_DATA_LIST_H
-
-/* FIXME: This header is a kluge and should go away when we come
- up with a less-klugy solution. */
-
-#include "var.h"
-#include "vfm.h"
-
-trns_proc_func repeating_data_trns_proc;
-void repeating_data_set_write_case (struct transformation *,
- write_case_func *, write_case_data);
-
-#endif /* data-list.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <ctype.h>
-#include <math.h>
-#include <float.h>
-#include <stdlib.h>
-#include <time.h>
-#include "calendar.h"
-#include "error.h"
-#include "format.h"
-#include "magic.h"
-#include "misc.h"
-#include "misc.h"
-#include "settings.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-\f
-/* Public functions. */
-
-typedef int numeric_converter (char *, const struct fmt_spec *, double);
-static numeric_converter convert_F, convert_N, convert_E, convert_F_plus;
-static numeric_converter convert_Z, convert_IB, convert_P, convert_PIB;
-static numeric_converter convert_PIBHEX, convert_PK, convert_RB;
-static numeric_converter convert_RBHEX, convert_CCx, convert_date;
-static numeric_converter convert_time, convert_WKDAY, convert_MONTH;
-
-static numeric_converter try_F, convert_infinite;
-
-typedef int string_converter (char *, const struct fmt_spec *, const char *);
-static string_converter convert_A, convert_AHEX;
-
-/* Converts binary value V into printable form in the exactly
- FP->W character in buffer S according to format specification
- FP. No null terminator is appended to the buffer. */
-bool
-data_out (char *s, const struct fmt_spec *fp, const union value *v)
-{
- int cat = formats[fp->type].cat;
- int ok;
-
- assert (check_output_specifier (fp, 0));
- if (!(cat & FCAT_STRING))
- {
- /* Numeric formatting. */
- double number = v->f;
-
- /* Handle SYSMIS turning into blanks. */
- if ((cat & FCAT_BLANKS_SYSMIS) && number == SYSMIS)
- {
- memset (s, ' ', fp->w);
- s[fp->w - fp->d - 1] = '.';
- return true;
- }
-
- /* Handle decimal shift. */
- if ((cat & FCAT_SHIFT_DECIMAL) && number != SYSMIS && fp->d)
- number *= pow (10.0, fp->d);
-
- switch (fp->type)
- {
- case FMT_F:
- ok = convert_F (s, fp, number);
- break;
-
- case FMT_N:
- ok = convert_N (s, fp, number);
- break;
-
- case FMT_E:
- ok = convert_E (s, fp, number);
- break;
-
- case FMT_COMMA: case FMT_DOT: case FMT_DOLLAR: case FMT_PCT:
- ok = convert_F_plus (s, fp, number);
- break;
-
- case FMT_Z:
- ok = convert_Z (s, fp, number);
- break;
-
- case FMT_A:
- assert (0);
- abort ();
-
- case FMT_AHEX:
- assert (0);
- abort ();
-
- case FMT_IB:
- ok = convert_IB (s, fp, number);
- break;
-
- case FMT_P:
- ok = convert_P (s, fp, number);
- break;
-
- case FMT_PIB:
- ok = convert_PIB (s, fp, number);
- break;
-
- case FMT_PIBHEX:
- ok = convert_PIBHEX (s, fp, number);
- break;
-
- case FMT_PK:
- ok = convert_PK (s, fp, number);
- break;
-
- case FMT_RB:
- ok = convert_RB (s, fp, number);
- break;
-
- case FMT_RBHEX:
- ok = convert_RBHEX (s, fp, number);
- break;
-
- case FMT_CCA: case FMT_CCB: case FMT_CCC: case FMT_CCD: case FMT_CCE:
- ok = convert_CCx (s, fp, number);
- break;
-
- case FMT_DATE: case FMT_EDATE: case FMT_SDATE: case FMT_ADATE:
- case FMT_JDATE: case FMT_QYR: case FMT_MOYR: case FMT_WKYR:
- case FMT_DATETIME:
- ok = convert_date (s, fp, number);
- break;
-
- case FMT_TIME: case FMT_DTIME:
- ok = convert_time (s, fp, number);
- break;
-
- case FMT_WKDAY:
- ok = convert_WKDAY (s, fp, number);
- break;
-
- case FMT_MONTH:
- ok = convert_MONTH (s, fp, number);
- break;
-
- default:
- assert (0);
- abort ();
- }
- }
- else
- {
- /* String formatting. */
- const char *string = v->s;
-
- switch (fp->type)
- {
- case FMT_A:
- ok = convert_A (s, fp, string);
- break;
-
- case FMT_AHEX:
- ok = convert_AHEX (s, fp, string);
- break;
-
- default:
- assert (0);
- abort ();
- }
- }
-
- /* Error handling. */
- if (!ok)
- strncpy (s, "ERROR", fp->w);
-
- return ok;
-}
-
-/* Converts V into S in F format with width W and D decimal places,
- then deletes trailing zeros. S is not null-terminated. */
-void
-num_to_string (double v, char *s, int w, int d)
-{
- struct fmt_spec f = make_output_format (FMT_F, w, d);
- convert_F (s, &f, v);
-}
-\f
-/* Main conversion functions. */
-
-static void insert_commas (char *dst, const char *src,
- const struct fmt_spec *fp);
-static int year4 (int year);
-static int try_CCx (char *s, const struct fmt_spec *fp, double v);
-
-#if FLT_RADIX!=2
-#error Write your own floating-point output routines.
-#endif
-
-/* Converts a number between 0 and 15 inclusive to a `hexit'
- [0-9A-F]. */
-#define MAKE_HEXIT(X) ("0123456789ABCDEF"[X])
-
-/* Table of powers of 10. */
-static const double power10[] =
- {
- 0, /* Not used. */
- 1e01, 1e02, 1e03, 1e04, 1e05, 1e06, 1e07, 1e08, 1e09, 1e10,
- 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19, 1e20,
- 1e21, 1e22, 1e23, 1e24, 1e25, 1e26, 1e27, 1e28, 1e29, 1e30,
- 1e31, 1e32, 1e33, 1e34, 1e35, 1e36, 1e37, 1e38, 1e39, 1e40,
- };
-
-/* Handles F format. */
-static int
-convert_F (char *dst, const struct fmt_spec *fp, double number)
-{
- if (!try_F (dst, fp, number))
- convert_E (dst, fp, number);
- return 1;
-}
-
-/* Handles N format. */
-static int
-convert_N (char *dst, const struct fmt_spec *fp, double number)
-{
- double d = floor (number);
-
- if (d < 0 || d == SYSMIS)
- {
- msg (ME, _("The N output format cannot be used to output a "
- "negative number or the system-missing value."));
- return 0;
- }
-
- if (d < power10[fp->w])
- {
- char buf[128];
- sprintf (buf, "%0*.0f", fp->w, number);
- memcpy (dst, buf, fp->w);
- }
- else
- memset (dst, '*', fp->w);
-
- return 1;
-}
-
-/* Handles E format. Also operates as fallback for some other
- formats. */
-static int
-convert_E (char *dst, const struct fmt_spec *fp, double number)
-{
- /* Temporary buffer. */
- char buf[128];
-
- /* Ranged number of decimal places. */
- int d;
-
- if (!finite (number))
- return convert_infinite (dst, fp, number);
-
- /* Check that the format is wide enough.
- Although PSPP generally checks this, convert_E() can be called as
- a fallback from other formats which do not check. */
- if (fp->w < 6)
- {
- memset (dst, '*', fp->w);
- return 1;
- }
-
- /* Put decimal places in usable range. */
- d = min (fp->d, fp->w - 6);
- if (number < 0)
- d--;
- if (d < 0)
- d = 0;
- sprintf (buf, "%*.*E", fp->w, d, number);
-
- /* What we do here is force the exponent part to have four
- characters whenever possible. That is, 1.00E+99 is okay (`E+99')
- but 1.00E+100 (`E+100') must be coerced to 1.00+100 (`+100'). On
- the other hand, 1.00E1000 (`E+100') cannot be canonicalized.
- Note that ANSI C guarantees at least two digits in the
- exponent. */
- if (fabs (number) > 1e99)
- {
- /* Pointer to the `E' in buf. */
- char *cp;
-
- cp = strchr (buf, 'E');
- if (cp)
- {
- /* Exponent better not be bigger than an int. */
- int exp = atoi (cp + 1);
-
- if (abs (exp) > 99 && abs (exp) < 1000)
- {
- /* Shift everything left one place: 1.00e+100 -> 1.00+100. */
- cp[0] = cp[1];
- cp[1] = cp[2];
- cp[2] = cp[3];
- cp[3] = cp[4];
- }
- else if (abs (exp) >= 1000)
- memset (buf, '*', fp->w);
- }
- }
-
- /* The C locale always uses a period `.' as a decimal point.
- Translate to comma if necessary. */
- if ((get_decimal() == ',' && fp->type != FMT_DOT)
- || (get_decimal() == '.' && fp->type == FMT_DOT))
- {
- char *cp = strchr (buf, '.');
- if (cp)
- *cp = ',';
- }
-
- memcpy (dst, buf, fp->w);
- return 1;
-}
-
-/* Handles COMMA, DOT, DOLLAR, and PCT formats. */
-static int
-convert_F_plus (char *dst, const struct fmt_spec *fp, double number)
-{
- char buf[40];
-
- if (try_F (buf, fp, number))
- insert_commas (dst, buf, fp);
- else
- convert_E (dst, fp, number);
-
- return 1;
-}
-
-static int
-convert_Z (char *dst, const struct fmt_spec *fp, double number)
-{
- static int warned = 0;
-
- if (!warned)
- {
- msg (MW,
- _("Quality of zoned decimal (Z) output format code is "
- "suspect. Check your results. Report bugs to %s."),
- PACKAGE_BUGREPORT);
- warned = 1;
- }
-
- if (number == SYSMIS)
- {
- msg (ME, _("The system-missing value cannot be output as a zoned "
- "decimal number."));
- return 0;
- }
-
- {
- char buf[41];
- double d;
- int i;
-
- d = fabs (floor (number));
- if (d >= power10[fp->w])
- {
- msg (ME, _("Number %g too big to fit in field with format Z%d.%d."),
- number, fp->w, fp->d);
- return 0;
- }
-
- sprintf (buf, "%*.0f", fp->w, number);
- for (i = 0; i < fp->w; i++)
- dst[i] = (buf[i] - '0') | 0xf0;
- if (number < 0)
- dst[fp->w - 1] &= 0xdf;
- }
-
- return 1;
-}
-
-static int
-convert_A (char *dst, const struct fmt_spec *fp, const char *string)
-{
- memcpy (dst, string, fp->w);
- return 1;
-}
-
-static int
-convert_AHEX (char *dst, const struct fmt_spec *fp, const char *string)
-{
- int i;
-
- for (i = 0; i < fp->w / 2; i++)
- {
- *dst++ = MAKE_HEXIT ((string[i]) >> 4);
- *dst++ = MAKE_HEXIT ((string[i]) & 0xf);
- }
-
- return 1;
-}
-
-static int
-convert_IB (char *dst, const struct fmt_spec *fp, double number)
-{
- /* Strategy: Basically the same as convert_PIBHEX() but with
- base 256. Then negate the two's-complement result if number
- is negative. */
-
- /* Used for constructing the two's-complement result. */
- unsigned temp[8];
-
- /* Fraction (mantissa). */
- double frac;
-
- /* Exponent. */
- int exp;
-
- /* Difference between exponent and (-8*fp->w-1). */
- int diff;
-
- /* Counter. */
- int i;
-
- /* Make the exponent (-8*fp->w-1). */
- frac = frexp (fabs (number), &exp);
- diff = exp - (-8 * fp->w - 1);
- exp -= diff;
- frac *= ldexp (1.0, diff);
-
- /* Extract each base-256 digit. */
- for (i = 0; i < fp->w; i++)
- {
- modf (frac, &frac);
- frac *= 256.0;
- temp[i] = floor (frac);
- }
-
- /* Perform two's-complement negation if number is negative. */
- if (number < 0)
- {
- /* Perform NOT operation. */
- for (i = 0; i < fp->w; i++)
- temp[i] = ~temp[i];
- /* Add 1 to the whole number. */
- for (i = fp->w - 1; i >= 0; i--)
- {
- temp[i]++;
- if (temp[i])
- break;
- }
- }
- memcpy (dst, temp, fp->w);
-#ifndef WORDS_BIGENDIAN
- buf_reverse (dst, fp->w);
-#endif
-
- return 1;
-}
-
-static int
-convert_P (char *dst, const struct fmt_spec *fp, double number)
-{
- /* Buffer for fp->w*2-1 characters + a decimal point if library is
- not quite compliant + a null. */
- char buf[17];
-
- /* Counter. */
- int i;
-
- /* Main extraction. */
- sprintf (buf, "%0*.0f", fp->w * 2 - 1, floor (fabs (number)));
-
- for (i = 0; i < fp->w; i++)
- ((unsigned char *) dst)[i]
- = ((buf[i * 2] - '0') << 4) + buf[i * 2 + 1] - '0';
-
- /* Set sign. */
- dst[fp->w - 1] &= 0xf0;
- if (number >= 0.0)
- dst[fp->w - 1] |= 0xf;
- else
- dst[fp->w - 1] |= 0xd;
-
- return 1;
-}
-
-static int
-convert_PIB (char *dst, const struct fmt_spec *fp, double number)
-{
- /* Strategy: Basically the same as convert_IB(). */
-
- /* Fraction (mantissa). */
- double frac;
-
- /* Exponent. */
- int exp;
-
- /* Difference between exponent and (-8*fp->w). */
- int diff;
-
- /* Counter. */
- int i;
-
- /* Make the exponent (-8*fp->w). */
- frac = frexp (fabs (number), &exp);
- diff = exp - (-8 * fp->w);
- exp -= diff;
- frac *= ldexp (1.0, diff);
-
- /* Extract each base-256 digit. */
- for (i = 0; i < fp->w; i++)
- {
- modf (frac, &frac);
- frac *= 256.0;
- ((unsigned char *) dst)[i] = floor (frac);
- }
-#ifndef WORDS_BIGENDIAN
- buf_reverse (dst, fp->w);
-#endif
-
- return 1;
-}
-
-static int
-convert_PIBHEX (char *dst, const struct fmt_spec *fp, double number)
-{
- /* Strategy: Use frexp() to create a normalized result (but mostly
- to find the base-2 exponent), then change the base-2 exponent to
- (-4*fp->w) using multiplication and division by powers of two.
- Extract each hexit by multiplying by 16. */
-
- /* Fraction (mantissa). */
- double frac;
-
- /* Exponent. */
- int exp;
-
- /* Difference between exponent and (-4*fp->w). */
- int diff;
-
- /* Counter. */
- int i;
-
- /* Make the exponent (-4*fp->w). */
- frac = frexp (fabs (number), &exp);
- diff = exp - (-4 * fp->w);
- exp -= diff;
- frac *= ldexp (1.0, diff);
-
- /* Extract each hexit. */
- for (i = 0; i < fp->w; i++)
- {
- modf (frac, &frac);
- frac *= 16.0;
- *dst++ = MAKE_HEXIT ((int) floor (frac));
- }
-
- return 1;
-}
-
-static int
-convert_PK (char *dst, const struct fmt_spec *fp, double number)
-{
- /* Buffer for fp->w*2 characters + a decimal point if library is not
- quite compliant + a null. */
- char buf[18];
-
- /* Counter. */
- int i;
-
- /* Main extraction. */
- sprintf (buf, "%0*.0f", fp->w * 2, floor (fabs (number)));
-
- for (i = 0; i < fp->w; i++)
- ((unsigned char *) dst)[i]
- = ((buf[i * 2] - '0') << 4) + buf[i * 2 + 1] - '0';
-
- return 1;
-}
-
-static int
-convert_RB (char *dst, const struct fmt_spec *fp, double number)
-{
- union
- {
- double d;
- char c[8];
- }
- u;
-
- u.d = number;
- memcpy (dst, u.c, fp->w);
-
- return 1;
-}
-
-static int
-convert_RBHEX (char *dst, const struct fmt_spec *fp, double number)
-{
- union
- {
- double d;
- char c[8];
- }
- u;
-
- int i;
-
- u.d = number;
- for (i = 0; i < fp->w / 2; i++)
- {
- *dst++ = MAKE_HEXIT (u.c[i] >> 4);
- *dst++ = MAKE_HEXIT (u.c[i] & 15);
- }
-
- return 1;
-}
-
-static int
-convert_CCx (char *dst, const struct fmt_spec *fp, double number)
-{
- if (try_CCx (dst, fp, number))
- return 1;
- else
- {
- struct fmt_spec f;
-
- f.type = FMT_COMMA;
- f.w = fp->w;
- f.d = fp->d;
-
- return convert_F_plus (dst, &f, number);
- }
-}
-
-static int
-convert_date (char *dst, const struct fmt_spec *fp, double number)
-{
- static const char *months[12] =
- {
- "JAN", "FEB", "MAR", "APR", "MAY", "JUN",
- "JUL", "AUG", "SEP", "OCT", "NOV", "DEC",
- };
-
- char buf[64] = {0};
- int ofs = number / 86400.;
- int month, day, year;
-
- if (ofs < 1)
- return 0;
-
- calendar_offset_to_gregorian (ofs, &year, &month, &day);
- switch (fp->type)
- {
- case FMT_DATE:
- if (fp->w >= 11)
- sprintf (buf, "%02d-%s-%04d", day, months[month - 1], year);
- else
- sprintf (buf, "%02d-%s-%02d", day, months[month - 1], year % 100);
- break;
- case FMT_EDATE:
- if (fp->w >= 10)
- sprintf (buf, "%02d.%02d.%04d", day, month, year);
- else
- sprintf (buf, "%02d.%02d.%02d", day, month, year % 100);
- break;
- case FMT_SDATE:
- if (fp->w >= 10)
- sprintf (buf, "%04d/%02d/%02d", year, month, day);
- else
- sprintf (buf, "%02d/%02d/%02d", year % 100, month, day);
- break;
- case FMT_ADATE:
- if (fp->w >= 10)
- sprintf (buf, "%02d/%02d/%04d", month, day, year);
- else
- sprintf (buf, "%02d/%02d/%02d", month, day, year % 100);
- break;
- case FMT_JDATE:
- {
- int yday = calendar_offset_to_yday (ofs);
-
- if (fp->w < 7)
- sprintf (buf, "%02d%03d", year % 100, yday);
- else if (year4 (year))
- sprintf (buf, "%04d%03d", year, yday);
- else
- break;
- }
- case FMT_QYR:
- if (fp->w >= 8)
- sprintf (buf, "%d Q% 04d", (month - 1) / 3 + 1, year);
- else
- sprintf (buf, "%d Q% 02d", (month - 1) / 3 + 1, year % 100);
- break;
- case FMT_MOYR:
- if (fp->w >= 8)
- sprintf (buf, "%s% 04d", months[month - 1], year);
- else
- sprintf (buf, "%s% 02d", months[month - 1], year % 100);
- break;
- case FMT_WKYR:
- {
- int yday = calendar_offset_to_yday (ofs);
-
- if (fp->w >= 10)
- sprintf (buf, "%02d WK% 04d", (yday - 1) / 7 + 1, year);
- else
- sprintf (buf, "%02d WK% 02d", (yday - 1) / 7 + 1, year % 100);
- }
- break;
- case FMT_DATETIME:
- {
- char *cp;
-
- cp = spprintf (buf, "%02d-%s-%04d %02d:%02d",
- day, months[month - 1], year,
- (int) fmod (floor (number / 60. / 60.), 24.),
- (int) fmod (floor (number / 60.), 60.));
- if (fp->w >= 20)
- {
- int w, d;
-
- if (fp->w >= 22 && fp->d > 0)
- {
- d = min (fp->d, fp->w - 21);
- w = 3 + d;
- }
- else
- {
- w = 2;
- d = 0;
- }
-
- cp = spprintf (cp, ":%0*.*f", w, d, fmod (number, 60.));
- }
- }
- break;
- default:
- assert (0);
- }
-
- if (buf[0] == 0)
- return 0;
- buf_copy_str_rpad (dst, fp->w, buf);
- return 1;
-}
-
-static int
-convert_time (char *dst, const struct fmt_spec *fp, double number)
-{
- char temp_buf[40];
- char *cp;
-
- double time;
- int width;
-
- if (fabs (number) > 1e20)
- {
- msg (ME, _("Time value %g too large in magnitude to convert to "
- "alphanumeric time."), number);
- return 0;
- }
-
- time = number;
- width = fp->w;
- cp = temp_buf;
- if (time < 0)
- *cp++ = '-', time = -time;
- if (fp->type == FMT_DTIME)
- {
- double days = floor (time / 60. / 60. / 24.);
- cp = spprintf (temp_buf, "%02.0f ", days);
- time = time - days * 60. * 60. * 24.;
- width -= 3;
- }
- else
- cp = temp_buf;
-
- cp = spprintf (cp, "%02.0f:%02.0f",
- fmod (floor (time / 60. / 60.), 24.),
- fmod (floor (time / 60.), 60.));
-
- if (width >= 8)
- {
- int w, d;
-
- if (width >= 10 && fp->d >= 0 && fp->d != 0)
- d = min (fp->d, width - 9), w = 3 + d;
- else
- w = 2, d = 0;
-
- cp = spprintf (cp, ":%0*.*f", w, d, fmod (time, 60.));
- }
- buf_copy_str_rpad (dst, fp->w, temp_buf);
-
- return 1;
-}
-
-static int
-convert_WKDAY (char *dst, const struct fmt_spec *fp, double wkday)
-{
- static const char *weekdays[7] =
- {
- "SUNDAY", "MONDAY", "TUESDAY", "WEDNESDAY",
- "THURSDAY", "FRIDAY", "SATURDAY",
- };
-
- if (wkday < 1 || wkday > 7)
- {
- msg (ME, _("Weekday index %f does not lie between 1 and 7."),
- (double) wkday);
- return 0;
- }
- buf_copy_str_rpad (dst, fp->w, weekdays[(int) wkday - 1]);
-
- return 1;
-}
-
-static int
-convert_MONTH (char *dst, const struct fmt_spec *fp, double month)
-{
- static const char *months[12] =
- {
- "JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE",
- "JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER",
- };
-
- if (month < 1 || month > 12)
- {
- msg (ME, _("Month index %f does not lie between 1 and 12."),
- month);
- return 0;
- }
-
- buf_copy_str_rpad (dst, fp->w, months[(int) month - 1]);
-
- return 1;
-}
-\f
-/* Helper functions. */
-
-/* Copies SRC to DST, inserting commas and dollar signs as appropriate
- for format spec *FP. */
-static void
-insert_commas (char *dst, const char *src, const struct fmt_spec *fp)
-{
- /* Number of leading spaces in the number. This is the amount of
- room we have for inserting commas and dollar signs. */
- int n_spaces;
-
- /* Number of digits before the decimal point. This is used to
- determine the Number of commas to insert. */
- int n_digits;
-
- /* Number of commas to insert. */
- int n_commas;
-
- /* Number of items ,%$ to insert. */
- int n_items;
-
- /* Number of n_items items not to use for commas. */
- int n_reserved;
-
- /* Digit iterator. */
- int i;
-
- /* Source pointer. */
- const char *sp;
-
- /* Count spaces and digits. */
- sp = src;
- while (sp < src + fp->w && *sp == ' ')
- sp++;
- n_spaces = sp - src;
- sp = src + n_spaces;
- if (*sp == '-')
- sp++;
- n_digits = 0;
- while (sp + n_digits < src + fp->w && isdigit ((unsigned char) sp[n_digits]))
- n_digits++;
- n_commas = (n_digits - 1) / 3;
- n_items = n_commas + (fp->type == FMT_DOLLAR || fp->type == FMT_PCT);
-
- /* Check whether we have enough space to do insertions. */
- if (!n_spaces || !n_items)
- {
- memcpy (dst, src, fp->w);
- return;
- }
- if (n_items > n_spaces)
- {
- n_items -= n_commas;
- if (!n_items)
- {
- memcpy (dst, src, fp->w);
- return;
- }
- }
-
- /* Put spaces at the beginning if there's extra room. */
- if (n_spaces > n_items)
- {
- memset (dst, ' ', n_spaces - n_items);
- dst += n_spaces - n_items;
- }
-
- /* Insert $ and reserve space for %. */
- n_reserved = 0;
- if (fp->type == FMT_DOLLAR)
- {
- *dst++ = '$';
- n_items--;
- }
- else if (fp->type == FMT_PCT)
- n_reserved = 1;
-
- /* Copy negative sign and digits, inserting commas. */
- if (sp - src > n_spaces)
- *dst++ = '-';
- for (i = n_digits; i; i--)
- {
- if (i % 3 == 0 && n_digits > i && n_items > n_reserved)
- {
- n_items--;
- *dst++ = fp->type == FMT_COMMA ? get_grouping() : get_decimal();
- }
- *dst++ = *sp++;
- }
-
- /* Copy decimal places and insert % if necessary. */
- memcpy (dst, sp, fp->w - (sp - src));
- if (fp->type == FMT_PCT && n_items > 0)
- dst[fp->w - (sp - src)] = '%';
-}
-
-/* Returns 1 if YEAR (i.e., 1987) can be represented in four digits, 0
- otherwise. */
-static int
-year4 (int year)
-{
- if (year >= 1 && year <= 9999)
- return 1;
- msg (ME, _("Year %d cannot be represented in four digits for "
- "output formatting purposes."), year);
- return 0;
-}
-
-static int
-try_CCx (char *dst, const struct fmt_spec *fp, double number)
-{
- const struct custom_currency *cc = get_cc(fp->type - FMT_CCA);
-
- struct fmt_spec f;
-
- char buf[64];
- char buf2[64];
- char *cp;
-
- /* Determine length available, decimal character for number
- proper. */
- f.type = cc->decimal == get_decimal () ? FMT_COMMA : FMT_DOT;
- f.w = fp->w - strlen (cc->prefix) - strlen (cc->suffix);
- if (number < 0)
- f.w -= strlen (cc->neg_prefix) + strlen (cc->neg_suffix) - 1;
- else
- /* Convert -0 to +0. */
- number = fabs (number);
- f.d = fp->d;
-
- if (f.w <= 0)
- return 0;
-
- /* There's room for all that currency crap. Let's do the F
- conversion first. */
- if (!convert_F (buf, &f, number) || *buf == '*')
- return 0;
- insert_commas (buf2, buf, &f);
-
- /* Postprocess back into buf. */
- cp = buf;
- if (number < 0)
- cp = stpcpy (cp, cc->neg_prefix);
- cp = stpcpy (cp, cc->prefix);
- {
- char *bp = buf2;
- while (*bp == ' ')
- bp++;
-
- assert ((number >= 0) ^ (*bp == '-'));
- if (number < 0)
- bp++;
-
- memcpy (cp, bp, f.w - (bp - buf2));
- cp += f.w - (bp - buf2);
- }
- cp = stpcpy (cp, cc->suffix);
- if (number < 0)
- cp = stpcpy (cp, cc->neg_suffix);
-
- /* Copy into dst. */
- assert (cp - buf <= fp->w);
- if (cp - buf < fp->w)
- {
- memcpy (&dst[fp->w - (cp - buf)], buf, cp - buf);
- memset (dst, ' ', fp->w - (cp - buf));
- }
- else
- memcpy (dst, buf, fp->w);
-
- return 1;
-}
-
-static int
-format_and_round (char *dst, double number, const struct fmt_spec *fp,
- int decimals);
-
-/* Tries to format NUMBER into DST as the F format specified in
- *FP. Return true if successful, false on failure. */
-static int
-try_F (char *dst, const struct fmt_spec *fp, double number)
-{
- assert (fp->w <= 40);
- if (finite (number))
- {
- if (fabs (number) < power10[fp->w])
- {
- /* The value may fit in the field. */
- if (fp->d == 0)
- {
- /* There are no decimal places, so there's no way
- that the value can be shortened. Either it fits
- or it doesn't. */
- char buf[41];
- sprintf (buf, "%*.0f", fp->w, number);
- if (strlen (buf) <= fp->w)
- {
- buf_copy_str_lpad (dst, fp->w, buf);
- return true;
- }
- else
- return false;
- }
- else
- {
- /* First try to format it with 2 extra decimal
- places. This gives us a good chance of not
- needing even more decimal places, but it also
- avoids wasting too much time formatting more
- decimal places on the first try. */
- int result = format_and_round (dst, number, fp, fp->d + 2);
- if (result >= 0)
- return result;
-
- /* 2 extra decimal places weren't enough to
- correctly round. Try again with the maximum
- number of places. */
- return format_and_round (dst, number, fp, LDBL_DIG + 1);
- }
- }
- else
- {
- /* The value is too big to fit in the field. */
- return false;
- }
- }
- else
- return convert_infinite (dst, fp, number);
-}
-
-/* Tries to compose NUMBER into DST in format FP by first
- formatting it with DECIMALS decimal places, then rounding off
- to as many decimal places will fit or the number specified in
- FP, whichever is fewer.
-
- Returns 1 if conversion succeeds, 0 if this try at conversion
- failed and so will any other tries (because the integer part
- of the number is too long), or -1 if this try failed but
- another with higher DECIMALS might succeed (because we'd be
- able to properly round). */
-static int
-format_and_round (char *dst, double number, const struct fmt_spec *fp,
- int decimals)
-{
- /* Number of characters before the decimal point,
- which includes digits and possibly a minus sign. */
- int predot_chars;
-
- /* Number of digits in the output fraction,
- which may be smaller than fp->d if there's not enough room. */
- int fraction_digits;
-
- /* Points to last digit that will remain in the fraction after
- rounding. */
- char *final_frac_dig;
-
- /* Round up? */
- bool round_up;
-
- char buf[128];
-
- assert (decimals > fp->d);
- if (decimals > LDBL_DIG)
- decimals = LDBL_DIG + 1;
-
- sprintf (buf, "%.*f", decimals, number);
-
- /* Omit integer part if it's 0. */
- if (!memcmp (buf, "0.", 2))
- memmove (buf, buf + 1, strlen (buf));
- else if (!memcmp (buf, "-0.", 3))
- memmove (buf + 1, buf + 2, strlen (buf + 1));
-
- predot_chars = strcspn (buf, ".");
- if (predot_chars > fp->w)
- {
- /* Can't possibly fit. */
- return 0;
- }
- else if (predot_chars == fp->w)
- {
- /* Exact fit for integer part and sign. */
- memcpy (dst, buf, fp->w);
- return 1;
- }
- else if (predot_chars + 1 == fp->w)
- {
- /* There's room for the decimal point, but not for any
- digits of the fraction.
- Right-justify the integer part and sign. */
- dst[0] = ' ';
- memcpy (dst + 1, buf, fp->w);
- return 1;
- }
-
- /* It looks like we have room for at least one digit of the
- fraction. Figure out how many. */
- fraction_digits = fp->w - predot_chars - 1;
- if (fraction_digits > fp->d)
- fraction_digits = fp->d;
- final_frac_dig = buf + predot_chars + fraction_digits;
-
- /* Decide rounding direction and truncate string. */
- if (final_frac_dig[1] == '5'
- && strspn (final_frac_dig + 2, "0") == strlen (final_frac_dig + 2))
- {
- /* Exactly 1/2. */
- if (decimals <= LDBL_DIG)
- {
- /* Don't have enough fractional digits to know which way to
- round. We can format with more decimal places, so go
- around again. */
- return -1;
- }
- else
- {
- /* We used up all our fractional digits and still don't
- know. Round to even. */
- round_up = (final_frac_dig[0] - '0') % 2 != 0;
- }
- }
- else
- round_up = final_frac_dig[1] >= '5';
- final_frac_dig[1] = '\0';
-
- /* Do rounding. */
- if (round_up)
- {
- char *cp = final_frac_dig;
- for (;;)
- {
- if (*cp >= '0' && *cp <= '8')
- {
- (*cp)++;
- break;
- }
- else if (*cp == '9')
- *cp = '0';
- else
- assert (*cp == '.');
-
- if (cp == buf || *--cp == '-')
- {
- size_t length;
-
- /* Tried to go past the leftmost digit. Insert a 1. */
- memmove (cp + 1, cp, strlen (cp) + 1);
- *cp = '1';
-
- length = strlen (buf);
- if (length > fp->w)
- {
- /* Inserting the `1' overflowed our space.
- Drop a decimal place. */
- buf[--length] = '\0';
-
- /* If that was the last decimal place, drop the
- decimal point too. */
- if (buf[length - 1] == '.')
- buf[length - 1] = '\0';
- }
-
- break;
- }
- }
- }
-
- /* Omit `-' if value output is zero. */
- if (buf[0] == '-' && buf[strspn (buf, "-.0")] == '\0')
- memmove (buf, buf + 1, strlen (buf));
-
- buf_copy_str_lpad (dst, fp->w, buf);
- return 1;
-}
-
-/* Formats non-finite NUMBER into DST according to the width
- given in FP. */
-static int
-convert_infinite (char *dst, const struct fmt_spec *fp, double number)
-{
- assert (!finite (number));
-
- if (fp->w >= 3)
- {
- const char *s;
-
- if (isnan (number))
- s = "NaN";
- else if (isinf (number))
- s = number > 0 ? "+Infinity" : "-Infinity";
- else
- s = "Unknown";
-
- buf_copy_str_lpad (dst, fp->w, s);
- }
- else
- memset (dst, '*', fp->w);
-
- return true;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "command.h"
-#include "error.h"
-#include "lexer.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* Stub for USE command. */
-int
-cmd_use (void)
-{
- if (lex_match (T_ALL))
- return lex_end_of_command ();
-
- msg (SW, _("Only USE ALL is currently implemented."));
- return CMD_FAILURE;
-}
+++ /dev/null
-/* This file can be included multiple times. It redeclares its macros
- appropriately each time, like assert.h. */
-
-#undef debug_printf
-#undef debug_puts
-#undef debug_putc
-
-#if DEBUGGING
-
-#define debug_printf(args) \
- do \
- { \
- printf args; \
- fflush (stdout); \
- } \
- while (0)
-
-#define debug_puts(string) \
- do \
- { \
- puts (string); \
- fflush (stdout); \
- } \
- while (0)
-
-#define debug_putc(char, stream) \
- do \
- { \
- putc (char, stream); \
- fflush (stdout); \
- } \
- while (0)
-
-#else /* !DEBUGGING */
-
-#define debug_printf(args) \
- do \
- { \
- } \
- while (0)
-
-#define debug_puts(string) \
- do \
- { \
- } \
- while (0)
-
-#define debug_putc(char, stream) \
- do \
- { \
- } \
- while (0)
-
-#endif /* !DEBUGGING */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-/* FIXME: Many possible optimizations. */
-
-#include <config.h>
-#include "error.h"
-#include <limits.h>
-#include <math.h>
-#include <stdlib.h>
-#include "algorithm.h"
-#include "alloc.h"
-#include "case.h"
-#include "casefile.h"
-#include "command.h"
-#include "dictionary.h"
-#include "lexer.h"
-#include "error.h"
-#include "magic.h"
-#include "moments.h"
-#include "som.h"
-#include "tab.h"
-#include "var.h"
-#include "vfm.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-#define N_(msgid) msgid
-
-/* DESCRIPTIVES private data. */
-
-struct dsc_proc;
-
-/* Handling of missing values. */
-enum dsc_missing_type
- {
- DSC_VARIABLE, /* Handle missing values on a per-variable basis. */
- DSC_LISTWISE /* Discard entire case if any variable is missing. */
- };
-
-/* Describes properties of a distribution for the purpose of
- calculating a Z-score. */
-struct dsc_z_score
- {
- int src_idx; /* Source index into case data. */
- int dst_idx; /* Destination index into case data. */
- double mean; /* Distribution mean. */
- double std_dev; /* Distribution standard deviation. */
- struct variable *v; /* Variable on which z-score is based. */
- };
-
-/* DESCRIPTIVES transformation (for calculating Z-scores). */
-struct dsc_trns
- {
- struct dsc_z_score *z_scores; /* Array of Z-scores. */
- int z_score_cnt; /* Number of Z-scores. */
- struct variable **vars; /* Variables for listwise missing checks. */
- size_t var_cnt; /* Number of variables. */
- enum dsc_missing_type missing_type; /* Treatment of missing values. */
- int include_user_missing; /* Nonzero to include user-missing values. */
- };
-
-/* Statistics. Used as bit indexes, so must be 32 or fewer. */
-enum dsc_statistic
- {
- DSC_MEAN = 0, DSC_SEMEAN, DSC_STDDEV, DSC_VARIANCE, DSC_KURTOSIS,
- DSC_SEKURT, DSC_SKEWNESS, DSC_SESKEW, DSC_RANGE, DSC_MIN,
- DSC_MAX, DSC_SUM, DSC_N_STATS,
-
- /* Only valid as sort criteria. */
- DSC_NAME = -2, /* Sort by name. */
- DSC_NONE = -1 /* Unsorted. */
- };
-
-/* Describes one statistic. */
-struct dsc_statistic_info
- {
- const char *identifier; /* Identifier. */
- const char *name; /* Full name. */
- enum moment moment; /* Highest moment needed to calculate. */
- };
-
-/* Table of statistics, indexed by DSC_*. */
-static const struct dsc_statistic_info dsc_info[DSC_N_STATS] =
- {
- {"MEAN", N_("Mean"), MOMENT_MEAN},
- {"SEMEAN", N_("S E Mean"), MOMENT_VARIANCE},
- {"STDDEV", N_("Std Dev"), MOMENT_VARIANCE},
- {"VARIANCE", N_("Variance"), MOMENT_VARIANCE},
- {"KURTOSIS", N_("Kurtosis"), MOMENT_KURTOSIS},
- {"SEKURTOSIS", N_("S E Kurt"), MOMENT_NONE},
- {"SKEWNESS", N_("Skewness"), MOMENT_SKEWNESS},
- {"SESKEWNESS", N_("S E Skew"), MOMENT_NONE},
- {"RANGE", N_("Range"), MOMENT_NONE},
- {"MINIMUM", N_("Minimum"), MOMENT_NONE},
- {"MAXIMUM", N_("Maximum"), MOMENT_NONE},
- {"SUM", N_("Sum"), MOMENT_MEAN},
- };
-
-/* Statistics calculated by default if none are explicitly
- requested. */
-#define DEFAULT_STATS \
- ((1ul << DSC_MEAN) | (1ul << DSC_STDDEV) | (1ul << DSC_MIN) \
- | (1ul << DSC_MAX))
-
-/* A variable specified on DESCRIPTIVES. */
-struct dsc_var
- {
- struct variable *v; /* Variable to calculate on. */
- char z_name[LONG_NAME_LEN + 1]; /* Name for z-score variable. */
- double valid, missing; /* Valid, missing counts. */
- struct moments *moments; /* Moments. */
- double min, max; /* Maximum and mimimum values. */
- double stats[DSC_N_STATS]; /* All the stats' values. */
- };
-
-/* Output format. */
-enum dsc_format
- {
- DSC_LINE, /* Abbreviated format. */
- DSC_SERIAL /* Long format. */
- };
-
-/* A DESCRIPTIVES procedure. */
-struct dsc_proc
- {
- /* Per-variable info. */
- struct dsc_var *vars; /* Variables. */
- size_t var_cnt; /* Number of variables. */
-
- /* User options. */
- enum dsc_missing_type missing_type; /* Treatment of missing values. */
- int include_user_missing; /* Nonzero to include user-missing values. */
- int show_var_labels; /* Nonzero to show variable labels. */
- int show_index; /* Nonzero to show variable index. */
- enum dsc_format format; /* Output format. */
-
- /* Accumulated results. */
- double missing_listwise; /* Sum of weights of cases missing listwise. */
- double valid; /* Sum of weights of valid cases. */
- int bad_warn; /* Warn if bad weight found. */
- enum dsc_statistic sort_by_stat; /* Statistic to sort by; -1: name. */
- int sort_ascending; /* !0: ascending order; 0: descending. */
- unsigned long show_stats; /* Statistics to display. */
- unsigned long calc_stats; /* Statistics to calculate. */
- enum moment max_moment; /* Highest moment needed for stats. */
- };
-
-/* Parsing. */
-static enum dsc_statistic match_statistic (void);
-static void free_dsc_proc (struct dsc_proc *);
-
-/* Z-score functions. */
-static int try_name (struct dsc_proc *dsc, char *name);
-static int generate_z_varname (struct dsc_proc *dsc, char *z_name,
- const char *name, size_t *z_cnt);
-static void dump_z_table (struct dsc_proc *);
-static void setup_z_trns (struct dsc_proc *);
-
-/* Procedure execution functions. */
-static void calc_descriptives (const struct casefile *, void *dsc_);
-static void display (struct dsc_proc *dsc);
-\f
-/* Parser and outline. */
-
-/* Handles DESCRIPTIVES. */
-int
-cmd_descriptives (void)
-{
- struct dsc_proc *dsc;
- struct variable **vars = NULL;
- size_t var_cnt = 0;
- int save_z_scores = 0;
- size_t z_cnt = 0;
- size_t i;
-
- /* Create and initialize dsc. */
- dsc = xmalloc (sizeof *dsc);
- dsc->vars = NULL;
- dsc->var_cnt = 0;
- dsc->missing_type = DSC_VARIABLE;
- dsc->include_user_missing = 0;
- dsc->show_var_labels = 1;
- dsc->show_index = 0;
- dsc->format = DSC_LINE;
- dsc->missing_listwise = 0.;
- dsc->valid = 0.;
- dsc->bad_warn = 1;
- dsc->sort_by_stat = DSC_NONE;
- dsc->sort_ascending = 1;
- dsc->show_stats = dsc->calc_stats = DEFAULT_STATS;
-
- /* Parse DESCRIPTIVES. */
- while (token != '.')
- {
- if (lex_match_id ("MISSING"))
- {
- lex_match ('=');
- while (token != '.' && token != '/')
- {
- if (lex_match_id ("VARIABLE"))
- dsc->missing_type = DSC_VARIABLE;
- else if (lex_match_id ("LISTWISE"))
- dsc->missing_type = DSC_LISTWISE;
- else if (lex_match_id ("INCLUDE"))
- dsc->include_user_missing = 1;
- else
- {
- lex_error (NULL);
- goto error;
- }
- lex_match (',');
- }
- }
- else if (lex_match_id ("SAVE"))
- save_z_scores = 1;
- else if (lex_match_id ("FORMAT"))
- {
- lex_match ('=');
- while (token != '.' && token != '/')
- {
- if (lex_match_id ("LABELS"))
- dsc->show_var_labels = 1;
- else if (lex_match_id ("NOLABELS"))
- dsc->show_var_labels = 0;
- else if (lex_match_id ("INDEX"))
- dsc->show_index = 1;
- else if (lex_match_id ("NOINDEX"))
- dsc->show_index = 0;
- else if (lex_match_id ("LINE"))
- dsc->format = DSC_LINE;
- else if (lex_match_id ("SERIAL"))
- dsc->format = DSC_SERIAL;
- else
- {
- lex_error (NULL);
- goto error;
- }
- lex_match (',');
- }
- }
- else if (lex_match_id ("STATISTICS"))
- {
- lex_match ('=');
- dsc->show_stats = 0;
- while (token != '.' && token != '/')
- {
- if (lex_match (T_ALL))
- dsc->show_stats |= (1ul << DSC_N_STATS) - 1;
- else if (lex_match_id ("DEFAULT"))
- dsc->show_stats |= DEFAULT_STATS;
- else
- dsc->show_stats |= 1ul << (match_statistic ());
- lex_match (',');
- }
- if (dsc->show_stats == 0)
- dsc->show_stats = DEFAULT_STATS;
- }
- else if (lex_match_id ("SORT"))
- {
- lex_match ('=');
- if (lex_match_id ("NAME"))
- dsc->sort_by_stat = DSC_NAME;
- else
- {
- dsc->sort_by_stat = match_statistic ();
- if (dsc->sort_by_stat == DSC_NONE )
- dsc->sort_by_stat = DSC_MEAN;
- }
- if (lex_match ('('))
- {
- if (lex_match_id ("A"))
- dsc->sort_ascending = 1;
- else if (lex_match_id ("D"))
- dsc->sort_ascending = 0;
- else
- lex_error (NULL);
- lex_force_match (')');
- }
- }
- else if (var_cnt == 0)
- {
- if (lex_look_ahead () == '=')
- {
- lex_match_id ("VARIABLES");
- lex_match ('=');
- }
-
- while (token != '.' && token != '/')
- {
- int i;
-
- if (!parse_variables (default_dict, &vars, &var_cnt,
- PV_APPEND | PV_NO_DUPLICATE | PV_NUMERIC))
- goto error;
-
- dsc->vars = xnrealloc (dsc->vars, var_cnt, sizeof *dsc->vars);
- for (i = dsc->var_cnt; i < var_cnt; i++)
- {
- struct dsc_var *dv = &dsc->vars[i];
- dv->v = vars[i];
- dv->z_name[0] = '\0';
- dv->moments = NULL;
- }
- dsc->var_cnt = var_cnt;
-
- if (lex_match ('('))
- {
- if (token != T_ID)
- {
- lex_error (NULL);
- goto error;
- }
- if (try_name (dsc, tokid))
- {
- strcpy (dsc->vars[dsc->var_cnt - 1].z_name, tokid);
- z_cnt++;
- }
- else
- msg (SE, _("Z-score variable name %s would be"
- " a duplicate variable name."), tokid);
- lex_get ();
- if (!lex_force_match (')'))
- goto error;
- }
- }
- }
- else
- {
- lex_error (NULL);
- goto error;
- }
-
- lex_match ('/');
- }
- if (var_cnt == 0)
- {
- msg (SE, _("No variables specified."));
- goto error;
- }
-
- /* Construct z-score varnames, show translation table. */
- if (z_cnt || save_z_scores)
- {
- if (save_z_scores)
- {
- size_t gen_cnt = 0;
-
- for (i = 0; i < dsc->var_cnt; i++)
- if (dsc->vars[i].z_name[0] == 0)
- {
- if (!generate_z_varname (dsc, dsc->vars[i].z_name,
- dsc->vars[i].v->name, &gen_cnt))
- goto error;
- z_cnt++;
- }
- }
- dump_z_table (dsc);
- }
-
- /* Figure out statistics to display. */
- if (dsc->show_stats & (1ul << DSC_SKEWNESS))
- dsc->show_stats |= 1ul << DSC_SESKEW;
- if (dsc->show_stats & (1ul << DSC_KURTOSIS))
- dsc->show_stats |= 1ul << DSC_SEKURT;
-
- /* Figure out which statistics to calculate. */
- dsc->calc_stats = dsc->show_stats;
- if (z_cnt > 0)
- dsc->calc_stats |= (1ul << DSC_MEAN) | (1ul << DSC_STDDEV);
- if (dsc->sort_by_stat >= 0)
- dsc->calc_stats |= 1ul << dsc->sort_by_stat;
- if (dsc->show_stats & (1ul << DSC_SESKEW))
- dsc->calc_stats |= 1ul << DSC_SKEWNESS;
- if (dsc->show_stats & (1ul << DSC_SEKURT))
- dsc->calc_stats |= 1ul << DSC_KURTOSIS;
-
- /* Figure out maximum moment needed and allocate moments for
- the variables. */
- dsc->max_moment = MOMENT_NONE;
- for (i = 0; i < DSC_N_STATS; i++)
- if (dsc->calc_stats & (1ul << i) && dsc_info[i].moment > dsc->max_moment)
- dsc->max_moment = dsc_info[i].moment;
- if (dsc->max_moment != MOMENT_NONE)
- for (i = 0; i < dsc->var_cnt; i++)
- dsc->vars[i].moments = moments_create (dsc->max_moment);
-
- /* Data pass. */
- multipass_procedure_with_splits (calc_descriptives, dsc);
-
- /* Z-scoring! */
- if (z_cnt)
- setup_z_trns (dsc);
-
- /* Done. */
- free (vars);
- free_dsc_proc (dsc);
- return CMD_SUCCESS;
-
- error:
- free (vars);
- free_dsc_proc (dsc);
- return CMD_FAILURE;
-}
-
-/* Returns the statistic named by the current token and skips past the token.
- Returns DSC_NONE if no statistic is given (e.g., subcommand with no
- specifiers). Emits an error if the current token ID does not name a
- statistic. */
-static enum dsc_statistic
-match_statistic (void)
-{
- if (token == T_ID)
- {
- enum dsc_statistic stat;
-
- for (stat = 0; stat < DSC_N_STATS; stat++)
- if (lex_match_id (dsc_info[stat].identifier))
- return stat;
-
- lex_get();
- lex_error (_("expecting statistic name: reverting to default"));
- }
-
- return DSC_NONE;
-}
-
-/* Frees DSC. */
-static void
-free_dsc_proc (struct dsc_proc *dsc)
-{
- size_t i;
-
- if (dsc == NULL)
- return;
-
- for (i = 0; i < dsc->var_cnt; i++)
- moments_destroy (dsc->vars[i].moments);
- free (dsc->vars);
- free (dsc);
-}
-\f
-/* Z scores. */
-
-/* Returns 0 if NAME is a duplicate of any existing variable name or
- of any previously-declared z-var name; otherwise returns 1. */
-static int
-try_name (struct dsc_proc *dsc, char *name)
-{
- size_t i;
-
- if (dict_lookup_var (default_dict, name) != NULL)
- return 0;
- for (i = 0; i < dsc->var_cnt; i++)
- if (!strcasecmp (dsc->vars[i].z_name, name))
- return 0;
- return 1;
-}
-
-/* Generates a name for a Z-score variable based on a variable
- named VAR_NAME, given that *Z_CNT generated variable names are
- known to already exist. If successful, returns nonzero and
- copies the new name into Z_NAME. On failure, returns zero. */
-static int
-generate_z_varname (struct dsc_proc *dsc, char *z_name,
- const char *var_name, size_t *z_cnt)
-{
- char name[LONG_NAME_LEN + 1];
-
- /* Try a name based on the original variable name. */
- name[0] = 'Z';
- str_copy_trunc (name + 1, sizeof name - 1, var_name);
- if (try_name (dsc, name))
- {
- strcpy (z_name, name);
- return 1;
- }
-
- /* Generate a synthetic name. */
- for (;;)
- {
- (*z_cnt)++;
-
- if (*z_cnt <= 99)
- sprintf (name, "ZSC%03d", *z_cnt);
- else if (*z_cnt <= 108)
- sprintf (name, "STDZ%02d", *z_cnt - 99);
- else if (*z_cnt <= 117)
- sprintf (name, "ZZZZ%02d", *z_cnt - 108);
- else if (*z_cnt <= 126)
- sprintf (name, "ZQZQ%02d", *z_cnt - 117);
- else
- {
- msg (SE, _("Ran out of generic names for Z-score variables. "
- "There are only 126 generic names: ZSC001-ZSC0999, "
- "STDZ01-STDZ09, ZZZZ01-ZZZZ09, ZQZQ01-ZQZQ09."));
- return 0;
- }
-
- if (try_name (dsc, name))
- {
- strcpy (z_name, name);
- return 1;
- }
- }
-}
-
-/* Outputs a table describing the mapping between source
- variables and Z-score variables. */
-static void
-dump_z_table (struct dsc_proc *dsc)
-{
- size_t cnt = 0;
- struct tab_table *t;
-
- {
- size_t i;
-
- for (i = 0; i < dsc->var_cnt; i++)
- if (dsc->vars[i].z_name[0] != '\0')
- cnt++;
- }
-
- t = tab_create (2, cnt + 1, 0);
- tab_title (t, 0, _("Mapping of variables to corresponding Z-scores."));
- tab_columns (t, SOM_COL_DOWN, 1);
- tab_headers (t, 0, 0, 1, 0);
- tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 1, cnt);
- tab_hline (t, TAL_2, 0, 1, 1);
- tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Source"));
- tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Target"));
- tab_dim (t, tab_natural_dimensions);
-
- {
- size_t i, y;
-
- for (i = 0, y = 1; i < dsc->var_cnt; i++)
- if (dsc->vars[i].z_name[0] != '\0')
- {
- tab_text (t, 0, y, TAB_LEFT, dsc->vars[i].v->name);
- tab_text (t, 1, y++, TAB_LEFT, dsc->vars[i].z_name);
- }
- }
-
- tab_submit (t);
-}
-
-/* Transformation function to calculate Z-scores. Will return SYSMIS if any of
- the following are true: 1) mean or standard deviation is SYSMIS 2) score is
- SYSMIS 3) score is user missing and they were not included in the original
- analyis. 4) any of the variables in the original analysis were missing
- (either system or user-missing values that weren't included).
-*/
-static int
-descriptives_trns_proc (void *trns_, struct ccase * c,
- int case_idx UNUSED)
-{
- struct dsc_trns *t = trns_;
- struct dsc_z_score *z;
- struct variable **vars;
- int all_sysmis = 0;
-
- if (t->missing_type == DSC_LISTWISE)
- {
- assert(t->vars);
- for (vars = t->vars; vars < t->vars + t->var_cnt; vars++)
- {
- double score = case_num (c, (*vars)->fv);
- if ( score == SYSMIS
- || (!t->include_user_missing
- && mv_is_num_user_missing (&(*vars)->miss, score)))
- {
- all_sysmis = 1;
- break;
- }
- }
- }
-
- for (z = t->z_scores; z < t->z_scores + t->z_score_cnt; z++)
- {
- double input = case_num (c, z->src_idx);
- double *output = &case_data_rw (c, z->dst_idx)->f;
-
- if (z->mean == SYSMIS || z->std_dev == SYSMIS
- || all_sysmis || input == SYSMIS
- || (!t->include_user_missing
- && mv_is_num_user_missing (&z->v->miss, input)))
- *output = SYSMIS;
- else
- *output = (input - z->mean) / z->std_dev;
- }
- return -1;
-}
-
-/* Frees a descriptives_trns struct. */
-static void
-descriptives_trns_free (void *trns_)
-{
- struct dsc_trns *t = trns_;
-
- free (t->z_scores);
- assert((t->missing_type != DSC_LISTWISE) ^ (t->vars != NULL));
- free (t->vars);
-}
-
-/* Sets up a transformation to calculate Z scores. */
-static void
-setup_z_trns (struct dsc_proc *dsc)
-{
- struct dsc_trns *t;
- size_t cnt, i;
-
- for (cnt = i = 0; i < dsc->var_cnt; i++)
- if (dsc->vars[i].z_name[0] != '\0')
- cnt++;
-
- t = xmalloc (sizeof *t);
- t->z_scores = xnmalloc (cnt, sizeof *t->z_scores);
- t->z_score_cnt = cnt;
- t->missing_type = dsc->missing_type;
- t->include_user_missing = dsc->include_user_missing;
- if ( t->missing_type == DSC_LISTWISE )
- {
- t->var_cnt = dsc->var_cnt;
- t->vars = xnmalloc (t->var_cnt, sizeof *t->vars);
- for (i = 0; i < t->var_cnt; i++)
- t->vars[i] = dsc->vars[i].v;
- }
- else
- {
- t->var_cnt = 0;
- t->vars = NULL;
- }
-
- for (cnt = i = 0; i < dsc->var_cnt; i++)
- {
- struct dsc_var *dv = &dsc->vars[i];
- if (dv->z_name[0] != '\0')
- {
- struct dsc_z_score *z;
- char *cp;
- struct variable *dst_var;
-
- dst_var = dict_create_var_assert (default_dict, dv->z_name, 0);
- dst_var->init = 0;
- if (dv->v->label)
- {
- dst_var->label = xmalloc (strlen (dv->v->label) + 12);
- cp = stpcpy (dst_var->label, _("Z-score of "));
- strcpy (cp, dv->v->label);
- }
- else
- {
- dst_var->label = xmalloc (strlen (dv->v->name) + 12);
- cp = stpcpy (dst_var->label, _("Z-score of "));
- strcpy (cp, dv->v->name);
- }
-
- z = &t->z_scores[cnt++];
- z->src_idx = dv->v->fv;
- z->dst_idx = dst_var->fv;
- z->mean = dv->stats[DSC_MEAN];
- z->std_dev = dv->stats[DSC_STDDEV];
- z->v = dv->v;
- }
- }
-
- add_transformation (descriptives_trns_proc, descriptives_trns_free, t);
-}
-\f
-/* Statistical calculation. */
-
-static int listwise_missing (struct dsc_proc *dsc, const struct ccase *c);
-
-/* Calculates and displays descriptive statistics for the cases
- in CF. */
-static void
-calc_descriptives (const struct casefile *cf, void *dsc_)
-{
- struct dsc_proc *dsc = dsc_;
- struct casereader *reader;
- struct ccase c;
- size_t i;
-
- for (i = 0; i < dsc->var_cnt; i++)
- {
- struct dsc_var *dv = &dsc->vars[i];
-
- dv->valid = dv->missing = 0.0;
- if (dv->moments != NULL)
- moments_clear (dv->moments);
- dv->min = DBL_MAX;
- dv->max = -DBL_MAX;
- }
- dsc->missing_listwise = 0.;
- dsc->valid = 0.;
-
- /* First pass to handle most of the work. */
- for (reader = casefile_get_reader (cf);
- casereader_read (reader, &c);
- case_destroy (&c))
- {
- double weight = dict_get_case_weight (default_dict, &c, &dsc->bad_warn);
- if (weight <= 0.0)
- continue;
-
- /* Check for missing values. */
- if (listwise_missing (dsc, &c))
- {
- dsc->missing_listwise += weight;
- if (dsc->missing_type == DSC_LISTWISE)
- continue;
- }
- dsc->valid += weight;
-
- for (i = 0; i < dsc->var_cnt; i++)
- {
- struct dsc_var *dv = &dsc->vars[i];
- double x = case_num (&c, dv->v->fv);
-
- if (dsc->missing_type != DSC_LISTWISE
- && (x == SYSMIS
- || (!dsc->include_user_missing
- && mv_is_num_user_missing (&dv->v->miss, x))))
- {
- dv->missing += weight;
- continue;
- }
-
- if (dv->moments != NULL)
- moments_pass_one (dv->moments, x, weight);
-
- if (x < dv->min)
- dv->min = x;
- if (x > dv->max)
- dv->max = x;
- }
- }
- casereader_destroy (reader);
-
- /* Second pass for higher-order moments. */
- if (dsc->max_moment > MOMENT_MEAN)
- {
- for (reader = casefile_get_reader (cf);
- casereader_read (reader, &c);
- case_destroy (&c))
- {
- double weight = dict_get_case_weight (default_dict, &c,
- &dsc->bad_warn);
- if (weight <= 0.0)
- continue;
-
- /* Check for missing values. */
- if (listwise_missing (dsc, &c)
- && dsc->missing_type == DSC_LISTWISE)
- continue;
-
- for (i = 0; i < dsc->var_cnt; i++)
- {
- struct dsc_var *dv = &dsc->vars[i];
- double x = case_num (&c, dv->v->fv);
-
- if (dsc->missing_type != DSC_LISTWISE
- && (x == SYSMIS
- || (!dsc->include_user_missing
- && mv_is_num_user_missing (&dv->v->miss, x))))
- continue;
-
- if (dv->moments != NULL)
- moments_pass_two (dv->moments, x, weight);
- }
- }
- casereader_destroy (reader);
- }
-
- /* Calculate results. */
- for (i = 0; i < dsc->var_cnt; i++)
- {
- struct dsc_var *dv = &dsc->vars[i];
- double W;
- int j;
-
- for (j = 0; j < DSC_N_STATS; j++)
- dv->stats[j] = SYSMIS;
-
- dv->valid = W = dsc->valid - dv->missing;
-
- if (dv->moments != NULL)
- moments_calculate (dv->moments, NULL,
- &dv->stats[DSC_MEAN], &dv->stats[DSC_VARIANCE],
- &dv->stats[DSC_SKEWNESS], &dv->stats[DSC_KURTOSIS]);
- if (dsc->calc_stats & (1ul << DSC_SEMEAN)
- && dv->stats[DSC_VARIANCE] != SYSMIS && W > 0.)
- dv->stats[DSC_SEMEAN] = sqrt (dv->stats[DSC_VARIANCE]) / sqrt (W);
- if (dsc->calc_stats & (1ul << DSC_STDDEV)
- && dv->stats[DSC_VARIANCE] != SYSMIS)
- dv->stats[DSC_STDDEV] = sqrt (dv->stats[DSC_VARIANCE]);
- if (dsc->calc_stats & (1ul << DSC_SEKURT))
- if (dv->stats[DSC_KURTOSIS] != SYSMIS)
- dv->stats[DSC_SEKURT] = calc_sekurt (W);
- if (dsc->calc_stats & (1ul << DSC_SESKEW)
- && dv->stats[DSC_SKEWNESS] != SYSMIS)
- dv->stats[DSC_SESKEW] = calc_seskew (W);
- dv->stats[DSC_RANGE] = ((dv->min == DBL_MAX || dv->max == -DBL_MAX)
- ? SYSMIS : dv->max - dv->min);
- dv->stats[DSC_MIN] = dv->min == DBL_MAX ? SYSMIS : dv->min;
- dv->stats[DSC_MAX] = dv->max == -DBL_MAX ? SYSMIS : dv->max;
- if (dsc->calc_stats & (1ul << DSC_SUM))
- dv->stats[DSC_SUM] = W * dv->stats[DSC_MEAN];
- }
-
- /* Output results. */
- display (dsc);
-}
-
-/* Returns nonzero if any of the descriptives variables in DSC's
- variable list have missing values in case C, zero otherwise. */
-static int
-listwise_missing (struct dsc_proc *dsc, const struct ccase *c)
-{
- size_t i;
-
- for (i = 0; i < dsc->var_cnt; i++)
- {
- struct dsc_var *dv = &dsc->vars[i];
- double x = case_num (c, dv->v->fv);
-
- if (x == SYSMIS
- || (!dsc->include_user_missing
- && mv_is_num_user_missing (&dv->v->miss, x)))
- return 1;
- }
- return 0;
-}
-\f
-/* Statistical display. */
-
-static algo_compare_func descriptives_compare_dsc_vars;
-
-/* Displays a table of descriptive statistics for DSC. */
-static void
-display (struct dsc_proc *dsc)
-{
- size_t i;
- int nc;
- struct tab_table *t;
-
- nc = 1 + (dsc->format == DSC_SERIAL ? 2 : 1);
- for (i = 0; i < DSC_N_STATS; i++)
- if (dsc->show_stats & (1ul << i))
- nc++;
-
- if (dsc->sort_by_stat != DSC_NONE)
- sort (dsc->vars, dsc->var_cnt, sizeof *dsc->vars,
- descriptives_compare_dsc_vars, dsc);
-
- t = tab_create (nc, dsc->var_cnt + 1, 0);
- tab_headers (t, 1, 0, 1, 0);
- tab_box (t, TAL_1, TAL_1, -1, -1, 0, 0, nc - 1, dsc->var_cnt);
- tab_box (t, -1, -1, -1, TAL_1, 1, 0, nc - 1, dsc->var_cnt);
- tab_hline (t, TAL_2, 0, nc - 1, 1);
- tab_vline (t, TAL_2, 1, 0, dsc->var_cnt);
- tab_dim (t, tab_natural_dimensions);
-
- nc = 0;
- tab_text (t, nc++, 0, TAB_LEFT | TAT_TITLE, _("Variable"));
- if (dsc->format == DSC_SERIAL)
- {
- tab_text (t, nc++, 0, TAB_CENTER | TAT_TITLE, _("Valid N"));
- tab_text (t, nc++, 0, TAB_CENTER | TAT_TITLE, _("Missing N"));
- }
- else
- tab_text (t, nc++, 0, TAB_CENTER | TAT_TITLE, "N");
-
- for (i = 0; i < DSC_N_STATS; i++)
- if (dsc->show_stats & (1ul << i))
- {
- const char *title = gettext (dsc_info[i].name);
- tab_text (t, nc++, 0, TAB_CENTER | TAT_TITLE, title);
- }
-
- for (i = 0; i < dsc->var_cnt; i++)
- {
- struct dsc_var *dv = &dsc->vars[i];
- size_t j;
-
- nc = 0;
- tab_text (t, nc++, i + 1, TAB_LEFT, dv->v->name);
- tab_text (t, nc++, i + 1, TAT_PRINTF, "%g", dv->valid);
- if (dsc->format == DSC_SERIAL)
- tab_text (t, nc++, i + 1, TAT_PRINTF, "%g", dv->missing);
- for (j = 0; j < DSC_N_STATS; j++)
- if (dsc->show_stats & (1ul << j))
- tab_float (t, nc++, i + 1, TAB_NONE, dv->stats[j], 10, 3);
- }
-
- tab_title (t, 1, _("Valid cases = %g; cases with missing value(s) = %g."),
- dsc->valid, dsc->missing_listwise);
-
- tab_submit (t);
-}
-
-/* Compares `struct dsc_var's A and B according to the ordering
- specified by CMD. */
-static int
-descriptives_compare_dsc_vars (const void *a_, const void *b_, void *dsc_)
-{
- const struct dsc_var *a = a_;
- const struct dsc_var *b = b_;
- struct dsc_proc *dsc = dsc_;
-
- int result;
-
- if (dsc->sort_by_stat == DSC_NAME)
- result = strcasecmp (a->v->name, b->v->name);
- else
- {
- double as = a->stats[dsc->sort_by_stat];
- double bs = b->stats[dsc->sort_by_stat];
-
- result = as < bs ? -1 : as > bs;
- }
-
- if (!dsc->sort_ascending)
- result = -result;
-
- return result;
-}
+++ /dev/null
-/* PSPP - Creates design-matrices.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Written by Jason H Stover <jason@sakla.net>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-/*
- Create design matrices for procedures that need them.
-*/
-#include <config.h>
-#include <stdlib.h>
-#include <error.h>
-#include "alloc.h"
-#include "error.h"
-#include "var.h"
-#include "cat.h"
-#include "design-matrix.h"
-#include <string.h>
-#include <math.h>
-#include <gsl/gsl_machine.h>
-#include <gsl/gsl_vector.h>
-#include <gsl/gsl_matrix.h>
-
-#define DM_COLUMN_NOT_FOUND -1
-#define DM_INDEX_NOT_FOUND -3
-
-/*
- Which element of a vector is equal to the value x?
- */
-static size_t
-cat_which_element_eq (const gsl_vector * vec, double x)
-{
- size_t i;
-
- for (i = 0; i < vec->size; i++)
- {
- if (fabs (gsl_vector_get (vec, i) - x) < GSL_DBL_EPSILON)
- {
- return i;
- }
- }
- return CAT_VALUE_NOT_FOUND;
-}
-static int
-cat_is_zero_vector (const gsl_vector * vec)
-{
- size_t i;
-
- for (i = 0; i < vec->size; i++)
- {
- if (gsl_vector_get (vec, i) != 0.0)
- {
- return 0;
- }
- }
- return 1;
-}
-
-/*
- Return the value of v corresponding to the vector vec.
- */
-union value *
-cat_vector_to_value (const gsl_vector * vec, struct variable *v)
-{
- size_t i;
-
- i = cat_which_element_eq (vec, 1.0);
- if (i != CAT_VALUE_NOT_FOUND)
- {
- return cat_subscript_to_value (i + 1, v);
- }
- if (cat_is_zero_vector (vec))
- {
- return cat_subscript_to_value (0, v);
- }
- return NULL;
-}
-
-struct design_matrix *
-design_matrix_create (int n_variables,
- const struct variable *v_variables[],
- const size_t n_data)
-{
- struct design_matrix *dm;
- const struct variable *v;
- size_t i;
- size_t n_cols = 0;
- size_t col;
-
- dm = xmalloc (sizeof *dm);
- dm->vars = xnmalloc (n_variables, sizeof *dm->vars);
- dm->n_vars = n_variables;
-
- for (i = 0; i < n_variables; i++)
- {
- v = v_variables[i];
- assert ((dm->vars + i) != NULL);
- (dm->vars + i)->v = v; /* Allows us to look up the variable from
- the design matrix. */
- (dm->vars + i)->first_column = n_cols;
- if (v->type == NUMERIC)
- {
- (dm->vars + i)->last_column = n_cols;
- n_cols++;
- }
- else if (v->type == ALPHA)
- {
- assert (v->obs_vals != NULL);
- (dm->vars + i)->last_column =
- (dm->vars + i)->first_column + v->obs_vals->n_categories - 2;
- n_cols += v->obs_vals->n_categories - 1;
- }
- }
- dm->m = gsl_matrix_calloc (n_data, n_cols);
- col = 0;
-
- return dm;
-}
-
-void
-design_matrix_destroy (struct design_matrix *dm)
-{
- free (dm->vars);
- gsl_matrix_free (dm->m);
- free (dm);
-}
-
-/*
- Return the index of the variable for the
- given column.
- */
-static size_t
-design_matrix_col_to_var_index (const struct design_matrix *dm, size_t col)
-{
- size_t i;
- struct design_matrix_var v;
-
- for (i = 0; i < dm->n_vars; i++)
- {
- v = dm->vars[i];
- if (v.first_column <= col && col <= v.last_column)
- return (v.v)->index;
- }
- return DM_INDEX_NOT_FOUND;
-}
-
-/*
- Return a pointer to the variable whose values
- are stored in column col.
- */
-struct variable *
-design_matrix_col_to_var (const struct design_matrix *dm, size_t col)
-{
- size_t index;
- size_t i;
- struct design_matrix_var dmv;
-
- index = design_matrix_col_to_var_index (dm, col);
- for (i = 0; i < dm->n_vars; i++)
- {
- dmv = dm->vars[i];
- if ((dmv.v)->index == index)
- {
- return (struct variable *) dmv.v;
- }
- }
- return NULL;
-}
-
-static size_t
-cmp_dm_var_index (const struct design_matrix_var *dmv, size_t index)
-{
- if (dmv->v->index == index)
- return 1;
- return 0;
-}
-
-/*
- Return the number of the first column which holds the
- values for variable v.
- */
-size_t
-design_matrix_var_to_column (const struct design_matrix * dm,
- const struct variable * v)
-{
- size_t i;
- struct design_matrix_var tmp;
-
- for (i = 0; i < dm->n_vars; i++)
- {
- tmp = dm->vars[i];
- if (cmp_dm_var_index (&tmp, v->index))
- {
- return tmp.first_column;
- }
- }
- return DM_COLUMN_NOT_FOUND;
-}
-
-/* Last column. */
-static size_t
-dm_var_to_last_column (const struct design_matrix *dm,
- const struct variable *v)
-{
- size_t i;
- struct design_matrix_var tmp;
-
- for (i = 0; i < dm->n_vars; i++)
- {
- tmp = dm->vars[i];
- if (cmp_dm_var_index (&tmp, v->index))
- {
- return tmp.last_column;
- }
- }
- return DM_COLUMN_NOT_FOUND;
-}
-
-/*
- Set the appropriate value in the design matrix,
- whether that value is from a categorical or numeric
- variable. For a categorical variable, only the usual
- binary encoding is allowed.
- */
-void
-design_matrix_set_categorical (struct design_matrix *dm, size_t row,
- const struct variable *var,
- const union value *val)
-{
- size_t col;
- size_t is_one;
- size_t fc;
- size_t lc;
- double entry;
-
- assert (var->type == ALPHA);
- fc = design_matrix_var_to_column (dm, var);
- lc = dm_var_to_last_column (dm, var);
- assert (lc != DM_COLUMN_NOT_FOUND);
- assert (fc != DM_COLUMN_NOT_FOUND);
- is_one = fc + cat_value_find (var, val);
- for (col = fc; col <= lc; col++)
- {
- entry = (col == is_one) ? 1.0 : 0.0;
- gsl_matrix_set (dm->m, row, col, entry);
- }
-}
-void
-design_matrix_set_numeric (struct design_matrix *dm, size_t row,
- const struct variable *var, const union value *val)
-{
- size_t col;
-
- assert (var->type == NUMERIC);
- col = design_matrix_var_to_column ((const struct design_matrix *) dm, var);
- assert (col != DM_COLUMN_NOT_FOUND);
- gsl_matrix_set (dm->m, row, col, val->f);
-}
+++ /dev/null
-/* PSPP - Creates design matrices.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Written by Jason H Stover <jason@sakla.net>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-/*
- Create design matrices for procedures that need them.
- */
-
-#ifndef DESIGN_MATRIX_H
-#define DESIGN_MATRIX_H
-
-#include <gsl/gsl_matrix.h>
-#include <stdbool.h>
-#include "cat.h"
-#include "cat-routines.h"
-struct design_matrix_var
-{
- size_t first_column; /* First column for this variable in
- the design_matix. If this variable
- is categorical, its values are
- stored in multiple, contiguous
- columns, as dictated by its vector
- encoding in the variable's struct
- cat_vals.
- */
- size_t last_column;
- const struct variable *v;
-};
-struct design_matrix
-{
- gsl_matrix *m;
- struct design_matrix_var *vars; /* Element i corresponds to
- the variable whose values
- are stored in at least one
- column of m. If that
- variable is categorical
- with more than two
- categories, its values are
- stored in multiple,
- contiguous columns. The
- variable's values are then
- stored in the columns
- first_column through
- last_column of the
- design_matrix_var
- structure.
- */
- size_t n_vars;
-};
-union value *cat_vector_to_value (const gsl_vector *, struct variable *);
-
-struct design_matrix *design_matrix_create (int, const struct variable *[],
- const size_t);
-
-void design_matrix_destroy (struct design_matrix *);
-
-void design_matrix_set_categorical (struct design_matrix *, size_t,
- const struct variable *,
- const union value *);
-
-void design_matrix_set_numeric (struct design_matrix *, size_t,
- const struct variable *, const union value *);
-
-size_t design_matrix_var_to_column (const struct design_matrix *,
- const struct variable *);
-
-struct variable *design_matrix_col_to_var (const struct design_matrix *,
- size_t);
-
-#endif
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-2004, 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "dfm-read.h"
-#include <ctype.h>
-#include <errno.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "command.h"
-#include "error.h"
-#include "file-handle.h"
-#include "file-handle-def.h"
-#include "filename.h"
-#include "getl.h"
-#include "lexer.h"
-#include "str.h"
-#include "vfm.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-/* Flags for DFM readers. */
-enum dfm_reader_flags
- {
- DFM_EOF = 001, /* At end-of-file? */
- DFM_ADVANCE = 002, /* Read next line on dfm_get_record() call? */
- DFM_SAW_BEGIN_DATA = 004, /* For inline_file only, whether we've
- already read a BEGIN DATA line. */
- DFM_TABS_EXPANDED = 010, /* Tabs have been expanded. */
- };
-
-/* Data file reader. */
-struct dfm_reader
- {
- struct file_handle *fh; /* File handle. */
- struct file_locator where; /* Current location in data file. */
- struct string line; /* Current line. */
- struct string scratch; /* Extra line buffer. */
- enum dfm_reader_flags flags; /* Zero or more of DFM_*. */
- struct file_ext file; /* Associated file. */
- size_t pos; /* Offset in line of current character. */
- };
-
-static void read_record (struct dfm_reader *r);
-
-/* Closes reader R opened by dfm_open_reader(). */
-void
-dfm_close_reader (struct dfm_reader *r)
-{
- int still_open;
- bool is_inline;
-
- if (r == NULL)
- return;
-
- is_inline = r->fh == fh_inline_file ();
- still_open = fh_close (r->fh, "data file", "rs");
- if (still_open)
- return;
-
- if (!is_inline)
- {
- fn_close_ext (&r->file);
- free (r->file.filename);
- r->file.filename = NULL;
- }
- else
- {
- /* Skip any remaining data on the inline file. */
- if (r->flags & DFM_SAW_BEGIN_DATA)
- while ((r->flags & DFM_EOF) == 0)
- read_record (r);
- }
-
- ds_destroy (&r->line);
- ds_destroy (&r->scratch);
- free (r);
-}
-
-/* Opens the file designated by file handle FH for reading as a
- data file. Providing fh_inline_file() for FH designates the
- "inline file", that is, data included inline in the command
- file between BEGIN FILE and END FILE. Returns a reader if
- successful, or a null pointer otherwise. */
-struct dfm_reader *
-dfm_open_reader (struct file_handle *fh)
-{
- struct dfm_reader *r;
- void **rp;
-
- rp = fh_open (fh, FH_REF_FILE | FH_REF_INLINE, "data file", "rs");
- if (rp == NULL)
- return NULL;
- if (*rp != NULL)
- return *rp;
-
- r = xmalloc (sizeof *r);
- r->fh = fh;
- ds_init (&r->line, 64);
- ds_init (&r->scratch, 0);
- r->flags = DFM_ADVANCE;
- if (fh != fh_inline_file ())
- {
- r->where.filename = fh_get_filename (fh);
- r->where.line_number = 0;
- r->file.file = NULL;
- r->file.filename = xstrdup (fh_get_filename (r->fh));
- r->file.mode = "rb";
- r->file.file = NULL;
- r->file.sequence_no = NULL;
- r->file.param = NULL;
- r->file.postopen = NULL;
- r->file.preclose = NULL;
- if (!fn_open_ext (&r->file))
- {
- msg (ME, _("Could not open \"%s\" for reading as a data file: %s."),
- fh_get_filename (r->fh), strerror (errno));
- err_cond_fail ();
- fh_close (fh,"data file", "rs");
- free (r);
- return NULL;
- }
- }
- *rp = r;
-
- return r;
-}
-
-/* Reads a record from the inline file into R.
- Returns true if successful, false on failure. */
-static bool
-read_inline_record (struct dfm_reader *r)
-{
- if ((r->flags & DFM_SAW_BEGIN_DATA) == 0)
- {
- char *s;
-
- r->flags |= DFM_SAW_BEGIN_DATA;
-
- /* FIXME: WTF can't this just be done with tokens?
- Is this really a special case? */
- do
- {
- char *cp;
-
- if (!getl_read_line ())
- {
- msg (SE, _("BEGIN DATA expected."));
- err_failure ();
- }
-
- /* Skip leading whitespace, separate out first
- word, so that S points to a single word reduced
- to lowercase. */
- s = ds_c_str (&getl_buf);
- while (isspace ((unsigned char) *s))
- s++;
- for (cp = s; isalpha ((unsigned char) *cp); cp++)
- *cp = tolower ((unsigned char) (*cp));
- ds_truncate (&getl_buf, cp - s);
- }
- while (*s == '\0');
-
- if (!lex_id_match_len ("begin", 5, s, strcspn (s, " \t\r\v\n")))
- {
- msg (SE, _("BEGIN DATA expected."));
- lex_preprocess_line ();
- return false;
- }
- getl_prompt = GETL_PRPT_DATA;
- }
-
- if (!getl_read_line ())
- {
- msg (SE, _("Unexpected end-of-file while reading data in BEGIN "
- "DATA. This probably indicates "
- "a missing or misformatted END DATA command. "
- "END DATA must appear by itself on a single line "
- "with exactly one space between words."));
- err_failure ();
- }
-
- if (ds_length (&getl_buf) >= 8
- && !strncasecmp (ds_c_str (&getl_buf), "end data", 8))
- {
- lex_set_prog (ds_c_str (&getl_buf) + ds_length (&getl_buf));
- return false;
- }
-
- ds_replace (&r->line, ds_c_str (&getl_buf));
- return true;
-}
-
-/* Reads a record from a disk file into R.
- Returns true if successful, false on failure. */
-static bool
-read_file_record (struct dfm_reader *r)
-{
- assert (r->fh != fh_inline_file ());
- if (fh_get_mode (r->fh) == FH_MODE_TEXT)
- {
- ds_clear (&r->line);
- if (!ds_gets (&r->line, r->file.file))
- {
- if (ferror (r->file.file))
- {
- msg (ME, _("Error reading file %s: %s."),
- fh_get_name (r->fh), strerror (errno));
- err_cond_fail ();
- }
- return false;
- }
- }
- else if (fh_get_mode (r->fh) == FH_MODE_BINARY)
- {
- size_t record_width = fh_get_record_width (r->fh);
- size_t amt;
-
- if (ds_length (&r->line) < record_width)
- ds_rpad (&r->line, record_width, 0);
-
- amt = fread (ds_c_str (&r->line), 1, record_width,
- r->file.file);
- if (record_width != amt)
- {
- if (ferror (r->file.file))
- msg (ME, _("Error reading file %s: %s."),
- fh_get_name (r->fh), strerror (errno));
- else if (amt != 0)
- msg (ME, _("%s: Partial record at end of file."),
- fh_get_name (r->fh));
- else
- return false;
-
- err_cond_fail ();
- return false;
- }
- }
- else
- assert (0);
-
- r->where.line_number++;
-
- return true;
-}
-
-/* Reads a record from R, setting the current position to the
- start of the line. If an error occurs or end-of-file is
- encountered, the current line is set to null. */
-static void
-read_record (struct dfm_reader *r)
-{
- bool success;
-
- if (fh_get_referent (r->fh) == FH_REF_FILE)
- success = read_file_record (r);
- else
- success = read_inline_record (r);
-
- if (success)
- r->pos = 0;
- else
- r->flags |= DFM_EOF;
-}
-
-/* Returns nonzero if end of file has been reached on HANDLE.
- Reads forward in HANDLE's file, if necessary to tell. */
-int
-dfm_eof (struct dfm_reader *r)
-{
- if (r->flags & DFM_ADVANCE)
- {
- r->flags &= ~DFM_ADVANCE;
- if ((r->flags & DFM_EOF) == 0)
- read_record (r);
- else
- {
- if (r->fh != fh_inline_file ())
- msg (SE, _("Attempt to read beyond end-of-file on file %s."),
- fh_get_name (r->fh));
- else
- msg (SE, _("Attempt to read beyond END DATA."));
- err_cond_fail ();
- }
- }
-
- return (r->flags & DFM_EOF) != 0;
-}
-
-/* Returns the current record in the file corresponding to
- HANDLE. Aborts if reading from the file is necessary or at
- end of file, so call dfm_eof() first. Sets *LINE to the line,
- which is not null-terminated. The caller must not free or
- modify the returned string. */
-void
-dfm_get_record (struct dfm_reader *r, struct fixed_string *line)
-{
- assert ((r->flags & DFM_ADVANCE) == 0);
- assert ((r->flags & DFM_EOF) == 0);
- assert (r->pos <= ds_length (&r->line));
-
- line->string = ds_data (&r->line) + r->pos;
- line->length = ds_length (&r->line) - r->pos;
-}
-
-/* Expands tabs in the current line into the equivalent number of
- spaces, if appropriate for this kind of file. Aborts if
- reading from the file is necessary or at end of file, so call
- dfm_eof() first.*/
-void
-dfm_expand_tabs (struct dfm_reader *r)
-{
- struct string temp;
- size_t ofs, new_pos, tab_width;
-
- assert ((r->flags & DFM_ADVANCE) == 0);
- assert ((r->flags & DFM_EOF) == 0);
- assert (r->pos <= ds_length (&r->line));
-
- if (r->flags & DFM_TABS_EXPANDED)
- return;
- r->flags |= DFM_TABS_EXPANDED;
-
- if (r->fh != fh_inline_file ()
- && (fh_get_mode (r->fh) == FH_MODE_BINARY
- || fh_get_tab_width (r->fh) == 0
- || memchr (ds_c_str (&r->line), '\t', ds_length (&r->line)) == NULL))
- return;
-
- /* Expand tabs from r->line into r->scratch, and figure out
- new value for r->pos. */
- tab_width = fh_get_tab_width (r->fh);
- ds_clear (&r->scratch);
- new_pos = 0;
- for (ofs = 0; ofs < ds_length (&r->line); ofs++)
- {
- unsigned char c;
-
- if (ofs == r->pos)
- new_pos = ds_length (&r->scratch);
-
- c = ds_c_str (&r->line)[ofs];
- if (c != '\t')
- ds_putc (&r->scratch, c);
- else
- {
- do
- ds_putc (&r->scratch, ' ');
- while (ds_length (&r->scratch) % tab_width != 0);
- }
- }
-
- /* Swap r->line and r->scratch and set new r->pos. */
- temp = r->line;
- r->line = r->scratch;
- r->scratch = temp;
- r->pos = new_pos;
-}
-
-/* Causes dfm_get_record() to read in the next record the next time it
- is executed on file HANDLE. */
-void
-dfm_forward_record (struct dfm_reader *r)
-{
- r->flags |= DFM_ADVANCE;
-}
-
-/* Cancels the effect of any previous dfm_fwd_record() executed
- on file HANDLE. Sets the current line to begin in the 1-based
- column COLUMN. */
-void
-dfm_reread_record (struct dfm_reader *r, size_t column)
-{
- r->flags &= ~DFM_ADVANCE;
- if (column < 1)
- r->pos = 0;
- else if (column > ds_length (&r->line))
- r->pos = ds_length (&r->line);
- else
- r->pos = column - 1;
-}
-
-/* Sets the current line to begin COLUMNS characters following
- the current start. */
-void
-dfm_forward_columns (struct dfm_reader *r, size_t columns)
-{
- dfm_reread_record (r, (r->pos + 1) + columns);
-}
-
-/* Returns the 1-based column to which the line pointer in HANDLE
- is set. Unless dfm_reread_record() or dfm_forward_columns()
- have been called, this is 1. */
-size_t
-dfm_column_start (struct dfm_reader *r)
-{
- return r->pos + 1;
-}
-
-/* Pushes the filename and line number on the fn/ln stack. */
-void
-dfm_push (struct dfm_reader *r)
-{
- if (r->fh != fh_inline_file ())
- err_push_file_locator (&r->where);
-}
-
-/* Pops the filename and line number from the fn/ln stack. */
-void
-dfm_pop (struct dfm_reader *r)
-{
- if (r->fh != fh_inline_file ())
- err_pop_file_locator (&r->where);
-}
-\f
-/* BEGIN DATA...END DATA procedure. */
-
-/* Perform BEGIN DATA...END DATA as a procedure in itself. */
-int
-cmd_begin_data (void)
-{
- struct dfm_reader *r;
-
- if (!fh_is_open (fh_inline_file ()))
- {
- msg (SE, _("This command is not valid here since the current "
- "input program does not access the inline file."));
- err_cond_fail ();
- return CMD_FAILURE;
- }
-
- /* Open inline file. */
- r = dfm_open_reader (fh_inline_file ());
- r->flags |= DFM_SAW_BEGIN_DATA;
-
- /* Input procedure reads from inline file. */
- getl_prompt = GETL_PRPT_DATA;
- procedure (NULL, NULL);
-
- dfm_close_reader (r);
-
- return CMD_SUCCESS;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef DFM_READ_H
-#define DFM_READ_H
-
-/* Data file manager (dfm).
-
- This module is in charge of reading and writing data files (other
- than system files). dfm is an fhuser, so see file-handle.h for the
- fhuser interface. */
-
-#include <stddef.h>
-
-struct file_handle;
-struct fixed_string;
-
-/* Input. */
-struct dfm_reader *dfm_open_reader (struct file_handle *);
-void dfm_close_reader (struct dfm_reader *);
-int dfm_eof (struct dfm_reader *);
-void dfm_get_record (struct dfm_reader *, struct fixed_string *);
-void dfm_expand_tabs (struct dfm_reader *);
-
-/* Line control. */
-void dfm_forward_record (struct dfm_reader *);
-void dfm_reread_record (struct dfm_reader *, size_t column);
-void dfm_forward_columns (struct dfm_reader *, size_t columns);
-size_t dfm_column_start (struct dfm_reader *);
-
-/* File stack. */
-void dfm_push (struct dfm_reader *);
-void dfm_pop (struct dfm_reader *);
-
-#endif /* dfm-read.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-2004 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "dfm-write.h"
-#include <assert.h>
-#include <errno.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "error.h"
-#include "file-handle.h"
-#include "filename.h"
-#include "str.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* Data file writer. */
-struct dfm_writer
- {
- struct file_handle *fh; /* File handle. */
- struct file_ext file; /* Associated file. */
- char *bounce; /* Bounce buffer for fixed-size fields. */
- };
-
-/* Opens a file handle for writing as a data file. */
-struct dfm_writer *
-dfm_open_writer (struct file_handle *fh)
-{
- struct dfm_writer *w;
- void **aux;
-
- aux = fh_open (fh, FH_REF_FILE, "data file", "ws");
- if (aux == NULL)
- return NULL;
- if (*aux != NULL)
- return *aux;
-
- w = *aux = xmalloc (sizeof *w);
- w->fh = fh;
- w->file.file = NULL;
- w->bounce = NULL;
-
- w->file.filename = xstrdup (fh_get_filename (w->fh));
- w->file.mode = "wb";
- w->file.file = NULL;
- w->file.sequence_no = NULL;
- w->file.param = NULL;
- w->file.postopen = NULL;
- w->file.preclose = NULL;
-
- if (!fn_open_ext (&w->file))
- {
- msg (ME, _("An error occurred while opening \"%s\" for writing "
- "as a data file: %s."),
- fh_get_filename (w->fh), strerror (errno));
- goto error;
- }
-
- return w;
-
- error:
- err_cond_fail ();
- dfm_close_writer (w);
- return NULL;
-}
-
-/* Writes record REC having length LEN to the file corresponding to
- HANDLE. REC is not null-terminated. Returns nonzero on success,
- zero on failure. */
-int
-dfm_put_record (struct dfm_writer *w, const char *rec, size_t len)
-{
- assert (w != NULL);
-
- if (fh_get_mode (w->fh) == FH_MODE_BINARY
- && len < fh_get_record_width (w->fh))
- {
- size_t rec_width = fh_get_record_width (w->fh);
- if (w->bounce == NULL)
- w->bounce = xmalloc (rec_width);
- memcpy (w->bounce, rec, len);
- memset (&w->bounce[len], 0, rec_width - len);
- rec = w->bounce;
- len = rec_width;
- }
-
- if (fwrite (rec, len, 1, w->file.file) != 1)
- {
- msg (ME, _("Error writing file %s: %s."),
- fh_get_name (w->fh), strerror (errno));
- err_cond_fail ();
- return 0;
- }
-
- return 1;
-}
-
-/* Closes data file writer W. */
-void
-dfm_close_writer (struct dfm_writer *w)
-{
- if (fh_close (w->fh, "data file", "ws"))
- return;
-
- if (w->file.file)
- {
- fn_close_ext (&w->file);
- free (w->file.filename);
- w->file.filename = NULL;
- }
- free (w->bounce);
- free (w);
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef DFM_WRITE_H
-#define DFM_WRITE_H
-
-/* Writing data files. */
-
-#include <stddef.h>
-
-struct file_handle;
-struct dfm_writer *dfm_open_writer (struct file_handle *);
-void dfm_close_writer (struct dfm_writer *);
-int dfm_put_record (struct dfm_writer *, const char *rec, size_t len);
-
-#endif /* dfm-write.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "dictionary.h"
-#include <stdlib.h>
-#include <ctype.h>
-#include "algorithm.h"
-#include "alloc.h"
-#include "case.h"
-#include "cat.h"
-#include "cat-routines.h"
-#include "error.h"
-#include "hash.h"
-#include "misc.h"
-#include "settings.h"
-#include "str.h"
-#include "value-labels.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* A dictionary. */
-struct dictionary
- {
- struct variable **var; /* Variables. */
- size_t var_cnt, var_cap; /* Number of variables, capacity. */
- struct hsh_table *name_tab; /* Variable index by name. */
- int next_value_idx; /* Index of next `union value' to allocate. */
- struct variable **split; /* SPLIT FILE vars. */
- size_t split_cnt; /* SPLIT FILE count. */
- struct variable *weight; /* WEIGHT variable. */
- struct variable *filter; /* FILTER variable. */
- int case_limit; /* Current case limit (N command). */
- char *label; /* File label. */
- char *documents; /* Documents, as a string. */
- struct vector **vector; /* Vectors of variables. */
- size_t vector_cnt; /* Number of vectors. */
- };
-
-/* Creates and returns a new dictionary. */
-struct dictionary *
-dict_create (void)
-{
- struct dictionary *d = xmalloc (sizeof *d);
-
- d->var = NULL;
- d->var_cnt = d->var_cap = 0;
- d->name_tab = hsh_create (8, compare_var_names, hash_var_name, NULL, NULL);
- d->next_value_idx = 0;
- d->split = NULL;
- d->split_cnt = 0;
- d->weight = NULL;
- d->filter = NULL;
- d->case_limit = 0;
- d->label = NULL;
- d->documents = NULL;
- d->vector = NULL;
- d->vector_cnt = 0;
-
- return d;
-}
-
-/* Creates and returns a (deep) copy of an existing
- dictionary. */
-struct dictionary *
-dict_clone (const struct dictionary *s)
-{
- struct dictionary *d;
- size_t i;
-
- assert (s != NULL);
-
- d = dict_create ();
-
- for (i = 0; i < s->var_cnt; i++)
- {
- struct variable *sv = s->var[i];
- struct variable *dv = dict_clone_var_assert (d, sv, sv->name);
- var_set_short_name (dv, sv->short_name);
- }
-
- d->next_value_idx = s->next_value_idx;
-
- d->split_cnt = s->split_cnt;
- if (d->split_cnt > 0)
- {
- d->split = xnmalloc (d->split_cnt, sizeof *d->split);
- for (i = 0; i < d->split_cnt; i++)
- d->split[i] = dict_lookup_var_assert (d, s->split[i]->name);
- }
-
- if (s->weight != NULL)
- d->weight = dict_lookup_var_assert (d, s->weight->name);
-
- if (s->filter != NULL)
- d->filter = dict_lookup_var_assert (d, s->filter->name);
-
- d->case_limit = s->case_limit;
- dict_set_label (d, dict_get_label (s));
- dict_set_documents (d, dict_get_documents (s));
-
- d->vector_cnt = s->vector_cnt;
- d->vector = xnmalloc (d->vector_cnt, sizeof *d->vector);
- for (i = 0; i < s->vector_cnt; i++)
- {
- struct vector *sv = s->vector[i];
- struct vector *dv = d->vector[i] = xmalloc (sizeof *dv);
- int j;
-
- dv->idx = i;
- strcpy (dv->name, sv->name);
- dv->cnt = sv->cnt;
- dv->var = xnmalloc (dv->cnt, sizeof *dv->var);
- for (j = 0; j < dv->cnt; j++)
- dv->var[j] = d->var[sv->var[j]->index];
- }
-
- return d;
-}
-
-/* Clears the contents from a dictionary without destroying the
- dictionary itself. */
-void
-dict_clear (struct dictionary *d)
-{
- /* FIXME? Should we really clear case_limit, label, documents?
- Others are necessarily cleared by deleting all the variables.*/
- int i;
-
- assert (d != NULL);
-
- for (i = 0; i < d->var_cnt; i++)
- {
- struct variable *v = d->var[i];
- var_clear_aux (v);
- val_labs_destroy (v->val_labs);
- free (v->label);
- free (v);
- }
- free (d->var);
- d->var = NULL;
- d->var_cnt = d->var_cap = 0;
- hsh_clear (d->name_tab);
- d->next_value_idx = 0;
- free (d->split);
- d->split = NULL;
- d->split_cnt = 0;
- d->weight = NULL;
- d->filter = NULL;
- d->case_limit = 0;
- free (d->label);
- d->label = NULL;
- free (d->documents);
- d->documents = NULL;
- dict_clear_vectors (d);
-}
-
-/* Destroys the aux data for every variable in D, by calling
- var_clear_aux() for each variable. */
-void
-dict_clear_aux (struct dictionary *d)
-{
- int i;
-
- assert (d != NULL);
-
- for (i = 0; i < d->var_cnt; i++)
- var_clear_aux (d->var[i]);
-}
-
-/* Clears a dictionary and destroys it. */
-void
-dict_destroy (struct dictionary *d)
-{
- if (d != NULL)
- {
- dict_clear (d);
- hsh_destroy (d->name_tab);
- free (d);
- }
-}
-
-/* Returns the number of variables in D. */
-size_t
-dict_get_var_cnt (const struct dictionary *d)
-{
- assert (d != NULL);
-
- return d->var_cnt;
-}
-
-/* Returns the variable in D with index IDX, which must be
- between 0 and the count returned by dict_get_var_cnt(),
- exclusive. */
-struct variable *
-dict_get_var (const struct dictionary *d, size_t idx)
-{
- assert (d != NULL);
- assert (idx < d->var_cnt);
-
- return d->var[idx];
-}
-
-/* Sets *VARS to an array of pointers to variables in D and *CNT
- to the number of variables in *D. By default all variables
- are returned, but bits may be set in EXCLUDE_CLASSES to
- exclude ordinary, system, and/or scratch variables. */
-void
-dict_get_vars (const struct dictionary *d, struct variable ***vars,
- size_t *cnt, unsigned exclude_classes)
-{
- size_t count;
- size_t i;
-
- assert (d != NULL);
- assert (vars != NULL);
- assert (cnt != NULL);
- assert ((exclude_classes & ~((1u << DC_ORDINARY)
- | (1u << DC_SYSTEM)
- | (1u << DC_SCRATCH))) == 0);
-
- count = 0;
- for (i = 0; i < d->var_cnt; i++)
- if (!(exclude_classes & (1u << dict_class_from_id (d->var[i]->name))))
- count++;
-
- *vars = xnmalloc (count, sizeof **vars);
- *cnt = 0;
- for (i = 0; i < d->var_cnt; i++)
- if (!(exclude_classes & (1u << dict_class_from_id (d->var[i]->name))))
- (*vars)[(*cnt)++] = d->var[i];
- assert (*cnt == count);
-}
-
-
-/* Creates and returns a new variable in D with the given NAME
- and WIDTH. Returns a null pointer if the given NAME would
- duplicate that of an existing variable in the dictionary. */
-struct variable *
-dict_create_var (struct dictionary *d, const char *name, int width)
-{
- struct variable *v;
-
- assert (d != NULL);
- assert (name != NULL);
-
- assert (width >= 0 && width < 256);
-
- assert (var_is_valid_name(name,0));
-
- /* Make sure there's not already a variable by that name. */
- if (dict_lookup_var (d, name) != NULL)
- return NULL;
-
- /* Allocate and initialize variable. */
- v = xmalloc (sizeof *v);
- str_copy_trunc (v->name, sizeof v->name, name);
- v->type = width == 0 ? NUMERIC : ALPHA;
- v->width = width;
- v->fv = d->next_value_idx;
- v->nv = width == 0 ? 1 : DIV_RND_UP (width, 8);
- v->init = 1;
- v->reinit = dict_class_from_id (v->name) != DC_SCRATCH;
- v->index = d->var_cnt;
- mv_init (&v->miss, width);
- if (v->type == NUMERIC)
- {
- v->print = f8_2;
- v->alignment = ALIGN_RIGHT;
- v->display_width = 8;
- v->measure = MEASURE_SCALE;
- }
- else
- {
- v->print = make_output_format (FMT_A, v->width, 0);
- v->alignment = ALIGN_LEFT;
- v->display_width = 8;
- v->measure = MEASURE_NOMINAL;
- }
- v->write = v->print;
- v->val_labs = val_labs_create (v->width);
- v->label = NULL;
- var_clear_short_name (v);
- v->aux = NULL;
- v->aux_dtor = NULL;
- v->obs_vals = NULL;
-
- /* Update dictionary. */
- if (d->var_cnt >= d->var_cap)
- {
- d->var_cap = 8 + 2 * d->var_cap;
- d->var = xnrealloc (d->var, d->var_cap, sizeof *d->var);
- }
- d->var[v->index] = v;
- d->var_cnt++;
- hsh_force_insert (d->name_tab, v);
-
- d->next_value_idx += v->nv;
-
- return v;
-}
-
-/* Creates and returns a new variable in D with the given NAME
- and WIDTH. Assert-fails if the given NAME would duplicate
- that of an existing variable in the dictionary. */
-struct variable *
-dict_create_var_assert (struct dictionary *d, const char *name, int width)
-{
- struct variable *v = dict_create_var (d, name, width);
- assert (v != NULL);
- return v;
-}
-
-/* Creates and returns a new variable in D with name NAME, as a
- copy of existing variable OV, which need not be in D or in any
- dictionary. Returns a null pointer if the given NAME would
- duplicate that of an existing variable in the dictionary. */
-struct variable *
-dict_clone_var (struct dictionary *d, const struct variable *ov,
- const char *name)
-{
- struct variable *nv;
-
- assert (d != NULL);
- assert (ov != NULL);
- assert (name != NULL);
-
- assert (strlen (name) >= 1);
- assert (strlen (name) <= LONG_NAME_LEN);
-
- nv = dict_create_var (d, name, ov->width);
- if (nv == NULL)
- return NULL;
-
- /* Copy most members not copied via dict_create_var().
- short_name[] is intentionally not copied, because there is
- no reason to give a new variable with potentially a new name
- the same short name. */
- nv->init = 1;
- nv->reinit = ov->reinit;
- mv_copy (&nv->miss, &ov->miss);
- nv->print = ov->print;
- nv->write = ov->write;
- val_labs_destroy (nv->val_labs);
- nv->val_labs = val_labs_copy (ov->val_labs);
- if (ov->label != NULL)
- nv->label = xstrdup (ov->label);
- nv->measure = ov->measure;
- nv->display_width = ov->display_width;
- nv->alignment = ov->alignment;
-
- return nv;
-}
-
-/* Creates and returns a new variable in D with name NAME, as a
- copy of existing variable OV, which need not be in D or in any
- dictionary. Assert-fails if the given NAME would duplicate
- that of an existing variable in the dictionary. */
-struct variable *
-dict_clone_var_assert (struct dictionary *d, const struct variable *ov,
- const char *name)
-{
- struct variable *v = dict_clone_var (d, ov, name);
- assert (v != NULL);
- return v;
-}
-
-/* Returns the variable named NAME in D, or a null pointer if no
- variable has that name. */
-struct variable *
-dict_lookup_var (const struct dictionary *d, const char *name)
-{
- struct variable v;
-
- assert (d != NULL);
- assert (name != NULL);
-
- str_copy_trunc (v.name, sizeof v.name, name);
- return hsh_find (d->name_tab, &v);
-}
-
-/* Returns the variable named NAME in D. Assert-fails if no
- variable has that name. */
-struct variable *
-dict_lookup_var_assert (const struct dictionary *d, const char *name)
-{
- struct variable *v = dict_lookup_var (d, name);
- assert (v != NULL);
- return v;
-}
-
-/* Returns true if variable V is in dictionary D,
- false otherwise. */
-bool
-dict_contains_var (const struct dictionary *d, const struct variable *v)
-{
- assert (d != NULL);
- assert (v != NULL);
-
- return v->index >= 0 && v->index < d->var_cnt && d->var[v->index] == v;
-}
-
-/* Compares two double pointers to variables, which should point
- to elements of a struct dictionary's `var' member array. */
-static int
-compare_var_ptrs (const void *a_, const void *b_, void *aux UNUSED)
-{
- struct variable *const *a = a_;
- struct variable *const *b = b_;
-
- return *a < *b ? -1 : *a > *b;
-}
-
-/* Deletes variable V from dictionary D and frees V.
-
- This is a very bad idea if there might be any pointers to V
- from outside D. In general, no variable in default_dict
- should be deleted when any transformations are active, because
- those transformations might reference the deleted variable.
- The safest time to delete a variable is just after a procedure
- has been executed, as done by MODIFY VARS.
-
- Pointers to V within D are not a problem, because
- dict_delete_var() knows to remove V from split variables,
- weights, filters, etc. */
-void
-dict_delete_var (struct dictionary *d, struct variable *v)
-{
- size_t i;
-
- assert (d != NULL);
- assert (v != NULL);
- assert (dict_contains_var (d, v));
-
- /* Delete aux data. */
- var_clear_aux (v);
-
- /* Remove V from splits, weight, filter variables. */
- d->split_cnt = remove_equal (d->split, d->split_cnt, sizeof *d->split,
- &v, compare_var_ptrs, NULL);
- if (d->weight == v)
- d->weight = NULL;
- if (d->filter == v)
- d->filter = NULL;
- dict_clear_vectors (d);
-
- /* Remove V from var array. */
- remove_element (d->var, d->var_cnt, sizeof *d->var, v->index);
- d->var_cnt--;
-
- /* Update index. */
- for (i = v->index; i < d->var_cnt; i++)
- d->var[i]->index = i;
-
- /* Update name hash. */
- hsh_force_delete (d->name_tab, v);
-
- /* Free memory. */
- val_labs_destroy (v->val_labs);
- cat_stored_values_destroy (v);
- free (v->label);
- free (v);
-}
-
-/* Deletes the COUNT variables listed in VARS from D. This is
- unsafe; see the comment on dict_delete_var() for details. */
-void
-dict_delete_vars (struct dictionary *d,
- struct variable *const *vars, size_t count)
-{
- /* FIXME: this can be done in O(count) time, but this algorithm
- is O(count**2). */
- assert (d != NULL);
- assert (count == 0 || vars != NULL);
-
- while (count-- > 0)
- dict_delete_var (d, *vars++);
-}
-
-/* Deletes scratch variables from dictionary D. */
-void
-dict_delete_scratch_vars (struct dictionary *d)
-{
- int i;
-
- /* FIXME: this can be done in O(count) time, but this algorithm
- is O(count**2). */
- assert (d != NULL);
-
- for (i = 0; i < d->var_cnt; )
- if (dict_class_from_id (d->var[i]->name) == DC_SCRATCH)
- dict_delete_var (d, d->var[i]);
- else
- i++;
-}
-
-/* Moves V to 0-based position IDX in D. Other variables in D,
- if any, retain their relative positions. Runs in time linear
- in the distance moved. */
-void
-dict_reorder_var (struct dictionary *d, struct variable *v,
- size_t new_index)
-{
- size_t min_idx, max_idx;
- size_t i;
-
- assert (d != NULL);
- assert (v != NULL);
- assert (dict_contains_var (d, v));
- assert (new_index < d->var_cnt);
-
- move_element (d->var, d->var_cnt, sizeof *d->var, v->index, new_index);
-
- min_idx = min (v->index, new_index);
- max_idx = max (v->index, new_index);
- for (i = min_idx; i <= max_idx; i++)
- d->var[i]->index = i;
-}
-
-/* Reorders the variables in D, placing the COUNT variables
- listed in ORDER in that order at the beginning of D. The
- other variables in D, if any, retain their relative
- positions. */
-void
-dict_reorder_vars (struct dictionary *d,
- struct variable *const *order, size_t count)
-{
- struct variable **new_var;
- size_t i;
-
- assert (d != NULL);
- assert (count == 0 || order != NULL);
- assert (count <= d->var_cnt);
-
- new_var = xnmalloc (d->var_cnt, sizeof *new_var);
- memcpy (new_var, order, count * sizeof *new_var);
- for (i = 0; i < count; i++)
- {
- assert (d->var[order[i]->index] != NULL);
- d->var[order[i]->index] = NULL;
- order[i]->index = i;
- }
- for (i = 0; i < d->var_cnt; i++)
- if (d->var[i] != NULL)
- {
- assert (count < d->var_cnt);
- new_var[count] = d->var[i];
- new_var[count]->index = count;
- count++;
- }
- free (d->var);
- d->var = new_var;
-}
-
-/* Changes the name of V in D to name NEW_NAME. Assert-fails if
- a variable named NEW_NAME is already in D, except that
- NEW_NAME may be the same as V's existing name. */
-void
-dict_rename_var (struct dictionary *d, struct variable *v,
- const char *new_name)
-{
- assert (d != NULL);
- assert (v != NULL);
- assert (new_name != NULL);
- assert (var_is_valid_name (new_name, false));
- assert (dict_contains_var (d, v));
- assert (!compare_var_names (v->name, new_name, NULL)
- || dict_lookup_var (d, new_name) == NULL);
-
- hsh_force_delete (d->name_tab, v);
- str_copy_trunc (v->name, sizeof v->name, new_name);
- hsh_force_insert (d->name_tab, v);
-
- if (get_algorithm () == ENHANCED)
- var_clear_short_name (v);
-}
-
-/* Renames COUNT variables specified in VARS to the names given
- in NEW_NAMES within dictionary D. If the renaming would
- result in a duplicate variable name, returns false and stores a
- name that would be duplicated into *ERR_NAME (if ERR_NAME is
- non-null). Otherwise, the renaming is successful, and true
- is returned. */
-bool
-dict_rename_vars (struct dictionary *d,
- struct variable **vars, char **new_names,
- size_t count, char **err_name)
-{
- char **old_names;
- size_t i;
- bool success = true;
-
- assert (d != NULL);
- assert (count == 0 || vars != NULL);
- assert (count == 0 || new_names != NULL);
-
- /* Remove the variables to be renamed from the name hash,
- save their names, and rename them. */
- old_names = xnmalloc (count, sizeof *old_names);
- for (i = 0; i < count; i++)
- {
- assert (d->var[vars[i]->index] == vars[i]);
- assert (var_is_valid_name (new_names[i], false));
- hsh_force_delete (d->name_tab, vars[i]);
- old_names[i] = xstrdup (vars[i]->name);
- strcpy (vars[i]->name, new_names[i]);
- }
-
- /* Add the renamed variables back into the name hash,
- checking for conflicts. */
- for (i = 0; i < count; i++)
- {
- assert (new_names[i] != NULL);
- assert (*new_names[i] != '\0');
- assert (strlen (new_names[i]) >= 1);
- assert (strlen (new_names[i]) <= LONG_NAME_LEN);
-
- if (hsh_insert (d->name_tab, vars[i]) != NULL)
- {
- /* There is a name conflict.
- Back out all the name changes that have already
- taken place, and indicate failure. */
- size_t fail_idx = i;
- if (err_name != NULL)
- *err_name = new_names[i];
-
- for (i = 0; i < fail_idx; i++)
- hsh_force_delete (d->name_tab, vars[i]);
-
- for (i = 0; i < count; i++)
- {
- strcpy (vars[i]->name, old_names[i]);
- hsh_force_insert (d->name_tab, vars[i]);
- }
-
- success = false;
- goto done;
- }
- }
-
- /* Clear short names. */
- if (get_algorithm () == ENHANCED)
- for (i = 0; i < count; i++)
- var_clear_short_name (vars[i]);
-
- done:
- /* Free the old names we kept around. */
- for (i = 0; i < count; i++)
- free (old_names[i]);
- free (old_names);
-
- return success;
-}
-
-/* Returns the weighting variable in dictionary D, or a null
- pointer if the dictionary is unweighted. */
-struct variable *
-dict_get_weight (const struct dictionary *d)
-{
- assert (d != NULL);
- assert (d->weight == NULL || dict_contains_var (d, d->weight));
-
- return d->weight;
-}
-
-/* Returns the value of D's weighting variable in case C, except that a
- negative weight is returned as 0. Returns 1 if the dictionary is
- unweighted. Will warn about missing, negative, or zero values if
- warn_on_invalid is nonzero. The function will set warn_on_invalid to zero
- if an invalid weight is found. */
-double
-dict_get_case_weight (const struct dictionary *d, const struct ccase *c,
- int *warn_on_invalid)
-{
- assert (d != NULL);
- assert (c != NULL);
-
- if (d->weight == NULL)
- return 1.0;
- else
- {
- double w = case_num (c, d->weight->fv);
- if (w < 0.0 || mv_is_num_missing (&d->weight->miss, w))
- w = 0.0;
- if ( w == 0.0 && *warn_on_invalid ) {
- *warn_on_invalid = 0;
- msg (SW, _("At least one case in the data file had a weight value "
- "that was user-missing, system-missing, zero, or "
- "negative. These case(s) were ignored."));
- }
- return w;
- }
-}
-
-/* Sets the weighting variable of D to V, or turning off
- weighting if V is a null pointer. */
-void
-dict_set_weight (struct dictionary *d, struct variable *v)
-{
- assert (d != NULL);
- assert (v == NULL || dict_contains_var (d, v));
- assert (v == NULL || v->type == NUMERIC);
-
- d->weight = v;
-}
-
-/* Returns the filter variable in dictionary D (see cmd_filter())
- or a null pointer if the dictionary is unfiltered. */
-struct variable *
-dict_get_filter (const struct dictionary *d)
-{
- assert (d != NULL);
- assert (d->filter == NULL || dict_contains_var (d, d->filter));
-
- return d->filter;
-}
-
-/* Sets V as the filter variable for dictionary D. Passing a
- null pointer for V turn off filtering. */
-void
-dict_set_filter (struct dictionary *d, struct variable *v)
-{
- assert (d != NULL);
- assert (v == NULL || dict_contains_var (d, v));
-
- d->filter = v;
-}
-
-/* Returns the case limit for dictionary D, or zero if the number
- of cases is unlimited (see cmd_n()). */
-int
-dict_get_case_limit (const struct dictionary *d)
-{
- assert (d != NULL);
-
- return d->case_limit;
-}
-
-/* Sets CASE_LIMIT as the case limit for dictionary D. Zero for
- CASE_LIMIT indicates no limit. */
-void
-dict_set_case_limit (struct dictionary *d, int case_limit)
-{
- assert (d != NULL);
- assert (case_limit >= 0);
-
- d->case_limit = case_limit;
-}
-
-/* Returns the index of the next value to be added to D. This
- value is the number of `union value's that need to be
- allocated to store a case for dictionary D. */
-int
-dict_get_next_value_idx (const struct dictionary *d)
-{
- assert (d != NULL);
-
- return d->next_value_idx;
-}
-
-/* Returns the number of bytes needed to store a case for
- dictionary D. */
-size_t
-dict_get_case_size (const struct dictionary *d)
-{
- assert (d != NULL);
-
- return sizeof (union value) * dict_get_next_value_idx (d);
-}
-
-/* Deletes scratch variables in dictionary D and reassigns values
- so that fragmentation is eliminated. */
-void
-dict_compact_values (struct dictionary *d)
-{
- size_t i;
-
- d->next_value_idx = 0;
- for (i = 0; i < d->var_cnt; )
- {
- struct variable *v = d->var[i];
-
- if (dict_class_from_id (v->name) != DC_SCRATCH)
- {
- v->fv = d->next_value_idx;
- d->next_value_idx += v->nv;
- i++;
- }
- else
- dict_delete_var (d, v);
- }
-}
-
-/* Returns the number of values that would be used by a case if
- dict_compact_values() were called. */
-size_t
-dict_get_compacted_value_cnt (const struct dictionary *d)
-{
- size_t i;
- size_t cnt;
-
- cnt = 0;
- for (i = 0; i < d->var_cnt; i++)
- if (dict_class_from_id (d->var[i]->name) != DC_SCRATCH)
- cnt += d->var[i]->nv;
- return cnt;
-}
-
-/* Creates and returns an array mapping from a dictionary index
- to the `fv' that the corresponding variable will have after
- calling dict_compact_values(). Scratch variables receive -1
- for `fv' because dict_compact_values() will delete them. */
-int *
-dict_get_compacted_idx_to_fv (const struct dictionary *d)
-{
- size_t i;
- size_t next_value_idx;
- int *idx_to_fv;
-
- idx_to_fv = xnmalloc (d->var_cnt, sizeof *idx_to_fv);
- next_value_idx = 0;
- for (i = 0; i < d->var_cnt; i++)
- {
- struct variable *v = d->var[i];
-
- if (dict_class_from_id (v->name) != DC_SCRATCH)
- {
- idx_to_fv[i] = next_value_idx;
- next_value_idx += v->nv;
- }
- else
- idx_to_fv[i] = -1;
- }
- return idx_to_fv;
-}
-
-/* Returns true if a case for dictionary D would be smaller after
- compaction, false otherwise. Compacting a case eliminates
- "holes" between values and after the last value. Holes are
- created by deleting variables (or by scratch variables).
-
- The return value may differ from whether compacting a case
- from dictionary D would *change* the case: compaction could
- rearrange values even if it didn't reduce space
- requirements. */
-bool
-dict_needs_compaction (const struct dictionary *d)
-{
- return dict_get_compacted_value_cnt (d) < dict_get_next_value_idx (d);
-}
-\f
-/* How to copy a contiguous range of values between cases. */
-struct copy_map
- {
- size_t src_idx; /* Starting value index in source case. */
- size_t dst_idx; /* Starting value index in target case. */
- size_t cnt; /* Number of values. */
- };
-
-/* How to compact a case. */
-struct dict_compactor
- {
- struct copy_map *maps; /* Array of mappings. */
- size_t map_cnt; /* Number of mappings. */
- };
-
-/* Creates and returns a dict_compactor that can be used to
- compact cases for dictionary D.
-
- Compacting a case eliminates "holes" between values and after
- the last value. Holes are created by deleting variables (or
- by scratch variables). */
-struct dict_compactor *
-dict_make_compactor (const struct dictionary *d)
-{
- struct dict_compactor *compactor;
- struct copy_map *map;
- size_t map_allocated;
- size_t value_idx;
- size_t i;
-
- compactor = xmalloc (sizeof *compactor);
- compactor->maps = NULL;
- compactor->map_cnt = 0;
- map_allocated = 0;
-
- value_idx = 0;
- map = NULL;
- for (i = 0; i < d->var_cnt; i++)
- {
- struct variable *v = d->var[i];
-
- if (dict_class_from_id (v->name) == DC_SCRATCH)
- continue;
- if (map != NULL && map->src_idx + map->cnt == v->fv)
- map->cnt += v->nv;
- else
- {
- if (compactor->map_cnt == map_allocated)
- compactor->maps = x2nrealloc (compactor->maps, &map_allocated,
- sizeof *compactor->maps);
- map = &compactor->maps[compactor->map_cnt++];
- map->src_idx = v->fv;
- map->dst_idx = value_idx;
- map->cnt = v->nv;
- }
- value_idx += v->nv;
- }
-
- return compactor;
-}
-
-/* Compacts SRC by copying it to DST according to the scheme in
- COMPACTOR.
-
- Compacting a case eliminates "holes" between values and after
- the last value. Holes are created by deleting variables (or
- by scratch variables). */
-void
-dict_compactor_compact (const struct dict_compactor *compactor,
- struct ccase *dst, const struct ccase *src)
-{
- size_t i;
-
- for (i = 0; i < compactor->map_cnt; i++)
- {
- const struct copy_map *map = &compactor->maps[i];
- case_copy (dst, map->dst_idx, src, map->src_idx, map->cnt);
- }
-}
-
-/* Destroys COMPACTOR. */
-void
-dict_compactor_destroy (struct dict_compactor *compactor)
-{
- if (compactor != NULL)
- {
- free (compactor->maps);
- free (compactor);
- }
-}
-
-/* Returns the SPLIT FILE vars (see cmd_split_file()). Call
- dict_get_split_cnt() to determine how many SPLIT FILE vars
- there are. Returns a null pointer if and only if there are no
- SPLIT FILE vars. */
-struct variable *const *
-dict_get_split_vars (const struct dictionary *d)
-{
- assert (d != NULL);
-
- return d->split;
-}
-
-/* Returns the number of SPLIT FILE vars. */
-size_t
-dict_get_split_cnt (const struct dictionary *d)
-{
- assert (d != NULL);
-
- return d->split_cnt;
-}
-
-/* Sets CNT split vars SPLIT in dictionary D. */
-void
-dict_set_split_vars (struct dictionary *d,
- struct variable *const *split, size_t cnt)
-{
- assert (d != NULL);
- assert (cnt == 0 || split != NULL);
-
- d->split_cnt = cnt;
- d->split = xnrealloc (d->split, cnt, sizeof *d->split);
- memcpy (d->split, split, cnt * sizeof *d->split);
-}
-
-/* Returns the file label for D, or a null pointer if D is
- unlabeled (see cmd_file_label()). */
-const char *
-dict_get_label (const struct dictionary *d)
-{
- assert (d != NULL);
-
- return d->label;
-}
-
-/* Sets D's file label to LABEL, truncating it to a maximum of 60
- characters. */
-void
-dict_set_label (struct dictionary *d, const char *label)
-{
- assert (d != NULL);
-
- free (d->label);
- if (label == NULL)
- d->label = NULL;
- else if (strlen (label) < 60)
- d->label = xstrdup (label);
- else
- {
- d->label = xmalloc (61);
- memcpy (d->label, label, 60);
- d->label[60] = '\0';
- }
-}
-
-/* Returns the documents for D, or a null pointer if D has no
- documents (see cmd_document()).. */
-const char *
-dict_get_documents (const struct dictionary *d)
-{
- assert (d != NULL);
-
- return d->documents;
-}
-
-/* Sets the documents for D to DOCUMENTS, or removes D's
- documents if DOCUMENT is a null pointer. */
-void
-dict_set_documents (struct dictionary *d, const char *documents)
-{
- assert (d != NULL);
-
- free (d->documents);
- if (documents == NULL)
- d->documents = NULL;
- else
- d->documents = xstrdup (documents);
-}
-
-/* Creates in D a vector named NAME that contains CNT variables
- VAR (see cmd_vector()). Returns true if successful, or
- false if a vector named NAME already exists in D. */
-bool
-dict_create_vector (struct dictionary *d,
- const char *name,
- struct variable **var, size_t cnt)
-{
- struct vector *vector;
- size_t i;
-
- assert (d != NULL);
- assert (name != NULL);
- assert (var_is_valid_name (name, false));
- assert (var != NULL);
- assert (cnt > 0);
-
- if (dict_lookup_vector (d, name) != NULL)
- return false;
-
- d->vector = xnrealloc (d->vector, d->vector_cnt + 1, sizeof *d->vector);
- vector = d->vector[d->vector_cnt] = xmalloc (sizeof *vector);
- vector->idx = d->vector_cnt++;
- str_copy_trunc (vector->name, sizeof vector->name, name);
- vector->var = xnmalloc (cnt, sizeof *var);
- for (i = 0; i < cnt; i++)
- {
- assert (dict_contains_var (d, var[i]));
- vector->var[i] = var[i];
- }
- vector->cnt = cnt;
-
- return true;
-}
-
-/* Returns the vector in D with index IDX, which must be less
- than dict_get_vector_cnt (D). */
-const struct vector *
-dict_get_vector (const struct dictionary *d, size_t idx)
-{
- assert (d != NULL);
- assert (idx < d->vector_cnt);
-
- return d->vector[idx];
-}
-
-/* Returns the number of vectors in D. */
-size_t
-dict_get_vector_cnt (const struct dictionary *d)
-{
- assert (d != NULL);
-
- return d->vector_cnt;
-}
-
-/* Looks up and returns the vector within D with the given
- NAME. */
-const struct vector *
-dict_lookup_vector (const struct dictionary *d, const char *name)
-{
- size_t i;
-
- assert (d != NULL);
- assert (name != NULL);
-
- for (i = 0; i < d->vector_cnt; i++)
- if (!strcasecmp (d->vector[i]->name, name))
- return d->vector[i];
- return NULL;
-}
-
-/* Deletes all vectors from D. */
-void
-dict_clear_vectors (struct dictionary *d)
-{
- size_t i;
-
- assert (d != NULL);
-
- for (i = 0; i < d->vector_cnt; i++)
- {
- free (d->vector[i]->var);
- free (d->vector[i]);
- }
- free (d->vector);
- d->vector = NULL;
- d->vector_cnt = 0;
-}
-
-/* Compares two strings. */
-static int
-compare_strings (const void *a, const void *b, void *aux UNUSED)
-{
- return strcmp (a, b);
-}
-
-/* Hashes a string. */
-static unsigned
-hash_string (const void *s, void *aux UNUSED)
-{
- return hsh_hash_string (s);
-}
-
-/* Assigns a valid, unique short_name[] to each variable in D.
- Each variable whose actual name is short has highest priority
- for that short name. Otherwise, variables with an existing
- short_name[] have the next highest priority for a given short
- name; if it is already taken, then the variable is treated as
- if short_name[] had been empty. Otherwise, long names are
- truncated to form short names. If that causes conflicts,
- variables are renamed as PREFIX_A, PREFIX_B, and so on. */
-void
-dict_assign_short_names (struct dictionary *d)
-{
- struct hsh_table *short_names;
- size_t i;
-
- /* Give variables whose names are short the corresponding short
- names, and clear short_names[] that conflict with a variable
- name. */
- for (i = 0; i < d->var_cnt; i++)
- {
- struct variable *v = d->var[i];
- if (strlen (v->name) <= SHORT_NAME_LEN)
- var_set_short_name (v, v->name);
- else if (dict_lookup_var (d, v->short_name) != NULL)
- var_clear_short_name (v);
- }
-
- /* Each variable with an assigned short_name[] now gets it
- unless there is a conflict. */
- short_names = hsh_create (d->var_cnt, compare_strings, hash_string,
- NULL, NULL);
- for (i = 0; i < d->var_cnt; i++)
- {
- struct variable *v = d->var[i];
- if (v->short_name[0] && hsh_insert (short_names, v->short_name) != NULL)
- var_clear_short_name (v);
- }
-
- /* Now assign short names to remaining variables. */
- for (i = 0; i < d->var_cnt; i++)
- {
- struct variable *v = d->var[i];
- if (v->short_name[0] == '\0')
- {
- int sfx;
-
- /* Form initial short_name. */
- var_set_short_name (v, v->name);
-
- /* Try _A, _B, ... _AA, _AB, etc., if needed. */
- for (sfx = 0; hsh_insert (short_names, v->short_name) != NULL; sfx++)
- var_set_short_name_suffix (v, v->name, sfx);
- }
- }
-
- /* Get rid of hash table. */
- hsh_destroy (short_names);
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef DICTIONARY_H
-#define DICTIONARY_H
-
-#include <stdbool.h>
-#include <stddef.h>
-
-/* Dictionary. */
-
-struct variable;
-struct dictionary *dict_create (void);
-struct dictionary *dict_clone (const struct dictionary *);
-void dict_clear (struct dictionary *);
-void dict_clear_aux (struct dictionary *);
-void dict_destroy (struct dictionary *);
-
-size_t dict_get_var_cnt (const struct dictionary *);
-struct variable *dict_get_var (const struct dictionary *, size_t idx);
-void dict_get_vars (const struct dictionary *,
- struct variable ***vars, size_t *cnt,
- unsigned exclude_classes);
-
-struct variable *dict_create_var (struct dictionary *, const char *,
- int width);
-
-struct variable *dict_create_var_assert (struct dictionary *, const char *,
- int width);
-struct variable *dict_clone_var (struct dictionary *, const struct variable *,
- const char *);
-struct variable *dict_clone_var_assert (struct dictionary *,
- const struct variable *, const char *);
-
-struct variable *dict_lookup_var (const struct dictionary *, const char *);
-struct variable *dict_lookup_var_assert (const struct dictionary *,
- const char *);
-bool dict_contains_var (const struct dictionary *, const struct variable *);
-void dict_delete_var (struct dictionary *, struct variable *);
-void dict_delete_vars (struct dictionary *,
- struct variable *const *, size_t count);
-void dict_delete_scratch_vars (struct dictionary *);
-void dict_reorder_var (struct dictionary *d, struct variable *v,
- size_t new_index);
-void dict_reorder_vars (struct dictionary *,
- struct variable *const *, size_t count);
-void dict_rename_var (struct dictionary *, struct variable *, const char *);
-bool dict_rename_vars (struct dictionary *,
- struct variable **, char **new_names,
- size_t count, char **err_name);
-
-struct ccase;
-struct variable *dict_get_weight (const struct dictionary *);
-double dict_get_case_weight (const struct dictionary *,
- const struct ccase *, int *);
-void dict_set_weight (struct dictionary *, struct variable *);
-
-struct variable *dict_get_filter (const struct dictionary *);
-void dict_set_filter (struct dictionary *, struct variable *);
-
-int dict_get_case_limit (const struct dictionary *);
-void dict_set_case_limit (struct dictionary *, int);
-
-int dict_get_next_value_idx (const struct dictionary *);
-size_t dict_get_case_size (const struct dictionary *);
-
-void dict_compact_values (struct dictionary *);
-size_t dict_get_compacted_value_cnt (const struct dictionary *);
-int *dict_get_compacted_idx_to_fv (const struct dictionary *);
-bool dict_needs_compaction (const struct dictionary *);
-
-struct dict_compactor *dict_make_compactor (const struct dictionary *);
-void dict_compactor_compact (const struct dict_compactor *,
- struct ccase *, const struct ccase *);
-void dict_compactor_destroy (struct dict_compactor *);
-
-struct variable *const *dict_get_split_vars (const struct dictionary *);
-size_t dict_get_split_cnt (const struct dictionary *);
-void dict_set_split_vars (struct dictionary *,
- struct variable *const *, size_t cnt);
-
-const char *dict_get_label (const struct dictionary *);
-void dict_set_label (struct dictionary *, const char *);
-
-const char *dict_get_documents (const struct dictionary *);
-void dict_set_documents (struct dictionary *, const char *);
-
-bool dict_create_vector (struct dictionary *,
- const char *name,
- struct variable **, size_t cnt);
-const struct vector *dict_get_vector (const struct dictionary *,
- size_t idx);
-size_t dict_get_vector_cnt (const struct dictionary *);
-const struct vector *dict_lookup_vector (const struct dictionary *,
- const char *name);
-void dict_clear_vectors (struct dictionary *);
-
-void dict_assign_short_names (struct dictionary *);
-
-#endif /* dictionary.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "ctl-stack.h"
-#include "error.h"
-#include <stdlib.h>
-#include "alloc.h"
-#include "command.h"
-#include "error.h"
-#include "expressions/public.h"
-#include "lexer.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* DO IF, ELSE IF, and ELSE are translated as a single
- transformation that evaluates each condition and jumps to the
- start of the appropriate block of transformations. Each block
- of transformations (except for the last) ends with a
- transformation that jumps past the remaining blocks.
-
- So, the following code:
-
- DO IF a.
- ...block 1...
- ELSE IF b.
- ...block 2...
- ELSE.
- ...block 3...
- END IF.
-
- is effectively translated like this:
-
- IF a GOTO 1, IF b GOTO 2, ELSE GOTO 3.
- 1: ...block 1...
- GOTO 4
- 2: ...block 2...
- GOTO 4
- 3: ...block 3...
- 4:
-
-*/
-
-/* A conditional clause. */
-struct clause
- {
- struct expression *condition; /* Test expression; NULL for ELSE clause. */
- int target_index; /* Transformation to jump to if true. */
- };
-
-/* DO IF transformation. */
-struct do_if_trns
- {
- struct clause *clauses; /* Clauses. */
- size_t clause_cnt; /* Number of clauses. */
- int past_END_IF_index; /* Transformation just past last clause. */
- };
-
-static struct ctl_class do_if_class;
-
-static int parse_clause (struct do_if_trns *);
-static void add_clause (struct do_if_trns *,
- struct expression *condition, int target_index);
-static void add_else (struct do_if_trns *);
-
-static bool has_else (struct do_if_trns *);
-static bool must_not_have_else (struct do_if_trns *);
-static void close_do_if (void *do_if);
-
-static trns_proc_func do_if_trns_proc, break_trns_proc;
-static trns_free_func do_if_trns_free;
-
-/* Parse DO IF. */
-int
-cmd_do_if (void)
-{
- struct do_if_trns *do_if = xmalloc (sizeof *do_if);
- do_if->clauses = NULL;
- do_if->clause_cnt = 0;
-
- ctl_stack_push (&do_if_class, do_if);
- add_transformation (do_if_trns_proc, do_if_trns_free, do_if);
-
- return parse_clause (do_if);
-}
-
-/* Parse ELSE IF. */
-int
-cmd_else_if (void)
-{
- struct do_if_trns *do_if = ctl_stack_top (&do_if_class);
- if (do_if == NULL || !must_not_have_else (do_if))
- return CMD_FAILURE;
- return parse_clause (do_if);
-}
-
-/* Parse ELSE. */
-int
-cmd_else (void)
-{
- struct do_if_trns *do_if = ctl_stack_top (&do_if_class);
- if (do_if == NULL || !must_not_have_else (do_if))
- return CMD_FAILURE;
- add_else (do_if);
- return lex_end_of_command ();
-}
-
-/* Parse END IF. */
-int
-cmd_end_if (void)
-{
- struct do_if_trns *do_if = ctl_stack_top (&do_if_class);
- if (do_if == NULL)
- return CMD_FAILURE;
-
- ctl_stack_pop (do_if);
-
- return lex_end_of_command ();
-}
-
-/* Closes out DO_IF, by adding a sentinel ELSE clause if
- necessary and setting past_END_IF_index. */
-static void
-close_do_if (void *do_if_)
-{
- struct do_if_trns *do_if = do_if_;
-
- if (!has_else (do_if))
- add_else (do_if);
- do_if->past_END_IF_index = next_transformation ();
-}
-
-/* Adds an ELSE clause to DO_IF pointing to the next
- transformation. */
-static void
-add_else (struct do_if_trns *do_if)
-{
- assert (!has_else (do_if));
- add_clause (do_if, NULL, next_transformation ());
-}
-
-/* Returns true if DO_IF does not yet have an ELSE clause.
- Reports an error and returns false if it does already. */
-static bool
-must_not_have_else (struct do_if_trns *do_if)
-{
- if (has_else (do_if))
- {
- msg (SE, _("This command may not follow ELSE in DO IF...END IF."));
- return false;
- }
- else
- return true;
-}
-
-/* Returns true if DO_IF already has an ELSE clause,
- false otherwise. */
-static bool
-has_else (struct do_if_trns *do_if)
-{
- return (do_if->clause_cnt != 0
- && do_if->clauses[do_if->clause_cnt - 1].condition == NULL);
-}
-
-/* Parses a DO IF or ELSE IF expression and appends the
- corresponding clause to DO_IF. Checks for end of command and
- returns a command return code. */
-static int
-parse_clause (struct do_if_trns *do_if)
-{
- struct expression *condition;
-
- condition = expr_parse (default_dict, EXPR_BOOLEAN);
- if (condition == NULL)
- return CMD_FAILURE;
-
- add_clause (do_if, condition, next_transformation ());
-
- return lex_end_of_command ();
-}
-
-/* Adds a clause to DO_IF that tests for the given CONDITION and,
- if true, jumps to TARGET_INDEX. */
-static void
-add_clause (struct do_if_trns *do_if,
- struct expression *condition, int target_index)
-{
- struct clause *clause;
-
- if (do_if->clause_cnt > 0)
- add_transformation (break_trns_proc, NULL, do_if);
-
- do_if->clauses = xnrealloc (do_if->clauses,
- do_if->clause_cnt + 1, sizeof *do_if->clauses);
- clause = &do_if->clauses[do_if->clause_cnt++];
- clause->condition = condition;
- clause->target_index = target_index;
-}
-
-/* DO IF transformation procedure.
- Checks each clause and jumps to the appropriate
- transformation. */
-static int
-do_if_trns_proc (void *do_if_, struct ccase *c, int case_num UNUSED)
-{
- struct do_if_trns *do_if = do_if_;
- struct clause *clause;
-
- for (clause = do_if->clauses; clause < do_if->clauses + do_if->clause_cnt;
- clause++)
- {
- if (clause->condition != NULL)
- {
- double boolean = expr_evaluate_num (clause->condition, c, case_num);
- if (boolean == 1.0)
- return clause->target_index;
- else if (boolean == SYSMIS)
- return do_if->past_END_IF_index;
- }
- else
- return clause->target_index;
- }
- return do_if->past_END_IF_index;
-}
-
-/* Frees a DO IF transformation. */
-static void
-do_if_trns_free (void *do_if_)
-{
- struct do_if_trns *do_if = do_if_;
- struct clause *clause;
-
- for (clause = do_if->clauses; clause < do_if->clauses + do_if->clause_cnt;
- clause++)
- expr_free (clause->condition);
- free (do_if->clauses);
- free (do_if);
-}
-
-/* Breaks out of a DO IF construct. */
-static int
-break_trns_proc (void *do_if_, struct ccase *c UNUSED, int case_num UNUSED)
-{
- struct do_if_trns *do_if = do_if_;
-
- return do_if->past_END_IF_index;
-}
-
-/* DO IF control structure class definition. */
-static struct ctl_class do_if_class =
- {
- "DO IF",
- "END IF",
- close_do_if,
- };
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-
-/* Stubs for plotting routines.
- This module is linked only when charts are not supported */
-
-#include "config.h"
-#include "chart.h"
-
-
-#ifndef NO_CHARTS
-#error This file should be used only when compiling without charts.
-#endif
-
-struct chart *
-chart_create(void)
-{
- return 0;
-}
-
-
-void
-chart_write_title(struct chart *chart, const char *title, ...)
-{
-}
-
-
-void
-chart_submit(struct chart *chart)
-{
-}
-
-
-void
-chart_write_xscale(struct chart *ch, double min, double max, int ticks)
-{
-}
-
-
-void
-chart_write_yscale(struct chart *ch, double smin, double smax, int ticks)
-{
-}
-
-
-void
-chart_write_xlabel(struct chart *ch, const char *label)
-{
-}
-
-void
-chart_write_ylabel(struct chart *ch, const char *label)
-{
-}
-
-
-void
-chart_line(struct chart *ch, double slope, double intercept,
- double limit1, double limit2, enum CHART_DIM lim_dim)
-{
-}
-
-
-void
-chart_datum(struct chart *ch, int dataset UNUSED, double x, double y)
-{
-}
-
-
-void
-histogram_plot(const gsl_histogram *hist,
- const char *factorname,
- const struct normal_curve *norm, short show_normal)
-{
-}
-
-void
-boxplot_draw_yscale(struct chart *ch , double y_max, double y_min)
-{
-}
-
-void
-boxplot_draw_boxplot(struct chart *ch,
- double box_centre,
- double box_width,
- struct metrics *m,
- const char *name)
-{
-}
-
-
-
-void
-piechart_plot(const char *title, const struct slice *slices, int n_slices)
-{
-}
+++ /dev/null
-/* PSPP - computes sample statistics. -*-c-*-
-
- Copyright (C) 2005 Free Software Foundation, Inc.
- Written by John Darrington 2005
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include "alloc.h"
-#include "str.h"
-#include "lexer.h"
-#include "command.h"
-#include "tab.h"
-#include "som.h"
-
-/* Echos a string to the output stream */
-int
-cmd_echo(void)
-{
- struct tab_table *tab;
-
- if (token != T_STRING)
- return CMD_FAILURE;
-
- tab = tab_create(1, 1, 0);
-
- tab_dim (tab, tab_natural_dimensions);
- tab_flags (tab, SOMF_NO_TITLE );
-
- tab_text(tab, 0, 0, 0, tokstr.string);
-
- tab_submit(tab);
-
- return CMD_SUCCESS;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <ctype.h>
-#include <stdarg.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "command.h"
-#include "getl.h"
-#include "glob.h"
-#include "lexer.h"
-#include "main.h"
-#include "output.h"
-#include "progname.h"
-#include "readln.h"
-#include "settings.h"
-#include "str.h"
-#include "var.h"
-#include "version.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-#define N_(msgid) msgid
-
-int err_error_count;
-int err_warning_count;
-
-int err_already_flagged;
-
-int err_verbosity;
-
-\f
-/* Fairly common public functions. */
-
-/* Writes error message in CLASS, with title TITLE and text FORMAT,
- formatted with printf, to the standard places. */
-void
-tmsg (int class, const char *title, const char *format, ...)
-{
- struct error e;
- va_list args;
-
- e.class = class;
- err_location (&e.where);
- e.title = title;
-
- va_start (args, format);
- err_vmsg (&e, format, args);
- va_end (args);
-}
-
-/* Writes error message in CLASS, with text FORMAT, formatted with
- printf, to the standard places. */
-void
-msg (int class, const char *format, ...)
-{
- struct error e;
- va_list args;
-
- e.class = class;
- err_location (&e.where);
- e.title = NULL;
-
- va_start (args, format);
- err_vmsg (&e, format, args);
- va_end (args);
-}
-
-/* Terminate due to fatal error in input. */
-void
-err_failure (void)
-{
- fflush (stdout);
- fflush (stderr);
-
- fprintf (stderr, "%s: %s\n", program_name,
- _("Terminating NOW due to a fatal error!"));
-
- terminate (false);
-}
-
-/* Terminate unless we're interactive or will go interactive when the
- file is over with. */
-void
-err_cond_fail (void)
-{
- if (getl_reading_script ())
- {
- if (getl_interactive)
- getl_close_all ();
- else
- err_failure ();
- }
-}
-\f
-/* Obscure public functions. */
-
-/* Writes a blank line to the error device(s).
- FIXME: currently a no-op. */
-void
-err_break (void)
-{
-}
-
-/* Checks whether we've had so many errors that it's time to quit
- processing this syntax file. If so, then take appropriate
- action. */
-void
-err_check_count (void)
-{
- int error_class = getl_interactive ? MM : FE;
-
- if (get_errorbreak() && err_error_count)
- msg (error_class, _("Terminating execution of syntax file due to error."));
- else if (err_error_count > get_mxerrs() )
- msg (error_class, _("Errors (%d) exceeds limit (%d)."),
- err_error_count, get_mxerrs());
- else if (err_error_count + err_warning_count > get_mxwarns() )
- msg (error_class, _("Warnings (%d) exceed limit (%d)."),
- err_error_count + err_warning_count, get_mxwarns() );
- else
- return;
-
- getl_close_all ();
-}
-
-/* Some machines are broken. Compensate. */
-#ifndef EXIT_SUCCESS
-#define EXIT_SUCCESS 0
-#endif
-
-#ifndef EXIT_FAILURE
-#define EXIT_FAILURE 1
-#endif
-
-static void puts_stdout (const char *s);
-static void dump_message (char *errbuf, unsigned indent,
- void (*func) (const char *), unsigned width);
-
-void
-err_done (void)
-{
- lex_done();
- getl_uninitialize ();
- readln_uninitialize();
-}
-
-void
-err_vmsg (const struct error *e, const char *format, va_list args)
-{
- /* Class flags. */
- enum
- {
- ERR_IN_PROCEDURE = 01, /* 1=Display name of current procedure. */
- ERR_WITH_FILE = 02, /* 1=Display filename and line number. */
- };
-
- /* Describes one class of error. */
- struct error_class
- {
- int flags; /* Zero or more of ERR_*. */
- int *count; /* Counting category. */
- const char *banner; /* Banner. */
- };
-
- static const struct error_class error_classes[ERR_CLASS_COUNT] =
- {
- {0, NULL, N_("fatal")}, /* FE */
-
- {3, &err_error_count, N_("error")}, /* SE */
- {3, &err_warning_count, N_("warning")}, /* SW */
- {3, NULL, N_("note")}, /* SM */
-
- {0, NULL, N_("installation error")}, /* IE */
- {2, NULL, N_("installation error")}, /* IS */
-
- {2, &err_error_count, N_("error")}, /* DE */
- {2, &err_warning_count, N_("warning")}, /* DW */
-
- {0, &err_error_count, N_("error")}, /* ME */
- {0, &err_warning_count, N_("warning")}, /* MW */
- {0, NULL, N_("note")}, /* MM */
- };
-
- struct string msg;
- int class;
-
- /* Check verbosity level. */
- class = e->class;
- if (((class >> ERR_VERBOSITY_SHIFT) & ERR_VERBOSITY_MASK) > err_verbosity)
- return;
- class &= ERR_CLASS_MASK;
-
- assert (class >= 0 && class < ERR_CLASS_COUNT);
- assert (format != NULL);
-
- ds_init (&msg, 64);
- if (e->where.filename && (error_classes[class].flags & ERR_WITH_FILE))
- {
- ds_printf (&msg, "%s:", e->where.filename);
- if (e->where.line_number != -1)
- ds_printf (&msg, "%d:", e->where.line_number);
- ds_putc (&msg, ' ');
- }
-
- ds_printf (&msg, "%s: ", gettext (error_classes[class].banner));
-
- {
- int *count = error_classes[class].count;
- if (count)
- (*count)++;
- }
-
- if (cur_proc && (error_classes[class].flags & ERR_IN_PROCEDURE))
- ds_printf (&msg, "%s: ", cur_proc);
-
- if (e->title)
- ds_puts (&msg, e->title);
-
- ds_vprintf (&msg, format, args);
-
- /* FIXME: Check set_messages and set_errors to determine where to
- send errors and messages.
-
- Please note that this is not trivial. We have to avoid an
- infinite loop in reporting errors that originate in the output
- section. */
- dump_message (ds_c_str (&msg), 8, puts_stdout, get_viewwidth());
-
- ds_destroy (&msg);
-
- if (e->class == FE)
- terminate (0);
-}
-\f
-/* Private functions. */
-
-#if 0
-/* Write S followed by a newline to stderr. */
-static void
-puts_stderr (const char *s)
-{
- fputs (s, stderr);
- fputc ('\n', stderr);
-}
-#endif
-
-/* Write S followed by a newline to stdout. */
-static void
-puts_stdout (const char *s)
-{
- puts (s);
-}
-
-/* Returns 1 if the line must be broken here */
-static int
-compulsory_break(int c)
-{
- return ( c == '\n' );
-}
-
-/* Returns 1 if C is a `break character', that is, if it is a good
- place to break a message into lines. */
-static inline int
-char_is_break (int quote, int c)
-{
- return ((quote && c == DIR_SEPARATOR)
- || (!quote && (isspace (c) || c == '-' || c == '/')));
-}
-
-/* Returns 1 if C is a break character where the break should be made
- BEFORE the character. */
-static inline int
-break_before (int quote, int c)
-{
- return !quote && isspace (c);
-}
-
-/* If C is a break character, returns 1 if the break should be made
- AFTER the character. Does not return a meaningful result if C is
- not a break character. */
-static inline int
-break_after (int quote, int c)
-{
- return !break_before (quote, c);
-}
-
-/* If you want very long words that occur at a bad break point to be
- broken into two lines even if they're shorter than a whole line by
- themselves, define as 2/3, or 4/5, or whatever fraction of a whole
- line you think is necessary in order to consider a word long enough
- to break into pieces. Otherwise, define as 0. See code to grok
- the details. Do NOT parenthesize the expression! */
-#define BREAK_LONG_WORD 0
-/* #define BREAK_LONG_WORD 2/3 */
-/* #define BREAK_LONG_WORD 4/5 */
-
-/* Divides MSG into lines of WIDTH width for the first line and WIDTH
- - INDENT width for each succeeding line. Each line is dumped
- through FUNC, which may do with the string what it will. */
-static void
-dump_message (char *msg, unsigned indent, void (*func) (const char *),
- unsigned width)
-{
- char *cp;
-
- /* 1 when at a position inside double quotes ("). */
- int quote = 0;
-
- /* Buffer for a single line. */
- char *buf;
-
- /* If the message is short, just print the full thing. */
- if (strlen (msg) < width)
- {
- func (msg);
- return;
- }
-
- /* Make sure the indent isn't too big relative to the page width. */
- if (indent > width / 3)
- indent = width / 3;
-
- buf = local_alloc (width + 2);
-
- /* Advance WIDTH characters into MSG.
- If that's a valid breakpoint, keep it; otherwise, back up.
- Output the line. */
- for (cp = msg; (unsigned) (cp - msg) < width - 1 &&
- ! compulsory_break(*cp); cp++)
- if (*cp == '"')
- quote ^= 1;
-
- if (break_after (quote, (unsigned char) *cp))
- {
- for (cp--; !char_is_break (quote, (unsigned char) *cp) && cp > msg; cp--)
- if (*cp == '"')
- quote ^= 1;
-
- if (break_after (quote, (unsigned char) *cp))
- cp++;
- }
-
- if (cp <= msg + width * BREAK_LONG_WORD)
- for (; cp < msg + width - 1; cp++)
- if (*cp == '"')
- quote ^= 1;
-
- {
- int c = *cp;
- *cp = '\0';
- func (msg);
- *cp = c;
- }
-
-
- /* Repeat above procedure for remaining lines. */
- for (;;)
- {
- static int hard_break=0;
-
- int idx=0;
- char *cp2;
-
- /* Advance past whitespace. */
- if (! hard_break )
- while ( isspace ((unsigned char) *cp) )
- cp++;
- else
- cp++;
-
- if (*cp == 0)
- break;
-
-
- /* Advance WIDTH - INDENT characters. */
- for (cp2 = cp; (unsigned) (cp2 - cp) < width - indent &&
- *cp2 && !compulsory_break(*cp2); cp2++)
- if (*cp2 == '"')
- quote ^= 1;
-
- if ( compulsory_break(*cp2) )
- hard_break = 1;
- else
- hard_break = 0;
-
-
- /* Back up if this isn't a breakpoint. */
- {
- unsigned w = cp2 - cp;
- if (*cp2 && ! compulsory_break(*cp2) )
- for (cp2--; !char_is_break (quote, (unsigned char) *cp2) &&
- cp2 > cp;
- cp2--)
- {
-
- if (*cp2 == '"')
- quote ^= 1;
- }
-
- if (w == width - indent
- && (unsigned) (cp2 - cp) <= (width - indent) * BREAK_LONG_WORD)
- for (; (unsigned) (cp2 - cp) < width - indent && *cp2 ; cp2++)
- if (*cp2 == '"')
- quote ^= 1;
- }
-
-
- /* Write out the line. */
-
- memset (buf, ' ', indent);
- memcpy (&buf[indent], cp, cp2 - cp);
-
- buf[indent + idx + cp2 - cp] = '\0';
- func (buf);
- cp = cp2;
- }
-
- local_free (buf);
-}
-
-
-void
-request_bug_report_and_abort(const char *msg )
-{
- fprintf(stderr,
- "******************************************************************\n"
- "You have discovered a bug in PSPP.\n\n"
- " Please report this, by sending "
- "an email to " PACKAGE_BUGREPORT ",\n"
- "explaining what you were doing when this happened, and including\n"
- "a sample of your input file which caused it.\n");
-
- fprintf(stderr,
- "Also, please copy the following lines into your bug report:\n\n"
- "bare_version: %s\n"
- "version: %s\n"
- "stat_version: %s\n"
- "host_system: %s\n"
- "build_system: %s\n"
- "default_config_path: %s\n"
- "include_path: %s\n"
- "groff_font_path: %s\n"
- "locale_dir: %s\n"
- "compiler version: %s\n"
- ,
-
- bare_version,
- version,
- stat_version,
- host_system,
- build_system,
- default_config_path,
- include_path,
- groff_font_path,
- locale_dir,
-#ifdef __VERSION__
- __VERSION__
-#else
- "Unknown"
-#endif
- );
-
- if ( msg )
- fprintf(stderr,"Diagnosis: %s\n",msg);
-
- fprintf(stderr,
- "******************************************************************\n");
-
- abort();
-}
-
-void
-err_assert_fail(const char *expr, const char *file, int line)
-{
- char msg[256];
- snprintf(msg,256,"Assertion failed: %s:%d; (%s)",file,line,expr);
- request_bug_report_and_abort( msg );
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !error_h
-#define error_h 1
-
-#include <stdarg.h>
-
-/* Message classes. */
-enum
- {
- FE, /* Fatal errors. */
- SE, SW, SM, /* Script error/warning/message. */
- IE, IS, /* Installation error/script error. */
- DE, DW, /* Data-file error/warning. */
- ME, MW, MM, /* General error/warning/message. */
- ERR_CLASS_COUNT, /* Number of message classes. */
- ERR_CLASS_MASK = 0xf, /* Bitmask for class. */
- ERR_VERBOSITY_SHIFT = 4, /* Shift count for verbosity. */
- ERR_VERBOSITY_MASK = 0xf /* Bitmask for verbosity. */
- };
-
-/* If passed to msg() as CLASS, the return value will cause the message
- to be displayed only if `verbosity' is at least LEVEL. */
-#define VM(LEVEL) (MM | ((LEVEL) << ERR_VERBOSITY_SHIFT))
-
-/* A file location. */
-struct file_locator
- {
- const char *filename; /* Filename. */
- int line_number; /* Line number. */
- };
-
-/* An error message. */
-struct error
- {
- int class; /* One of the classes above. */
- struct file_locator where; /* File location, or (NULL, -1). */
- const char *title; /* Special text inserted if not null. */
- };
-
-/* Number of errors, warnings reported. */
-extern int err_error_count;
-extern int err_warning_count;
-
-/* If number of allowable errors/warnings is exceeded, then a message
- is displayed and this flag is set to suppress subsequent
- messages. */
-extern int err_already_flagged;
-
-/* Nonnegative verbosity level. Higher value == more verbose. */
-extern int err_verbosity;
-
-/* Functions. */
-void msg (int class, const char *format, ...)
- PRINTF_FORMAT (2, 3);
-void tmsg (int class, const char *title, const char *format, ...)
- PRINTF_FORMAT (3, 4);
-void err_failure (void);
-void err_cond_fail (void);
-
-/* File-locator stack. */
-void err_push_file_locator (const struct file_locator *);
-void err_pop_file_locator (const struct file_locator *);
-void err_location (struct file_locator *);
-
-/* Obscure functions. */
-void err_done (void);
-void err_break (void);
-void err_check_count (void);
-void err_vmsg (const struct error *, const char *, va_list);
-
-/* Used in panic situations only */
-void request_bug_report_and_abort(const char *msg );
-
-void err_assert_fail(const char *expr, const char *file, int line);
-
-#undef __STRING
-#define __STRING(x) #x
-#undef assert
-
-
-#define assert(expr) ( (void) ( expr ? (void) 0 : \
- err_assert_fail(__STRING(expr), __FILE__, __LINE__)) )
-
-
-#endif /* error.h */
+++ /dev/null
-/* PSPP - EXAMINE data for normality . -*-c-*-
-
-Copyright (C) 2004 Free Software Foundation, Inc.
-Author: John Darrington 2004
-
-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 the Free Software Foundation; either version 2 of the
-License, or (at your option) any later version.
-
-This program is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA. */
-
-#include <config.h>
-#include <gsl/gsl_cdf.h>
-#include "error.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include <math.h>
-#include "alloc.h"
-#include "str.h"
-#include "case.h"
-#include "dictionary.h"
-#include "command.h"
-#include "lexer.h"
-#include "error.h"
-#include "magic.h"
-#include "misc.h"
-#include "tab.h"
-#include "som.h"
-#include "value-labels.h"
-#include "var.h"
-#include "vfm.h"
-#include "hash.h"
-#include "casefile.h"
-#include "factor_stats.h"
-#include "moments.h"
-#include "percentiles.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-#define N_(msgid) msgid
-
-/* (headers) */
-#include "chart.h"
-
-/* (specification)
- "EXAMINE" (xmn_):
- *^variables=custom;
- +total=custom;
- +nototal=custom;
- +missing=miss:pairwise/!listwise,
- rep:report/!noreport,
- incl:include/!exclude;
- +compare=cmp:variables/!groups;
- +percentiles=custom;
- +id=var;
- +plot[plt_]=stemleaf,boxplot,npplot,:spreadlevel(*d:n),histogram,all,none;
- +cinterval=double;
- +statistics[st_]=descriptives,:extreme(*d:n),all,none.
-*/
-
-/* (declarations) */
-
-/* (functions) */
-
-
-
-static struct cmd_examine cmd;
-
-static struct variable **dependent_vars;
-
-static size_t n_dependent_vars;
-
-
-struct factor
-{
- /* The independent variable */
- struct variable *indep_var[2];
-
-
- /* Hash table of factor stats indexed by 2 values */
- struct hsh_table *fstats;
-
- /* The hash table after it has been crunched */
- struct factor_statistics **fs;
-
- struct factor *next;
-
-};
-
-/* Linked list of factors */
-static struct factor *factors=0;
-
-static struct metrics *totals=0;
-
-/* Parse the clause specifying the factors */
-static int examine_parse_independent_vars(struct cmd_examine *cmd);
-
-
-
-/* Output functions */
-static void show_summary(struct variable **dependent_var, int n_dep_var,
- const struct factor *f);
-
-static void show_extremes(struct variable **dependent_var,
- int n_dep_var,
- const struct factor *factor,
- int n_extremities);
-
-static void show_descriptives(struct variable **dependent_var,
- int n_dep_var,
- struct factor *factor);
-
-static void show_percentiles(struct variable **dependent_var,
- int n_dep_var,
- struct factor *factor);
-
-
-
-
-void np_plot(const struct metrics *m, const char *factorname);
-
-
-void box_plot_group(const struct factor *fctr,
- const struct variable **vars, int n_vars,
- const struct variable *id
- ) ;
-
-
-void box_plot_variables(const struct factor *fctr,
- const struct variable **vars, int n_vars,
- const struct variable *id
- );
-
-
-
-/* Per Split function */
-static void run_examine(const struct casefile *cf, void *cmd_);
-
-static void output_examine(void);
-
-
-void factor_calc(struct ccase *c, int case_no,
- double weight, int case_missing);
-
-
-/* Represent a factor as a string, so it can be
- printed in a human readable fashion */
-const char * factor_to_string(const struct factor *fctr,
- struct factor_statistics *fs,
- const struct variable *var);
-
-
-/* Represent a factor as a string, so it can be
- printed in a human readable fashion,
- but sacrificing some readablility for the sake of brevity */
-const char *factor_to_string_concise(const struct factor *fctr,
- struct factor_statistics *fs);
-
-
-
-
-/* Function to use for testing for missing values */
-static is_missing_func *value_is_missing;
-
-
-/* PERCENTILES */
-
-static subc_list_double percentile_list;
-
-static enum pc_alg percentile_algorithm;
-
-static short sbc_percentile;
-
-
-int
-cmd_examine(void)
-{
-
- subc_list_double_create(&percentile_list);
- percentile_algorithm = PC_HAVERAGE;
-
- if ( !parse_examine(&cmd) )
- return CMD_FAILURE;
-
- /* If /MISSING=INCLUDE is set, then user missing values are ignored */
- if (cmd.incl == XMN_INCLUDE )
- value_is_missing = mv_is_value_system_missing;
- else
- value_is_missing = mv_is_value_missing;
-
- if ( cmd.st_n == SYSMIS )
- cmd.st_n = 5;
-
- if ( ! cmd.sbc_cinterval)
- cmd.n_cinterval[0] = 95.0;
-
- /* If descriptives have been requested, make sure the
- quartiles are calculated */
- if ( cmd.a_statistics[XMN_ST_DESCRIPTIVES] )
- {
- subc_list_double_push(&percentile_list, 25);
- subc_list_double_push(&percentile_list, 50);
- subc_list_double_push(&percentile_list, 75);
- }
-
- multipass_procedure_with_splits (run_examine, &cmd);
-
- if ( totals )
- {
- free( totals );
- }
-
- if ( dependent_vars )
- free (dependent_vars);
-
- {
- struct factor *f = factors ;
- while ( f )
- {
- struct factor *ff = f;
-
- f = f->next;
- free ( ff->fs );
- hsh_destroy ( ff->fstats ) ;
- free ( ff ) ;
- }
- factors = 0;
- }
-
- subc_list_double_destroy(&percentile_list);
-
- return CMD_SUCCESS;
-};
-
-
-
-/* Show all the appropriate tables */
-static void
-output_examine(void)
-{
- struct factor *fctr;
-
- /* Show totals if appropriate */
- if ( ! cmd.sbc_nototal || factors == 0 )
- {
- show_summary(dependent_vars, n_dependent_vars, 0);
-
- if ( cmd.sbc_statistics )
- {
- if ( cmd.a_statistics[XMN_ST_EXTREME])
- show_extremes(dependent_vars, n_dependent_vars, 0, cmd.st_n);
-
- if ( cmd.a_statistics[XMN_ST_DESCRIPTIVES])
- show_descriptives(dependent_vars, n_dependent_vars, 0);
-
- }
- if ( sbc_percentile )
- show_percentiles(dependent_vars, n_dependent_vars, 0);
-
- if ( cmd.sbc_plot)
- {
- int v;
- if ( cmd.a_plot[XMN_PLT_NPPLOT] )
- {
- for ( v = 0 ; v < n_dependent_vars; ++v )
- np_plot(&totals[v], var_to_string(dependent_vars[v]));
- }
-
- if ( cmd.a_plot[XMN_PLT_BOXPLOT] )
- {
- if ( cmd.cmp == XMN_GROUPS )
- {
- box_plot_group(0, dependent_vars, n_dependent_vars,
- cmd.v_id);
- }
- else
- box_plot_variables(0, dependent_vars, n_dependent_vars,
- cmd.v_id);
- }
-
- if ( cmd.a_plot[XMN_PLT_HISTOGRAM] )
- {
- for ( v = 0 ; v < n_dependent_vars; ++v )
- {
- struct normal_curve normal;
-
- normal.N = totals[v].n;
- normal.mean = totals[v].mean;
- normal.stddev = totals[v].stddev;
-
- histogram_plot(totals[v].histogram,
- var_to_string(dependent_vars[v]),
- &normal, 0);
- }
- }
-
- }
-
- }
-
-
- /* Show grouped statistics as appropriate */
- fctr = factors;
- while ( fctr )
- {
- show_summary(dependent_vars, n_dependent_vars, fctr);
-
- if ( cmd.sbc_statistics )
- {
- if ( cmd.a_statistics[XMN_ST_EXTREME])
- show_extremes(dependent_vars, n_dependent_vars, fctr, cmd.st_n);
-
- if ( cmd.a_statistics[XMN_ST_DESCRIPTIVES])
- show_descriptives(dependent_vars, n_dependent_vars, fctr);
- }
-
- if ( sbc_percentile )
- show_percentiles(dependent_vars, n_dependent_vars, fctr);
-
-
- if ( cmd.sbc_plot)
- {
- size_t v;
-
- struct factor_statistics **fs = fctr->fs ;
-
- if ( cmd.a_plot[XMN_PLT_BOXPLOT] )
- {
- if ( cmd.cmp == XMN_VARIABLES )
- box_plot_variables(fctr, dependent_vars, n_dependent_vars,
- cmd.v_id);
- else
- box_plot_group(fctr, dependent_vars, n_dependent_vars,
- cmd.v_id);
- }
-
- for ( v = 0 ; v < n_dependent_vars; ++v )
- {
-
- for ( fs = fctr->fs ; *fs ; ++fs )
- {
- const char *s = factor_to_string(fctr, *fs, dependent_vars[v]);
-
- if ( cmd.a_plot[XMN_PLT_NPPLOT] )
- np_plot(&(*fs)->m[v], s);
-
- if ( cmd.a_plot[XMN_PLT_HISTOGRAM] )
- {
- struct normal_curve normal;
-
- normal.N = (*fs)->m[v].n;
- normal.mean = (*fs)->m[v].mean;
- normal.stddev = (*fs)->m[v].stddev;
-
- histogram_plot((*fs)->m[v].histogram,
- s, &normal, 0);
- }
-
- } /* for ( fs .... */
-
- } /* for ( v = 0 ..... */
-
- }
-
- fctr = fctr->next;
- }
-
-}
-
-
-/* Create a hash table of percentiles and their values from the list of
- percentiles */
-static struct hsh_table *
-list_to_ptile_hash(const subc_list_double *l)
-{
- int i;
-
- struct hsh_table *h ;
-
- h = hsh_create(subc_list_double_count(l),
- (hsh_compare_func *) ptile_compare,
- (hsh_hash_func *) ptile_hash,
- (hsh_free_func *) free,
- 0);
-
-
- for ( i = 0 ; i < subc_list_double_count(l) ; ++i )
- {
- struct percentile *p = xmalloc (sizeof *p);
-
- p->p = subc_list_double_at(l,i);
- p->v = SYSMIS;
-
- hsh_insert(h, p);
-
- }
-
- return h;
-
-}
-
-/* Parse the PERCENTILES subcommand */
-static int
-xmn_custom_percentiles(struct cmd_examine *p UNUSED)
-{
- sbc_percentile = 1;
-
- lex_match('=');
-
- lex_match('(');
-
- while ( lex_is_number() )
- {
- subc_list_double_push(&percentile_list,lex_number());
-
- lex_get();
-
- lex_match(',') ;
- }
- lex_match(')');
-
- lex_match('=');
-
- if ( lex_match_id("HAVERAGE"))
- percentile_algorithm = PC_HAVERAGE;
-
- else if ( lex_match_id("WAVERAGE"))
- percentile_algorithm = PC_WAVERAGE;
-
- else if ( lex_match_id("ROUND"))
- percentile_algorithm = PC_ROUND;
-
- else if ( lex_match_id("EMPIRICAL"))
- percentile_algorithm = PC_EMPIRICAL;
-
- else if ( lex_match_id("AEMPIRICAL"))
- percentile_algorithm = PC_AEMPIRICAL;
-
- else if ( lex_match_id("NONE"))
- percentile_algorithm = PC_NONE;
-
-
- if ( 0 == subc_list_double_count(&percentile_list))
- {
- subc_list_double_push(&percentile_list, 5);
- subc_list_double_push(&percentile_list, 10);
- subc_list_double_push(&percentile_list, 25);
- subc_list_double_push(&percentile_list, 50);
- subc_list_double_push(&percentile_list, 75);
- subc_list_double_push(&percentile_list, 90);
- subc_list_double_push(&percentile_list, 95);
- }
-
- return 1;
-}
-
-/* TOTAL and NOTOTAL are simple, mutually exclusive flags */
-static int
-xmn_custom_total(struct cmd_examine *p)
-{
- if ( p->sbc_nototal )
- {
- msg (SE, _("%s and %s are mutually exclusive"),"TOTAL","NOTOTAL");
- return 0;
- }
-
- return 1;
-}
-
-static int
-xmn_custom_nototal(struct cmd_examine *p)
-{
- if ( p->sbc_total )
- {
- msg (SE, _("%s and %s are mutually exclusive"),"TOTAL","NOTOTAL");
- return 0;
- }
-
- return 1;
-}
-
-
-
-/* Parser for the variables sub command
- Returns 1 on success */
-static int
-xmn_custom_variables(struct cmd_examine *cmd )
-{
- lex_match('=');
-
- if ((token != T_ID || dict_lookup_var (default_dict, tokid) == NULL)
- && token != T_ALL)
- {
- return 2;
- }
-
- if (!parse_variables (default_dict, &dependent_vars, &n_dependent_vars,
- PV_NO_DUPLICATE | PV_NUMERIC | PV_NO_SCRATCH) )
- {
- free (dependent_vars);
- return 0;
- }
-
- assert(n_dependent_vars);
-
- totals = xnmalloc (n_dependent_vars, sizeof *totals);
-
- if ( lex_match(T_BY))
- {
- int success ;
- success = examine_parse_independent_vars(cmd);
- if ( success != 1 ) {
- free (dependent_vars);
- free (totals) ;
- }
- return success;
- }
-
- return 1;
-}
-
-
-
-/* Parse the clause specifying the factors */
-static int
-examine_parse_independent_vars(struct cmd_examine *cmd)
-{
- int success;
- struct factor *sf = xmalloc (sizeof *sf);
-
- if ((token != T_ID || dict_lookup_var (default_dict, tokid) == NULL)
- && token != T_ALL)
- {
- free ( sf ) ;
- return 2;
- }
-
-
- sf->indep_var[0] = parse_variable();
- sf->indep_var[1] = 0;
-
- if ( token == T_BY )
- {
-
- lex_match(T_BY);
-
- if ((token != T_ID || dict_lookup_var (default_dict, tokid) == NULL)
- && token != T_ALL)
- {
- free ( sf ) ;
- return 2;
- }
-
- sf->indep_var[1] = parse_variable();
-
- }
-
-
- sf->fstats = hsh_create(4,
- (hsh_compare_func *) factor_statistics_compare,
- (hsh_hash_func *) factor_statistics_hash,
- (hsh_free_func *) factor_statistics_free,
- 0);
-
- sf->next = factors;
- factors = sf;
-
- lex_match(',');
-
- if ( token == '.' || token == '/' )
- return 1;
-
- success = examine_parse_independent_vars(cmd);
-
- if ( success != 1 )
- free ( sf ) ;
-
- return success;
-}
-
-
-
-
-void populate_percentiles(struct tab_table *tbl, int col, int row,
- const struct metrics *m);
-
-void populate_descriptives(struct tab_table *t, int col, int row,
- const struct metrics *fs);
-
-void populate_extremes(struct tab_table *t, int col, int row, int n,
- const struct metrics *m);
-
-void populate_summary(struct tab_table *t, int col, int row,
- const struct metrics *m);
-
-
-
-
-static int bad_weight_warn = 1;
-
-
-/* Perform calculations for the sub factors */
-void
-factor_calc(struct ccase *c, int case_no, double weight, int case_missing)
-{
- size_t v;
- struct factor *fctr = factors;
-
- while ( fctr)
- {
- struct factor_statistics **foo ;
- union value indep_vals[2] ;
-
- indep_vals[0] = * case_data(c, fctr->indep_var[0]->fv);
-
- if ( fctr->indep_var[1] )
- indep_vals[1] = * case_data(c, fctr->indep_var[1]->fv);
- else
- indep_vals[1].f = SYSMIS;
-
- assert(fctr->fstats);
-
- foo = ( struct factor_statistics ** )
- hsh_probe(fctr->fstats, (void *) &indep_vals);
-
- if ( !*foo )
- {
-
- *foo = create_factor_statistics(n_dependent_vars,
- &indep_vals[0],
- &indep_vals[1]);
-
- for ( v = 0 ; v < n_dependent_vars ; ++v )
- {
- metrics_precalc( &(*foo)->m[v] );
- }
-
- }
-
- for ( v = 0 ; v < n_dependent_vars ; ++v )
- {
- const struct variable *var = dependent_vars[v];
- const union value *val = case_data (c, var->fv);
-
- if ( value_is_missing (&var->miss, val) || case_missing )
- val = 0;
-
- metrics_calc( &(*foo)->m[v], val, weight, case_no);
-
- }
-
- fctr = fctr->next;
- }
-
-
-}
-
-static void
-run_examine(const struct casefile *cf, void *cmd_ )
-{
- struct casereader *r;
- struct ccase c;
- int v;
-
- const struct cmd_examine *cmd = (struct cmd_examine *) cmd_;
-
- /* Make sure we haven't got rubbish left over from a
- previous split */
- struct factor *fctr = factors;
- while (fctr)
- {
- struct factor *next = fctr->next;
-
- hsh_clear(fctr->fstats);
-
- fctr->fs = 0;
-
- fctr = next;
- }
-
-
-
- for ( v = 0 ; v < n_dependent_vars ; ++v )
- metrics_precalc(&totals[v]);
-
- for(r = casefile_get_reader (cf);
- casereader_read (r, &c) ;
- case_destroy (&c) )
- {
- int case_missing=0;
- const int case_no = casereader_cnum(r);
-
- const double weight =
- dict_get_case_weight(default_dict, &c, &bad_weight_warn);
-
- if ( cmd->miss == XMN_LISTWISE )
- {
- for ( v = 0 ; v < n_dependent_vars ; ++v )
- {
- const struct variable *var = dependent_vars[v];
- const union value *val = case_data (&c, var->fv);
-
- if ( value_is_missing(&var->miss, val))
- case_missing = 1;
-
- }
- }
-
- for ( v = 0 ; v < n_dependent_vars ; ++v )
- {
- const struct variable *var = dependent_vars[v];
- const union value *val = case_data (&c, var->fv);
-
- if ( value_is_missing(&var->miss, val) || case_missing )
- val = 0;
-
- metrics_calc(&totals[v], val, weight, case_no);
-
- }
-
- factor_calc(&c, case_no, weight, case_missing);
-
- }
-
-
- for ( v = 0 ; v < n_dependent_vars ; ++v)
- {
- fctr = factors;
- while ( fctr )
- {
- struct hsh_iterator hi;
- struct factor_statistics *fs;
-
- for ( fs = hsh_first(fctr->fstats, &hi);
- fs != 0 ;
- fs = hsh_next(fctr->fstats, &hi))
- {
-
- fs->m[v].ptile_hash = list_to_ptile_hash(&percentile_list);
- fs->m[v].ptile_alg = percentile_algorithm;
- metrics_postcalc(&fs->m[v]);
- }
-
- fctr = fctr->next;
- }
-
- totals[v].ptile_hash = list_to_ptile_hash(&percentile_list);
- totals[v].ptile_alg = percentile_algorithm;
- metrics_postcalc(&totals[v]);
- }
-
-
- /* Make sure that the combination of factors are complete */
-
- fctr = factors;
- while ( fctr )
- {
- struct hsh_iterator hi;
- struct hsh_iterator hi0;
- struct hsh_iterator hi1;
- struct factor_statistics *fs;
-
- struct hsh_table *idh0=0;
- struct hsh_table *idh1=0;
- union value *val0;
- union value *val1;
-
- idh0 = hsh_create(4, (hsh_compare_func *) compare_values,
- (hsh_hash_func *) hash_value,
- 0,0);
-
- idh1 = hsh_create(4, (hsh_compare_func *) compare_values,
- (hsh_hash_func *) hash_value,
- 0,0);
-
-
- for ( fs = hsh_first(fctr->fstats, &hi);
- fs != 0 ;
- fs = hsh_next(fctr->fstats, &hi))
- {
- hsh_insert(idh0,(void *) &fs->id[0]);
- hsh_insert(idh1,(void *) &fs->id[1]);
- }
-
- /* Ensure that the factors combination is complete */
- for ( val0 = hsh_first(idh0, &hi0);
- val0 != 0 ;
- val0 = hsh_next(idh0, &hi0))
- {
- for ( val1 = hsh_first(idh1, &hi1);
- val1 != 0 ;
- val1 = hsh_next(idh1, &hi1))
- {
- struct factor_statistics **ffs;
- union value key[2];
- key[0] = *val0;
- key[1] = *val1;
-
- ffs = (struct factor_statistics **)
- hsh_probe(fctr->fstats, (void *) &key );
-
- if ( !*ffs ) {
- size_t i;
- (*ffs) = create_factor_statistics (n_dependent_vars,
- &key[0], &key[1]);
- for ( i = 0 ; i < n_dependent_vars ; ++i )
- metrics_precalc( &(*ffs)->m[i]);
- }
- }
- }
-
- hsh_destroy(idh0);
- hsh_destroy(idh1);
-
- fctr->fs = (struct factor_statistics **) hsh_sort_copy(fctr->fstats);
-
- fctr = fctr->next;
- }
-
- output_examine();
-
-
- if ( totals )
- {
- size_t i;
- for ( i = 0 ; i < n_dependent_vars ; ++i )
- {
- metrics_destroy(&totals[i]);
- }
- }
-
-}
-
-
-static void
-show_summary(struct variable **dependent_var, int n_dep_var,
- const struct factor *fctr)
-{
- static const char *subtitle[]=
- {
- N_("Valid"),
- N_("Missing"),
- N_("Total")
- };
-
- int i;
- int heading_columns ;
- int n_cols;
- const int heading_rows = 3;
- struct tab_table *tbl;
-
- int n_rows ;
- int n_factors = 1;
-
- if ( fctr )
- {
- heading_columns = 2;
- n_factors = hsh_count(fctr->fstats);
- n_rows = n_dep_var * n_factors ;
-
- if ( fctr->indep_var[1] )
- heading_columns = 3;
- }
- else
- {
- heading_columns = 1;
- n_rows = n_dep_var;
- }
-
- n_rows += heading_rows;
-
- n_cols = heading_columns + 6;
-
- tbl = tab_create (n_cols,n_rows,0);
- tab_headers (tbl, heading_columns, 0, heading_rows, 0);
-
- tab_dim (tbl, tab_natural_dimensions);
-
- /* Outline the box */
- tab_box (tbl,
- TAL_2, TAL_2,
- -1, -1,
- 0, 0,
- n_cols - 1, n_rows - 1);
-
- /* Vertical lines for the data only */
- tab_box (tbl,
- -1, -1,
- -1, TAL_1,
- heading_columns, 0,
- n_cols - 1, n_rows - 1);
-
-
- tab_hline (tbl, TAL_2, 0, n_cols - 1, heading_rows );
- tab_hline (tbl, TAL_1, heading_columns, n_cols - 1, 1 );
- tab_hline (tbl, TAL_1, heading_columns, n_cols - 1, heading_rows -1 );
-
- tab_vline (tbl, TAL_2, heading_columns, 0, n_rows - 1);
-
-
- tab_title (tbl, 0, _("Case Processing Summary"));
-
-
- tab_joint_text(tbl, heading_columns, 0,
- n_cols -1, 0,
- TAB_CENTER | TAT_TITLE,
- _("Cases"));
-
- /* Remove lines ... */
- tab_box (tbl,
- -1, -1,
- TAL_0, TAL_0,
- heading_columns, 0,
- n_cols - 1, 0);
-
- for ( i = 0 ; i < 3 ; ++i )
- {
- tab_text (tbl, heading_columns + i*2 , 2, TAB_CENTER | TAT_TITLE,
- _("N"));
-
- tab_text (tbl, heading_columns + i*2 + 1, 2, TAB_CENTER | TAT_TITLE,
- _("Percent"));
-
- tab_joint_text(tbl, heading_columns + i*2 , 1,
- heading_columns + i*2 + 1, 1,
- TAB_CENTER | TAT_TITLE,
- subtitle[i]);
-
- tab_box (tbl, -1, -1,
- TAL_0, TAL_0,
- heading_columns + i*2, 1,
- heading_columns + i*2 + 1, 1);
-
- }
-
-
- /* Titles for the independent variables */
- if ( fctr )
- {
- tab_text (tbl, 1, heading_rows - 1, TAB_CENTER | TAT_TITLE,
- var_to_string(fctr->indep_var[0]));
-
- if ( fctr->indep_var[1] )
- {
- tab_text (tbl, 2, heading_rows - 1, TAB_CENTER | TAT_TITLE,
- var_to_string(fctr->indep_var[1]));
- }
-
- }
-
-
- for ( i = 0 ; i < n_dep_var ; ++i )
- {
- int n_factors = 1;
- if ( fctr )
- n_factors = hsh_count(fctr->fstats);
-
-
- if ( i > 0 )
- tab_hline(tbl, TAL_1, 0, n_cols -1 , i * n_factors + heading_rows);
-
- tab_text (tbl,
- 0, i * n_factors + heading_rows,
- TAB_LEFT | TAT_TITLE,
- var_to_string(dependent_var[i])
- );
-
-
- if ( !fctr )
- populate_summary(tbl, heading_columns,
- (i * n_factors) + heading_rows,
- &totals[i]);
-
-
- else
- {
- struct factor_statistics **fs = fctr->fs;
- int count = 0 ;
-
- while (*fs)
- {
- static union value prev;
-
- if ( 0 != compare_values(&prev, &(*fs)->id[0],
- fctr->indep_var[0]->width))
- {
- tab_text (tbl,
- 1,
- (i * n_factors ) + count +
- heading_rows,
- TAB_LEFT | TAT_TITLE,
- value_to_string(&(*fs)->id[0], fctr->indep_var[0])
- );
-
- if (fctr->indep_var[1] && count > 0 )
- tab_hline(tbl, TAL_1, 1, n_cols - 1,
- (i * n_factors ) + count + heading_rows);
-
- }
-
- prev = (*fs)->id[0];
-
-
- if ( fctr->indep_var[1])
- tab_text (tbl,
- 2,
- (i * n_factors ) + count +
- heading_rows,
- TAB_LEFT | TAT_TITLE,
- value_to_string(&(*fs)->id[1], fctr->indep_var[1])
- );
-
- populate_summary(tbl, heading_columns,
- (i * n_factors) + count
- + heading_rows,
- &(*fs)->m[i]);
-
- count++ ;
- fs++;
- }
- }
- }
-
- tab_submit (tbl);
-}
-
-
-void
-populate_summary(struct tab_table *t, int col, int row,
- const struct metrics *m)
-
-{
- const double total = m->n + m->n_missing ;
-
- tab_float(t, col + 0, row + 0, TAB_RIGHT, m->n, 8, 0);
- tab_float(t, col + 2, row + 0, TAB_RIGHT, m->n_missing, 8, 0);
- tab_float(t, col + 4, row + 0, TAB_RIGHT, total, 8, 0);
-
-
- if ( total > 0 ) {
- tab_text (t, col + 1, row + 0, TAB_RIGHT | TAT_PRINTF, "%2.0f%%",
- 100.0 * m->n / total );
-
- tab_text (t, col + 3, row + 0, TAB_RIGHT | TAT_PRINTF, "%2.0f%%",
- 100.0 * m->n_missing / total );
-
- /* This seems a bit pointless !!! */
- tab_text (t, col + 5, row + 0, TAB_RIGHT | TAT_PRINTF, "%2.0f%%",
- 100.0 * total / total );
-
-
- }
-
-
-}
-
-
-
-static void
-show_extremes(struct variable **dependent_var, int n_dep_var,
- const struct factor *fctr, int n_extremities)
-{
- int i;
- int heading_columns ;
- int n_cols;
- const int heading_rows = 1;
- struct tab_table *tbl;
-
- int n_factors = 1;
- int n_rows ;
-
- if ( fctr )
- {
- heading_columns = 2;
- n_factors = hsh_count(fctr->fstats);
-
- n_rows = n_dep_var * 2 * n_extremities * n_factors;
-
- if ( fctr->indep_var[1] )
- heading_columns = 3;
- }
- else
- {
- heading_columns = 1;
- n_rows = n_dep_var * 2 * n_extremities;
- }
-
- n_rows += heading_rows;
-
- heading_columns += 2;
- n_cols = heading_columns + 2;
-
- tbl = tab_create (n_cols,n_rows,0);
- tab_headers (tbl, heading_columns, 0, heading_rows, 0);
-
- tab_dim (tbl, tab_natural_dimensions);
-
- /* Outline the box, No internal lines*/
- tab_box (tbl,
- TAL_2, TAL_2,
- -1, -1,
- 0, 0,
- n_cols - 1, n_rows - 1);
-
- tab_hline (tbl, TAL_2, 0, n_cols - 1, heading_rows );
-
- tab_title (tbl, 0, _("Extreme Values"));
-
- tab_vline (tbl, TAL_2, n_cols - 2, 0, n_rows -1);
- tab_vline (tbl, TAL_1, n_cols - 1, 0, n_rows -1);
-
- if ( fctr )
- {
- tab_text (tbl, 1, heading_rows - 1, TAB_CENTER | TAT_TITLE,
- var_to_string(fctr->indep_var[0]));
-
- if ( fctr->indep_var[1] )
- tab_text (tbl, 2, heading_rows - 1, TAB_CENTER | TAT_TITLE,
- var_to_string(fctr->indep_var[1]));
- }
-
- tab_text (tbl, n_cols - 1, 0, TAB_CENTER | TAT_TITLE, _("Value"));
- tab_text (tbl, n_cols - 2, 0, TAB_CENTER | TAT_TITLE, _("Case Number"));
-
- for ( i = 0 ; i < n_dep_var ; ++i )
- {
-
- if ( i > 0 )
- tab_hline(tbl, TAL_1, 0, n_cols -1 ,
- i * 2 * n_extremities * n_factors + heading_rows);
-
- tab_text (tbl, 0,
- i * 2 * n_extremities * n_factors + heading_rows,
- TAB_LEFT | TAT_TITLE,
- var_to_string(dependent_var[i])
- );
-
-
- if ( !fctr )
- populate_extremes(tbl, heading_columns - 2,
- i * 2 * n_extremities * n_factors + heading_rows,
- n_extremities, &totals[i]);
-
- else
- {
- struct factor_statistics **fs = fctr->fs;
- int count = 0 ;
-
- while (*fs)
- {
- static union value prev ;
-
- const int row = heading_rows + ( 2 * n_extremities ) *
- ( ( i * n_factors ) + count );
-
-
- if ( 0 != compare_values(&prev, &(*fs)->id[0],
- fctr->indep_var[0]->width))
- {
-
- if ( count > 0 )
- tab_hline (tbl, TAL_1, 1, n_cols - 1, row);
-
- tab_text (tbl,
- 1, row,
- TAB_LEFT | TAT_TITLE,
- value_to_string(&(*fs)->id[0], fctr->indep_var[0])
- );
- }
-
- prev = (*fs)->id[0];
-
- if (fctr->indep_var[1] && count > 0 )
- tab_hline(tbl, TAL_1, 2, n_cols - 1, row);
-
- if ( fctr->indep_var[1])
- tab_text (tbl, 2, row,
- TAB_LEFT | TAT_TITLE,
- value_to_string(&(*fs)->id[1], fctr->indep_var[1])
- );
-
- populate_extremes(tbl, heading_columns - 2,
- row, n_extremities,
- &(*fs)->m[i]);
-
- count++ ;
- fs++;
- }
- }
- }
-
- tab_submit(tbl);
-}
-
-
-
-/* Fill in the extremities table */
-void
-populate_extremes(struct tab_table *t,
- int col, int row, int n, const struct metrics *m)
-{
- int extremity;
- int idx=0;
-
-
- tab_text(t, col, row,
- TAB_RIGHT | TAT_TITLE ,
- _("Highest")
- );
-
- tab_text(t, col, row + n ,
- TAB_RIGHT | TAT_TITLE ,
- _("Lowest")
- );
-
-
- tab_hline(t, TAL_1, col, col + 3, row + n );
-
- for (extremity = 0; extremity < n ; ++extremity )
- {
- /* Highest */
- tab_float(t, col + 1, row + extremity,
- TAB_RIGHT,
- extremity + 1, 8, 0);
-
-
- /* Lowest */
- tab_float(t, col + 1, row + extremity + n,
- TAB_RIGHT,
- extremity + 1, 8, 0);
-
- }
-
-
- /* Lowest */
- for (idx = 0, extremity = 0; extremity < n && idx < m->n_data ; ++idx )
- {
- int j;
- const struct weighted_value *wv = m->wvp[idx];
- struct case_node *cn = wv->case_nos;
-
-
- for (j = 0 ; j < wv->w ; ++j )
- {
- if ( extremity + j >= n )
- break ;
-
- tab_float(t, col + 3, row + extremity + j + n,
- TAB_RIGHT,
- wv->v.f, 8, 2);
-
- tab_float(t, col + 2, row + extremity + j + n,
- TAB_RIGHT,
- cn->num, 8, 0);
-
- if ( cn->next )
- cn = cn->next;
-
- }
-
- extremity += wv->w ;
- }
-
-
- /* Highest */
- for (idx = m->n_data - 1, extremity = 0; extremity < n && idx >= 0; --idx )
- {
- int j;
- const struct weighted_value *wv = m->wvp[idx];
- struct case_node *cn = wv->case_nos;
-
- for (j = 0 ; j < wv->w ; ++j )
- {
- if ( extremity + j >= n )
- break ;
-
- tab_float(t, col + 3, row + extremity + j,
- TAB_RIGHT,
- wv->v.f, 8, 2);
-
- tab_float(t, col + 2, row + extremity + j,
- TAB_RIGHT,
- cn->num, 8, 0);
-
- if ( cn->next )
- cn = cn->next;
-
- }
-
- extremity += wv->w ;
- }
-}
-
-
-/* Show the descriptives table */
-void
-show_descriptives(struct variable **dependent_var,
- int n_dep_var,
- struct factor *fctr)
-{
- int i;
- int heading_columns ;
- int n_cols;
- const int n_stat_rows = 13;
-
- const int heading_rows = 1;
-
- struct tab_table *tbl;
-
- int n_factors = 1;
- int n_rows ;
-
- if ( fctr )
- {
- heading_columns = 4;
- n_factors = hsh_count(fctr->fstats);
-
- n_rows = n_dep_var * n_stat_rows * n_factors;
-
- if ( fctr->indep_var[1] )
- heading_columns = 5;
- }
- else
- {
- heading_columns = 3;
- n_rows = n_dep_var * n_stat_rows;
- }
-
- n_rows += heading_rows;
-
- n_cols = heading_columns + 2;
-
-
- tbl = tab_create (n_cols, n_rows, 0);
-
- tab_headers (tbl, heading_columns + 1, 0, heading_rows, 0);
-
- tab_dim (tbl, tab_natural_dimensions);
-
- /* Outline the box and have no internal lines*/
- tab_box (tbl,
- TAL_2, TAL_2,
- -1, -1,
- 0, 0,
- n_cols - 1, n_rows - 1);
-
- tab_hline (tbl, TAL_2, 0, n_cols - 1, heading_rows );
-
- tab_vline (tbl, TAL_1, heading_columns, 0, n_rows - 1);
- tab_vline (tbl, TAL_2, n_cols - 2, 0, n_rows - 1);
- tab_vline (tbl, TAL_1, n_cols - 1, 0, n_rows - 1);
-
- tab_text (tbl, n_cols - 2, 0, TAB_CENTER | TAT_TITLE, _("Statistic"));
- tab_text (tbl, n_cols - 1, 0, TAB_CENTER | TAT_TITLE, _("Std. Error"));
-
- tab_title (tbl, 0, _("Descriptives"));
-
-
- for ( i = 0 ; i < n_dep_var ; ++i )
- {
- const int row = heading_rows + i * n_stat_rows * n_factors ;
-
- if ( i > 0 )
- tab_hline(tbl, TAL_1, 0, n_cols - 1, row );
-
- tab_text (tbl, 0,
- i * n_stat_rows * n_factors + heading_rows,
- TAB_LEFT | TAT_TITLE,
- var_to_string(dependent_var[i])
- );
-
-
- if ( fctr )
- {
- struct factor_statistics **fs = fctr->fs;
- int count = 0;
-
- tab_text (tbl, 1, heading_rows - 1, TAB_CENTER | TAT_TITLE,
- var_to_string(fctr->indep_var[0]));
-
-
- if ( fctr->indep_var[1])
- tab_text (tbl, 2, heading_rows - 1, TAB_CENTER | TAT_TITLE,
- var_to_string(fctr->indep_var[1]));
-
- while( *fs )
- {
-
- static union value prev ;
-
- const int row = heading_rows + n_stat_rows *
- ( ( i * n_factors ) + count );
-
-
- if ( 0 != compare_values(&prev, &(*fs)->id[0],
- fctr->indep_var[0]->width))
- {
-
- if ( count > 0 )
- tab_hline (tbl, TAL_1, 1, n_cols - 1, row);
-
- tab_text (tbl,
- 1, row,
- TAB_LEFT | TAT_TITLE,
- value_to_string(&(*fs)->id[0], fctr->indep_var[0])
- );
- }
-
- prev = (*fs)->id[0];
-
- if (fctr->indep_var[1] && count > 0 )
- tab_hline(tbl, TAL_1, 2, n_cols - 1, row);
-
- if ( fctr->indep_var[1])
- tab_text (tbl, 2, row,
- TAB_LEFT | TAT_TITLE,
- value_to_string(&(*fs)->id[1], fctr->indep_var[1])
- );
-
- populate_descriptives(tbl, heading_columns - 2,
- row, &(*fs)->m[i]);
-
- count++ ;
- fs++;
- }
-
- }
-
- else
- {
-
- populate_descriptives(tbl, heading_columns - 2,
- i * n_stat_rows * n_factors + heading_rows,
- &totals[i]);
- }
- }
-
- tab_submit(tbl);
-
-}
-
-
-
-
-/* Fill in the descriptives data */
-void
-populate_descriptives(struct tab_table *tbl, int col, int row,
- const struct metrics *m)
-{
-
- const double t = gsl_cdf_tdist_Qinv(1 - cmd.n_cinterval[0]/100.0/2.0, \
- m->n -1);
-
-
- tab_text (tbl, col,
- row,
- TAB_LEFT | TAT_TITLE,
- _("Mean"));
-
- tab_float (tbl, col + 2,
- row,
- TAB_CENTER,
- m->mean,
- 8,2);
-
- tab_float (tbl, col + 3,
- row,
- TAB_CENTER,
- m->se_mean,
- 8,3);
-
-
- tab_text (tbl, col,
- row + 1,
- TAB_LEFT | TAT_TITLE | TAT_PRINTF,
- _("%g%% Confidence Interval for Mean"), cmd.n_cinterval[0]);
-
-
- tab_text (tbl, col + 1,
- row + 1,
- TAB_LEFT | TAT_TITLE,
- _("Lower Bound"));
-
- tab_float (tbl, col + 2,
- row + 1,
- TAB_CENTER,
- m->mean - t * m->se_mean,
- 8,3);
-
- tab_text (tbl, col + 1,
- row + 2,
- TAB_LEFT | TAT_TITLE,
- _("Upper Bound"));
-
-
- tab_float (tbl, col + 2,
- row + 2,
- TAB_CENTER,
- m->mean + t * m->se_mean,
- 8,3);
-
- tab_text (tbl, col,
- row + 3,
- TAB_LEFT | TAT_TITLE | TAT_PRINTF,
- _("5%% Trimmed Mean"));
-
- tab_float (tbl, col + 2,
- row + 3,
- TAB_CENTER,
- m->trimmed_mean,
- 8,2);
-
- tab_text (tbl, col,
- row + 4,
- TAB_LEFT | TAT_TITLE,
- _("Median"));
-
- {
- struct percentile *p;
- double d = 50;
-
- p = hsh_find(m->ptile_hash, &d);
-
- assert(p);
-
-
- tab_float (tbl, col + 2,
- row + 4,
- TAB_CENTER,
- p->v,
- 8, 2);
- }
-
-
- tab_text (tbl, col,
- row + 5,
- TAB_LEFT | TAT_TITLE,
- _("Variance"));
-
- tab_float (tbl, col + 2,
- row + 5,
- TAB_CENTER,
- m->var,
- 8,3);
-
-
- tab_text (tbl, col,
- row + 6,
- TAB_LEFT | TAT_TITLE,
- _("Std. Deviation"));
-
-
- tab_float (tbl, col + 2,
- row + 6,
- TAB_CENTER,
- m->stddev,
- 8,3);
-
-
- tab_text (tbl, col,
- row + 7,
- TAB_LEFT | TAT_TITLE,
- _("Minimum"));
-
- tab_float (tbl, col + 2,
- row + 7,
- TAB_CENTER,
- m->min,
- 8,3);
-
- tab_text (tbl, col,
- row + 8,
- TAB_LEFT | TAT_TITLE,
- _("Maximum"));
-
- tab_float (tbl, col + 2,
- row + 8,
- TAB_CENTER,
- m->max,
- 8,3);
-
-
- tab_text (tbl, col,
- row + 9,
- TAB_LEFT | TAT_TITLE,
- _("Range"));
-
-
- tab_float (tbl, col + 2,
- row + 9,
- TAB_CENTER,
- m->max - m->min,
- 8,3);
-
- tab_text (tbl, col,
- row + 10,
- TAB_LEFT | TAT_TITLE,
- _("Interquartile Range"));
-
- {
- struct percentile *p1;
- struct percentile *p2;
-
- double d = 75;
- p1 = hsh_find(m->ptile_hash, &d);
-
- d = 25;
- p2 = hsh_find(m->ptile_hash, &d);
-
- assert(p1);
- assert(p2);
-
- tab_float (tbl, col + 2,
- row + 10,
- TAB_CENTER,
- p1->v - p2->v,
- 8, 2);
- }
-
-
-
- tab_text (tbl, col,
- row + 11,
- TAB_LEFT | TAT_TITLE,
- _("Skewness"));
-
-
- tab_float (tbl, col + 2,
- row + 11,
- TAB_CENTER,
- m->skewness,
- 8,3);
-
- /* stderr of skewness */
- tab_float (tbl, col + 3,
- row + 11,
- TAB_CENTER,
- calc_seskew(m->n),
- 8,3);
-
-
- tab_text (tbl, col,
- row + 12,
- TAB_LEFT | TAT_TITLE,
- _("Kurtosis"));
-
-
- tab_float (tbl, col + 2,
- row + 12,
- TAB_CENTER,
- m->kurtosis,
- 8,3);
-
- /* stderr of kurtosis */
- tab_float (tbl, col + 3,
- row + 12,
- TAB_CENTER,
- calc_sekurt(m->n),
- 8,3);
-
-
-}
-
-
-
-void
-box_plot_variables(const struct factor *fctr,
- const struct variable **vars, int n_vars,
- const struct variable *id)
-{
-
- int i;
- struct factor_statistics **fs ;
-
- if ( ! fctr )
- {
- box_plot_group(fctr, vars, n_vars, id);
- return;
- }
-
- for ( fs = fctr->fs ; *fs ; ++fs )
- {
- double y_min = DBL_MAX;
- double y_max = -DBL_MAX;
- struct chart *ch = chart_create();
- const char *s = factor_to_string(fctr, *fs, 0 );
-
- chart_write_title(ch, s);
-
- for ( i = 0 ; i < n_vars ; ++i )
- {
- y_max = max(y_max, (*fs)->m[i].max);
- y_min = min(y_min, (*fs)->m[i].min);
- }
-
- boxplot_draw_yscale(ch, y_max, y_min);
-
- for ( i = 0 ; i < n_vars ; ++i )
- {
-
- const double box_width = (ch->data_right - ch->data_left)
- / (n_vars * 2.0 ) ;
-
- const double box_centre = ( i * 2 + 1) * box_width
- + ch->data_left;
-
- boxplot_draw_boxplot(ch,
- box_centre, box_width,
- &(*fs)->m[i],
- var_to_string(vars[i]));
-
-
- }
-
- chart_submit(ch);
-
- }
-}
-
-
-
-/* Do a box plot, grouping all factors into one plot ;
- each dependent variable has its own plot.
-*/
-void
-box_plot_group(const struct factor *fctr,
- const struct variable **vars,
- int n_vars,
- const struct variable *id UNUSED)
-{
-
- int i;
-
- for ( i = 0 ; i < n_vars ; ++i )
- {
- struct factor_statistics **fs ;
- struct chart *ch;
-
- ch = chart_create();
-
- boxplot_draw_yscale(ch, totals[i].max, totals[i].min);
-
- if ( fctr )
- {
- int n_factors = 0;
- int f=0;
- for ( fs = fctr->fs ; *fs ; ++fs )
- ++n_factors;
-
- chart_write_title(ch, _("Boxplot of %s vs. %s"),
- var_to_string(vars[i]), var_to_string(fctr->indep_var[0]) );
-
- for ( fs = fctr->fs ; *fs ; ++fs )
- {
-
- const char *s = factor_to_string_concise(fctr, *fs);
-
- const double box_width = (ch->data_right - ch->data_left)
- / (n_factors * 2.0 ) ;
-
- const double box_centre = ( f++ * 2 + 1) * box_width
- + ch->data_left;
-
- boxplot_draw_boxplot(ch,
- box_centre, box_width,
- &(*fs)->m[i],
- s);
- }
- }
- else if ( ch )
- {
- const double box_width = (ch->data_right - ch->data_left) / 3.0;
- const double box_centre = (ch->data_right + ch->data_left) / 2.0;
-
- chart_write_title(ch, _("Boxplot"));
-
- boxplot_draw_boxplot(ch,
- box_centre, box_width,
- &totals[i],
- var_to_string(vars[i]) );
-
- }
-
- chart_submit(ch);
- }
-}
-
-
-/* Plot the normal and detrended normal plots for m
- Label the plots with factorname */
-void
-np_plot(const struct metrics *m, const char *factorname)
-{
- int i;
- double yfirst=0, ylast=0;
-
- /* Normal Plot */
- struct chart *np_chart;
-
- /* Detrended Normal Plot */
- struct chart *dnp_chart;
-
- /* The slope and intercept of the ideal normal probability line */
- const double slope = 1.0 / m->stddev;
- const double intercept = - m->mean / m->stddev;
-
- /* Cowardly refuse to plot an empty data set */
- if ( m->n_data == 0 )
- return ;
-
- np_chart = chart_create();
- dnp_chart = chart_create();
-
- if ( !np_chart || ! dnp_chart )
- return ;
-
- chart_write_title(np_chart, _("Normal Q-Q Plot of %s"), factorname);
- chart_write_xlabel(np_chart, _("Observed Value"));
- chart_write_ylabel(np_chart, _("Expected Normal"));
-
-
- chart_write_title(dnp_chart, _("Detrended Normal Q-Q Plot of %s"),
- factorname);
- chart_write_xlabel(dnp_chart, _("Observed Value"));
- chart_write_ylabel(dnp_chart, _("Dev from Normal"));
-
- yfirst = gsl_cdf_ugaussian_Pinv (m->wvp[0]->rank / ( m->n + 1));
- ylast = gsl_cdf_ugaussian_Pinv (m->wvp[m->n_data-1]->rank / ( m->n + 1));
-
-
- {
- /* Need to make sure that both the scatter plot and the ideal fit into the
- plot */
- double x_lower = min(m->min, (yfirst - intercept) / slope) ;
- double x_upper = max(m->max, (ylast - intercept) / slope) ;
- double slack = (x_upper - x_lower) * 0.05 ;
-
- chart_write_xscale(np_chart, x_lower - slack, x_upper + slack, 5);
-
- chart_write_xscale(dnp_chart, m->min, m->max, 5);
-
- }
-
- chart_write_yscale(np_chart, yfirst, ylast, 5);
-
- {
- /* We have to cache the detrended data, beacause we need to
- find its limits before we can plot it */
- double *d_data = xnmalloc (m->n_data, sizeof *d_data);
- double d_max = -DBL_MAX;
- double d_min = DBL_MAX;
- for ( i = 0 ; i < m->n_data; ++i )
- {
- const double ns = gsl_cdf_ugaussian_Pinv (m->wvp[i]->rank / ( m->n + 1));
-
- chart_datum(np_chart, 0, m->wvp[i]->v.f, ns);
-
- d_data[i] = (m->wvp[i]->v.f - m->mean) / m->stddev - ns;
-
- if ( d_data[i] < d_min ) d_min = d_data[i];
- if ( d_data[i] > d_max ) d_max = d_data[i];
- }
- chart_write_yscale(dnp_chart, d_min, d_max, 5);
-
- for ( i = 0 ; i < m->n_data; ++i )
- chart_datum(dnp_chart, 0, m->wvp[i]->v.f, d_data[i]);
-
- free(d_data);
- }
-
- chart_line(np_chart, slope, intercept, yfirst, ylast , CHART_DIM_Y);
- chart_line(dnp_chart, 0, 0, m->min, m->max , CHART_DIM_X);
-
- chart_submit(np_chart);
- chart_submit(dnp_chart);
-}
-
-
-
-
-/* Show the percentiles */
-void
-show_percentiles(struct variable **dependent_var,
- int n_dep_var,
- struct factor *fctr)
-{
- struct tab_table *tbl;
- int i;
-
- int n_cols, n_rows;
- int n_factors;
-
- struct hsh_table *ptiles ;
-
- int n_heading_columns;
- const int n_heading_rows = 2;
- const int n_stat_rows = 2;
-
- int n_ptiles ;
-
- if ( fctr )
- {
- struct factor_statistics **fs = fctr->fs ;
- n_heading_columns = 3;
- n_factors = hsh_count(fctr->fstats);
-
- ptiles = (*fs)->m[0].ptile_hash;
-
- if ( fctr->indep_var[1] )
- n_heading_columns = 4;
- }
- else
- {
- n_factors = 1;
- n_heading_columns = 2;
-
- ptiles = totals[0].ptile_hash;
- }
-
- n_ptiles = hsh_count(ptiles);
-
- n_rows = n_heading_rows + n_dep_var * n_stat_rows * n_factors;
-
- n_cols = n_heading_columns + n_ptiles ;
-
- tbl = tab_create (n_cols, n_rows, 0);
-
- tab_headers (tbl, n_heading_columns + 1, 0, n_heading_rows, 0);
-
- tab_dim (tbl, tab_natural_dimensions);
-
- /* Outline the box and have no internal lines*/
- tab_box (tbl,
- TAL_2, TAL_2,
- -1, -1,
- 0, 0,
- n_cols - 1, n_rows - 1);
-
- tab_hline (tbl, TAL_2, 0, n_cols - 1, n_heading_rows );
-
- tab_vline (tbl, TAL_2, n_heading_columns, 0, n_rows - 1);
-
-
- tab_title (tbl, 0, _("Percentiles"));
-
-
- tab_hline (tbl, TAL_1, n_heading_columns, n_cols - 1, 1 );
-
-
- tab_box (tbl,
- -1, -1,
- -1, TAL_1,
- 0, n_heading_rows,
- n_heading_columns - 1, n_rows - 1);
-
-
- tab_box (tbl,
- -1, -1,
- -1, TAL_1,
- n_heading_columns, n_heading_rows - 1,
- n_cols - 1, n_rows - 1);
-
- tab_joint_text(tbl, n_heading_columns + 1, 0,
- n_cols - 1 , 0,
- TAB_CENTER | TAT_TITLE ,
- _("Percentiles"));
-
-
- {
- /* Put in the percentile break points as headings */
-
- struct percentile **p = (struct percentile **) hsh_sort(ptiles);
-
- i = 0;
- while ( (*p) )
- {
- tab_float(tbl, n_heading_columns + i++ , 1,
- TAB_CENTER,
- (*p)->p, 8, 0);
-
- p++;
- }
-
- }
-
- for ( i = 0 ; i < n_dep_var ; ++i )
- {
- const int n_stat_rows = 2;
- const int row = n_heading_rows + i * n_stat_rows * n_factors ;
-
- if ( i > 0 )
- tab_hline(tbl, TAL_1, 0, n_cols - 1, row );
-
- tab_text (tbl, 0,
- i * n_stat_rows * n_factors + n_heading_rows,
- TAB_LEFT | TAT_TITLE,
- var_to_string(dependent_var[i])
- );
-
- if ( fctr )
- {
- struct factor_statistics **fs = fctr->fs;
- int count = 0;
-
- tab_text (tbl, 1, n_heading_rows - 1,
- TAB_CENTER | TAT_TITLE,
- var_to_string(fctr->indep_var[0]));
-
-
- if ( fctr->indep_var[1])
- tab_text (tbl, 2, n_heading_rows - 1, TAB_CENTER | TAT_TITLE,
- var_to_string(fctr->indep_var[1]));
-
- while( *fs )
- {
-
- static union value prev ;
-
- const int row = n_heading_rows + n_stat_rows *
- ( ( i * n_factors ) + count );
-
-
- if ( 0 != compare_values(&prev, &(*fs)->id[0],
- fctr->indep_var[0]->width))
- {
-
- if ( count > 0 )
- tab_hline (tbl, TAL_1, 1, n_cols - 1, row);
-
- tab_text (tbl,
- 1, row,
- TAB_LEFT | TAT_TITLE,
- value_to_string(&(*fs)->id[0], fctr->indep_var[0])
- );
-
-
- }
-
- prev = (*fs)->id[0];
-
- if (fctr->indep_var[1] && count > 0 )
- tab_hline(tbl, TAL_1, 2, n_cols - 1, row);
-
- if ( fctr->indep_var[1])
- tab_text (tbl, 2, row,
- TAB_LEFT | TAT_TITLE,
- value_to_string(&(*fs)->id[1], fctr->indep_var[1])
- );
-
-
- populate_percentiles(tbl, n_heading_columns - 1,
- row, &(*fs)->m[i]);
-
-
- count++ ;
- fs++;
- }
-
-
- }
- else
- {
- populate_percentiles(tbl, n_heading_columns - 1,
- i * n_stat_rows * n_factors + n_heading_rows,
- &totals[i]);
- }
-
-
- }
-
-
- tab_submit(tbl);
-
-
-}
-
-
-
-
-void
-populate_percentiles(struct tab_table *tbl, int col, int row,
- const struct metrics *m)
-{
- int i;
-
- struct percentile **p = (struct percentile **) hsh_sort(m->ptile_hash);
-
- tab_text (tbl,
- col, row + 1,
- TAB_LEFT | TAT_TITLE,
- _("Tukey\'s Hinges")
- );
-
- tab_text (tbl,
- col, row,
- TAB_LEFT | TAT_TITLE,
- ptile_alg_desc[m->ptile_alg]
- );
-
-
- i = 0;
- while ( (*p) )
- {
- tab_float(tbl, col + i + 1 , row,
- TAB_CENTER,
- (*p)->v, 8, 2);
- if ( (*p)->p == 25 )
- tab_float(tbl, col + i + 1 , row + 1,
- TAB_CENTER,
- m->hinge[0], 8, 2);
-
- if ( (*p)->p == 50 )
- tab_float(tbl, col + i + 1 , row + 1,
- TAB_CENTER,
- m->hinge[1], 8, 2);
-
- if ( (*p)->p == 75 )
- tab_float(tbl, col + i + 1 , row + 1,
- TAB_CENTER,
- m->hinge[2], 8, 2);
-
-
- i++;
-
- p++;
- }
-
-}
-
-
-
-const char *
-factor_to_string(const struct factor *fctr,
- struct factor_statistics *fs,
- const struct variable *var)
-{
-
- static char buf1[100];
- char buf2[100];
-
- strcpy(buf1,"");
-
- if (var)
- sprintf(buf1, "%s (",var_to_string(var) );
-
-
- snprintf(buf2, 100, "%s = %s",
- var_to_string(fctr->indep_var[0]),
- value_to_string(&fs->id[0],fctr->indep_var[0]));
-
- strcat(buf1, buf2);
-
- if ( fctr->indep_var[1] )
- {
- sprintf(buf2, "; %s = %s)",
- var_to_string(fctr->indep_var[1]),
- value_to_string(&fs->id[1],
- fctr->indep_var[1]));
- strcat(buf1, buf2);
- }
- else
- {
- if ( var )
- strcat(buf1, ")");
- }
-
- return buf1;
-}
-
-
-
-const char *
-factor_to_string_concise(const struct factor *fctr,
- struct factor_statistics *fs)
-
-{
-
- static char buf[100];
-
- char buf2[100];
-
- snprintf(buf, 100, "%s",
- value_to_string(&fs->id[0], fctr->indep_var[0]));
-
- if ( fctr->indep_var[1] )
- {
- sprintf(buf2, ",%s)", value_to_string(&fs->id[1], fctr->indep_var[1]) );
- strcat(buf, buf2);
- }
-
-
- return buf;
-}
+++ /dev/null
-/* PSPP - A program for statistical analysis . -*-c-*-
-
-Copyright (C) 2004 Free Software Foundation, Inc.
-Author: John Darrington 2004
-
-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 the Free Software Foundation; either version 2 of the
-License, or (at your option) any later version.
-
-This program is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA. */
-
-#include <config.h>
-#include "factor_stats.h"
-#include "val.h"
-#include "hash.h"
-#include "algorithm.h"
-#include "alloc.h"
-#include "moments.h"
-#include "percentiles.h"
-
-#include <stdlib.h>
-#include <math.h>
-#include <float.h>
-#include <assert.h>
-#include <chart.h>
-
-
-void
-metrics_precalc(struct metrics *m)
-{
- assert (m) ;
-
- m->n_missing = 0;
-
- m->min = DBL_MAX;
- m->max = -DBL_MAX;
-
- m->histogram = 0;
-
- m->moments = moments1_create(MOMENT_KURTOSIS);
-
- m->ordered_data = hsh_create(20,
- (hsh_compare_func *) compare_values,
- (hsh_hash_func *) hash_value,
- (hsh_free_func *) weighted_value_free,
- (void *) 0);
-}
-
-
-/* Include val in the calculation for the metrics.
- If val is null, then treat it as MISSING
-*/
-void
-metrics_calc(struct metrics *fs, const union value *val,
- double weight, int case_no)
-{
- struct weighted_value **wv;
- double x;
-
- if ( ! val )
- {
- fs->n_missing += weight;
- return ;
- }
-
- x = val->f;
-
- moments1_add(fs->moments, x, weight);
-
-
- if ( x < fs->min) fs->min = x;
- if ( x > fs->max) fs->max = x;
-
-
- wv = (struct weighted_value **) hsh_probe (fs->ordered_data,(void *) val );
-
- if ( *wv )
- {
- /* If this value has already been seen, then simply
- increase its weight and push a new case number */
-
- struct case_node *cn;
-
- assert( (*wv)->v.f == val->f );
- (*wv)->w += weight;
-
- cn = xmalloc ( sizeof *cn);
- cn->next = (*wv)->case_nos ;
- cn->num = case_no;
-
- (*wv)->case_nos = cn;
- }
- else
- {
- struct case_node *cn;
-
- *wv = weighted_value_create();
- (*wv)->v = *val;
- (*wv)->w = weight;
-
- cn = xmalloc (sizeof *cn);
- cn->next=0;
- cn->num = case_no;
- (*wv)->case_nos = cn;
-
- }
-
-}
-
-void
-metrics_postcalc(struct metrics *m)
-{
- double cc = 0.0;
- double tc ;
- int k1, k2 ;
- int i;
- int j = 1;
-
- moments1_calculate (m->moments, &m->n, &m->mean, &m->var,
- &m->skewness, &m->kurtosis);
-
- moments1_destroy (m->moments);
-
-
- m->stddev = sqrt(m->var);
-
- /* FIXME: Check this is correct ???
- Shouldn't we use the sample variance ??? */
- m->se_mean = sqrt (m->var / m->n) ;
-
-
-
- m->wvp = (struct weighted_value **) hsh_sort(m->ordered_data);
- m->n_data = hsh_count(m->ordered_data);
-
- /* Trimmed mean calculation */
- if ( m->n_data <= 1 )
- {
- m->trimmed_mean = m->mean;
- return;
- }
-
- m->histogram = histogram_create(10, m->min, m->max);
-
- for ( i = 0 ; i < m->n_data ; ++i )
- {
- struct weighted_value **wv = (m->wvp) ;
- gsl_histogram_accumulate(m->histogram, wv[i]->v.f, wv[i]->w);
- }
-
- tc = m->n * 0.05 ;
- k1 = -1;
- k2 = -1;
-
- for ( i = 0 ; i < m->n_data ; ++i )
- {
- cc += m->wvp[i]->w;
- m->wvp[i]->cc = cc;
-
- m->wvp[i]->rank = j + (m->wvp[i]->w - 1) / 2.0 ;
-
- j += m->wvp[i]->w;
-
- if ( cc < tc )
- k1 = i;
- }
-
-
-
- k2 = m->n_data;
- for ( i = m->n_data -1 ; i >= 0; --i )
- {
- if ( tc > m->n - m->wvp[i]->cc)
- k2 = i;
- }
-
-
- /* Calculate the percentiles */
- ptiles(m->ptile_hash, m->wvp, m->n_data, m->n, m->ptile_alg);
-
- tukey_hinges(m->wvp, m->n_data, m->n, m->hinge);
-
- /* Special case here */
- if ( k1 + 1 == k2 )
- {
- m->trimmed_mean = m->wvp[k2]->v.f;
- return;
- }
-
- m->trimmed_mean = 0;
- for ( i = k1 + 2 ; i <= k2 - 1 ; ++i )
- {
- m->trimmed_mean += m->wvp[i]->v.f * m->wvp[i]->w;
- }
-
-
- m->trimmed_mean += (m->n - m->wvp[k2 - 1]->cc - tc) * m->wvp[k2]->v.f ;
- m->trimmed_mean += (m->wvp[k1 + 1]->cc - tc) * m->wvp[k1 + 1]->v.f ;
- m->trimmed_mean /= 0.9 * m->n ;
-
-
-}
-
-
-struct weighted_value *
-weighted_value_create(void)
-{
- struct weighted_value *wv;
- wv = xmalloc (sizeof *wv);
-
- wv->cc = 0;
- wv->case_nos = 0;
-
- return wv;
-}
-
-void
-weighted_value_free(struct weighted_value *wv)
-{
- struct case_node *cn ;
-
- if ( !wv )
- return ;
-
- cn = wv->case_nos;
-
- while(cn)
- {
- struct case_node *next = cn->next;
-
- free(cn);
- cn = next;
- }
-
- free(wv);
-
-}
-
-
-
-
-
-/* Create a factor statistics object with for N dependent vars
- and ID as the value of the independent variable */
-struct factor_statistics *
-create_factor_statistics (int n, union value *id0, union value *id1)
-{
- struct factor_statistics *f;
-
- f = xmalloc (sizeof *f);
-
- f->id[0] = *id0;
- f->id[1] = *id1;
- f->m = xnmalloc (n, sizeof *f->m);
- memset (f->m, 0, sizeof(struct metrics) * n);
- f->n_var = n;
-
- return f;
-}
-
-
-void
-metrics_destroy(struct metrics *m)
-{
- hsh_destroy(m->ordered_data);
- hsh_destroy(m->ptile_hash);
- if ( m-> histogram )
- gsl_histogram_free(m->histogram);
-}
-
-void
-factor_statistics_free(struct factor_statistics *f)
-{
-
- int i;
- for ( i = 0 ; i < f->n_var; ++i )
- metrics_destroy(&f->m[i]);
- free(f->m) ;
- free(f);
-}
-
-
-
-
-int
-factor_statistics_compare(const struct factor_statistics *f0,
- const struct factor_statistics *f1, int width)
-{
-
- int cmp0;
-
- assert(f0);
- assert(f1);
-
- cmp0 = compare_values(&f0->id[0], &f1->id[0], width);
-
- if ( cmp0 != 0 )
- return cmp0;
-
-
- if ( ( f0->id[1].f == SYSMIS ) && (f1->id[1].f != SYSMIS) )
- return 1;
-
- if ( ( f0->id[1].f != SYSMIS ) && (f1->id[1].f == SYSMIS) )
- return -1;
-
- return compare_values(&f0->id[1], &f1->id[1], width);
-
-}
-
-unsigned int
-factor_statistics_hash(const struct factor_statistics *f, int width)
-{
-
- unsigned int h;
-
- h = hash_value(&f->id[0], width);
-
- if ( f->id[1].f != SYSMIS )
- h += hash_value(&f->id[1], width);
-
-
- return h;
-
-}
-
+++ /dev/null
-/* PSPP - A program for statistical analysis . -*-c-*-
-
-Copyright (C) 2004 Free Software Foundation, Inc.
-Author: John Darrington 2004
-
-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 the Free Software Foundation; either version 2 of the
-License, or (at your option) any later version.
-
-This program is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA. */
-
-#ifndef FACTOR_STATS
-#define FACTOR_STATS
-
-
-/* FIXME: These things should probably be amalgamated with the
- group_statistics struct */
-
-#include "hash.h"
-#include "val.h"
-#include <string.h>
-#include <gsl/gsl_histogram.h>
-#include "subclist.h"
-#include "percentiles.h"
-
-struct moments1;
-
-struct metrics
-{
- double n;
-
- double n_missing;
-
- double min;
-
- double max;
-
- double mean;
-
- double se_mean;
-
- double var;
-
- double stddev;
-
- struct moments1 *moments;
-
- gsl_histogram *histogram;
-
- double skewness;
- double kurtosis;
-
- double trimmed_mean;
-
- /* A hash of data for this factor. */
- struct hsh_table *ordered_data;
-
- /* A Pointer to this hash table AFTER it has been SORTED and crunched */
- struct weighted_value **wvp;
-
- /* The number of values in the above array
- (if all the weights are 1, then this will
- be the same as n) */
- int n_data;
-
- /* Percentile stuff */
-
- /* A hash of struct percentiles */
- struct hsh_table *ptile_hash;
-
- /* Algorithm to be used for calculating percentiles */
- enum pc_alg ptile_alg;
-
- /* Tukey's Hinges */
- double hinge[3];
-
-};
-
-
-struct metrics * metrics_create(void);
-
-void metrics_precalc(struct metrics *m);
-
-void metrics_calc(struct metrics *m, const union value *f, double weight,
- int case_no);
-
-void metrics_postcalc(struct metrics *m);
-
-void metrics_destroy(struct metrics *m);
-
-
-
-/* Linked list of case nos */
-struct case_node
-{
- int num;
- struct case_node *next;
-};
-
-struct weighted_value
-{
- union value v;
-
- /* The weight */
- double w;
-
- /* The cumulative weight */
- double cc;
-
- /* The rank */
- double rank;
-
- /* Linked list of cases nos which have this value */
- struct case_node *case_nos;
-
-};
-
-
-struct weighted_value *weighted_value_create(void);
-
-void weighted_value_free(struct weighted_value *wv);
-
-
-
-struct factor_statistics {
-
- /* The values of the independent variables */
- union value id[2];
-
- /* The an array stats for this factor, one for each dependent var */
- struct metrics *m;
-
- /* The number of dependent variables */
- int n_var;
-};
-
-
-/* Create a factor statistics object with for N dependent vars
- and ID as the value of the independent variable */
-struct factor_statistics *
-create_factor_statistics (int n, union value *id0, union value *id1);
-
-
-void factor_statistics_free(struct factor_statistics *f);
-
-
-/* Compare f0 and f1.
- width is the width of the independent variable */
-int
-factor_statistics_compare(const struct factor_statistics *f0,
- const struct factor_statistics *f1, int width);
-
-
-
-unsigned int
-factor_statistics_hash(const struct factor_statistics *f, int width);
-
-#endif
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "file-handle-def.h"
-#include "error.h"
-#include <errno.h>
-#include <stdlib.h>
-#include <string.h>
-#include "alloc.h"
-#include "file-handle.h"
-#include "filename.h"
-#include "command.h"
-#include "getl.h"
-#include "error.h"
-#include "magic.h"
-#include "var.h"
-#include "scratch-handle.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* (headers) */
-
-/* File handle. */
-struct file_handle
- {
- struct file_handle *next; /* Next in global list. */
- int open_cnt; /* 0=not open, otherwise # of openers. */
- bool deleted; /* Destroy handle when open_cnt goes to 0? */
-
- char *name; /* File handle identifier. */
- const char *type; /* If open, type of file. */
- char open_mode[3]; /* "[rw][se]". */
- void *aux; /* Aux data pointer for owner if any. */
- enum fh_referent referent; /* What the file handle refers to. */
-
- /* FH_REF_FILE only. */
- char *filename; /* Filename as provided by user. */
- struct file_identity *identity; /* For checking file identity. */
- enum fh_mode mode; /* File mode. */
-
- /* FH_REF_FILE and FH_REF_INLINE only. */
- size_t record_width; /* Length of fixed-format records. */
- size_t tab_width; /* Tab width, 0=do not expand tabs. */
-
- /* FH_REF_SCRATCH only. */
- struct scratch_handle *sh; /* Scratch file data. */
- };
-
-/* List of all handles. */
-static struct file_handle *file_handles;
-
-/* Default file handle for DATA LIST, REREAD, REPEATING DATA
- commands. */
-static struct file_handle *default_handle;
-
-/* The "file" that reads from BEGIN DATA...END DATA. */
-static struct file_handle *inline_file;
-
-static struct file_handle *create_handle (const char *name, enum fh_referent);
-
-/* File handle initialization routine. */
-void
-fh_init (void)
-{
- inline_file = create_handle ("INLINE", FH_REF_INLINE);
- inline_file->record_width = 80;
- inline_file->tab_width = 8;
-}
-
-/* Free HANDLE and remove it from the global list. */
-static void
-free_handle (struct file_handle *handle)
-{
- /* Remove handle from global list. */
- if (file_handles == handle)
- file_handles = handle->next;
- else
- {
- struct file_handle *iter = file_handles;
- while (iter->next != handle)
- iter = iter->next;
- iter->next = handle->next;
- }
-
- /* Free data. */
- free (handle->name);
- free (handle->filename);
- fn_free_identity (handle->identity);
- scratch_handle_destroy (handle->sh);
- free (handle);
-}
-
-/* Frees all the file handles. */
-void
-fh_done (void)
-{
- while (file_handles != NULL)
- free_handle (file_handles);
-}
-
-/* Returns the handle named HANDLE_NAME, or a null pointer if
- there is none. */
-struct file_handle *
-fh_from_name (const char *handle_name)
-{
- struct file_handle *iter;
-
- for (iter = file_handles; iter != NULL; iter = iter->next)
- if (!iter->deleted && !strcasecmp (handle_name, iter->name))
- return iter;
- return NULL;
-}
-
-/* Returns the handle for the file named FILENAME,
- or a null pointer if none exists.
- Different names for the same file (e.g. "x" and "./x") are
- considered equivalent. */
-struct file_handle *
-fh_from_filename (const char *filename)
-{
- struct file_identity *identity;
- struct file_handle *iter;
-
- /* First check for a file with the same identity. */
- identity = fn_get_identity (filename);
- if (identity != NULL)
- {
- for (iter = file_handles; iter != NULL; iter = iter->next)
- if (!iter->deleted
- && iter->referent == FH_REF_FILE
- && iter->identity != NULL
- && !fn_compare_file_identities (identity, iter->identity))
- {
- fn_free_identity (identity);
- return iter;
- }
- fn_free_identity (identity);
- }
-
- /* Then check for a file with the same name. */
- for (iter = file_handles; iter != NULL; iter = iter->next)
- if (!iter->deleted
- && iter->referent == FH_REF_FILE && !strcmp (filename, iter->filename))
- return iter;
-
- return NULL;
-}
-
-/* Creates a new handle with name HANDLE_NAME that refers to
- REFERENT. Links the new handle into the global list. Returns
- the new handle.
-
- The new handle is not fully initialized. The caller is
- responsible for completing its initialization. */
-static struct file_handle *
-create_handle (const char *handle_name, enum fh_referent referent)
-{
- struct file_handle *handle = xzalloc (sizeof *handle);
- handle->next = file_handles;
- handle->open_cnt = 0;
- handle->deleted = false;
- handle->name = xstrdup (handle_name);
- handle->type = NULL;
- handle->aux = NULL;
- handle->referent = referent;
- file_handles = handle;
- return handle;
-}
-
-/* Returns the unique handle of referent type FH_REF_INLINE,
- which refers to the "inline file" that represents character
- data in the command file between BEGIN DATA and END DATA. */
-struct file_handle *
-fh_inline_file (void)
-{
- return inline_file;
-}
-
-/* Creates a new file handle named HANDLE_NAME, which must not be
- the name of an existing file handle. The new handle is
- associated with file FILENAME and the given PROPERTIES. */
-struct file_handle *
-fh_create_file (const char *handle_name, const char *filename,
- const struct fh_properties *properties)
-{
- struct file_handle *handle;
- assert (fh_from_name (handle_name) == NULL);
- handle = create_handle (handle_name, FH_REF_FILE);
- handle->filename = xstrdup (filename);
- handle->identity = fn_get_identity (filename);
- handle->mode = properties->mode;
- handle->record_width = properties->record_width;
- handle->tab_width = properties->tab_width;
- return handle;
-}
-
-/* Creates a new file handle named HANDLE_NAME, which must not be
- the name of an existing file handle. The new handle is
- associated with a scratch file (initially empty). */
-struct file_handle *
-fh_create_scratch (const char *handle_name)
-{
- struct file_handle *handle = create_handle (handle_name, FH_REF_SCRATCH);
- handle->sh = NULL;
- return handle;
-}
-
-/* Returns a set of default properties for a file handle. */
-const struct fh_properties *
-fh_default_properties (void)
-{
- static const struct fh_properties default_properties
- = {FH_MODE_TEXT, 1024, 4};
- return &default_properties;
-}
-
-/* Deletes FH from the global list of file handles. Afterward,
- attempts to search for it will fail. Unless the file handle
- is currently open, it will be destroyed; otherwise, it will be
- destroyed later when it is closed.
- Normally needed only if a file_handle needs to be re-assigned.
- Otherwise, just let fh_done() destroy the handle. */
-void
-fh_free (struct file_handle *handle)
-{
- if (handle == fh_inline_file () || handle == NULL || handle->deleted)
- return;
- handle->deleted = true;
-
- if (handle == default_handle)
- default_handle = fh_inline_file ();
-
- if (handle->open_cnt == 0)
- free_handle (handle);
-}
-
-/* Returns an English description of MODE,
- which is in the format of the MODE argument to fh_open(). */
-static const char *
-mode_name (const char *mode)
-{
- assert (mode != NULL);
- assert (mode[0] == 'r' || mode[0] == 'w');
-
- return mode[0] == 'r' ? "reading" : "writing";
-}
-
-/* Tries to open handle H with the given TYPE and MODE.
-
- H's referent type must be one of the bits in MASK. The caller
- must verify this ahead of time; we simply assert it here.
-
- TYPE is the sort of file, e.g. "system file". Only one given
- type of access is allowed on a given file handle at once.
- If successful, a reference to TYPE is retained, so it should
- probably be a string literal.
-
- MODE combines the read or write mode with the sharing mode.
- The first character is 'r' for read, 'w' for write. The
- second character is 's' to permit sharing, 'e' to require
- exclusive access.
-
- Returns the address of a void * that the caller can use for
- data specific to the file handle if successful, or a null
- pointer on failure. For exclusive access modes the void *
- will always be a null pointer at return. In shared access
- modes the void * will necessarily be null only if no other
- sharers are active. */
-void **
-fh_open (struct file_handle *h, enum fh_referent mask UNUSED,
- const char *type, const char *mode)
-{
- assert (h != NULL);
- assert ((fh_get_referent (h) & mask) != 0);
- assert (type != NULL);
- assert (mode != NULL);
- assert (mode[0] == 'r' || mode[0] == 'w');
- assert (mode[1] == 's' || mode[1] == 'e');
- assert (mode[2] == '\0');
-
- if (h->open_cnt != 0)
- {
- if (strcmp (h->type, type))
- {
- msg (SE, _("Can't open %s as a %s because it is "
- "already open as a %s."),
- fh_get_name (h), type, h->type);
- return NULL;
- }
- else if (strcmp (h->open_mode, mode))
- {
- msg (SE, _("Can't open %s as a %s for %s because it is "
- "already open for %s."),
- fh_get_name (h), type, mode_name (mode),
- mode_name (h->open_mode));
- return NULL;
- }
- else if (h->open_mode[1] == 'e')
- {
- msg (SE, _("Can't re-open %s as a %s for %s."),
- fh_get_name (h), type, mode_name (mode));
- return NULL;
- }
- }
- else
- {
- h->type = type;
- strcpy (h->open_mode, mode);
- assert (h->aux == NULL);
- }
- h->open_cnt++;
-
- return &h->aux;
-}
-
-/* Closes file handle H, which must have been open for the
- specified TYPE and MODE of access provided to fh_open().
- Returns zero if the file is now closed, nonzero if it is still
- open due to another reference.
-
- After fh_close() returns zero for a handle, it is unsafe to
- reference that file handle again in any way, because its
- storage may have been freed. */
-int
-fh_close (struct file_handle *h, const char *type, const char *mode)
-{
- assert (h != NULL);
- assert (h->open_cnt > 0);
- assert (type != NULL);
- assert (!strcmp (type, h->type));
- assert (mode != NULL);
- assert (!strcmp (mode, h->open_mode));
-
- if (--h->open_cnt == 0)
- {
- h->type = NULL;
- h->aux = NULL;
- if (h->deleted)
- free_handle (h);
- return 0;
- }
- return 1;
-}
-
-/* Is the file open? BEGIN DATA...END DATA uses this to detect
- whether the inline file is actually in use. */
-bool
-fh_is_open (const struct file_handle *handle)
-{
- return handle->open_cnt > 0;
-}
-
-/* Returns the identifier of file HANDLE. If HANDLE was created
- by referring to a filename instead of a handle name, returns
- the filename, enclosed in double quotes. Return value is
- owned by the file handle.
-
- Useful for printing error messages about use of file handles. */
-const char *
-fh_get_name (const struct file_handle *handle)
-{
- return handle->name;
-}
-
-/* Returns the type of object that HANDLE refers to. */
-enum fh_referent
-fh_get_referent (const struct file_handle *handle)
-{
- return handle->referent;
-}
-
-/* Returns the name of the file associated with HANDLE. */
-const char *
-fh_get_filename (const struct file_handle *handle)
-{
- assert (handle->referent == FH_REF_FILE);
- return handle->filename;
-}
-
-/* Returns the mode of HANDLE. */
-enum fh_mode
-fh_get_mode (const struct file_handle *handle)
-{
- assert (handle->referent == FH_REF_FILE);
- return handle->mode;
-}
-
-/* Returns the width of a logical record on HANDLE. */
-size_t
-fh_get_record_width (const struct file_handle *handle)
-{
- assert (handle->referent & (FH_REF_FILE | FH_REF_INLINE));
- return handle->record_width;
-}
-
-/* Returns the number of characters per tab stop for HANDLE, or
- zero if tabs are not to be expanded. Applicable only to
- FH_MODE_TEXT files. */
-size_t
-fh_get_tab_width (const struct file_handle *handle)
-{
- assert (handle->referent & (FH_REF_FILE | FH_REF_INLINE));
- return handle->tab_width;
-}
-
-/* Returns the scratch file handle associated with HANDLE.
- Applicable to only FH_REF_SCRATCH files. */
-struct scratch_handle *
-fh_get_scratch_handle (struct file_handle *handle)
-{
- assert (handle->referent == FH_REF_SCRATCH);
- return handle->sh;
-}
-
-/* Sets SH to be the scratch file handle associated with HANDLE.
- Applicable to only FH_REF_SCRATCH files. */
-void
-fh_set_scratch_handle (struct file_handle *handle, struct scratch_handle *sh)
-{
- assert (handle->referent == FH_REF_SCRATCH);
- handle->sh = sh;
-}
-
-/* Returns the current default handle. */
-struct file_handle *
-fh_get_default_handle (void)
-{
- return default_handle ? default_handle : fh_inline_file ();
-}
-
-/* Sets NEW_DEFAULT_HANDLE as the default handle. */
-void
-fh_set_default_handle (struct file_handle *new_default_handle)
-{
- assert (new_default_handle == NULL
- || (new_default_handle->referent & (FH_REF_INLINE | FH_REF_FILE)));
- default_handle = new_default_handle;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000, 2005, 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef FILE_HANDLE_DEF_H
-#define FILE_HANDLE_DEF_H
-
-#include <stdbool.h>
-#include <stddef.h>
-
-/* What a file handle refers to.
- (Ordinarily only a single value is allowed, but fh_open()
- and fh_parse() take a mask.) */
-enum fh_referent
- {
- FH_REF_FILE = 001, /* Ordinary file (the most common case). */
- FH_REF_INLINE = 002, /* The inline file. */
- FH_REF_SCRATCH = 004 /* Temporary dataset. */
- };
-
-/* File modes. */
-enum fh_mode
- {
- FH_MODE_TEXT, /* New-line delimited lines. */
- FH_MODE_BINARY /* Fixed-length records. */
- };
-
-/* Properties of a file handle. */
-struct fh_properties
- {
- enum fh_mode mode; /* File mode. */
- size_t record_width; /* Length of fixed-format records. */
- size_t tab_width; /* Tab width, 0=do not expand tabs. */
- };
-
-void fh_init (void);
-void fh_done (void);
-
-/* Creating file handles. */
-struct file_handle *fh_create_file (const char *handle_name,
- const char *filename,
- const struct fh_properties *);
-struct file_handle *fh_create_scratch (const char *handle_name);
-const struct fh_properties *fh_default_properties (void);
-
-/* Delete file handle from global list. */
-void fh_free (struct file_handle *);
-
-/* Finding file handles. */
-struct file_handle *fh_from_name (const char *handle_name);
-struct file_handle *fh_from_filename (const char *filename);
-struct file_handle *fh_inline_file (void);
-
-/* Generic properties of file handles. */
-const char *fh_get_name (const struct file_handle *);
-enum fh_referent fh_get_referent (const struct file_handle *);
-
-/* Properties of FH_REF_FILE file handles. */
-const char *fh_get_filename (const struct file_handle *);
-enum fh_mode fh_get_mode (const struct file_handle *) ;
-
-/* Properties of FH_REF_FILE and FH_REF_INLINE file handles. */
-size_t fh_get_record_width (const struct file_handle *);
-size_t fh_get_tab_width (const struct file_handle *);
-
-/* Properties of FH_REF_SCRATCH file handles. */
-struct scratch_handle *fh_get_scratch_handle (struct file_handle *);
-void fh_set_scratch_handle (struct file_handle *, struct scratch_handle *);
-
-/* Opening and closing file handles. */
-void **fh_open (struct file_handle *, enum fh_referent mask,
- const char *type, const char *mode);
-int fh_close (struct file_handle *, const char *type, const char *mode);
-bool fh_is_open (const struct file_handle *);
-
-/* Default file handle for DATA LIST, REREAD, REPEATING DATA
- commands. */
-struct file_handle *fh_get_default_handle (void);
-void fh_set_default_handle (struct file_handle *);
-
-#endif
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !file_handle_h
-#define file_handle_h 1
-
-/* File handles. */
-
-#include <stdbool.h>
-#include <stddef.h>
-#include "file-handle-def.h"
-
-struct file_handle *fh_parse (enum fh_referent);
-
-#endif /* !file_handle.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "file-handle.h"
-#include "error.h"
-#include <errno.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "filename.h"
-#include "command.h"
-#include "lexer.h"
-#include "getl.h"
-#include "error.h"
-#include "magic.h"
-#include "str.h"
-#include "var.h"
-#include "linked-list.h"
-#include "file-handle-def.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* (headers) */
-
-
-/* (specification)
- "FILE HANDLE" (fh_):
- name=string;
- lrecl=integer;
- tabwidth=integer "x>=0" "%s must be nonnegative";
- mode=mode:!character/image/scratch.
-*/
-/* (declarations) */
-/* (functions) */
-
-int
-cmd_file_handle (void)
-{
- char handle_name[LONG_NAME_LEN + 1];
- struct fh_properties properties = *fh_default_properties ();
-
- struct cmd_file_handle cmd;
- struct file_handle *handle;
-
- if (!lex_force_id ())
- return CMD_FAILURE;
- str_copy_trunc (handle_name, sizeof handle_name, tokid);
-
- handle = fh_from_name (handle_name);
- if (handle != NULL)
- {
- msg (SE, _("File handle %s is already defined. "
- "Use CLOSE FILE HANDLE before redefining a file handle."),
- handle_name);
- return CMD_FAILURE;
- }
-
- lex_get ();
- if (!lex_force_match ('/'))
- return CMD_FAILURE;
-
- if (!parse_file_handle (&cmd))
- return CMD_FAILURE;
-
- if (lex_end_of_command () != CMD_SUCCESS)
- goto lossage;
-
- if (cmd.s_name == NULL && cmd.mode != FH_SCRATCH)
- {
- lex_sbc_missing ("NAME");
- goto lossage;
- }
-
- switch (cmd.mode)
- {
- case FH_CHARACTER:
- properties.mode = FH_MODE_TEXT;
- if (cmd.sbc_tabwidth)
- properties.tab_width = cmd.n_tabwidth[0];
- break;
- case FH_IMAGE:
- properties.mode = FH_MODE_BINARY;
- if (cmd.n_lrecl[0] == NOT_LONG)
- msg (SE, _("Fixed-length records were specified on /RECFORM, but "
- "record length was not specified on /LRECL. "
- "Assuming %d-character records."),
- properties.record_width);
- else if (cmd.n_lrecl[0] < 1)
- msg (SE, _("Record length (%ld) must be at least one byte. "
- "Assuming %d-character records."),
- cmd.n_lrecl[0], properties.record_width);
- else
- properties.record_width = cmd.n_lrecl[0];
- break;
- default:
- assert (0);
- }
-
- if (cmd.mode != FH_SCRATCH)
- fh_create_file (handle_name, cmd.s_name, &properties);
- else
- fh_create_scratch (handle_name);
-
- free_file_handle (&cmd);
- return CMD_SUCCESS;
-
- lossage:
- free_file_handle (&cmd);
- return CMD_FAILURE;
-}
-
-int
-cmd_close_file_handle (void)
-{
- struct file_handle *handle;
-
- if (!lex_force_id ())
- return CMD_FAILURE;
- handle = fh_from_name (tokid);
- if (handle == NULL)
- return CMD_FAILURE;
-
- fh_free (handle);
-
- return CMD_SUCCESS;
-}
-
-/* Returns the name for REFERENT. */
-static const char *
-referent_name (enum fh_referent referent)
-{
- switch (referent)
- {
- case FH_REF_FILE:
- return _("file");
- case FH_REF_INLINE:
- return _("inline file");
- case FH_REF_SCRATCH:
- return _("scratch file");
- default:
- abort ();
- }
-}
-
-/* Parses a file handle name, which may be a filename as a string
- or a file handle name as an identifier. The allowed types of
- file handle are restricted to those in REFERENT_MASK. Returns
- the file handle when successful, a null pointer on failure. */
-struct file_handle *
-fh_parse (enum fh_referent referent_mask)
-{
- struct file_handle *handle;
-
- if (lex_match_id ("INLINE"))
- handle = fh_inline_file ();
- else
- {
- if (token != T_ID && token != T_STRING)
- {
- lex_error (_("expecting a file name or handle name"));
- return NULL;
- }
-
- handle = NULL;
- if (token == T_ID)
- handle = fh_from_name (tokid);
- if (handle == NULL)
- handle = fh_from_filename (ds_c_str (&tokstr));
- if (handle == NULL)
- {
- if (token != T_ID || tokid[0] != '#' || get_syntax () != ENHANCED)
- {
- char *filename = ds_c_str (&tokstr);
- char *handle_name = xasprintf ("\"%s\"", filename);
- handle = fh_create_file (handle_name, filename,
- fh_default_properties ());
- free (handle_name);
- }
- else
- handle = fh_create_scratch (tokid);
- }
- lex_get ();
- }
-
- if (!(fh_get_referent (handle) & referent_mask))
- {
- msg (SE, _("Handle for %s not allowed here."),
- referent_name (fh_get_referent (handle)));
- return NULL;
- }
-
- return handle;
-}
-
-/*
- Local variables:
- mode: c
- End:
-*/
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "case.h"
-#include "command.h"
-#include "data-in.h"
-#include "dfm-read.h"
-#include "dictionary.h"
-#include "error.h"
-#include "file-handle.h"
-#include "format.h"
-#include "lexer.h"
-#include "str.h"
-#include "var.h"
-#include "vfm.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* Defines the three types of complex files read by FILE TYPE. */
-enum
- {
- FTY_MIXED,
- FTY_GROUPED,
- FTY_NESTED
- };
-
-/* Limited variable column specifications. */
-struct col_spec
- {
- char name[LONG_NAME_LEN + 1]; /* Variable name. */
- int fc, nc; /* First column (1-based), # of columns. */
- int fmt; /* Format type. */
- struct variable *v; /* Variable. */
- };
-
-/* RCT_* record type constants. */
-enum
- {
- RCT_OTHER = 001, /* 1=OTHER. */
- RCT_SKIP = 002, /* 1=SKIP. */
- RCT_DUPLICATE = 004, /* DUPLICATE: 0=NOWARN, 1=WARN. */
- RCT_MISSING = 010, /* MISSING: 0=NOWARN, 1=WARN. */
- RCT_SPREAD = 020 /* SPREAD: 0=NO, 1=YES. */
- };
-
-/* Represents a RECORD TYPE command. */
-struct record_type
- {
- struct record_type *next;
- unsigned flags; /* RCT_* constants. */
- union value *v; /* Vector of values for this record type. */
- int nv; /* Length of vector V. */
- struct col_spec case_sbc; /* CASE subcommand. */
- int ft, lt; /* First, last transformation index. */
- }; /* record_type */
-
-/* Represents a FILE TYPE input program. */
-struct file_type_pgm
- {
- int type; /* One of the FTY_* constants. */
- struct dfm_reader *reader; /* Data file to read. */
- struct col_spec record; /* RECORD subcommand. */
- struct col_spec case_sbc; /* CASE subcommand. */
- int wild; /* 0=NOWARN, 1=WARN. */
- int duplicate; /* 0=NOWARN, 1=WARN. */
- int missing; /* 0=NOWARN, 1=WARN, 2=CASE. */
- int ordered; /* 0=NO, 1=YES. */
- int had_rec_type; /* 1=Had a RECORD TYPE command.
- RECORD TYPE must precede the first
- DATA LIST. */
- struct record_type *recs_head; /* List of record types. */
- struct record_type *recs_tail; /* Last in list of record types. */
- size_t case_size; /* Case size in bytes. */
- };
-
-static int parse_col_spec (struct col_spec *, const char *);
-static void create_col_var (struct col_spec *c);
-
-int cmd_file_type (void);
-
-/* Parses FILE TYPE command. */
-int
-cmd_file_type (void)
-{
- static struct file_type_pgm *fty; /* FIXME: static? WTF? */
- struct file_handle *fh = fh_inline_file ();
-
- /* Initialize. */
- discard_variables ();
-
- fty = xmalloc (sizeof *fty);
- fty->reader = NULL;
- fty->record.name[0] = 0;
- fty->case_sbc.name[0] = 0;
- fty->wild = fty->duplicate = fty->missing = fty->ordered = 0;
- fty->had_rec_type = 0;
- fty->recs_head = fty->recs_tail = NULL;
-
- if (lex_match_id ("MIXED"))
- fty->type = FTY_MIXED;
- else if (lex_match_id ("GROUPED"))
- {
- fty->type = FTY_GROUPED;
- fty->wild = 1;
- fty->duplicate = 1;
- fty->missing = 1;
- fty->ordered = 1;
- }
- else if (lex_match_id ("NESTED"))
- fty->type = FTY_NESTED;
- else
- {
- msg (SE, _("MIXED, GROUPED, or NESTED expected."));
- goto error;
- }
-
- while (token != '.')
- {
- if (lex_match_id ("FILE"))
- {
- lex_match ('=');
- fh = fh_parse (FH_REF_FILE | FH_REF_INLINE);
- if (fh == NULL)
- goto error;
- }
- else if (lex_match_id ("RECORD"))
- {
- lex_match ('=');
- if (!parse_col_spec (&fty->record, "####RECD"))
- goto error;
- }
- else if (lex_match_id ("CASE"))
- {
- if (fty->type == FTY_MIXED)
- {
- msg (SE, _("The CASE subcommand is not valid on FILE TYPE "
- "MIXED."));
- goto error;
- }
-
- lex_match ('=');
- if (!parse_col_spec (&fty->case_sbc, "####CASE"))
- goto error;
- }
- else if (lex_match_id ("WILD"))
- {
- lex_match ('=');
- if (lex_match_id ("WARN"))
- fty->wild = 1;
- else if (lex_match_id ("NOWARN"))
- fty->wild = 0;
- else
- {
- msg (SE, _("WARN or NOWARN expected after WILD."));
- goto error;
- }
- }
- else if (lex_match_id ("DUPLICATE"))
- {
- if (fty->type == FTY_MIXED)
- {
- msg (SE, _("The DUPLICATE subcommand is not valid on "
- "FILE TYPE MIXED."));
- goto error;
- }
-
- lex_match ('=');
- if (lex_match_id ("WARN"))
- fty->duplicate = 1;
- else if (lex_match_id ("NOWARN"))
- fty->duplicate = 0;
- else if (lex_match_id ("CASE"))
- {
- if (fty->type != FTY_NESTED)
- {
- msg (SE, _("DUPLICATE=CASE is only valid on "
- "FILE TYPE NESTED."));
- goto error;
- }
-
- fty->duplicate = 2;
- }
- else
- {
- msg (SE, _("WARN%s expected after DUPLICATE."),
- (fty->type == FTY_NESTED ? _(", NOWARN, or CASE")
- : _(" or NOWARN")));
- goto error;
- }
- }
- else if (lex_match_id ("MISSING"))
- {
- if (fty->type == FTY_MIXED)
- {
- msg (SE, _("The MISSING subcommand is not valid on "
- "FILE TYPE MIXED."));
- goto error;
- }
-
- lex_match ('=');
- if (lex_match_id ("NOWARN"))
- fty->missing = 0;
- else if (lex_match_id ("WARN"))
- fty->missing = 1;
- else
- {
- msg (SE, _("WARN or NOWARN after MISSING."));
- goto error;
- }
- }
- else if (lex_match_id ("ORDERED"))
- {
- if (fty->type != FTY_GROUPED)
- {
- msg (SE, _("ORDERED is only valid on FILE TYPE GROUPED."));
- goto error;
- }
-
- lex_match ('=');
- if (lex_match_id ("YES"))
- fty->ordered = 1;
- else if (lex_match_id ("NO"))
- fty->ordered = 0;
- else
- {
- msg (SE, _("YES or NO expected after ORDERED."));
- goto error;
- }
- }
- else
- {
- lex_error (_("while expecting a valid subcommand"));
- goto error;
- }
- }
-
- if (fty->record.name[0] == 0)
- {
- msg (SE, _("The required RECORD subcommand was not present."));
- goto error;
- }
-
- if (fty->type == FTY_GROUPED)
- {
- if (fty->case_sbc.name[0] == 0)
- {
- msg (SE, _("The required CASE subcommand was not present."));
- goto error;
- }
-
- if (!strcasecmp (fty->case_sbc.name, fty->record.name))
- {
- msg (SE, _("CASE and RECORD must specify different variable "
- "names."));
- goto error;
- }
- }
-
- fty->reader = dfm_open_reader (fh);
- if (fty->reader == NULL)
- goto error;
- fh_set_default_handle (fh);
-
- create_col_var (&fty->record);
- if (fty->case_sbc.name[0])
- create_col_var (&fty->case_sbc);
- vfm_source = create_case_source (&file_type_source_class, fty);
-
- return CMD_SUCCESS;
-
- error:
- free (fty);
- return CMD_FAILURE;
-}
-
-/* Creates a variable with attributes specified by struct col_spec C, and
- stores it into C->V. */
-static void
-create_col_var (struct col_spec *c)
-{
- int width;
-
- if (formats[c->fmt].cat & FCAT_STRING)
- width = c->nc;
- else
- width = 0;
- c->v = dict_create_var (default_dict, c->name, width);
-}
-
-/* Parses variable, column, type specifications for a variable. */
-static int
-parse_col_spec (struct col_spec *c, const char *def_name)
-{
- struct fmt_spec spec;
-
- /* Name. */
- if (token == T_ID)
- {
- strcpy (c->name, tokid);
- lex_get ();
- }
- else
- strcpy (c->name, def_name);
-
- /* First column. */
- if (!lex_force_int ())
- return 0;
- c->fc = lex_integer ();
- if (c->fc < 1)
- {
- msg (SE, _("Column value must be positive."));
- return 0;
- }
- lex_get ();
-
- /* Last column. */
- lex_negative_to_dash ();
- if (lex_match ('-'))
- {
- if (!lex_force_int ())
- return 0;
- c->nc = lex_integer ();
- lex_get ();
-
- if (c->nc < c->fc)
- {
- msg (SE, _("Ending column precedes beginning column."));
- return 0;
- }
-
- c->nc -= c->fc - 1;
- }
- else
- c->nc = 1;
-
- /* Format specifier. */
- if (lex_match ('('))
- {
- const char *cp;
- if (!lex_force_id ())
- return 0;
- c->fmt = parse_format_specifier_name (&cp, 0);
- if (c->fmt == -1)
- return 0;
- if (*cp)
- {
- msg (SE, _("Bad format specifier name."));
- return 0;
- }
- lex_get ();
- if (!lex_force_match (')'))
- return 0;
- }
- else
- c->fmt = FMT_F;
-
- spec.type = c->fmt;
- spec.w = c->nc;
- spec.d = 0;
- return check_input_specifier (&spec, 1);
-}
-\f
-/* RECORD TYPE. */
-
-/* Parse the RECORD TYPE command. */
-int
-cmd_record_type (void)
-{
- struct file_type_pgm *fty;
- struct record_type *rct;
-
- /* Make sure we're inside a FILE TYPE structure. */
- if (pgm_state != STATE_INPUT
- || !case_source_is_class (vfm_source, &file_type_source_class))
- {
- msg (SE, _("This command may only appear within a "
- "FILE TYPE/END FILE TYPE structure."));
- return CMD_FAILURE;
- }
-
- fty = vfm_source->aux;
-
- /* Initialize the record_type structure. */
- rct = xmalloc (sizeof *rct);
- rct->next = NULL;
- rct->flags = 0;
- if (fty->duplicate)
- rct->flags |= RCT_DUPLICATE;
- if (fty->missing)
- rct->flags |= RCT_MISSING;
- rct->v = NULL;
- rct->nv = 0;
- rct->ft = n_trns;
- if (fty->case_sbc.name[0])
- rct->case_sbc = fty->case_sbc;
-
- if (fty->recs_tail && (fty->recs_tail->flags & RCT_OTHER))
- {
- msg (SE, _("OTHER may appear only on the last RECORD TYPE command."));
- goto error;
- }
-
- if (fty->recs_tail)
- {
- fty->recs_tail->lt = n_trns - 1;
- if (!(fty->recs_tail->flags & RCT_SKIP)
- && fty->recs_tail->ft == fty->recs_tail->lt)
- {
- msg (SE, _("No input commands (DATA LIST, REPEATING DATA) "
- "for above RECORD TYPE."));
- goto error;
- }
- }
-
- /* Parse record type values. */
- if (lex_match_id ("OTHER"))
- rct->flags |= RCT_OTHER;
- else
- {
- int mv = 0;
-
- while (lex_is_number () || token == T_STRING)
- {
- if (rct->nv >= mv)
- {
- mv += 16;
- rct->v = xnrealloc (rct->v, mv, sizeof *rct->v);
- }
-
- if (formats[fty->record.fmt].cat & FCAT_STRING)
- {
- if (!lex_force_string ())
- goto error;
- rct->v[rct->nv].c = xmalloc (fty->record.nc + 1);
- buf_copy_str_rpad (rct->v[rct->nv].c, fty->record.nc + 1,
- ds_c_str (&tokstr));
- }
- else
- {
- if (!lex_force_num ())
- goto error;
- rct->v[rct->nv].f = tokval;
- }
- rct->nv++;
- lex_get ();
-
- lex_match (',');
- }
- }
-
- /* Parse the rest of the subcommands. */
- while (token != '.')
- {
- if (lex_match_id ("SKIP"))
- rct->flags |= RCT_SKIP;
- else if (lex_match_id ("CASE"))
- {
- if (fty->type == FTY_MIXED)
- {
- msg (SE, _("The CASE subcommand is not allowed on "
- "the RECORD TYPE command for FILE TYPE MIXED."));
- goto error;
- }
-
- lex_match ('=');
- if (!parse_col_spec (&rct->case_sbc, ""))
- goto error;
- if (rct->case_sbc.name[0])
- {
- msg (SE, _("No variable name may be specified for the "
- "CASE subcommand on RECORD TYPE."));
- goto error;
- }
-
- if ((formats[rct->case_sbc.fmt].cat ^ formats[fty->case_sbc.fmt].cat)
- & FCAT_STRING)
- {
- msg (SE, _("The CASE column specification on RECORD TYPE "
- "must give a format specifier that is the "
- "same type as that of the CASE column "
- "specification given on FILE TYPE."));
- goto error;
- }
- }
- else if (lex_match_id ("DUPLICATE"))
- {
- lex_match ('=');
- if (lex_match_id ("WARN"))
- rct->flags |= RCT_DUPLICATE;
- else if (lex_match_id ("NOWARN"))
- rct->flags &= ~RCT_DUPLICATE;
- else
- {
- msg (SE, _("WARN or NOWARN expected on DUPLICATE "
- "subcommand."));
- goto error;
- }
- }
- else if (lex_match_id ("MISSING"))
- {
- lex_match ('=');
- if (lex_match_id ("WARN"))
- rct->flags |= RCT_MISSING;
- else if (lex_match_id ("NOWARN"))
- rct->flags &= ~RCT_MISSING;
- else
- {
- msg (SE, _("WARN or NOWARN expected on MISSING subcommand."));
- goto error;
- }
- }
- else if (lex_match_id ("SPREAD"))
- {
- lex_match ('=');
- if (lex_match_id ("YES"))
- rct->flags |= RCT_SPREAD;
- else if (lex_match_id ("NO"))
- rct->flags &= ~RCT_SPREAD;
- else
- {
- msg (SE, _("YES or NO expected on SPREAD subcommand."));
- goto error;
- }
- }
- else
- {
- lex_error (_("while expecting a valid subcommand"));
- goto error;
- }
- }
-
- if (fty->recs_head)
- fty->recs_tail = fty->recs_tail->next = xmalloc (sizeof *fty->recs_tail);
- else
- fty->recs_head = fty->recs_tail = xmalloc (sizeof *fty->recs_tail);
- memcpy (fty->recs_tail, &rct, sizeof *fty->recs_tail);
-
- return CMD_SUCCESS;
-
- error:
- if (formats[fty->record.fmt].cat & FCAT_STRING)
- {
- int i;
-
- for (i = 0; i < rct->nv; i++)
- free (rct->v[i].c);
- }
- free (rct->v);
- free (rct);
-
- return CMD_FAILURE;
-}
-\f
-/* END FILE TYPE. */
-
-int cmd_end_file_type (void);
-int
-cmd_end_file_type (void)
-{
- struct file_type_pgm *fty;
-
- if (pgm_state != STATE_INPUT
- || case_source_is_class (vfm_source, &file_type_source_class))
- {
- msg (SE, _("This command may only appear within a "
- "FILE TYPE/END FILE TYPE structure."));
- return CMD_FAILURE;
- }
- fty = vfm_source->aux;
- fty->case_size = dict_get_case_size (default_dict);
-
- if (fty->recs_tail)
- {
- fty->recs_tail->lt = n_trns - 1;
- if (!(fty->recs_tail->flags & RCT_SKIP)
- && fty->recs_tail->ft == fty->recs_tail->lt)
- {
- msg (SE, _("No input commands (DATA LIST, REPEATING DATA) "
- "on above RECORD TYPE."));
- goto fail;
- }
- }
- else
- {
- msg (SE, _("No commands between FILE TYPE and END FILE TYPE."));
- goto fail;
- }
-
- f_trns = n_trns;
-
- return lex_end_of_command ();
-
- fail:
- /* Come here on discovering catastrophic error. */
- err_cond_fail ();
- discard_variables ();
- return CMD_FAILURE;
-}
-\f
-/* FILE TYPE runtime. */
-
-/*static void read_from_file_type_mixed(void);
- static void read_from_file_type_grouped(void);
- static void read_from_file_type_nested(void); */
-
-/* Reads any number of cases into case C and calls write_case()
- for each one. Compare data-list.c:read_from_data_list. */
-static void
-file_type_source_read (struct case_source *source,
- struct ccase *c,
- write_case_func *write_case UNUSED,
- write_case_data wc_data UNUSED)
-{
- struct file_type_pgm *fty = source->aux;
- struct fmt_spec format;
-
- dfm_push (fty->reader);
-
- format.type = fty->record.fmt;
- format.w = fty->record.nc;
- format.d = 0;
- while (!dfm_eof (fty->reader))
- {
- struct fixed_string line;
- struct record_type *iter;
- union value v;
- int i;
-
- dfm_expand_tabs (fty->reader);
- dfm_get_record (fty->reader, &line);
- if (formats[fty->record.fmt].cat & FCAT_STRING)
- {
- struct data_in di;
-
- v.c = case_data_rw (c, fty->record.v->fv)->s;
-
- data_in_finite_line (&di, ls_c_str (&line), ls_length (&line),
- fty->record.fc, fty->record.fc + fty->record.nc);
- di.v = (union value *) v.c;
- di.flags = 0;
- di.f1 = fty->record.fc;
- di.format = format;
- data_in (&di);
-
- for (iter = fty->recs_head; iter; iter = iter->next)
- {
- if (iter->flags & RCT_OTHER)
- goto found;
- for (i = 0; i < iter->nv; i++)
- if (!memcmp (iter->v[i].c, v.c, fty->record.nc))
- goto found;
- }
- if (fty->wild)
- msg (SW, _("Unknown record type \"%.*s\"."), fty->record.nc, v.c);
- }
- else
- {
- struct data_in di;
-
- data_in_finite_line (&di, ls_c_str (&line), ls_length (&line),
- fty->record.fc, fty->record.fc + fty->record.nc);
- di.v = &v;
- di.flags = 0;
- di.f1 = fty->record.fc;
- di.format = format;
- data_in (&di);
-
- case_data_rw (c, fty->record.v->fv)->f = v.f;
- for (iter = fty->recs_head; iter; iter = iter->next)
- {
- if (iter->flags & RCT_OTHER)
- goto found;
- for (i = 0; i < iter->nv; i++)
- if (iter->v[i].f == v.f)
- goto found;
- }
- if (fty->wild)
- msg (SW, _("Unknown record type %g."), v.f);
- }
- dfm_forward_record (fty->reader);
- continue;
-
- found:
- /* Arrive here if there is a matching record_type, which is in
- iter. */
- dfm_forward_record (fty->reader);
- }
-
-/* switch(fty->type)
- {
- case FTY_MIXED: read_from_file_type_mixed(); break;
- case FTY_GROUPED: read_from_file_type_grouped(); break;
- case FTY_NESTED: read_from_file_type_nested(); break;
- default: assert(0);
- } */
-
- dfm_pop (fty->reader);
-}
-
-static void
-file_type_source_destroy (struct case_source *source)
-{
- struct file_type_pgm *fty = source->aux;
- struct record_type *iter, *next;
-
- cancel_transformations ();
- dfm_close_reader (fty->reader);
- for (iter = fty->recs_head; iter; iter = next)
- {
- next = iter->next;
- free (iter);
- }
-}
-
-const struct case_source_class file_type_source_class =
- {
- "FILE TYPE",
- NULL,
- file_type_source_read,
- file_type_source_destroy,
- };
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include "filename.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include <ctype.h>
-#include <errno.h>
-#include "alloc.h"
-#include "error.h"
-#include "settings.h"
-#include "str.h"
-#include "version.h"
-#include "xreadlink.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-/* PORTME: Everything in this file is system dependent. */
-
-#ifdef unix
-#include <pwd.h>
-#if HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-#include <sys/stat.h>
-#include "stat-macros.h"
-#endif
-
-#ifdef __WIN32__
-#define NOGDI
-#define NOUSER
-#define NONLS
-#include <win32/windows.h>
-#endif
-
-#if __DJGPP__
-#include <sys/stat.h>
-#endif
-\f
-/* Initialization. */
-
-const char *config_path;
-
-void
-fn_init (void)
-{
- config_path = fn_getenv_default ("STAT_CONFIG_PATH", default_config_path);
-}
-\f
-/* Functions for performing operations on filenames. */
-
-/* Substitutes $variables as defined by GETENV into INPUT and returns
- a copy of the resultant string. Supports $var and ${var} syntaxes;
- $$ substitutes as $. */
-char *
-fn_interp_vars (const char *input, const char *(*getenv) (const char *))
-{
- struct string output;
-
- if (NULL == strchr (input, '$'))
- return xstrdup (input);
-
- ds_init (&output, strlen (input));
-
- for (;;)
- switch (*input)
- {
- case '\0':
- return ds_c_str (&output);
-
- case '$':
- input++;
-
- if (*input == '$')
- {
- ds_putc (&output, '$');
- input++;
- }
- else
- {
- int stop;
- int start;
- const char *value;
-
- start = ds_length (&output);
-
- if (*input == '(')
- {
- stop = ')';
- input++;
- }
- else if (*input == '{')
- {
- stop = '}';
- input++;
- }
- else
- stop = 0;
-
- while (*input && *input != stop
- && (stop || isalpha ((unsigned char) *input)))
- ds_putc (&output, *input++);
-
- value = getenv (ds_c_str (&output) + start);
- ds_truncate (&output, start);
- ds_puts (&output, value);
-
- if (stop && *input == stop)
- input++;
- }
-
- default:
- ds_putc (&output, *input++);
- }
-}
-
-#ifdef unix
-/* Expands csh tilde notation from the path INPUT into a malloc()'d
- returned string. */
-char *
-fn_tilde_expand (const char *input)
-{
- const char *ip;
- struct string output;
-
- if (NULL == strchr (input, '~'))
- return xstrdup (input);
- ds_init (&output, strlen (input));
-
- ip = input;
-
- for (ip = input; *ip; )
- if (*ip != '~' || (ip != input && ip[-1] != PATH_DELIMITER))
- ds_putc (&output, *ip++);
- else
- {
- static const char stop_set[3] = {DIR_SEPARATOR, PATH_DELIMITER, 0};
- const char *cp;
-
- ip++;
-
- cp = ip + strcspn (ip, stop_set);
-
- if (cp > ip)
- {
- struct passwd *pwd;
- char username[9];
-
- strncpy (username, ip, cp - ip + 1);
- username[8] = 0;
- pwd = getpwnam (username);
-
- if (!pwd || !pwd->pw_dir)
- ds_putc (&output, *ip++);
- else
- ds_puts (&output, pwd->pw_dir);
- }
- else
- {
- const char *home = fn_getenv ("HOME");
- if (!home)
- ds_putc (&output, *ip++);
- else
- ds_puts (&output, home);
- }
-
- ip = cp;
- }
-
- return ds_c_str (&output);
-}
-#else /* !unix */
-char *
-fn_tilde_expand (const char *input)
-{
- return xstrdup (input);
-}
-#endif /* !unix */
-
-/* Searches for a configuration file with name NAME in the path given
- by PATH, which is tilde- and environment-interpolated. Directories
- in PATH are delimited by PATH_DELIMITER, defined in <pref.h>.
- Returns the malloc'd full name of the first file found, or NULL if
- none is found.
-
- If PREPEND is non-NULL, then it is prepended to each filename;
- i.e., it looks like PREPEND/PATH_COMPONENT/NAME. This is not done
- with absolute directories in the path. */
-#if defined (unix) || defined (__MSDOS__) || defined (__WIN32__)
-char *
-fn_search_path (const char *basename, const char *path, const char *prepend)
-{
- char *subst_path;
- struct string filename;
- const char *bp;
-
- if (fn_absolute_p (basename))
- return fn_tilde_expand (basename);
-
- {
- char *temp = fn_interp_vars (path, fn_getenv);
- bp = subst_path = fn_tilde_expand (temp);
- free (temp);
- }
-
- msg (VM (4), _("Searching for `%s'..."), basename);
- ds_init (&filename, 64);
-
- for (;;)
- {
- const char *ep;
- if (0 == *bp)
- {
- msg (VM (4), _("Search unsuccessful!"));
- ds_destroy (&filename);
- free (subst_path);
- return NULL;
- }
-
- for (ep = bp; *ep && *ep != PATH_DELIMITER; ep++)
- ;
-
- /* Paste together PREPEND/PATH/BASENAME. */
- ds_clear (&filename);
- if (prepend && !fn_absolute_p (bp))
- {
- ds_puts (&filename, prepend);
- ds_putc (&filename, DIR_SEPARATOR);
- }
- ds_concat (&filename, bp, ep - bp);
- if (ep - bp
- && ds_c_str (&filename)[ds_length (&filename) - 1] != DIR_SEPARATOR)
- ds_putc (&filename, DIR_SEPARATOR);
- ds_puts (&filename, basename);
-
- msg (VM (5), " - %s", ds_c_str (&filename));
- if (fn_exists_p (ds_c_str (&filename)))
- {
- msg (VM (4), _("Found `%s'."), ds_c_str (&filename));
- free (subst_path);
- return ds_c_str (&filename);
- }
-
- if (0 == *ep)
- {
- msg (VM (4), _("Search unsuccessful!"));
- free (subst_path);
- ds_destroy (&filename);
- return NULL;
- }
- bp = ep + 1;
- }
-}
-#else /* not unix, msdog, lose32 */
-char *
-fn_search_path (const char *basename, const char *path, const char *prepend)
-{
- size_t size = strlen (path) + 1 + strlen (basename) + 1;
- char *string;
- char *cp;
-
- if (prepend)
- size += strlen (prepend) + 1;
- string = xmalloc (size);
-
- cp = string;
- if (prepend)
- {
- cp = stpcpy (cp, prepend);
- *cp++ = DIR_SEPARATOR;
- }
- cp = stpcpy (cp, path);
- *cp++ = DIR_SEPARATOR;
- strcpy (cp, basename);
-
- return string;
-}
-#endif /* not unix, msdog, lose32 */
-
-/* Prepends directory DIR to filename FILE and returns a malloc()'d
- copy of it. */
-char *
-fn_prepend_dir (const char *file, const char *dir)
-{
- char *temp;
- char *cp;
-
- if (fn_absolute_p (file))
- return xstrdup (file);
-
- temp = xmalloc (strlen (file) + 1 + strlen (dir) + 1);
- cp = stpcpy (temp, dir);
- if (cp != temp && cp[-1] != DIR_SEPARATOR)
- *cp++ = DIR_SEPARATOR;
- cp = stpcpy (cp, file);
-
- return temp;
-}
-
-/* fn_normalize(): This very OS-dependent routine canonicalizes
- filename FN1. The filename should not need to be the name of an
- existing file. Returns a malloc()'d copy of the canonical name.
- This function must always succeed; if it needs to bail out then it
- should return xstrdup(FN1). */
-#ifdef unix
-char *
-fn_normalize (const char *filename)
-{
- const char *src;
- char *fn1, *fn2, *dest;
- int maxlen;
-
- if (fn_special_p (filename))
- return xstrdup (filename);
-
- fn1 = fn_tilde_expand (filename);
-
- /* Follow symbolic links. */
- for (;;)
- {
- fn2 = fn1;
- fn1 = fn_readlink (fn1);
- if (!fn1)
- {
- fn1 = fn2;
- break;
- }
- free (fn2);
- }
-
- maxlen = strlen (fn1) * 2;
- if (maxlen < 31)
- maxlen = 31;
- dest = fn2 = xmalloc (maxlen + 1);
- src = fn1;
-
- if (*src == DIR_SEPARATOR)
- *dest++ = *src++;
- else
- {
- errno = 0;
- while (getcwd (dest, maxlen - (dest - fn2)) == NULL && errno == ERANGE)
- {
- maxlen *= 2;
- dest = fn2 = xrealloc (fn2, maxlen + 1);
- errno = 0;
- }
- if (errno)
- {
- free (fn1);
- free (fn2);
- return NULL;
- }
- dest = strchr (fn2, '\0');
- if (dest - fn2 >= maxlen)
- {
- int ofs = dest - fn2;
- maxlen *= 2;
- fn2 = xrealloc (fn2, maxlen + 1);
- dest = fn2 + ofs;
- }
- if (dest[-1] != DIR_SEPARATOR)
- *dest++ = DIR_SEPARATOR;
- }
-
- for (;;)
- {
- int c, f;
-
- c = *src++;
-
- f = 0;
- if (c == DIR_SEPARATOR || c == 0)
- {
- /* remove `./', `../' from directory */
- if (dest[-1] == '.' && dest[-2] == DIR_SEPARATOR)
- dest--;
- else if (dest[-1] == '.' && dest[-2] == '.' && dest[-3] == DIR_SEPARATOR)
- {
- dest -= 3;
- if (dest == fn2)
- dest++;
- while (dest[-1] != DIR_SEPARATOR)
- dest--;
- }
- else if (dest[-1] != DIR_SEPARATOR) /* remove extra slashes */
- f = 1;
-
- if (c == 0)
- {
- if (dest[-1] == DIR_SEPARATOR && dest > fn2 + 1)
- dest--;
- *dest = 0;
- free (fn1);
-
- return xrealloc (fn2, strlen (fn2) + 1);
- }
- }
- else
- f = 1;
-
- if (f)
- {
- if (dest - fn2 >= maxlen)
- {
- int ofs = dest - fn2;
- maxlen *= 2;
- fn2 = xrealloc (fn2, maxlen + 1);
- dest = fn2 + ofs;
- }
- *dest++ = c;
- }
- }
-}
-#elif defined (__WIN32__)
-char *
-fn_normalize (const char *fn1)
-{
- DWORD len;
- DWORD success;
- char *fn2;
-
- /* Don't change special filenames. */
- if (is_special_filename (filename))
- return xstrdup (filename);
-
- /* First find the required buffer length. */
- len = GetFullPathName (fn1, 0, NULL, NULL);
- if (!len)
- {
- fn2 = xstrdup (fn1);
- return fn2;
- }
-
- /* Then make a buffer that big. */
- fn2 = xmalloc (len);
- success = GetFullPathName (fn1, len, fn2, NULL);
- if (success >= len || success == 0)
- {
- free (fn2);
- fn2 = xstrdup (fn1);
- return fn2;
- }
- return fn2;
-}
-#elif __BORLANDC__
-char *
-fn_normalize (const char *fn1)
-{
- char *fn2 = _fullpath (NULL, fn1, 0);
- if (fn2)
- {
- char *cp;
- for (cp = fn2; *cp; cp++)
- *cp = toupper ((unsigned char) (*cp));
- return fn2;
- }
- return xstrdup (fn1);
-}
-#elif __DJGPP__
-char *
-fn_normalize (const char *fn1)
-{
- char *fn2 = xmalloc (1024);
- _fixpath (fn1, fn2);
- fn2 = xrealloc (fn2, strlen (fn2) + 1);
- return fn2;
-}
-#else /* not Lose32, Unix, or DJGPP */
-char *
-fn_normalize (const char *fn)
-{
- return xstrdup (fn);
-}
-#endif /* not Lose32, Unix, or DJGPP */
-
-/* Returns the directory part of FILENAME, as a malloc()'d
- string. */
-char *
-fn_dirname (const char *filename)
-{
- const char *p;
- char *s;
- size_t len;
-
- len = strlen (filename);
- if (len == 1 && filename[0] == '/')
- p = filename + 1;
- else if (len && filename[len - 1] == DIR_SEPARATOR)
- p = buf_find_reverse (filename, len - 1, filename + len - 1, 1);
- else
- p = strrchr (filename, DIR_SEPARATOR);
- if (p == NULL)
- p = filename;
-
- s = xmalloc (p - filename + 1);
- memcpy (s, filename, p - filename);
- s[p - filename] = 0;
-
- return s;
-}
-
-/* Returns the basename part of FILENAME as a malloc()'d string. */
-#if 0
-char *
-fn_basename (const char *filename)
-{
- /* Not used, not implemented. */
- abort ();
-}
-#endif
-
-/* Returns the extension part of FILENAME as a malloc()'d string.
- If FILENAME does not have an extension, returns an empty
- string. */
-char *
-fn_extension (const char *filename)
-{
- const char *extension = strrchr (filename, '.');
- if (extension == NULL)
- extension = "";
- return xstrdup (extension);
-}
-\f
-#if unix
-/* Returns the current working directory, as a malloc()'d string.
- From libc.info. */
-char *
-fn_get_cwd (void)
-{
- int size = 100;
- char *buffer = xmalloc (size);
-
- for (;;)
- {
- char *value = getcwd (buffer, size);
- if (value != 0)
- return buffer;
-
- size *= 2;
- free (buffer);
- buffer = xmalloc (size);
- }
-}
-#else
-char *
-fn_get_cwd (void)
-{
- int size = 2;
- char *buffer = xmalloc (size);
- if ( buffer)
- {
- buffer[0]='.';
- buffer[1]='\0';
- }
-
- return buffer;
-
-}
-#endif
-\f
-/* Find out information about files. */
-
-/* Returns nonzero iff NAME specifies an absolute filename. */
-int
-fn_absolute_p (const char *name)
-{
-#ifdef unix
- if (name[0] == '/'
- || !strncmp (name, "./", 2)
- || !strncmp (name, "../", 3)
- || name[0] == '~')
- return 1;
-#elif defined (__MSDOS__)
- if (name[0] == '\\'
- || !strncmp (name, ".\\", 2)
- || !strncmp (name, "..\\", 3)
- || (name[0] && name[1] == ':'))
- return 1;
-#endif
-
- return 0;
-}
-
-/* Returns 1 if the filename specified is a virtual file that doesn't
- really exist on disk, 0 if it's a real filename. */
-int
-fn_special_p (const char *filename)
-{
- if (!strcmp (filename, "-") || !strcmp (filename, "stdin")
- || !strcmp (filename, "stdout") || !strcmp (filename, "stderr")
-#ifdef unix
- || filename[0] == '|'
- || (*filename && filename[strlen (filename) - 1] == '|')
-#endif
- )
- return 1;
-
- return 0;
-}
-
-/* Returns nonzero if file with name NAME exists. */
-int
-fn_exists_p (const char *name)
-{
-#ifdef unix
- struct stat temp;
-
- return stat (name, &temp) == 0;
-#else
- FILE *f = fopen (name, "r");
- if (!f)
- return 0;
- fclose (f);
- return 1;
-#endif
-}
-
-/* Returns the symbolic link value for FILENAME as a dynamically
- allocated buffer, or a null pointer on failure. */
-char *
-fn_readlink (const char *filename)
-{
- return xreadlink (filename, 32);
-}
-\f
-/* Environment variables. */
-
-/* Simulates $VER and $ARCH environment variables. */
-const char *
-fn_getenv (const char *s)
-{
- if (!strcmp (s, "VER"))
- return fn_getenv_default ("STAT_VER", bare_version);
- else if (!strcmp (s, "ARCH"))
- return fn_getenv_default ("STAT_ARCH", host_system);
- else
- return getenv (s);
-}
-
-/* Returns getenv(KEY) if that's non-NULL; else returns DEF. */
-const char *
-fn_getenv_default (const char *key, const char *def)
-{
- const char *value = getenv (key);
- return value ? value : def;
-}
-\f
-/* Basic file handling. */
-
-/* Used for giving an error message on a set_safer security
- violation. */
-static FILE *
-safety_violation (const char *fn)
-{
- msg (SE, _("Not opening pipe file `%s' because SAFER option set."), fn);
- errno = EPERM;
- return NULL;
-}
-
-/* As a general comment on the following routines, a `sensible value'
- for errno includes 0 if there is no associated system error. The
- routines will only set errno to 0 if there is an error in a
- callback that sets errno to 0; they themselves won't. */
-
-/* File open routine that understands `-' as stdin/stdout and `|cmd'
- as a pipe to command `cmd'. Returns resultant FILE on success,
- NULL on failure. If NULL is returned then errno is set to a
- sensible value. */
-FILE *
-fn_open (const char *fn, const char *mode)
-{
- assert (mode[0] == 'r' || mode[0] == 'w');
-
- if (mode[0] == 'r' && (!strcmp (fn, "stdin") || !strcmp (fn, "-")))
- return stdin;
- else if (mode[0] == 'w' && (!strcmp (fn, "stdout") || !strcmp (fn, "-")))
- return stdout;
- else if (mode[0] == 'w' && !strcmp (fn, "stderr"))
- return stderr;
-
-#ifdef unix
- if (fn[0] == '|')
- {
- if (get_safer_mode ())
- return safety_violation (fn);
-
- return popen (&fn[1], mode);
- }
- else if (*fn && fn[strlen (fn) - 1] == '|')
- {
- char *s;
- FILE *f;
-
- if (get_safer_mode ())
- return safety_violation (fn);
-
- s = local_alloc (strlen (fn));
- memcpy (s, fn, strlen (fn) - 1);
- s[strlen (fn) - 1] = 0;
-
- f = popen (s, mode);
-
- local_free (s);
-
- return f;
- }
- else
-#endif
- {
- FILE *f = fopen (fn, mode);
-
- if (f && mode[0] == 'w')
- setvbuf (f, NULL, _IOLBF, 0);
-
- return f;
- }
-}
-
-/* Counterpart to fn_open that closes file F with name FN; returns 0
- on success, EOF on failure. If EOF is returned, errno is set to a
- sensible value. */
-int
-fn_close (const char *fn, FILE *f)
-{
- if (!strcmp (fn, "-"))
- return 0;
-#ifdef unix
- else if (fn[0] == '|' || (*fn && fn[strlen (fn) - 1] == '|'))
- {
- pclose (f);
- return 0;
- }
-#endif
- else
- return fclose (f);
-}
-\f
-/* More extensive file handling. */
-
-/* File open routine that extends fn_open(). Opens or reopens a
- file according to the contents of file_ext F. Returns nonzero on
- success. If 0 is returned, errno is set to a sensible value. */
-int
-fn_open_ext (struct file_ext *f)
-{
- char *p;
-
- p = strstr (f->filename, "%d");
- if (p)
- {
- char *s = local_alloc (strlen (f->filename) + INT_DIGITS - 1);
- char *cp;
-
- memcpy (s, f->filename, p - f->filename);
- cp = spprintf (&s[p - f->filename], "%d", *f->sequence_no);
- strcpy (cp, &p[2]);
-
- if (f->file)
- {
- int error = 0;
-
- if (f->preclose)
- if (f->preclose (f) == 0)
- error = errno;
-
- if (EOF == fn_close (f->filename, f->file) || error)
- {
- f->file = NULL;
- local_free (s);
-
- if (error)
- errno = error;
-
- return 0;
- }
-
- f->file = NULL;
- }
-
- f->file = fn_open (s, f->mode);
- local_free (s);
-
- if (f->file && f->postopen)
- if (f->postopen (f) == 0)
- {
- int error = errno;
- fn_close (f->filename, f->file);
- errno = error;
-
- return 0;
- }
-
- return (f->file != NULL);
- }
- else if (f->file)
- return 1;
- else
- {
- f->file = fn_open (f->filename, f->mode);
-
- if (f->file && f->postopen)
- if (f->postopen (f) == 0)
- {
- int error = errno;
- fn_close (f->filename, f->file);
- errno = error;
-
- return 0;
- }
-
- return (f->file != NULL);
- }
-}
-
-/* Properly closes the file associated with file_ext F, if any.
- Return nonzero on success. If zero is returned, errno is set to a
- sensible value. */
-int
-fn_close_ext (struct file_ext *f)
-{
- if (f->file)
- {
- int error = 0;
-
- if (f->preclose)
- if (f->preclose (f) == 0)
- error = errno;
-
- if (EOF == fn_close (f->filename, f->file) || error)
- {
- f->file = NULL;
-
- if (error)
- errno = error;
-
- return 0;
- }
-
- f->file = NULL;
- }
- return 1;
-}
-
-#ifdef unix
-/* A file's identity. */
-struct file_identity
- {
- dev_t device; /* Device number. */
- ino_t inode; /* Inode number. */
- };
-
-/* Returns a pointer to a dynamically allocated structure whose
- value can be used to tell whether two files are actually the
- same file. Returns a null pointer if no information about the
- file is available, perhaps because it does not exist. The
- caller is responsible for freeing the structure with
- fn_free_identity() when finished. */
-struct file_identity *
-fn_get_identity (const char *filename)
-{
- struct stat s;
-
- if (stat (filename, &s) == 0)
- {
- struct file_identity *identity = xmalloc (sizeof *identity);
- identity->device = s.st_dev;
- identity->inode = s.st_ino;
- return identity;
- }
- else
- return NULL;
-}
-
-/* Frees IDENTITY obtained from fn_get_identity(). */
-void
-fn_free_identity (struct file_identity *identity)
-{
- free (identity);
-}
-
-/* Compares A and B, returning a strcmp()-type result. */
-int
-fn_compare_file_identities (const struct file_identity *a,
- const struct file_identity *b)
-{
- assert (a != NULL);
- assert (b != NULL);
- if (a->device != b->device)
- return a->device < b->device ? -1 : 1;
- else
- return a->inode < b->inode ? -1 : a->inode > b->inode;
-}
-#else /* not unix */
-/* A file's identity. */
-struct file_identity
- {
- char *normalized_filename; /* File's normalized name. */
- };
-
-/* Returns a pointer to a dynamically allocated structure whose
- value can be used to tell whether two files are actually the
- same file. Returns a null pointer if no information about the
- file is available, perhaps because it does not exist. The
- caller is responsible for freeing the structure with
- fn_free_identity() when finished. */
-struct file_identity *
-fn_get_identity (const char *filename)
-{
- struct file_identity *identity = xmalloc (sizeof *identity);
- identity->normalized_filename = fn_normalize (filename);
- return identity;
-}
-
-/* Frees IDENTITY obtained from fn_get_identity(). */
-void
-fn_free_identity (struct file_identity *identity)
-{
- if (identity != NULL)
- {
- free (identity->normalized_filename);
- free (identity);
- }
-}
-
-/* Compares A and B, returning a strcmp()-type result. */
-int
-fn_compare_file_identities (const struct file_identity *a,
- const struct file_identity *b)
-{
- return strcmp (a->normalized_filename, b->normalized_filename);
-}
-#endif /* not unix */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !filename_h
-#define filename_h 1
-
-#include <stdio.h>
-
-/* Search path for configuration files. */
-extern const char *config_path;
-
-void fn_init (void);
-
-char *fn_interp_vars (const char *input, const char *(*getenv) (const char *));
-char *fn_tilde_expand (const char *fn);
-char *fn_search_path (const char *basename, const char *path,
- const char *prepend);
-char *fn_prepend_dir (const char *filename, const char *directory);
-char *fn_normalize (const char *fn);
-char *fn_dirname (const char *fn);
-char *fn_basename (const char *fn);
-char *fn_extension (const char *fn);
-
-char *fn_get_cwd (void);
-
-int fn_absolute_p (const char *fn);
-int fn_special_p (const char *fn);
-int fn_exists_p (const char *fn);
-char *fn_readlink (const char *fn);
-
-const char *fn_getenv (const char *variable);
-const char *fn_getenv_default (const char *variable, const char *def);
-
-FILE *fn_open (const char *fn, const char *mode);
-int fn_close (const char *fn, FILE *file);
-
-struct file_identity *fn_get_identity (const char *filename);
-void fn_free_identity (struct file_identity *);
-int fn_compare_file_identities (const struct file_identity *,
- const struct file_identity *);
-\f
-/* Extended file routines. */
-struct file_ext;
-
-typedef int (*file_callback) (struct file_ext *);
-
-/* File callbacks may not return zero to indicate failure unless they
- set errno to a sensible value. */
-struct file_ext
- {
- char *filename; /* Filename. */
- const char *mode; /* Open mode, i.e, "wb". */
- FILE *file; /* File. */
- int *sequence_no; /* Page number, etc. */
- void *param; /* User data. */
- file_callback postopen; /* Called after FILE opened. */
- file_callback preclose; /* Called before FILE closed. */
- };
-
-int fn_open_ext (struct file_ext *file);
-int fn_close_ext (struct file_ext *file);
-
-#endif /* filename_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include "config.h"
-#include "error.h"
-#include <ctype.h>
-#include <errno.h>
-#include <float.h>
-#include <limits.h>
-#include <stdlib.h>
-#include "algorithm.h"
-#include "alloc.h"
-#include "case.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "lexer.h"
-#include "misc.h"
-#include "settings.h"
-#include "str.h"
-#include "val.h"
-#include "var.h"
-#include "vfm.h"
-
-#ifdef HAVE_SYS_TYPES_H
-#include <sys/types.h>
-#endif
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* List of variable names. */
-struct varname
- {
- struct varname *next;
- char name[SHORT_NAME_LEN + 1];
- };
-
-/* Represents a FLIP input program. */
-struct flip_pgm
- {
- struct variable **var; /* Variables to transpose. */
- int *idx_to_fv; /* var[]->index to compacted sink case fv. */
- size_t var_cnt; /* Number of elements in `var'. */
- int case_cnt; /* Pre-flip case count. */
- size_t case_size; /* Post-flip bytes per case. */
-
- struct variable *new_names; /* Variable containing new variable names. */
- struct varname *new_names_head; /* First new variable. */
- struct varname *new_names_tail; /* Last new variable. */
-
- FILE *file; /* Temporary file containing data. */
- };
-
-static void destroy_flip_pgm (struct flip_pgm *);
-static struct case_sink *flip_sink_create (struct flip_pgm *);
-static struct case_source *flip_source_create (struct flip_pgm *);
-static void flip_file (struct flip_pgm *);
-static int build_dictionary (struct flip_pgm *);
-
-static const struct case_source_class flip_source_class;
-static const struct case_sink_class flip_sink_class;
-
-/* Parses and executes FLIP. */
-int
-cmd_flip (void)
-{
- struct flip_pgm *flip;
-
- if (temporary != 0)
- {
- msg (SM, _("FLIP ignores TEMPORARY. "
- "Temporary transformations will be made permanent."));
- cancel_temporary ();
- }
-
- flip = xmalloc (sizeof *flip);
- flip->var = NULL;
- flip->idx_to_fv = dict_get_compacted_idx_to_fv (default_dict);
- flip->var_cnt = 0;
- flip->case_cnt = 0;
- flip->new_names = NULL;
- flip->new_names_head = NULL;
- flip->new_names_tail = NULL;
- flip->file = NULL;
-
- lex_match ('/');
- if (lex_match_id ("VARIABLES"))
- {
- lex_match ('=');
- if (!parse_variables (default_dict, &flip->var, &flip->var_cnt, PV_NO_DUPLICATE))
- return CMD_FAILURE;
- lex_match ('/');
- }
- else
- dict_get_vars (default_dict, &flip->var, &flip->var_cnt, 1u << DC_SYSTEM);
-
- lex_match ('/');
- if (lex_match_id ("NEWNAMES"))
- {
- lex_match ('=');
- flip->new_names = parse_variable ();
- if (!flip->new_names)
- goto error;
- }
- else
- flip->new_names = dict_lookup_var (default_dict, "CASE_LBL");
-
- if (flip->new_names)
- {
- size_t i;
-
- for (i = 0; i < flip->var_cnt; i++)
- if (flip->var[i] == flip->new_names)
- {
- remove_element (flip->var, flip->var_cnt, sizeof *flip->var, i);
- flip->var_cnt--;
- break;
- }
- }
-
- /* Read the active file into a flip_sink. */
- flip->case_cnt = 0;
- temp_trns = temporary = 0;
- vfm_sink = flip_sink_create (flip);
- flip->new_names_tail = NULL;
- procedure (NULL, NULL);
-
- /* Flip the data we read. */
- flip_file (flip);
-
- /* Flip the dictionary. */
- dict_clear (default_dict);
- if (!build_dictionary (flip))
- {
- discard_variables ();
- goto error;
- }
- flip->case_size = dict_get_case_size (default_dict);
-
- /* Set up flipped data for reading. */
- vfm_source = flip_source_create (flip);
-
- return lex_end_of_command ();
-
- error:
- destroy_flip_pgm (flip);
- return CMD_FAILURE;
-}
-
-/* Destroys FLIP. */
-static void
-destroy_flip_pgm (struct flip_pgm *flip)
-{
- struct varname *iter, *next;
-
- free (flip->var);
- free (flip->idx_to_fv);
- for (iter = flip->new_names_head; iter != NULL; iter = next)
- {
- next = iter->next;
- free (iter);
- }
- if (flip->file != NULL)
- fclose (flip->file);
- free (flip);
-}
-
-/* Make a new variable with base name NAME, which is bowdlerized and
- mangled until acceptable, and returns success. */
-static int
-make_new_var (char name[])
-{
- char *cp;
-
- /* Trim trailing spaces. */
- cp = strchr (name, '\0');
- while (cp > name && isspace ((unsigned char) cp[-1]))
- *--cp = '\0';
-
- /* Fix invalid characters. */
- for (cp = name; *cp && cp < name + SHORT_NAME_LEN; cp++)
- if (cp == name)
- {
- if (!CHAR_IS_ID1 (*cp) || *cp == '$')
- *cp = 'V';
- }
- else
- {
- if (!CHAR_IS_IDN (*cp))
- *cp = '_';
- }
- *cp = '\0';
- str_uppercase (name);
-
- if (dict_create_var (default_dict, name, 0))
- return 1;
-
- /* Add numeric extensions until acceptable. */
- {
- const int len = (int) strlen (name);
- char n[SHORT_NAME_LEN + 1];
- int i;
-
- for (i = 1; i < 10000000; i++)
- {
- int ofs = min (7 - intlog10 (i), len);
- memcpy (n, name, ofs);
- sprintf (&n[ofs], "%d", i);
-
- if (dict_create_var (default_dict, n, 0))
- return 1;
- }
- }
-
- msg (SE, _("Could not create acceptable variant for variable %s."), name);
- return 0;
-}
-
-/* Make a new dictionary for all the new variable names. */
-static int
-build_dictionary (struct flip_pgm *flip)
-{
- dict_create_var_assert (default_dict, "CASE_LBL", 8);
-
- if (flip->new_names_head == NULL)
- {
- int i;
-
- if (flip->case_cnt > 99999)
- {
- msg (SE, _("Cannot create more than 99999 variable names."));
- return 0;
- }
-
- for (i = 0; i < flip->case_cnt; i++)
- {
- struct variable *v;
- char s[SHORT_NAME_LEN + 1];
-
- sprintf (s, "VAR%03d", i);
- v = dict_create_var_assert (default_dict, s, 0);
- }
- }
- else
- {
- struct varname *v;
-
- for (v = flip->new_names_head; v; v = v->next)
- if (!make_new_var (v->name))
- return 0;
- }
-
- return 1;
-}
-
-/* Cases during transposition. */
-struct flip_sink_info
- {
- struct flip_pgm *flip; /* FLIP program. */
- union value *output_buf; /* Case output buffer. */
- };
-
-/* Creates a flip sink based on FLIP. */
-static struct case_sink *
-flip_sink_create (struct flip_pgm *flip)
-{
- struct flip_sink_info *info = xmalloc (sizeof *info);
- size_t i;
-
- info->flip = flip;
- info->output_buf = xnmalloc (flip->var_cnt, sizeof *info->output_buf);
-
- flip->file = tmpfile ();
- if (!flip->file)
- msg (FE, _("Could not create temporary file for FLIP."));
-
- /* Write variable names as first case. */
- for (i = 0; i < flip->var_cnt; i++)
- buf_copy_str_rpad (info->output_buf[i].s, MAX_SHORT_STRING,
- flip->var[i]->name);
- if (fwrite (info->output_buf, sizeof *info->output_buf,
- flip->var_cnt, flip->file) != (size_t) flip->var_cnt)
- msg (FE, _("Error writing FLIP file: %s."), strerror (errno));
-
- flip->case_cnt = 1;
-
- return create_case_sink (&flip_sink_class, default_dict, info);
-}
-
-/* Writes case C to the FLIP sink. */
-static void
-flip_sink_write (struct case_sink *sink, const struct ccase *c)
-{
- struct flip_sink_info *info = sink->aux;
- struct flip_pgm *flip = info->flip;
- size_t i;
-
- flip->case_cnt++;
-
- if (flip->new_names != NULL)
- {
- struct varname *v = xmalloc (sizeof *v);
- v->next = NULL;
- if (flip->new_names->type == NUMERIC)
- {
- double f = case_num (c, flip->idx_to_fv[flip->new_names->index]);
-
- if (f == SYSMIS)
- strcpy (v->name, "VSYSMIS");
- else if (f < INT_MIN)
- strcpy (v->name, "VNEGINF");
- else if (f > INT_MAX)
- strcpy (v->name, "VPOSINF");
- else
- {
- char name[INT_DIGITS + 2];
- sprintf (name, "V%d", (int) f);
- str_copy_trunc (v->name, sizeof v->name, name);
- }
- }
- else
- {
- int width = min (flip->new_names->width, MAX_SHORT_STRING);
- memcpy (v->name, case_str (c, flip->idx_to_fv[flip->new_names->index]),
- width);
- v->name[width] = 0;
- }
-
- if (flip->new_names_head == NULL)
- flip->new_names_head = v;
- else
- flip->new_names_tail->next = v;
- flip->new_names_tail = v;
- }
-
- /* Write to external file. */
- for (i = 0; i < flip->var_cnt; i++)
- {
- double out;
-
- if (flip->var[i]->type == NUMERIC)
- out = case_num (c, flip->idx_to_fv[flip->var[i]->index]);
- else
- out = SYSMIS;
- info->output_buf[i].f = out;
- }
-
- if (fwrite (info->output_buf, sizeof *info->output_buf,
- flip->var_cnt, flip->file) != (size_t) flip->var_cnt)
- msg (FE, _("Error writing FLIP file: %s."), strerror (errno));
-}
-
-/* Transposes the external file into a new file. */
-static void
-flip_file (struct flip_pgm *flip)
-{
- size_t case_bytes;
- size_t case_capacity;
- size_t case_idx;
- union value *input_buf, *output_buf;
- FILE *input_file, *output_file;
-
- /* Allocate memory for many cases. */
- case_bytes = flip->var_cnt * sizeof *input_buf;
- case_capacity = get_workspace () / case_bytes;
- if (case_capacity > flip->case_cnt * 2)
- case_capacity = flip->case_cnt * 2;
- if (case_capacity < 2)
- case_capacity = 2;
- for (;;)
- {
- size_t bytes = case_bytes * case_capacity;
- if (case_capacity > 2)
- input_buf = malloc (bytes);
- else
- input_buf = xmalloc (bytes);
- if (input_buf != NULL)
- break;
-
- case_capacity /= 2;
- if (case_capacity < 2)
- case_capacity = 2;
- }
-
- /* Use half the allocated memory for input_buf, half for
- output_buf. */
- case_capacity /= 2;
- output_buf = input_buf + flip->var_cnt * case_capacity;
-
- input_file = flip->file;
- if (fseek (input_file, 0, SEEK_SET) != 0)
- msg (FE, _("Error rewinding FLIP file: %s."), strerror (errno));
-
- output_file = tmpfile ();
- if (output_file == NULL)
- msg (FE, _("Error creating FLIP source file."));
-
- for (case_idx = 0; case_idx < flip->case_cnt; )
- {
- unsigned long read_cases = min (flip->case_cnt - case_idx,
- case_capacity);
- size_t i;
-
- if (read_cases != fread (input_buf, case_bytes, read_cases, input_file))
- msg (FE, _("Error reading FLIP file: %s."), strerror (errno));
-
- for (i = 0; i < flip->var_cnt; i++)
- {
- unsigned long j;
-
- for (j = 0; j < read_cases; j++)
- output_buf[j] = input_buf[i + j * flip->var_cnt];
-
-#ifndef HAVE_FSEEKO
-#define fseeko fseek
-#endif
-
-#ifndef HAVE_OFF_T
-#define off_t long int
-#endif
-
- if (fseeko (output_file,
- sizeof *input_buf * (case_idx
- + (off_t) i * flip->case_cnt),
- SEEK_SET) != 0)
- msg (FE, _("Error seeking FLIP source file: %s."),
- strerror (errno));
-
- if (fwrite (output_buf, sizeof *output_buf, read_cases, output_file)
- != read_cases)
- msg (FE, _("Error writing FLIP source file: %s."),
- strerror (errno));
- }
-
- case_idx += read_cases;
- }
-
- fclose (input_file);
- free (input_buf);
-
- if (fseek (output_file, 0, SEEK_SET) != 0)
- msg (FE, _("Error rewind FLIP source file: %s."), strerror (errno));
- flip->file = output_file;
-}
-
-/* Destroy sink's internal data. */
-static void
-flip_sink_destroy (struct case_sink *sink)
-{
- struct flip_sink_info *info = sink->aux;
-
- free (info->output_buf);
- free (info);
-}
-
-/* FLIP sink class. */
-static const struct case_sink_class flip_sink_class =
- {
- "FLIP",
- NULL,
- flip_sink_write,
- flip_sink_destroy,
- NULL,
- };
-
-/* Creates and returns a FLIP source based on PGM,
- which should have already been used as a sink. */
-static struct case_source *
-flip_source_create (struct flip_pgm *pgm)
-{
- return create_case_source (&flip_source_class, pgm);
-}
-
-/* Reads the FLIP stream. Copies each case into C and calls
- WRITE_CASE passing WC_DATA. */
-static void
-flip_source_read (struct case_source *source,
- struct ccase *c,
- write_case_func *write_case, write_case_data wc_data)
-{
- struct flip_pgm *flip = source->aux;
- union value *input_buf;
- size_t i;
-
- input_buf = xnmalloc (flip->case_cnt, sizeof *input_buf);
- for (i = 0; i < flip->var_cnt; i++)
- {
- size_t j;
-
- if (fread (input_buf, sizeof *input_buf, flip->case_cnt,
- flip->file) != flip->case_cnt)
- {
- if (ferror (flip->file))
- msg (SE, _("Error reading FLIP temporary file: %s."),
- strerror (errno));
- else if (feof (flip->file))
- msg (SE, _("Unexpected end of file reading FLIP temporary file."));
- else
- assert (0);
- break;
- }
-
- for (j = 0; j < flip->case_cnt; j++)
- case_data_rw (c, j)->f = input_buf[j].f;
- if (!write_case (wc_data))
- break;
- }
- free (input_buf);
-}
-
-/* Destroy internal data in SOURCE. */
-static void
-flip_source_destroy (struct case_source *source)
-{
- struct flip_pgm *flip = source->aux;
-
- destroy_flip_pgm (flip);
-}
-
-static const struct case_source_class flip_source_class =
- {
- "FLIP",
- NULL,
- flip_source_read,
- flip_source_destroy
- };
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !font_h
-#define font_h 1
-
-/* Possible ligatures. */
-#define LIG_ff 001
-#define LIG_ffi 002
-#define LIG_ffl 004
-#define LIG_fi 010
-#define LIG_fl 020
-
-/* Character type constants. */
-#define CTYP_NONE 000 /* Neither ascenders nor descenders. */
-#define CTYP_ASCENDER 001 /* Character has an ascender. */
-#define CTYP_DESCENDER 002 /* Character has a descender. */
-
-/* Font metrics for a single character. */
-struct char_metrics
- {
- int code; /* Character code. */
- int type; /* CTYP_* constants. */
- int width; /* Width. */
- int height; /* Height above baseline, never negative. */
- int depth; /* Depth below baseline, never negative. */
-
- /* These fields are not yet used, so to save memory, they are left
- out. */
-#if 0
- int italic_correction; /* Italic correction. */
- int left_italic_correction; /* Left italic correction. */
- int subscript_correction; /* Subscript correction. */
-#endif
- };
-
-/* Kerning for a pair of characters. */
-struct kern_pair
- {
- int ch1; /* First character. */
- int ch2; /* Second character. */
- int adjust; /* Kern amount. */
- };
-
-/* Font description. */
-struct font_desc
- {
- /* Housekeeping data. */
- struct pool *owner; /* Containing pool. */
- char *name; /* Font name. FIXME: this field's
- role is uncertain. */
- char *filename; /* Normalized filename. */
-
- /* PostScript-specific courtesy data. */
- char *internal_name; /* Font internal name. */
- char *encoding; /* Name of encoding file. */
-
- /* Basic font characteristics. */
- int space_width; /* Width of a space character. */
- double slant; /* Slant angle, in degrees of forward slant. */
- unsigned ligatures; /* Characters that have ligatures. */
- int special; /* 1=This is a special font that will be
- searched when a character is not present in
- another font. */
- int ascent, descent; /* Height above, below the baseline. */
-
- /* First dereferencing level is font_char_name_to_index(NAME). */
- /* Second dereferencing level. */
- short *deref; /* Each entry is an index into metric.
- metric[deref[lookup(NAME)]] is the metric
- for character with name NAME. */
- int deref_size; /* Number of spaces for entries in deref. */
-
- /* Third dereferencing level. */
- struct char_metrics **metric; /* Metrics for font characters. */
- int metric_size; /* Number of spaces for entries in metric. */
- int metric_used; /* Number of spaces used in metric. */
-
- /* Kern pairs. */
- struct kern_pair *kern; /* Hash table for kerns. */
- int kern_size; /* Number of spaces for kerns in kern. */
- int *kern_size_p; /* Next larger hash table size. */
- int kern_used; /* Number of used spaces in kern. */
- int kern_max_used; /* Max number used before rehashing. */
- };
-
-/* Index into deref[] of character with name "space". */
-extern int space_index;
-
-/* Functions to work with any font. */
-#define destroy_font(FONT) \
- pool_destroy (FONT->owner)
-
-int font_char_name_to_index (const char *);
-struct char_metrics *font_get_char_metrics (const struct font_desc *font,
- int ch);
-int font_get_kern_adjust (const struct font_desc *font, int ch1, int ch2);
-
-/* groff fonts. */
-struct groff_device_info
- {
- /* See groff_font man page. */
- int res, horiz, vert;
- int size_scale, unit_width;
- int (*sizes)[2], n_sizes;
- char *font_name[4]; /* Names of 4 default fonts. */
- char *family; /* Name of default font family. */
- };
-
-struct outp_driver;
-struct font_desc *groff_read_font (const char *fn);
-struct font_desc *groff_find_font (const char *dev, const char *name);
-int groff_read_DESC (const char *dev_name, struct groff_device_info * dev);
-void groff_init (void);
-void groff_done (void);
-
-struct font_desc *default_font (void);
-
-#endif /* font_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "format.h"
-#include <ctype.h>
-#include "error.h"
-#include <stdlib.h>
-#include "error.h"
-#include "lexer.h"
-#include "misc.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-
-/* Parses the alphabetic prefix of the current token as a format
- specifier name. Returns the corresponding format specifier
- type if successful, or -1 on failure. If ALLOW_XT is zero,
- then X and T format specifiers are not allowed. If CP is
- nonzero, then *CP is set to the first non-alphabetic character
- in the current token on success or to a null pointer on
- failure. */
-int
-parse_format_specifier_name (const char **cp, enum fmt_parse_flags flags)
-{
- char *sp, *ep;
- int idx;
-
- sp = ep = ds_c_str (&tokstr);
- while (isalpha ((unsigned char) *ep))
- ep++;
-
- if (sp != ep)
- {
- /* Find format. */
- for (idx = 0; idx < FMT_NUMBER_OF_FORMATS; idx++)
- if (strlen (formats[idx].name) == ep - sp
- && !buf_compare_case (formats[idx].name, sp, ep - sp))
- break;
-
- /* Check format. */
- if (idx < FMT_NUMBER_OF_FORMATS)
- {
- if (!(flags & FMTP_ALLOW_XT) && (idx == FMT_T || idx == FMT_X))
- {
- if (!(flags & FMTP_SUPPRESS_ERRORS))
- msg (SE, _("X and T format specifiers not allowed here."));
- idx = -1;
- }
- }
- else
- {
- /* No match. */
- if (!(flags & FMTP_SUPPRESS_ERRORS))
- msg (SE, _("%.*s is not a valid data format."),
- (int) (ep - sp), ds_c_str (&tokstr));
- idx = -1;
- }
- }
- else
- {
- lex_error ("expecting data format");
- idx = -1;
- }
-
- if (cp != NULL)
- {
- if (idx != -1)
- *cp = ep;
- else
- *cp = NULL;
- }
-
- return idx;
-}
-
-
-/* Parses a format specifier from the token stream and returns
- nonzero only if successful. Emits an error message on
- failure. Allows X and T format specifiers only if ALLOW_XT is
- nonzero. The caller should call check_input_specifier() or
- check_output_specifier() on the parsed format as
- necessary. */
-int
-parse_format_specifier (struct fmt_spec *input, enum fmt_parse_flags flags)
-{
- struct fmt_spec spec;
- struct fmt_desc *f;
- const char *cp;
- char *cp2;
- int type, w, d;
-
- if (token != T_ID)
- {
- if (!(flags & FMTP_SUPPRESS_ERRORS))
- msg (SE, _("Format specifier expected."));
- return 0;
- }
- type = parse_format_specifier_name (&cp, flags);
- if (type == -1)
- return 0;
- f = &formats[type];
-
- w = strtol (cp, &cp2, 10);
- if (cp2 == cp && type != FMT_X)
- {
- if (!(flags & FMTP_SUPPRESS_ERRORS))
- msg (SE, _("Data format %s does not specify a width."),
- ds_c_str (&tokstr));
- return 0;
- }
-
- cp = cp2;
- if (f->n_args > 1 && *cp == '.')
- {
- cp++;
- d = strtol (cp, &cp2, 10);
- cp = cp2;
- }
- else
- d = 0;
-
- if (*cp)
- {
- if (!(flags & FMTP_SUPPRESS_ERRORS))
- msg (SE, _("Data format %s is not valid."), ds_c_str (&tokstr));
- return 0;
- }
- lex_get ();
-
- spec.type = type;
- spec.w = w;
- spec.d = d;
- *input = spec;
-
- return 1;
-}
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "format.h"
-#include <ctype.h>
-#include "error.h"
-#include <stdlib.h>
-#include "error.h"
-#include "lex-def.h"
-#include "misc.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#define DEFFMT(LABEL, NAME, N_ARGS, IMIN_W, IMAX_W, OMIN_W, OMAX_W, CAT, \
- OUTPUT, SPSS_FMT) \
- {NAME, N_ARGS, IMIN_W, IMAX_W, OMIN_W, OMAX_W, CAT, OUTPUT, SPSS_FMT},
-struct fmt_desc formats[FMT_NUMBER_OF_FORMATS + 1] =
-{
-#include "format.def"
- {"", -1, -1, -1, -1, -1, 0000, -1, -1},
-};
-
-/* Common formats. */
-const struct fmt_spec f8_2 = {FMT_F, 8, 2};
-
-/* Converts F to its string representation (for instance, "F8.2") and
- returns a pointer to a static buffer containing that string. */
-char *
-fmt_to_string (const struct fmt_spec *f)
-{
- static char buf[32];
-
- if (formats[f->type].n_args >= 2)
- sprintf (buf, "%s%d.%d", formats[f->type].name, f->w, f->d);
- else
- sprintf (buf, "%s%d", formats[f->type].name, f->w);
- return buf;
-}
-
-/* Does checks in common betwen check_input_specifier() and
- check_output_specifier() and returns true if so. Otherwise,
- emits an error message (if EMIT_ERROR is nonzero) and returns
- false. */
-static bool
-check_common_specifier (const struct fmt_spec *spec, bool emit_error)
-{
- struct fmt_desc *f ;
- char *str;
-
- if ( spec->type > FMT_NUMBER_OF_FORMATS )
- {
- if (emit_error)
- msg (SE, _("Format specifies a bad type (%d)"), spec->type);
-
- return false;
- }
-
- f = &formats[spec->type];
- str = fmt_to_string (spec);
-
- if ((f->cat & FCAT_EVEN_WIDTH) && spec->w % 2)
- {
- if (emit_error)
- msg (SE, _("Format %s specifies an odd width %d, but "
- "an even width is required."),
- str, spec->w);
- return false;
- }
- if (f->n_args > 1 && (spec->d < 0 || spec->d > 16))
- {
- if (emit_error)
- msg (SE, _("Format %s specifies a bad number of "
- "implied decimal places %d. Input format %s allows "
- "up to 16 implied decimal places."), str, spec->d, f->name);
- return false;
- }
- return true;
-}
-
-/* Checks whether SPEC is valid as an input format and returns
- nonzero if so. Otherwise, emits an error message (if
- EMIT_ERROR is nonzero) and returns zero. */
-int
-check_input_specifier (const struct fmt_spec *spec, int emit_error)
-{
- struct fmt_desc *f ;
- char *str ;
-
- if (!check_common_specifier (spec, emit_error))
- return false;
-
- f = &formats[spec->type];
- str = fmt_to_string (spec);
-
-
- if (spec->type == FMT_X)
- return 1;
- if (f->cat & FCAT_OUTPUT_ONLY)
- {
- if (emit_error)
- msg (SE, _("Format %s may not be used for input."), f->name);
- return 0;
- }
- if (spec->w < f->Imin_w || spec->w > f->Imax_w)
- {
- if (emit_error)
- msg (SE, _("Input format %s specifies a bad width %d. "
- "Format %s requires a width between %d and %d."),
- str, spec->w, f->name, f->Imin_w, f->Imax_w);
- return 0;
- }
- if ((spec->type == FMT_F || spec->type == FMT_COMMA
- || spec->type == FMT_DOLLAR)
- && spec->d > spec->w)
- {
- if (emit_error)
- msg (SE, _("Input format %s is invalid because it specifies more "
- "decimal places than the field width."), str);
- return 0;
- }
- return 1;
-}
-
-/* Checks whether SPEC is valid as an output format and returns
- nonzero if so. Otherwise, emits an error message (if
- EMIT_ERROR is nonzero) and returns zero. */
-int
-check_output_specifier (const struct fmt_spec *spec, int emit_error)
-{
- struct fmt_desc *f;
- char *str ;
-
- if (!check_common_specifier (spec, emit_error))
- return false;
-
- f = &formats[spec->type];
- str = fmt_to_string (spec);
-
- if (spec->type == FMT_X)
- return 1;
- if (spec->w < f->Omin_w || spec->w > f->Omax_w)
- {
- if (emit_error)
- msg (SE, _("Output format %s specifies a bad width %d. "
- "Format %s requires a width between %d and %d."),
- str, spec->w, f->name, f->Omin_w, f->Omax_w);
- return 0;
- }
- if ((spec->type == FMT_F || spec->type == FMT_COMMA
- || spec->type == FMT_DOLLAR)
- && spec->d >= spec->w)
- {
- if (emit_error)
- msg (SE, _("Output format %s is invalid because it specifies as "
- "many decimal places as the field width, which "
- "fails to allow space for a decimal point. "
- "Try %s%d.%d instead."),
- str, f->name, spec->d + 1, spec->d);
- return 0;
- }
- return 1;
-}
-
-/* Checks that FORMAT is appropriate for a variable of the given
- TYPE and returns true if so. Otherwise returns false and (if
- EMIT_ERROR is true) emits an error message. */
-bool
-check_specifier_type (const struct fmt_spec *format,
- int type, bool emit_error)
-{
- const struct fmt_desc *f = &formats[format->type];
- assert (type == NUMERIC || type == ALPHA);
- if ((type == ALPHA) != ((f->cat & FCAT_STRING) != 0))
- {
- if (emit_error)
- msg (SE, _("%s variables are not compatible with %s format %s."),
- type == ALPHA ? _("String") : _("Numeric"),
- type == ALPHA ? _("numeric") : _("string"),
- fmt_to_string (format));
- return false;
- }
- return true;
-}
-
-/* Checks that FORMAT is appropriate for a variable of the given
- WIDTH and returns true if so. Otherwise returns false and (if
- EMIT_ERROR is true) emits an error message. */
-bool
-check_specifier_width (const struct fmt_spec *format,
- int width, bool emit_error)
-{
- if (!check_specifier_type (format, width != 0 ? ALPHA : NUMERIC, emit_error))
- return false;
- if (get_format_var_width (format) != width)
- {
- if (emit_error)
- msg (SE, _("String variable with width %d not compatible with "
- "format %s."),
- width, fmt_to_string (format));
- return false;
- }
- return true;
-}
-
-/* Converts input format specifier INPUT into output format
- specifier OUTPUT. */
-void
-convert_fmt_ItoO (const struct fmt_spec *input, struct fmt_spec *output)
-{
- assert (check_input_specifier (input, 0));
-
- output->type = formats[input->type].output;
- output->w = input->w;
- if (output->w > formats[output->type].Omax_w)
- output->w = formats[output->type].Omax_w;
- output->d = input->d;
-
- switch (input->type)
- {
- case FMT_F:
- case FMT_N:
- if (output->d > 0)
- output->w++;
- break;
- case FMT_E:
- output->w = max (max (input->w, input->d+7), 10);
- output->d = max (input->d, 3);
- break;
- case FMT_COMMA:
- case FMT_DOT:
- /* nothing is necessary */
- break;
- case FMT_DOLLAR:
- case FMT_PCT:
- if (output->w < 2)
- output->w = 2;
- break;
- case FMT_PIBHEX:
- {
- static const int map[] = {4, 6, 9, 11, 14, 16, 18, 21};
- assert (input->w % 2 == 0 && input->w >= 2 && input->w <= 16);
- output->w = map[input->w / 2 - 1];
- break;
- }
- case FMT_RBHEX:
- output->w = 8, output->d = 2; /* FIXME */
- break;
- case FMT_IB:
- case FMT_PIB:
- case FMT_P:
- case FMT_PK:
- case FMT_RB:
- if (input->d < 1)
- output->w = 8, output->d = 2;
- else
- output->w = 9 + input->d;
- break;
- case FMT_CCA:
- case FMT_CCB:
- case FMT_CCC:
- case FMT_CCD:
- case FMT_CCE:
- assert (0);
- case FMT_Z:
- case FMT_A:
- /* nothing is necessary */
- break;
- case FMT_AHEX:
- output->w = input->w / 2;
- break;
- case FMT_DATE:
- case FMT_EDATE:
- case FMT_SDATE:
- case FMT_ADATE:
- case FMT_JDATE:
- /* nothing is necessary */
- break;
- case FMT_QYR:
- if (output->w < 6)
- output->w = 6;
- break;
- case FMT_MOYR:
- /* nothing is necessary */
- break;
- case FMT_WKYR:
- if (output->w < 8)
- output->w = 8;
- break;
- case FMT_TIME:
- case FMT_DTIME:
- case FMT_DATETIME:
- case FMT_WKDAY:
- case FMT_MONTH:
- /* nothing is necessary */
- break;
- default:
- assert (0);
- }
-
- assert (check_output_specifier (output, 0));
-}
-
-/* Returns the width corresponding to the format specifier. The
- return value is the value of the `width' member of a `struct
- variable' for such an input format. */
-int
-get_format_var_width (const struct fmt_spec *spec)
-{
- if (spec->type == FMT_AHEX)
- return spec->w / 2;
- else if (spec->type == FMT_A)
- return spec->w;
- else
- return 0;
-}
-
-/* Returns the PSPP format corresponding to the given SPSS
- format. */
-int
-translate_fmt (int spss)
-{
- int type;
-
- for (type = 0; type < FMT_NUMBER_OF_FORMATS; type++)
- if (formats[type].spss == spss)
- return type;
- return -1;
-}
-
-/* Returns an input format specification with type TYPE, width W,
- and D decimals. */
-struct fmt_spec
-make_input_format (int type, int w, int d)
-{
- struct fmt_spec f;
- f.type = type;
- f.w = w;
- f.d = d;
- assert (check_input_specifier (&f, 0));
- return f;
-}
-
-/* Returns an output format specification with type TYPE, width
- W, and D decimals. */
-struct fmt_spec
-make_output_format (int type, int w, int d)
-{
- struct fmt_spec f;
- f.type = type;
- f.w = w;
- f.d = d;
- assert (check_output_specifier (&f, 0));
- return f;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !format_h
-#define format_h 1
-
-/* Display format types. */
-
-#include <stdbool.h>
-
-/* See the definitions of these functions and variables when modifying
- this list:
- misc.c:convert_fmt_ItoO()
- sfm-read.c:parse_format_spec()
- data-in.c:parse_string_as_format() */
-#define DEFFMT(LABEL, NAME, N_ARGS, IMIN_W, IMAX_W, OMIN_W, OMAX_W, \
- CAT, OUTPUT, SPSS_FMT) \
- LABEL,
-enum
- {
-#include "format.def"
- FMT_NUMBER_OF_FORMATS
- };
-#undef DEFFMT
-
-/* Describes one of the display formats above. */
-struct fmt_desc
- {
- char name[9]; /* `DATETIME' is the longest name. */
- int n_args; /* 1=width; 2=width.decimals. */
- int Imin_w, Imax_w; /* Bounds on input width. */
- int Omin_w, Omax_w; /* Bounds on output width. */
- int cat; /* Categories. */
- int output; /* Output format. */
- int spss; /* Equivalent SPSS output format. */
- };
-
-/* Display format categories. */
-enum
- {
- FCAT_BLANKS_SYSMIS = 001, /* 1=All-whitespace means SYSMIS. */
- FCAT_EVEN_WIDTH = 002, /* 1=Width must be even. */
- FCAT_STRING = 004, /* 1=String input/output format. */
- FCAT_SHIFT_DECIMAL = 010, /* 1=Automatically shift decimal point
- on output--used for fixed-point
- formats. */
- FCAT_OUTPUT_ONLY = 020 /* 1=This is not an input format. */
- };
-
-/* Display format. */
-struct fmt_spec
- {
- int type; /* One of the above constants. */
- int w; /* Width. */
- int d; /* Number of implied decimal places. */
- };
-
-
-enum alignment
- {
- ALIGN_LEFT = 0,
- ALIGN_RIGHT = 1,
- ALIGN_CENTRE = 2
- };
-
-
-enum measure
- {
- MEASURE_NOMINAL=1,
- MEASURE_ORDINAL=2,
- MEASURE_SCALE=3
- };
-
-
-
-/* Descriptions of all the display formats above. */
-extern struct fmt_desc formats[];
-
-union value;
-
-/* Maximum length of formatted value, in characters. */
-#define MAX_FORMATTED_LEN 256
-
-/* Flags for parsing formats. */
-enum fmt_parse_flags
- {
- FMTP_ALLOW_XT = 001, /* 1=Allow X and T formats. */
- FMTP_SUPPRESS_ERRORS = 002 /* 1=Do not emit error messages. */
- };
-
-/* Common formats. */
-extern const struct fmt_spec f8_2; /* F8.2. */
-
-int parse_format_specifier (struct fmt_spec *input, enum fmt_parse_flags);
-int parse_format_specifier_name (const char **cp, enum fmt_parse_flags);
-int check_input_specifier (const struct fmt_spec *spec, int emit_error);
-int check_output_specifier (const struct fmt_spec *spec, int emit_error);
-bool check_specifier_type (const struct fmt_spec *, int type, bool emit_error);
-bool check_specifier_width (const struct fmt_spec *,
- int width, bool emit_error);
-void convert_fmt_ItoO (const struct fmt_spec *input, struct fmt_spec *output);
-int get_format_var_width (const struct fmt_spec *);
-int parse_string_as_format (const char *s, int len, const struct fmt_spec *fp,
- int fc, union value *v);
-int translate_fmt (int spss);
-bool data_out (char *s, const struct fmt_spec *fp, const union value *v);
-char *fmt_to_string (const struct fmt_spec *);
-void num_to_string (double v, char *s, int w, int d);
-struct fmt_spec make_input_format (int type, int w, int d);
-struct fmt_spec make_output_format (int type, int w, int d);
-
-#endif /* !format_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <limits.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include "command.h"
-#include "error.h"
-#include "lexer.h"
-#include "misc.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-enum
- {
- FORMATS_PRINT = 001,
- FORMATS_WRITE = 002
- };
-
-static int internal_cmd_formats (int);
-
-int
-cmd_print_formats (void)
-{
- return internal_cmd_formats (FORMATS_PRINT);
-}
-
-int
-cmd_write_formats (void)
-{
- return internal_cmd_formats (FORMATS_WRITE);
-}
-
-int
-cmd_formats (void)
-{
- return internal_cmd_formats (FORMATS_PRINT | FORMATS_WRITE);
-}
-
-int
-internal_cmd_formats (int which)
-{
- /* Variables. */
- struct variable **v;
- size_t cv;
-
- /* Format to set the variables to. */
- struct fmt_spec f;
-
- /* Numeric or string. */
- int type;
-
- /* Counter. */
- size_t i;
-
- for (;;)
- {
- if (token == '.')
- break;
-
- if (!parse_variables (default_dict, &v, &cv, PV_NUMERIC))
- return CMD_PART_SUCCESS_MAYBE;
- type = v[0]->type;
-
- if (!lex_match ('('))
- {
- msg (SE, _("`(' expected after variable list"));
- goto fail;
- }
- if (!parse_format_specifier (&f, 0)
- || !check_output_specifier (&f, true)
- || !check_specifier_type (&f, NUMERIC, true))
- goto fail;
-
- if (!lex_match (')'))
- {
- msg (SE, _("`)' expected after output format."));
- goto fail;
- }
-
- for (i = 0; i < cv; i++)
- {
- if (which & FORMATS_PRINT)
- v[i]->print = f;
- if (which & FORMATS_WRITE)
- v[i]->write = f;
- }
- free (v);
- v = NULL;
- }
- return CMD_SUCCESS;
-
-fail:
- free (v);
- return CMD_PART_SUCCESS_MAYBE;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-/*
- TODO:
-
- * Remember that histograms, bar charts need mean, stddev.
-*/
-
-#include <config.h>
-#include "error.h"
-#include <math.h>
-#include <stdlib.h>
-#include <gsl/gsl_histogram.h>
-
-#include "alloc.h"
-#include "bitvector.h"
-#include "case.h"
-#include "dictionary.h"
-#include "hash.h"
-#include "pool.h"
-#include "command.h"
-#include "lexer.h"
-#include "moments.h"
-#include "error.h"
-#include "algorithm.h"
-#include "magic.h"
-#include "misc.h"
-#include "output.h"
-#include "som.h"
-#include "str.h"
-#include "tab.h"
-#include "value-labels.h"
-#include "var.h"
-#include "vfm.h"
-#include "settings.h"
-#include "chart.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-#define N_(msgid) msgid
-
-/* (headers) */
-
-#include "debug-print.h"
-
-/* (specification)
- FREQUENCIES (frq_):
- *variables=custom;
- format=cond:condense/onepage(*n:onepage_limit,"%s>=0")/!standard,
- table:limit(n:limit,"%s>0")/notable/!table,
- labels:!labels/nolabels,
- sort:!avalue/dvalue/afreq/dfreq,
- spaces:!single/double,
- paging:newpage/!oldpage;
- missing=miss:include/!exclude;
- barchart(ba_)=:minimum(d:min),
- :maximum(d:max),
- scale:freq(*n:freq,"%s>0")/percent(*n:pcnt,"%s>0");
- piechart(pie_)=:minimum(d:min),
- :maximum(d:max),
- missing:missing/!nomissing;
- histogram(hi_)=:minimum(d:min),
- :maximum(d:max),
- scale:freq(*n:freq,"%s>0")/percent(*n:pcnt,"%s>0"),
- norm:!nonormal/normal,
- incr:increment(d:inc,"%s>0");
- hbar(hb_)=:minimum(d:min),
- :maximum(d:max),
- scale:freq(*n:freq,"%s>0")/percent(*n:pcnt,"%s>0"),
- norm:!nonormal/normal,
- incr:increment(d:inc,"%s>0");
- grouped=custom;
- ntiles=integer;
- +percentiles = double list;
- statistics[st_]=1|mean,2|semean,3|median,4|mode,5|stddev,6|variance,
- 7|kurtosis,8|skewness,9|range,10|minimum,11|maximum,12|sum,
- 13|default,14|seskewness,15|sekurtosis,all,none.
-*/
-/* (declarations) */
-/* (functions) */
-
-/* Statistics. */
-enum
- {
- frq_mean = 0, frq_semean, frq_median, frq_mode, frq_stddev, frq_variance,
- frq_kurt, frq_sekurt, frq_skew, frq_seskew, frq_range, frq_min, frq_max,
- frq_sum, frq_n_stats
- };
-
-/* Description of a statistic. */
-struct frq_info
- {
- int st_indx; /* Index into a_statistics[]. */
- const char *s10; /* Identifying string. */
- };
-
-/* Table of statistics, indexed by dsc_*. */
-static struct frq_info st_name[frq_n_stats + 1] =
-{
- {FRQ_ST_MEAN, N_("Mean")},
- {FRQ_ST_SEMEAN, N_("S.E. Mean")},
- {FRQ_ST_MEDIAN, N_("Median")},
- {FRQ_ST_MODE, N_("Mode")},
- {FRQ_ST_STDDEV, N_("Std Dev")},
- {FRQ_ST_VARIANCE, N_("Variance")},
- {FRQ_ST_KURTOSIS, N_("Kurtosis")},
- {FRQ_ST_SEKURTOSIS, N_("S.E. Kurt")},
- {FRQ_ST_SKEWNESS, N_("Skewness")},
- {FRQ_ST_SESKEWNESS, N_("S.E. Skew")},
- {FRQ_ST_RANGE, N_("Range")},
- {FRQ_ST_MINIMUM, N_("Minimum")},
- {FRQ_ST_MAXIMUM, N_("Maximum")},
- {FRQ_ST_SUM, N_("Sum")},
- {-1, 0},
-};
-
-/* Percentiles to calculate. */
-
-struct percentile
-{
- double p; /* the %ile to be calculated */
- double value; /* the %ile's value */
- double x1; /* The datum value <= the percentile */
- double x2; /* The datum value >= the percentile */
- int flag;
- int flag2; /* Set to 1 if this percentile value has been found */
-};
-
-
-static void add_percentile (double x) ;
-
-static struct percentile *percentiles;
-static int n_percentiles;
-
-static int implicit_50th ;
-
-/* Groups of statistics. */
-#define BI BIT_INDEX
-#define frq_default \
- (BI (frq_mean) | BI (frq_stddev) | BI (frq_min) | BI (frq_max))
-#define frq_all \
- (BI (frq_sum) | BI(frq_min) | BI(frq_max) \
- | BI(frq_mean) | BI(frq_semean) | BI(frq_stddev) \
- | BI(frq_variance) | BI(frq_kurt) | BI(frq_sekurt) \
- | BI(frq_skew) | BI(frq_seskew) | BI(frq_range) \
- | BI(frq_range) | BI(frq_mode) | BI(frq_median))
-
-/* Statistics; number of statistics. */
-static unsigned long stats;
-static int n_stats;
-
-/* Types of graphs. */
-enum
- {
- GFT_NONE, /* Don't draw graphs. */
- GFT_BAR, /* Draw bar charts. */
- GFT_HIST, /* Draw histograms. */
- GFT_PIE, /* Draw piechart */
- GFT_HBAR /* Draw bar charts or histograms at our discretion. */
- };
-
-/* Parsed command. */
-static struct cmd_frequencies cmd;
-
-/* Summary of the barchart, histogram, and hbar subcommands. */
-/* FIXME: These should not be mututally exclusive */
-static int chart; /* NONE/BAR/HIST/HBAR/PIE. */
-static double min, max; /* Minimum, maximum on y axis. */
-static int format; /* FREQ/PERCENT: Scaling of y axis. */
-static double scale, incr; /* FIXME */
-static int normal; /* FIXME */
-
-/* Variables for which to calculate statistics. */
-static size_t n_variables;
-static struct variable **v_variables;
-
-/* Arenas used to store semi-permanent storage. */
-static struct pool *int_pool; /* Integer mode. */
-static struct pool *gen_pool; /* General mode. */
-
-/* Frequency tables. */
-
-/* Frequency table entry. */
-struct freq
- {
- union value v; /* The value. */
- double c; /* The number of occurrences of the value. */
- };
-
-/* Types of frequency tables. */
-enum
- {
- FRQM_GENERAL,
- FRQM_INTEGER
- };
-
-/* Entire frequency table. */
-struct freq_tab
- {
- int mode; /* FRQM_GENERAL or FRQM_INTEGER. */
-
- /* General mode. */
- struct hsh_table *data; /* Undifferentiated data. */
-
- /* Integer mode. */
- double *vector; /* Frequencies proper. */
- int min, max; /* The boundaries of the table. */
- double out_of_range; /* Sum of weights of out-of-range values. */
- double sysmis; /* Sum of weights of SYSMIS values. */
-
- /* All modes. */
- struct freq *valid; /* Valid freqs. */
- int n_valid; /* Number of total freqs. */
-
- struct freq *missing; /* Missing freqs. */
- int n_missing; /* Number of missing freqs. */
-
- /* Statistics. */
- double total_cases; /* Sum of weights of all cases. */
- double valid_cases; /* Sum of weights of valid cases. */
- };
-
-
-/* Per-variable frequency data. */
-struct var_freqs
- {
- /* Freqency table. */
- struct freq_tab tab; /* Frequencies table to use. */
-
- /* Percentiles. */
- int n_groups; /* Number of groups. */
- double *groups; /* Groups. */
-
- /* Statistics. */
- double stat[frq_n_stats];
- };
-
-static inline struct var_freqs *
-get_var_freqs (struct variable *v)
-{
- assert (v != NULL);
- assert (v->aux != NULL);
- return v->aux;
-}
-
-static void determine_charts (void);
-
-static void calc_stats (struct variable *v, double d[frq_n_stats]);
-
-static void precalc (void *);
-static int calc (struct ccase *, void *);
-static void postcalc (void *);
-
-static void postprocess_freq_tab (struct variable *);
-static void dump_full (struct variable *);
-static void dump_condensed (struct variable *);
-static void dump_statistics (struct variable *, int show_varname);
-static void cleanup_freq_tab (struct variable *);
-
-static hsh_hash_func hash_value_numeric, hash_value_alpha;
-static hsh_compare_func compare_value_numeric_a, compare_value_alpha_a;
-static hsh_compare_func compare_value_numeric_d, compare_value_alpha_d;
-static hsh_compare_func compare_freq_numeric_a, compare_freq_alpha_a;
-static hsh_compare_func compare_freq_numeric_d, compare_freq_alpha_d;
-
-
-static void do_piechart(const struct variable *var,
- const struct freq_tab *frq_tab);
-
-gsl_histogram *
-freq_tab_to_hist(const struct freq_tab *ft, const struct variable *var);
-
-
-\f
-/* Parser and outline. */
-
-static int internal_cmd_frequencies (void);
-
-int
-cmd_frequencies (void)
-{
- int result;
-
- int_pool = pool_create ();
- result = internal_cmd_frequencies ();
- pool_destroy (int_pool);
- int_pool=0;
- pool_destroy (gen_pool);
- gen_pool=0;
- free (v_variables);
- v_variables=0;
- return result;
-}
-
-static int
-internal_cmd_frequencies (void)
-{
- int i;
-
- n_percentiles = 0;
- percentiles = NULL;
-
- n_variables = 0;
- v_variables = NULL;
-
- if (!parse_frequencies (&cmd))
- return CMD_FAILURE;
-
- if (cmd.onepage_limit == NOT_LONG)
- cmd.onepage_limit = 50;
-
- /* Figure out statistics to calculate. */
- stats = 0;
- if (cmd.a_statistics[FRQ_ST_DEFAULT] || !cmd.sbc_statistics)
- stats |= frq_default;
- if (cmd.a_statistics[FRQ_ST_ALL])
- stats |= frq_all;
- if (cmd.sort != FRQ_AVALUE && cmd.sort != FRQ_DVALUE)
- stats &= ~frq_median;
- for (i = 0; i < frq_n_stats; i++)
- if (cmd.a_statistics[st_name[i].st_indx])
- stats |= BIT_INDEX (i);
- if (stats & frq_kurt)
- stats |= frq_sekurt;
- if (stats & frq_skew)
- stats |= frq_seskew;
-
- /* Calculate n_stats. */
- n_stats = 0;
- for (i = 0; i < frq_n_stats; i++)
- if ((stats & BIT_INDEX (i)))
- n_stats++;
-
- /* Charting. */
- determine_charts ();
- if (chart != GFT_NONE || cmd.sbc_ntiles)
- cmd.sort = FRQ_AVALUE;
-
- /* Work out what percentiles need to be calculated */
- if ( cmd.sbc_percentiles )
- {
- for ( i = 0 ; i < MAXLISTS ; ++i )
- {
- int pl;
- subc_list_double *ptl_list = &cmd.dl_percentiles[i];
- for ( pl = 0 ; pl < subc_list_double_count(ptl_list); ++pl)
- add_percentile(subc_list_double_at(ptl_list,pl) / 100.0 );
- }
- }
- if ( cmd.sbc_ntiles )
- {
- for ( i = 0 ; i < cmd.sbc_ntiles ; ++i )
- {
- int j;
- for (j = 0; j <= cmd.n_ntiles[i]; ++j )
- add_percentile(j / (double) cmd.n_ntiles[i]);
- }
- }
-
-
- /* Do it! */
- procedure_with_splits (precalc, calc, postcalc, NULL);
-
- free_frequencies(&cmd);
-
- return CMD_SUCCESS;
-}
-
-/* Figure out which charts the user requested. */
-static void
-determine_charts (void)
-{
- int count = (!!cmd.sbc_histogram) + (!!cmd.sbc_barchart) +
- (!!cmd.sbc_hbar) + (!!cmd.sbc_piechart);
-
- if (!count)
- {
- chart = GFT_NONE;
- return;
- }
- else if (count > 1)
- {
- chart = GFT_HBAR;
- msg (SW, _("At most one of BARCHART, HISTOGRAM, or HBAR should be "
- "given. HBAR will be assumed. Argument values will be "
- "given precedence increasing along the order given."));
- }
- else if (cmd.sbc_histogram)
- chart = GFT_HIST;
- else if (cmd.sbc_barchart)
- chart = GFT_BAR;
- else if (cmd.sbc_piechart)
- chart = GFT_PIE;
- else
- chart = GFT_HBAR;
-
- min = max = SYSMIS;
- format = FRQ_FREQ;
- scale = SYSMIS;
- incr = SYSMIS;
- normal = 0;
-
- if (cmd.sbc_barchart)
- {
- if (cmd.ba_min != SYSMIS)
- min = cmd.ba_min;
- if (cmd.ba_max != SYSMIS)
- max = cmd.ba_max;
- if (cmd.ba_scale == FRQ_FREQ)
- {
- format = FRQ_FREQ;
- scale = cmd.ba_freq;
- }
- else if (cmd.ba_scale == FRQ_PERCENT)
- {
- format = FRQ_PERCENT;
- scale = cmd.ba_pcnt;
- }
- }
-
- if (cmd.sbc_histogram)
- {
- if (cmd.hi_min != SYSMIS)
- min = cmd.hi_min;
- if (cmd.hi_max != SYSMIS)
- max = cmd.hi_max;
- if (cmd.hi_scale == FRQ_FREQ)
- {
- format = FRQ_FREQ;
- scale = cmd.hi_freq;
- }
- else if (cmd.hi_scale == FRQ_PERCENT)
- {
- format = FRQ_PERCENT;
- scale = cmd.ba_pcnt;
- }
- if (cmd.hi_norm != FRQ_NONORMAL )
- normal = 1;
- if (cmd.hi_incr == FRQ_INCREMENT)
- incr = cmd.hi_inc;
- }
-
- if (cmd.sbc_hbar)
- {
- if (cmd.hb_min != SYSMIS)
- min = cmd.hb_min;
- if (cmd.hb_max != SYSMIS)
- max = cmd.hb_max;
- if (cmd.hb_scale == FRQ_FREQ)
- {
- format = FRQ_FREQ;
- scale = cmd.hb_freq;
- }
- else if (cmd.hb_scale == FRQ_PERCENT)
- {
- format = FRQ_PERCENT;
- scale = cmd.ba_pcnt;
- }
- if (cmd.hb_norm)
- normal = 1;
- if (cmd.hb_incr == FRQ_INCREMENT)
- incr = cmd.hb_inc;
- }
-
- if (min != SYSMIS && max != SYSMIS && min >= max)
- {
- msg (SE, _("MAX must be greater than or equal to MIN, if both are "
- "specified. However, MIN was specified as %g and MAX as %g. "
- "MIN and MAX will be ignored."), min, max);
- min = max = SYSMIS;
- }
-}
-
-/* Add data from case C to the frequency table. */
-static int
-calc (struct ccase *c, void *aux UNUSED)
-{
- double weight;
- size_t i;
- int bad_warn = 1;
-
- weight = dict_get_case_weight (default_dict, c, &bad_warn);
-
- for (i = 0; i < n_variables; i++)
- {
- struct variable *v = v_variables[i];
- const union value *val = case_data (c, v->fv);
- struct freq_tab *ft = &get_var_freqs (v)->tab;
-
- switch (ft->mode)
- {
- case FRQM_GENERAL:
- {
-
- /* General mode. */
- struct freq **fpp = (struct freq **) hsh_probe (ft->data, val);
-
- if (*fpp != NULL)
- (*fpp)->c += weight;
- else
- {
- struct freq *fp = *fpp = pool_alloc (gen_pool, sizeof *fp);
- fp->v = *val;
- fp->c = weight;
- }
- }
- break;
- case FRQM_INTEGER:
- /* Integer mode. */
- if (val->f == SYSMIS)
- ft->sysmis += weight;
- else if (val->f > INT_MIN+1 && val->f < INT_MAX-1)
- {
- int i = val->f;
- if (i >= ft->min && i <= ft->max)
- ft->vector[i - ft->min] += weight;
- }
- else
- ft->out_of_range += weight;
- break;
- default:
- assert (0);
- }
- }
- return 1;
-}
-
-/* Prepares each variable that is the target of FREQUENCIES by setting
- up its hash table. */
-static void
-precalc (void *aux UNUSED)
-{
- size_t i;
-
- pool_destroy (gen_pool);
- gen_pool = pool_create ();
-
- for (i = 0; i < n_variables; i++)
- {
- struct variable *v = v_variables[i];
- struct freq_tab *ft = &get_var_freqs (v)->tab;
-
- if (ft->mode == FRQM_GENERAL)
- {
- hsh_hash_func *hash;
- hsh_compare_func *compare;
-
- if (v->type == NUMERIC)
- {
- hash = hash_value_numeric;
- compare = compare_value_numeric_a;
- }
- else
- {
- hash = hash_value_alpha;
- compare = compare_value_alpha_a;
- }
- ft->data = hsh_create (16, compare, hash, NULL, v);
- }
- else
- {
- int j;
-
- for (j = (ft->max - ft->min); j >= 0; j--)
- ft->vector[j] = 0.0;
- ft->out_of_range = 0.0;
- ft->sysmis = 0.0;
- }
- }
-}
-
-/* Finishes up with the variables after frequencies have been
- calculated. Displays statistics, percentiles, ... */
-static void
-postcalc (void *aux UNUSED)
-{
- size_t i;
-
- for (i = 0; i < n_variables; i++)
- {
- struct variable *v = v_variables[i];
- struct var_freqs *vf = get_var_freqs (v);
- struct freq_tab *ft = &vf->tab;
- int n_categories;
- int dumped_freq_tab = 1;
-
- postprocess_freq_tab (v);
-
- /* Frequencies tables. */
- n_categories = ft->n_valid + ft->n_missing;
- if (cmd.table == FRQ_TABLE
- || (cmd.table == FRQ_LIMIT && n_categories <= cmd.limit))
- switch (cmd.cond)
- {
- case FRQ_CONDENSE:
- dump_condensed (v);
- break;
- case FRQ_STANDARD:
- dump_full (v);
- break;
- case FRQ_ONEPAGE:
- if (n_categories > cmd.onepage_limit)
- dump_condensed (v);
- else
- dump_full (v);
- break;
- default:
- assert (0);
- }
- else
- dumped_freq_tab = 0;
-
- /* Statistics. */
- if (n_stats)
- dump_statistics (v, !dumped_freq_tab);
-
-
-
- if ( chart == GFT_HIST)
- {
- double d[frq_n_stats];
- struct normal_curve norm;
- gsl_histogram *hist ;
-
-
- norm.N = vf->tab.valid_cases;
-
- calc_stats(v,d);
- norm.mean = d[frq_mean];
- norm.stddev = d[frq_stddev];
-
- hist = freq_tab_to_hist(ft,v);
-
- histogram_plot(hist, var_to_string(v), &norm, normal);
-
- gsl_histogram_free(hist);
- }
-
-
- if ( chart == GFT_PIE)
- {
- do_piechart(v_variables[i], ft);
- }
-
-
-
- cleanup_freq_tab (v);
-
- }
-}
-
-/* Returns the comparison function that should be used for
- sorting a frequency table by FRQ_SORT using VAR_TYPE
- variables. */
-static hsh_compare_func *
-get_freq_comparator (int frq_sort, int var_type)
-{
- /* Note that q2c generates tags beginning with 1000. */
- switch (frq_sort | (var_type << 16))
- {
- case FRQ_AVALUE | (NUMERIC << 16): return compare_value_numeric_a;
- case FRQ_AVALUE | (ALPHA << 16): return compare_value_alpha_a;
- case FRQ_DVALUE | (NUMERIC << 16): return compare_value_numeric_d;
- case FRQ_DVALUE | (ALPHA << 16): return compare_value_alpha_d;
- case FRQ_AFREQ | (NUMERIC << 16): return compare_freq_numeric_a;
- case FRQ_AFREQ | (ALPHA << 16): return compare_freq_alpha_a;
- case FRQ_DFREQ | (NUMERIC << 16): return compare_freq_numeric_d;
- case FRQ_DFREQ | (ALPHA << 16): return compare_freq_alpha_d;
- default: assert (0);
- }
-
- return 0;
-}
-
-/* Returns nonzero iff the value in struct freq F is non-missing
- for variable V. */
-static int
-not_missing (const void *f_, void *v_)
-{
- const struct freq *f = f_;
- struct variable *v = v_;
-
- return !mv_is_value_missing (&v->miss, &f->v);
-}
-
-/* Summarizes the frequency table data for variable V. */
-static void
-postprocess_freq_tab (struct variable *v)
-{
- hsh_compare_func *compare;
- struct freq_tab *ft;
- size_t count;
- void *const *data;
- struct freq *freqs, *f;
- size_t i;
-
- ft = &get_var_freqs (v)->tab;
- assert (ft->mode == FRQM_GENERAL);
- compare = get_freq_comparator (cmd.sort, v->type);
-
- /* Extract data from hash table. */
- count = hsh_count (ft->data);
- data = hsh_data (ft->data);
-
- /* Copy dereferenced data into freqs. */
- freqs = xnmalloc (count, sizeof *freqs);
- for (i = 0; i < count; i++)
- {
- struct freq *f = data[i];
- freqs[i] = *f;
- }
-
- /* Put data into ft. */
- ft->valid = freqs;
- ft->n_valid = partition (freqs, count, sizeof *freqs, not_missing, v);
- ft->missing = freqs + ft->n_valid;
- ft->n_missing = count - ft->n_valid;
-
- /* Sort data. */
- sort (ft->valid, ft->n_valid, sizeof *ft->valid, compare, v);
- sort (ft->missing, ft->n_missing, sizeof *ft->missing, compare, v);
-
- /* Summary statistics. */
- ft->valid_cases = 0.0;
- for(i = 0 ; i < ft->n_valid ; ++i )
- {
- f = &ft->valid[i];
- ft->valid_cases += f->c;
-
- }
-
- ft->total_cases = ft->valid_cases ;
- for(i = 0 ; i < ft->n_missing ; ++i )
- {
- f = &ft->missing[i];
- ft->total_cases += f->c;
- }
-
-}
-
-/* Frees the frequency table for variable V. */
-static void
-cleanup_freq_tab (struct variable *v)
-{
- struct freq_tab *ft = &get_var_freqs (v)->tab;
- assert (ft->mode == FRQM_GENERAL);
- free (ft->valid);
- hsh_destroy (ft->data);
-}
-
-/* Parses the VARIABLES subcommand, adding to
- {n_variables,v_variables}. */
-static int
-frq_custom_variables (struct cmd_frequencies *cmd UNUSED)
-{
- int mode;
- int min = 0, max = 0;
-
- size_t old_n_variables = n_variables;
- size_t i;
-
- lex_match ('=');
- if (token != T_ALL && (token != T_ID
- || dict_lookup_var (default_dict, tokid) == NULL))
- return 2;
-
- if (!parse_variables (default_dict, &v_variables, &n_variables,
- PV_APPEND | PV_NO_SCRATCH))
- return 0;
-
- if (!lex_match ('('))
- mode = FRQM_GENERAL;
- else
- {
- mode = FRQM_INTEGER;
- if (!lex_force_int ())
- return 0;
- min = lex_integer ();
- lex_get ();
- if (!lex_force_match (','))
- return 0;
- if (!lex_force_int ())
- return 0;
- max = lex_integer ();
- lex_get ();
- if (!lex_force_match (')'))
- return 0;
- if (max < min)
- {
- msg (SE, _("Upper limit of integer mode value range must be "
- "greater than lower limit."));
- return 0;
- }
- }
-
- for (i = old_n_variables; i < n_variables; i++)
- {
- struct variable *v = v_variables[i];
- struct var_freqs *vf;
-
- if (v->aux != NULL)
- {
- msg (SE, _("Variable %s specified multiple times on VARIABLES "
- "subcommand."), v->name);
- return 0;
- }
- if (mode == FRQM_INTEGER && v->type != NUMERIC)
- {
- msg (SE, _("Integer mode specified, but %s is not a numeric "
- "variable."), v->name);
- return 0;
- }
-
- vf = var_attach_aux (v, xmalloc (sizeof *vf), var_dtor_free);
- vf->tab.mode = mode;
- vf->tab.valid = vf->tab.missing = NULL;
- if (mode == FRQM_INTEGER)
- {
- vf->tab.min = min;
- vf->tab.max = max;
- vf->tab.vector = pool_nalloc (int_pool,
- max - min + 1, sizeof *vf->tab.vector);
- }
- else
- vf->tab.vector = NULL;
- vf->n_groups = 0;
- vf->groups = NULL;
- }
- return 1;
-}
-
-/* Parses the GROUPED subcommand, setting the n_grouped, grouped
- fields of specified variables. */
-static int
-frq_custom_grouped (struct cmd_frequencies *cmd UNUSED)
-{
- lex_match ('=');
- if ((token == T_ID && dict_lookup_var (default_dict, tokid) != NULL)
- || token == T_ID)
- for (;;)
- {
- size_t i;
-
- /* Max, current size of list; list itself. */
- int nl, ml;
- double *dl;
-
- /* Variable list. */
- size_t n;
- struct variable **v;
-
- if (!parse_variables (default_dict, &v, &n,
- PV_NO_DUPLICATE | PV_NUMERIC))
- return 0;
- if (lex_match ('('))
- {
- nl = ml = 0;
- dl = NULL;
- while (lex_integer ())
- {
- if (nl >= ml)
- {
- ml += 16;
- dl = pool_nrealloc (int_pool, dl, ml, sizeof *dl);
- }
- dl[nl++] = tokval;
- lex_get ();
- lex_match (',');
- }
- /* Note that nl might still be 0 and dl might still be
- NULL. That's okay. */
- if (!lex_match (')'))
- {
- free (v);
- msg (SE, _("`)' expected after GROUPED interval list."));
- return 0;
- }
- }
- else
- {
- nl = 0;
- dl = NULL;
- }
-
- for (i = 0; i < n; i++)
- if (v[i]->aux == NULL)
- msg (SE, _("Variables %s specified on GROUPED but not on "
- "VARIABLES."), v[i]->name);
- else
- {
- struct var_freqs *vf = get_var_freqs (v[i]);
-
- if (vf->groups != NULL)
- msg (SE, _("Variables %s specified multiple times on GROUPED "
- "subcommand."), v[i]->name);
- else
- {
- vf->n_groups = nl;
- vf->groups = dl;
- }
- }
- free (v);
- if (!lex_match ('/'))
- break;
- if ((token != T_ID || dict_lookup_var (default_dict, tokid) != NULL)
- && token != T_ALL)
- {
- lex_put_back ('/');
- break;
- }
- }
-
- return 1;
-}
-
-/* Adds X to the list of percentiles, keeping the list in proper
- order. */
-static void
-add_percentile (double x)
-{
- int i;
-
- for (i = 0; i < n_percentiles; i++)
- {
- /* Do nothing if it's already in the list */
- if ( fabs(x - percentiles[i].p) < DBL_EPSILON )
- return;
-
- if (x < percentiles[i].p)
- break;
- }
-
- if (i >= n_percentiles || tokval != percentiles[i].p)
- {
- percentiles = pool_nrealloc (int_pool, percentiles,
- n_percentiles + 1, sizeof *percentiles);
-
- if (i < n_percentiles)
- memmove (&percentiles[i + 1], &percentiles[i],
- (n_percentiles - i) * sizeof (struct percentile) );
-
- percentiles[i].p = x;
- n_percentiles++;
- }
-}
-
-/* Comparison functions. */
-
-/* Hash of numeric values. */
-static unsigned
-hash_value_numeric (const void *value_, void *foo UNUSED)
-{
- const struct freq *value = value_;
- return hsh_hash_double (value->v.f);
-}
-
-/* Hash of string values. */
-static unsigned
-hash_value_alpha (const void *value_, void *v_)
-{
- const struct freq *value = value_;
- struct variable *v = v_;
-
- return hsh_hash_bytes (value->v.s, v->width);
-}
-
-/* Ascending numeric compare of values. */
-static int
-compare_value_numeric_a (const void *a_, const void *b_, void *foo UNUSED)
-{
- const struct freq *a = a_;
- const struct freq *b = b_;
-
- if (a->v.f > b->v.f)
- return 1;
- else if (a->v.f < b->v.f)
- return -1;
- else
- return 0;
-}
-
-/* Ascending string compare of values. */
-static int
-compare_value_alpha_a (const void *a_, const void *b_, void *v_)
-{
- const struct freq *a = a_;
- const struct freq *b = b_;
- const struct variable *v = v_;
-
- return memcmp (a->v.s, b->v.s, v->width);
-}
-
-/* Descending numeric compare of values. */
-static int
-compare_value_numeric_d (const void *a, const void *b, void *foo UNUSED)
-{
- return -compare_value_numeric_a (a, b, foo);
-}
-
-/* Descending string compare of values. */
-static int
-compare_value_alpha_d (const void *a, const void *b, void *v)
-{
- return -compare_value_alpha_a (a, b, v);
-}
-
-/* Ascending numeric compare of frequency;
- secondary key on ascending numeric value. */
-static int
-compare_freq_numeric_a (const void *a_, const void *b_, void *foo UNUSED)
-{
- const struct freq *a = a_;
- const struct freq *b = b_;
-
- if (a->c > b->c)
- return 1;
- else if (a->c < b->c)
- return -1;
-
- if (a->v.f > b->v.f)
- return 1;
- else if (a->v.f < b->v.f)
- return -1;
- else
- return 0;
-}
-
-/* Ascending numeric compare of frequency;
- secondary key on ascending string value. */
-static int
-compare_freq_alpha_a (const void *a_, const void *b_, void *v_)
-{
- const struct freq *a = a_;
- const struct freq *b = b_;
- const struct variable *v = v_;
-
- if (a->c > b->c)
- return 1;
- else if (a->c < b->c)
- return -1;
- else
- return memcmp (a->v.s, b->v.s, v->width);
-}
-
-/* Descending numeric compare of frequency;
- secondary key on ascending numeric value. */
-static int
-compare_freq_numeric_d (const void *a_, const void *b_, void *foo UNUSED)
-{
- const struct freq *a = a_;
- const struct freq *b = b_;
-
- if (a->c > b->c)
- return -1;
- else if (a->c < b->c)
- return 1;
-
- if (a->v.f > b->v.f)
- return 1;
- else if (a->v.f < b->v.f)
- return -1;
- else
- return 0;
-}
-
-/* Descending numeric compare of frequency;
- secondary key on ascending string value. */
-static int
-compare_freq_alpha_d (const void *a_, const void *b_, void *v_)
-{
- const struct freq *a = a_;
- const struct freq *b = b_;
- const struct variable *v = v_;
-
- if (a->c > b->c)
- return -1;
- else if (a->c < b->c)
- return 1;
- else
- return memcmp (a->v.s, b->v.s, v->width);
-}
-\f
-/* Frequency table display. */
-
-/* Sets the widths of all the columns and heights of all the rows in
- table T for driver D. */
-static void
-full_dim (struct tab_table *t, struct outp_driver *d)
-{
- int lab = cmd.labels == FRQ_LABELS;
- int i;
-
- if (lab)
- t->w[0] = min (tab_natural_width (t, d, 0), d->prop_em_width * 15);
- for (i = lab; i < lab + 5; i++)
- t->w[i] = max (tab_natural_width (t, d, i), d->prop_em_width * 8);
- for (i = 0; i < t->nr; i++)
- t->h[i] = d->font_height;
-}
-
-/* Displays a full frequency table for variable V. */
-static void
-dump_full (struct variable *v)
-{
- int n_categories;
- struct freq_tab *ft;
- struct freq *f;
- struct tab_table *t;
- int r;
- double cum_total = 0.0;
- double cum_freq = 0.0;
-
- struct init
- {
- int c, r;
- const char *s;
- };
-
- struct init *p;
-
- static struct init vec[] =
- {
- {4, 0, N_("Valid")},
- {5, 0, N_("Cum")},
- {1, 1, N_("Value")},
- {2, 1, N_("Frequency")},
- {3, 1, N_("Percent")},
- {4, 1, N_("Percent")},
- {5, 1, N_("Percent")},
- {0, 0, NULL},
- {1, 0, NULL},
- {2, 0, NULL},
- {3, 0, NULL},
- {-1, -1, NULL},
- };
-
- int lab = cmd.labels == FRQ_LABELS;
-
- ft = &get_var_freqs (v)->tab;
- n_categories = ft->n_valid + ft->n_missing;
- t = tab_create (5 + lab, n_categories + 3, 0);
- tab_headers (t, 0, 0, 2, 0);
- tab_dim (t, full_dim);
-
- if (lab)
- tab_text (t, 0, 1, TAB_CENTER | TAT_TITLE, _("Value Label"));
- for (p = vec; p->s; p++)
- tab_text (t, p->c - (p->r ? !lab : 0), p->r,
- TAB_CENTER | TAT_TITLE, gettext (p->s));
-
- r = 2;
- for (f = ft->valid; f < ft->missing; f++)
- {
- double percent, valid_percent;
-
- cum_freq += f->c;
-
- percent = f->c / ft->total_cases * 100.0;
- valid_percent = f->c / ft->valid_cases * 100.0;
- cum_total += valid_percent;
-
- if (lab)
- {
- const char *label = val_labs_find (v->val_labs, f->v);
- if (label != NULL)
- tab_text (t, 0, r, TAB_LEFT, label);
- }
-
- tab_value (t, 0 + lab, r, TAB_NONE, &f->v, &v->print);
- tab_float (t, 1 + lab, r, TAB_NONE, f->c, 8, 0);
- tab_float (t, 2 + lab, r, TAB_NONE, percent, 5, 1);
- tab_float (t, 3 + lab, r, TAB_NONE, valid_percent, 5, 1);
- tab_float (t, 4 + lab, r, TAB_NONE, cum_total, 5, 1);
- r++;
- }
- for (; f < &ft->valid[n_categories]; f++)
- {
- cum_freq += f->c;
-
- if (lab)
- {
- const char *label = val_labs_find (v->val_labs, f->v);
- if (label != NULL)
- tab_text (t, 0, r, TAB_LEFT, label);
- }
-
- tab_value (t, 0 + lab, r, TAB_NONE, &f->v, &v->print);
- tab_float (t, 1 + lab, r, TAB_NONE, f->c, 8, 0);
- tab_float (t, 2 + lab, r, TAB_NONE,
- f->c / ft->total_cases * 100.0, 5, 1);
- tab_text (t, 3 + lab, r, TAB_NONE, _("Missing"));
- r++;
- }
-
- tab_box (t, TAL_1, TAL_1,
- cmd.spaces == FRQ_SINGLE ? -1 : (TAL_1 | TAL_SPACING), TAL_1,
- 0, 0, 4 + lab, r);
- tab_hline (t, TAL_2, 0, 4 + lab, 2);
- tab_hline (t, TAL_2, 0, 4 + lab, r);
- tab_joint_text (t, 0, r, 0 + lab, r, TAB_RIGHT | TAT_TITLE, _("Total"));
- tab_vline (t, TAL_0, 1, r, r);
- tab_float (t, 1 + lab, r, TAB_NONE, cum_freq, 8, 0);
- tab_float (t, 2 + lab, r, TAB_NONE, 100.0, 5, 1);
- tab_float (t, 3 + lab, r, TAB_NONE, 100.0, 5, 1);
-
- tab_title (t, 1, "%s: %s", v->name, v->label ? v->label : "");
- tab_submit (t);
-
-}
-
-/* Sets the widths of all the columns and heights of all the rows in
- table T for driver D. */
-static void
-condensed_dim (struct tab_table *t, struct outp_driver *d)
-{
- int cum_w = max (outp_string_width (d, _("Cum")),
- max (outp_string_width (d, _("Cum")),
- outp_string_width (d, "000")));
-
- int i;
-
- for (i = 0; i < 2; i++)
- t->w[i] = max (tab_natural_width (t, d, i), d->prop_em_width * 8);
- for (i = 2; i < 4; i++)
- t->w[i] = cum_w;
- for (i = 0; i < t->nr; i++)
- t->h[i] = d->font_height;
-}
-
-/* Display condensed frequency table for variable V. */
-static void
-dump_condensed (struct variable *v)
-{
- int n_categories;
- struct freq_tab *ft;
- struct freq *f;
- struct tab_table *t;
- int r;
- double cum_total = 0.0;
-
- ft = &get_var_freqs (v)->tab;
- n_categories = ft->n_valid + ft->n_missing;
- t = tab_create (4, n_categories + 2, 0);
-
- tab_headers (t, 0, 0, 2, 0);
- tab_text (t, 0, 1, TAB_CENTER | TAT_TITLE, _("Value"));
- tab_text (t, 1, 1, TAB_CENTER | TAT_TITLE, _("Freq"));
- tab_text (t, 2, 1, TAB_CENTER | TAT_TITLE, _("Pct"));
- tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Cum"));
- tab_text (t, 3, 1, TAB_CENTER | TAT_TITLE, _("Pct"));
- tab_dim (t, condensed_dim);
-
- r = 2;
- for (f = ft->valid; f < ft->missing; f++)
- {
- double percent;
-
- percent = f->c / ft->total_cases * 100.0;
- cum_total += f->c / ft->valid_cases * 100.0;
-
- tab_value (t, 0, r, TAB_NONE, &f->v, &v->print);
- tab_float (t, 1, r, TAB_NONE, f->c, 8, 0);
- tab_float (t, 2, r, TAB_NONE, percent, 3, 0);
- tab_float (t, 3, r, TAB_NONE, cum_total, 3, 0);
- r++;
- }
- for (; f < &ft->valid[n_categories]; f++)
- {
- tab_value (t, 0, r, TAB_NONE, &f->v, &v->print);
- tab_float (t, 1, r, TAB_NONE, f->c, 8, 0);
- tab_float (t, 2, r, TAB_NONE,
- f->c / ft->total_cases * 100.0, 3, 0);
- r++;
- }
-
- tab_box (t, TAL_1, TAL_1,
- cmd.spaces == FRQ_SINGLE ? -1 : (TAL_1 | TAL_SPACING), TAL_1,
- 0, 0, 3, r - 1);
- tab_hline (t, TAL_2, 0, 3, 2);
- tab_title (t, 1, "%s: %s", v->name, v->label ? v->label : "");
- tab_columns (t, SOM_COL_DOWN, 1);
- tab_submit (t);
-}
-\f
-/* Statistical display. */
-
-/* Calculates all the pertinent statistics for variable V, putting
- them in array D[]. FIXME: This could be made much more optimal. */
-static void
-calc_stats (struct variable *v, double d[frq_n_stats])
-{
- struct freq_tab *ft = &get_var_freqs (v)->tab;
- double W = ft->valid_cases;
- struct moments *m;
- struct freq *f=0;
- int most_often;
- double X_mode;
-
- double rank;
- int i = 0;
- int idx;
- double *median_value;
-
- /* Calculate percentiles. */
-
- /* If the 50th percentile was not explicitly requested then we must
- calculate it anyway --- it's the median */
- median_value = 0 ;
- for (i = 0; i < n_percentiles; i++)
- {
- if (percentiles[i].p == 0.5)
- {
- median_value = &percentiles[i].value;
- break;
- }
- }
-
- if ( 0 == median_value )
- {
- add_percentile (0.5);
- implicit_50th = 1;
- }
-
- for (i = 0; i < n_percentiles; i++)
- {
- percentiles[i].flag = 0;
- percentiles[i].flag2 = 0;
- }
-
- rank = 0;
- for (idx = 0; idx < ft->n_valid; ++idx)
- {
- static double prev_value = SYSMIS;
- f = &ft->valid[idx];
- rank += f->c ;
- for (i = 0; i < n_percentiles; i++)
- {
- double tp;
- if ( percentiles[i].flag2 ) continue ;
-
- if ( get_algorithm() != COMPATIBLE )
- tp =
- (ft->valid_cases - 1) * percentiles[i].p;
- else
- tp =
- (ft->valid_cases + 1) * percentiles[i].p - 1;
-
- if ( percentiles[i].flag )
- {
- percentiles[i].x2 = f->v.f;
- percentiles[i].x1 = prev_value;
- percentiles[i].flag2 = 1;
- continue;
- }
-
- if (rank > tp )
- {
- if ( f->c > 1 && rank - (f->c - 1) > tp )
- {
- percentiles[i].x2 = percentiles[i].x1 = f->v.f;
- percentiles[i].flag2 = 1;
- }
- else
- {
- percentiles[i].flag=1;
- }
-
- continue;
- }
- }
- prev_value = f->v.f;
- }
-
- for (i = 0; i < n_percentiles; i++)
- {
- /* Catches the case when p == 100% */
- if ( ! percentiles[i].flag2 )
- percentiles[i].x1 = percentiles[i].x2 = f->v.f;
-
- /*
- printf("percentile %d (p==%.2f); X1 = %g; X2 = %g\n",
- i,percentiles[i].p,percentiles[i].x1,percentiles[i].x2);
- */
- }
-
- for (i = 0; i < n_percentiles; i++)
- {
- struct freq_tab *ft = &get_var_freqs (v)->tab;
- double s;
-
- double dummy;
- if ( get_algorithm() != COMPATIBLE )
- {
- s = modf((ft->valid_cases - 1) * percentiles[i].p , &dummy);
- }
- else
- {
- s = modf((ft->valid_cases + 1) * percentiles[i].p -1, &dummy);
- }
-
- percentiles[i].value = percentiles[i].x1 +
- ( percentiles[i].x2 - percentiles[i].x1) * s ;
-
- if ( percentiles[i].p == 0.50)
- median_value = &percentiles[i].value;
- }
-
-
- /* Calculate the mode. */
- most_often = -1;
- X_mode = SYSMIS;
- for (f = ft->valid; f < ft->missing; f++)
- {
- if (most_often < f->c)
- {
- most_often = f->c;
- X_mode = f->v.f;
- }
- else if (most_often == f->c)
- {
- /* A duplicate mode is undefined.
- FIXME: keep track of *all* the modes. */
- X_mode = SYSMIS;
- }
- }
-
- /* Calculate moments. */
- m = moments_create (MOMENT_KURTOSIS);
- for (f = ft->valid; f < ft->missing; f++)
- moments_pass_one (m, f->v.f, f->c);
- for (f = ft->valid; f < ft->missing; f++)
- moments_pass_two (m, f->v.f, f->c);
- moments_calculate (m, NULL, &d[frq_mean], &d[frq_variance],
- &d[frq_skew], &d[frq_kurt]);
- moments_destroy (m);
-
- /* Formulas below are taken from _SPSS Statistical Algorithms_. */
- d[frq_min] = ft->valid[0].v.f;
- d[frq_max] = ft->valid[ft->n_valid - 1].v.f;
- d[frq_mode] = X_mode;
- d[frq_range] = d[frq_max] - d[frq_min];
- d[frq_median] = *median_value;
- d[frq_sum] = d[frq_mean] * W;
- d[frq_stddev] = sqrt (d[frq_variance]);
- d[frq_semean] = d[frq_stddev] / sqrt (W);
- d[frq_seskew] = calc_seskew (W);
- d[frq_sekurt] = calc_sekurt (W);
-}
-
-/* Displays a table of all the statistics requested for variable V. */
-static void
-dump_statistics (struct variable *v, int show_varname)
-{
- struct freq_tab *ft;
- double stat_value[frq_n_stats];
- struct tab_table *t;
- int i, r;
-
- int n_explicit_percentiles = n_percentiles;
-
- if ( implicit_50th && n_percentiles > 0 )
- --n_percentiles;
-
- if (v->type == ALPHA)
- return;
- ft = &get_var_freqs (v)->tab;
- if (ft->n_valid == 0)
- {
- msg (SW, _("No valid data for variable %s; statistics not displayed."),
- v->name);
- return;
- }
- calc_stats (v, stat_value);
-
- t = tab_create (3, n_stats + n_explicit_percentiles + 2, 0);
- tab_dim (t, tab_natural_dimensions);
-
- tab_box (t, TAL_1, TAL_1, -1, -1 , 0 , 0 , 2, tab_nr(t) - 1) ;
-
-
- tab_vline (t, TAL_1 , 2, 0, tab_nr(t) - 1);
- tab_vline (t, TAL_1 | TAL_SPACING , 1, 0, tab_nr(t) - 1 ) ;
-
- r=2; /* N missing and N valid are always dumped */
-
- for (i = 0; i < frq_n_stats; i++)
- if (stats & BIT_INDEX (i))
- {
- tab_text (t, 0, r, TAB_LEFT | TAT_TITLE,
- gettext (st_name[i].s10));
- tab_float (t, 2, r, TAB_NONE, stat_value[i], 11, 3);
- r++;
- }
-
- tab_text (t, 0, 0, TAB_LEFT | TAT_TITLE, _("N"));
- tab_text (t, 1, 0, TAB_LEFT | TAT_TITLE, _("Valid"));
- tab_text (t, 1, 1, TAB_LEFT | TAT_TITLE, _("Missing"));
-
- tab_float(t, 2, 0, TAB_NONE, ft->valid_cases, 11, 0);
- tab_float(t, 2, 1, TAB_NONE, ft->total_cases - ft->valid_cases, 11, 0);
-
-
- for (i = 0; i < n_explicit_percentiles; i++, r++)
- {
- if ( i == 0 )
- {
- tab_text (t, 0, r, TAB_LEFT | TAT_TITLE, _("Percentiles"));
- }
-
- tab_float (t, 1, r, TAB_LEFT, percentiles[i].p * 100, 3, 0 );
- tab_float (t, 2, r, TAB_NONE, percentiles[i].value, 11, 3);
-
- }
-
- tab_columns (t, SOM_COL_DOWN, 1);
- if (show_varname)
- {
- if (v->label)
- tab_title (t, 1, "%s: %s", v->name, v->label);
- else
- tab_title (t, 0, v->name);
- }
- else
- tab_flags (t, SOMF_NO_TITLE);
-
-
- tab_submit (t);
-}
-
-
-/* Create a gsl_histogram from a freq_tab */
-gsl_histogram *
-freq_tab_to_hist(const struct freq_tab *ft, const struct variable *var)
-{
- int i;
- double x_min = DBL_MAX;
- double x_max = -DBL_MAX;
-
- gsl_histogram *hist;
- const double bins = 11;
-
- struct hsh_iterator hi;
- struct hsh_table *fh = ft->data;
- struct freq *frq;
-
- /* Find out the extremes of the x value */
- for ( frq = hsh_first(fh, &hi); frq != 0; frq = hsh_next(fh, &hi) )
- {
- if ( mv_is_value_missing(&var->miss, &frq->v))
- continue;
-
- if ( frq->v.f < x_min ) x_min = frq->v.f ;
- if ( frq->v.f > x_max ) x_max = frq->v.f ;
- }
-
- hist = histogram_create(bins, x_min, x_max);
-
- for( i = 0 ; i < ft->n_valid ; ++i )
- {
- frq = &ft->valid[i];
- gsl_histogram_accumulate(hist, frq->v.f, frq->c);
- }
-
- return hist;
-}
-
-
-static struct slice *
-freq_tab_to_slice_array(const struct freq_tab *frq_tab,
- const struct variable *var,
- int *n_slices);
-
-
-/* Allocate an array of slices and fill them from the data in frq_tab
- n_slices will contain the number of slices allocated.
- The caller is responsible for freeing slices
-*/
-static struct slice *
-freq_tab_to_slice_array(const struct freq_tab *frq_tab,
- const struct variable *var,
- int *n_slices)
-{
- int i;
- struct slice *slices;
-
- *n_slices = frq_tab->n_valid;
-
- slices = xnmalloc (*n_slices, sizeof *slices);
-
- for (i = 0 ; i < *n_slices ; ++i )
- {
- const struct freq *frq = &frq_tab->valid[i];
-
- slices[i].label = value_to_string(&frq->v, var);
-
- slices[i].magnetude = frq->c;
- }
-
- return slices;
-}
-
-
-
-
-static void
-do_piechart(const struct variable *var, const struct freq_tab *frq_tab)
-{
- struct slice *slices;
- int n_slices;
-
- slices = freq_tab_to_slice_array(frq_tab, var, &n_slices);
-
- piechart_plot(var_to_string(var), slices, n_slices);
-
- free(slices);
-}
-
-
-/*
- Local Variables:
- mode: c
- End:
-*/
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <stdlib.h>
-#include "alloc.h"
-#include "any-reader.h"
-#include "any-writer.h"
-#include "case.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "file-handle.h"
-#include "hash.h"
-#include "lexer.h"
-#include "misc.h"
-#include "pfm-write.h"
-#include "settings.h"
-#include "sfm-write.h"
-#include "str.h"
-#include "value-labels.h"
-#include "var.h"
-#include "vfm.h"
-#include "vfmP.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-/* Rearranging and reducing a dictionary. */
-static void start_case_map (struct dictionary *);
-static struct case_map *finish_case_map (struct dictionary *);
-static void map_case (const struct case_map *,
- const struct ccase *, struct ccase *);
-static void destroy_case_map (struct case_map *);
-
-static bool parse_dict_trim (struct dictionary *);
-\f
-/* Reading system and portable files. */
-
-/* Type of command. */
-enum reader_command
- {
- GET_CMD,
- IMPORT_CMD
- };
-
-/* Case reader input program. */
-struct case_reader_pgm
- {
- struct any_reader *reader; /* File reader. */
- struct case_map *map; /* Map from file dict to active file dict. */
- struct ccase bounce; /* Bounce buffer. */
- };
-
-static const struct case_source_class case_reader_source_class;
-
-static void case_reader_pgm_free (struct case_reader_pgm *);
-
-/* Parses a GET or IMPORT command. */
-static int
-parse_read_command (enum reader_command type)
-{
- struct case_reader_pgm *pgm = NULL;
- struct file_handle *fh = NULL;
- struct dictionary *dict = NULL;
-
- for (;;)
- {
- lex_match ('/');
-
- if (lex_match_id ("FILE") || token == T_STRING)
- {
- lex_match ('=');
-
- fh = fh_parse (FH_REF_FILE | FH_REF_SCRATCH);
- if (fh == NULL)
- goto error;
- }
- else if (type == IMPORT_CMD && lex_match_id ("TYPE"))
- {
- lex_match ('=');
-
- if (lex_match_id ("COMM"))
- type = PFM_COMM;
- else if (lex_match_id ("TAPE"))
- type = PFM_TAPE;
- else
- {
- lex_error (_("expecting COMM or TAPE"));
- goto error;
- }
- }
- else
- break;
- }
-
- if (fh == NULL)
- {
- lex_sbc_missing ("FILE");
- goto error;
- }
-
- discard_variables ();
-
- pgm = xmalloc (sizeof *pgm);
- pgm->reader = any_reader_open (fh, &dict);
- pgm->map = NULL;
- case_nullify (&pgm->bounce);
- if (pgm->reader == NULL)
- goto error;
-
- case_create (&pgm->bounce, dict_get_next_value_idx (dict));
-
- start_case_map (dict);
-
- while (token != '.')
- {
- lex_match ('/');
- if (!parse_dict_trim (dict))
- goto error;
- }
-
- pgm->map = finish_case_map (dict);
-
- dict_destroy (default_dict);
- default_dict = dict;
-
- vfm_source = create_case_source (&case_reader_source_class, pgm);
-
- return CMD_SUCCESS;
-
- error:
- case_reader_pgm_free (pgm);
- if (dict != NULL)
- dict_destroy (dict);
- return CMD_FAILURE;
-}
-
-/* Frees a struct case_reader_pgm. */
-static void
-case_reader_pgm_free (struct case_reader_pgm *pgm)
-{
- if (pgm != NULL)
- {
- any_reader_close (pgm->reader);
- destroy_case_map (pgm->map);
- case_destroy (&pgm->bounce);
- free (pgm);
- }
-}
-
-/* Clears internal state related to case reader input procedure. */
-static void
-case_reader_source_destroy (struct case_source *source)
-{
- struct case_reader_pgm *pgm = source->aux;
- case_reader_pgm_free (pgm);
-}
-
-/* Reads all the cases from the data file into C and passes them
- to WRITE_CASE one by one, passing WC_DATA. */
-static void
-case_reader_source_read (struct case_source *source,
- struct ccase *c,
- write_case_func *write_case, write_case_data wc_data)
-{
- struct case_reader_pgm *pgm = source->aux;
- int ok;
-
- do
- {
- if (pgm->map == NULL)
- ok = any_reader_read (pgm->reader, c);
- else
- {
- ok = any_reader_read (pgm->reader, &pgm->bounce);
- if (ok)
- map_case (pgm->map, &pgm->bounce, c);
- }
-
- if (ok)
- ok = write_case (wc_data);
- }
- while (ok);
-}
-
-static const struct case_source_class case_reader_source_class =
- {
- "case reader",
- NULL,
- case_reader_source_read,
- case_reader_source_destroy,
- };
-\f
-/* GET. */
-int
-cmd_get (void)
-{
- return parse_read_command (GET_CMD);
-}
-
-/* IMPORT. */
-int
-cmd_import (void)
-{
- return parse_read_command (IMPORT_CMD);
-}
-\f
-/* Writing system and portable files. */
-
-/* Type of output file. */
-enum writer_type
- {
- SYSFILE_WRITER, /* System file. */
- PORFILE_WRITER /* Portable file. */
- };
-
-/* Type of a command. */
-enum command_type
- {
- XFORM_CMD, /* Transformation. */
- PROC_CMD /* Procedure. */
- };
-
-/* File writer plus a case map. */
-struct case_writer
- {
- struct any_writer *writer; /* File writer. */
- struct case_map *map; /* Map to output file dictionary
- (null pointer for identity mapping). */
- struct ccase bounce; /* Bounce buffer for mapping (if needed). */
- };
-
-/* Destroys AW. */
-static void
-case_writer_destroy (struct case_writer *aw)
-{
- if (aw != NULL)
- {
- any_writer_close (aw->writer);
- destroy_case_map (aw->map);
- case_destroy (&aw->bounce);
- free (aw);
- }
-}
-
-/* Parses SAVE or XSAVE or EXPORT or XEXPORT command.
- WRITER_TYPE identifies the type of file to write,
- and COMMAND_TYPE identifies the type of command.
-
- On success, returns a writer.
- For procedures only, sets *RETAIN_UNSELECTED to true if cases
- that would otherwise be excluded by FILTER or USE should be
- included.
-
- On failure, returns a null pointer. */
-static struct case_writer *
-parse_write_command (enum writer_type writer_type,
- enum command_type command_type,
- bool *retain_unselected)
-{
- /* Common data. */
- struct file_handle *handle; /* Output file. */
- struct dictionary *dict; /* Dictionary for output file. */
- struct case_writer *aw; /* Writer. */
-
- /* Common options. */
- bool print_map; /* Print map? TODO. */
- bool print_short_names; /* Print long-to-short name map. TODO. */
- struct sfm_write_options sysfile_opts;
- struct pfm_write_options porfile_opts;
-
- assert (writer_type == SYSFILE_WRITER || writer_type == PORFILE_WRITER);
- assert (command_type == XFORM_CMD || command_type == PROC_CMD);
- assert ((retain_unselected != NULL) == (command_type == PROC_CMD));
-
- if (command_type == PROC_CMD)
- *retain_unselected = true;
-
- handle = NULL;
- dict = dict_clone (default_dict);
- aw = xmalloc (sizeof *aw);
- aw->writer = NULL;
- aw->map = NULL;
- case_nullify (&aw->bounce);
- print_map = false;
- print_short_names = false;
- sysfile_opts = sfm_writer_default_options ();
- porfile_opts = pfm_writer_default_options ();
-
- start_case_map (dict);
- dict_delete_scratch_vars (dict);
-
- lex_match ('/');
- for (;;)
- {
- if (lex_match_id ("OUTFILE"))
- {
- if (handle != NULL)
- {
- lex_sbc_only_once ("OUTFILE");
- goto error;
- }
-
- lex_match ('=');
-
- handle = fh_parse (FH_REF_FILE | FH_REF_SCRATCH);
- if (handle == NULL)
- goto error;
- }
- else if (lex_match_id ("NAMES"))
- print_short_names = true;
- else if (lex_match_id ("PERMISSIONS"))
- {
- bool cw;
-
- lex_match ('=');
- if (lex_match_id ("READONLY"))
- cw = false;
- else if (lex_match_id ("WRITEABLE"))
- cw = true;
- else
- {
- lex_error (_("expecting %s or %s"), "READONLY", "WRITEABLE");
- goto error;
- }
- sysfile_opts.create_writeable = porfile_opts.create_writeable = cw;
- }
- else if (command_type == PROC_CMD && lex_match_id ("UNSELECTED"))
- {
- lex_match ('=');
- if (lex_match_id ("RETAIN"))
- *retain_unselected = true;
- else if (lex_match_id ("DELETE"))
- *retain_unselected = false;
- else
- {
- lex_error (_("expecting %s or %s"), "RETAIN", "DELETE");
- goto error;
- }
- }
- else if (writer_type == SYSFILE_WRITER && lex_match_id ("COMPRESSED"))
- sysfile_opts.compress = true;
- else if (writer_type == SYSFILE_WRITER && lex_match_id ("UNCOMPRESSED"))
- sysfile_opts.compress = false;
- else if (writer_type == SYSFILE_WRITER && lex_match_id ("VERSION"))
- {
- lex_match ('=');
- if (!lex_force_int ())
- goto error;
- sysfile_opts.version = lex_integer ();
- lex_get ();
- }
- else if (writer_type == PORFILE_WRITER && lex_match_id ("TYPE"))
- {
- lex_match ('=');
- if (lex_match_id ("COMMUNICATIONS"))
- porfile_opts.type = PFM_COMM;
- else if (lex_match_id ("TAPE"))
- porfile_opts.type = PFM_TAPE;
- else
- {
- lex_error (_("expecting %s or %s"), "COMM", "TAPE");
- goto error;
- }
- }
- else if (writer_type == PORFILE_WRITER && lex_match_id ("DIGITS"))
- {
- lex_match ('=');
- if (!lex_force_int ())
- goto error;
- porfile_opts.digits = lex_integer ();
- lex_get ();
- }
- else if (!parse_dict_trim (dict))
- goto error;
-
- if (!lex_match ('/'))
- break;
- }
- if (lex_end_of_command () != CMD_SUCCESS)
- goto error;
-
- if (handle == NULL)
- {
- lex_sbc_missing ("OUTFILE");
- goto error;
- }
-
- dict_compact_values (dict);
- aw->map = finish_case_map (dict);
- if (aw->map != NULL)
- case_create (&aw->bounce, dict_get_next_value_idx (dict));
-
- if (fh_get_referent (handle) == FH_REF_FILE)
- {
- switch (writer_type)
- {
- case SYSFILE_WRITER:
- aw->writer = any_writer_from_sfm_writer (
- sfm_open_writer (handle, dict, sysfile_opts));
- break;
- case PORFILE_WRITER:
- aw->writer = any_writer_from_pfm_writer (
- pfm_open_writer (handle, dict, porfile_opts));
- break;
- }
- }
- else
- aw->writer = any_writer_open (handle, dict);
- dict_destroy (dict);
-
- return aw;
-
- error:
- case_writer_destroy (aw);
- dict_destroy (dict);
- return NULL;
-}
-
-/* Writes case C to writer AW. */
-static void
-case_writer_write_case (struct case_writer *aw, struct ccase *c)
-{
- if (aw->map != NULL)
- {
- map_case (aw->map, c, &aw->bounce);
- c = &aw->bounce;
- }
- any_writer_write (aw->writer, c);
-}
-\f
-/* SAVE and EXPORT. */
-
-static int output_proc (struct ccase *, void *);
-
-/* Parses and performs the SAVE or EXPORT procedure. */
-static int
-parse_output_proc (enum writer_type writer_type)
-{
- bool retain_unselected;
- struct variable *saved_filter_variable;
- struct case_writer *aw;
-
- aw = parse_write_command (writer_type, PROC_CMD, &retain_unselected);
- if (aw == NULL)
- return CMD_FAILURE;
-
- saved_filter_variable = dict_get_filter (default_dict);
- if (retain_unselected)
- dict_set_filter (default_dict, NULL);
- procedure (output_proc, aw);
- dict_set_filter (default_dict, saved_filter_variable);
-
- case_writer_destroy (aw);
- return CMD_SUCCESS;
-}
-
-/* Writes case C to file. */
-static int
-output_proc (struct ccase *c, void *aw_)
-{
- struct case_writer *aw = aw_;
- case_writer_write_case (aw, c);
- return 0;
-}
-
-int
-cmd_save (void)
-{
- return parse_output_proc (SYSFILE_WRITER);
-}
-
-int
-cmd_export (void)
-{
- return parse_output_proc (PORFILE_WRITER);
-}
-\f
-/* XSAVE and XEXPORT. */
-
-/* Transformation. */
-struct output_trns
- {
- struct case_writer *aw; /* Writer. */
- };
-
-static trns_proc_func output_trns_proc;
-static trns_free_func output_trns_free;
-
-/* Parses the XSAVE or XEXPORT transformation command. */
-static int
-parse_output_trns (enum writer_type writer_type)
-{
- struct output_trns *t = xmalloc (sizeof *t);
- t->aw = parse_write_command (writer_type, XFORM_CMD, NULL);
- if (t->aw == NULL)
- {
- free (t);
- return CMD_FAILURE;
- }
-
- add_transformation (output_trns_proc, output_trns_free, t);
- return CMD_SUCCESS;
-}
-
-/* Writes case C to the system file specified on XSAVE or XEXPORT. */
-static int
-output_trns_proc (void *trns_, struct ccase *c, int case_num UNUSED)
-{
- struct output_trns *t = trns_;
- case_writer_write_case (t->aw, c);
- return -1;
-}
-
-/* Frees an XSAVE or XEXPORT transformation. */
-static void
-output_trns_free (void *trns_)
-{
- struct output_trns *t = trns_;
-
- if (t != NULL)
- {
- case_writer_destroy (t->aw);
- free (t);
- }
-}
-
-/* XSAVE command. */
-int
-cmd_xsave (void)
-{
- return parse_output_trns (SYSFILE_WRITER);
-}
-
-/* XEXPORT command. */
-int
-cmd_xexport (void)
-{
- return parse_output_trns (PORFILE_WRITER);
-}
-\f
-static bool rename_variables (struct dictionary *dict);
-static bool drop_variables (struct dictionary *dict);
-static bool keep_variables (struct dictionary *dict);
-
-/* Commands that read and write system files share a great deal
- of common syntactic structure for rearranging and dropping
- variables. This function parses this syntax and modifies DICT
- appropriately. Returns true on success, false on failure. */
-static bool
-parse_dict_trim (struct dictionary *dict)
-{
- if (lex_match_id ("MAP"))
- {
- /* FIXME. */
- return true;
- }
- else if (lex_match_id ("DROP"))
- return drop_variables (dict);
- else if (lex_match_id ("KEEP"))
- return keep_variables (dict);
- else if (lex_match_id ("RENAME"))
- return rename_variables (dict);
- else
- {
- lex_error (_("expecting a valid subcommand"));
- return false;
- }
-}
-
-/* Parses and performs the RENAME subcommand of GET and SAVE. */
-static bool
-rename_variables (struct dictionary *dict)
-{
- size_t i;
-
- int success = 0;
-
- struct variable **v;
- char **new_names;
- size_t nv, nn;
- char *err_name;
-
- int group;
-
- lex_match ('=');
- if (token != '(')
- {
- struct variable *v;
-
- v = parse_dict_variable (dict);
- if (v == NULL)
- return 0;
- if (!lex_force_match ('=')
- || !lex_force_id ())
- return 0;
- if (dict_lookup_var (dict, tokid) != NULL)
- {
- msg (SE, _("Cannot rename %s as %s because there already exists "
- "a variable named %s. To rename variables with "
- "overlapping names, use a single RENAME subcommand "
- "such as \"/RENAME (A=B)(B=C)(C=A)\", or equivalently, "
- "\"/RENAME (A B C=B C A)\"."), v->name, tokid, tokid);
- return 0;
- }
-
- dict_rename_var (dict, v, tokid);
- lex_get ();
- return 1;
- }
-
- nv = nn = 0;
- v = NULL;
- new_names = 0;
- group = 1;
- while (lex_match ('('))
- {
- size_t old_nv = nv;
-
- if (!parse_variables (dict, &v, &nv, PV_NO_DUPLICATE | PV_APPEND))
- goto done;
- if (!lex_match ('='))
- {
- msg (SE, _("`=' expected after variable list."));
- goto done;
- }
- if (!parse_DATA_LIST_vars (&new_names, &nn, PV_APPEND | PV_NO_SCRATCH))
- goto done;
- if (nn != nv)
- {
- msg (SE, _("Number of variables on left side of `=' (%d) does not "
- "match number of variables on right side (%d), in "
- "parenthesized group %d of RENAME subcommand."),
- (unsigned) (nv - old_nv), (unsigned) (nn - old_nv), group);
- goto done;
- }
- if (!lex_force_match (')'))
- goto done;
- group++;
- }
-
- if (!dict_rename_vars (dict, v, new_names, nv, &err_name))
- {
- msg (SE, _("Requested renaming duplicates variable name %s."), err_name);
- goto done;
- }
- success = 1;
-
- done:
- for (i = 0; i < nn; i++)
- free (new_names[i]);
- free (new_names);
- free (v);
-
- return success;
-}
-
-/* Parses and performs the DROP subcommand of GET and SAVE.
- Returns true if successful, false on failure.*/
-static bool
-drop_variables (struct dictionary *dict)
-{
- struct variable **v;
- size_t nv;
-
- lex_match ('=');
- if (!parse_variables (dict, &v, &nv, PV_NONE))
- return false;
- dict_delete_vars (dict, v, nv);
- free (v);
-
- if (dict_get_var_cnt (dict) == 0)
- {
- msg (SE, _("Cannot DROP all variables from dictionary."));
- return false;
- }
- return true;
-}
-
-/* Parses and performs the KEEP subcommand of GET and SAVE.
- Returns true if successful, false on failure.*/
-static bool
-keep_variables (struct dictionary *dict)
-{
- struct variable **v;
- size_t nv;
- size_t i;
-
- lex_match ('=');
- if (!parse_variables (dict, &v, &nv, PV_NONE))
- return false;
-
- /* Move the specified variables to the beginning. */
- dict_reorder_vars (dict, v, nv);
-
- /* Delete the remaining variables. */
- v = xnrealloc (v, dict_get_var_cnt (dict) - nv, sizeof *v);
- for (i = nv; i < dict_get_var_cnt (dict); i++)
- v[i - nv] = dict_get_var (dict, i);
- dict_delete_vars (dict, v, dict_get_var_cnt (dict) - nv);
- free (v);
-
- return true;
-}
-\f
-/* MATCH FILES. */
-
-#include "debug-print.h"
-
-/* File types. */
-enum
- {
- MTF_FILE, /* Specified on FILE= subcommand. */
- MTF_TABLE /* Specified on TABLE= subcommand. */
- };
-
-/* One of the files on MATCH FILES. */
-struct mtf_file
- {
- struct mtf_file *next, *prev; /* Next, previous in the list of files. */
- struct mtf_file *next_min; /* Next in the chain of minimums. */
-
- int type; /* One of MTF_*. */
- struct variable **by; /* List of BY variables for this file. */
- struct file_handle *handle; /* File handle. */
- struct any_reader *reader; /* File reader. */
- struct dictionary *dict; /* Dictionary from system file. */
-
- /* IN subcommand. */
- char *in_name; /* Variable name. */
- struct variable *in_var; /* Variable (in master dictionary). */
-
- struct ccase input; /* Input record. */
- };
-
-/* MATCH FILES procedure. */
-struct mtf_proc
- {
- struct mtf_file *head; /* First file mentioned on FILE or TABLE. */
- struct mtf_file *tail; /* Last file mentioned on FILE or TABLE. */
-
- size_t by_cnt; /* Number of variables on BY subcommand. */
-
- /* Names of FIRST, LAST variables. */
- char first[LONG_NAME_LEN + 1], last[LONG_NAME_LEN + 1];
-
- struct dictionary *dict; /* Dictionary of output file. */
- struct case_sink *sink; /* Sink to receive output. */
- struct ccase mtf_case; /* Case used for output. */
-
- unsigned seq_num; /* Have we initialized this variable? */
- unsigned *seq_nums; /* Sequence numbers for each var in dict. */
- };
-
-static void mtf_free (struct mtf_proc *);
-static void mtf_free_file (struct mtf_file *);
-static int mtf_merge_dictionary (struct dictionary *const, struct mtf_file *);
-static void mtf_delete_file_in_place (struct mtf_proc *, struct mtf_file **);
-
-static void mtf_read_nonactive_records (void *);
-static void mtf_processing_finish (void *);
-static int mtf_processing (struct ccase *, void *);
-
-static char *var_type_description (struct variable *);
-
-static void set_master (struct variable *, struct variable *master);
-static struct variable *get_master (struct variable *);
-
-/* Parse and execute the MATCH FILES command. */
-int
-cmd_match_files (void)
-{
- struct mtf_proc mtf;
- struct mtf_file *first_table = NULL;
- struct mtf_file *iter;
-
- bool used_active_file = false;
- bool saw_table = false;
- bool saw_in = false;
-
- mtf.head = mtf.tail = NULL;
- mtf.by_cnt = 0;
- mtf.first[0] = '\0';
- mtf.last[0] = '\0';
- mtf.dict = dict_create ();
- mtf.sink = NULL;
- case_nullify (&mtf.mtf_case);
- mtf.seq_num = 0;
- mtf.seq_nums = NULL;
- dict_set_case_limit (mtf.dict, dict_get_case_limit (default_dict));
-
- lex_match ('/');
- while (token == T_ID
- && (lex_id_match ("FILE", tokid) || lex_id_match ("TABLE", tokid)))
- {
- struct mtf_file *file = xmalloc (sizeof *file);
-
- if (lex_match_id ("FILE"))
- file->type = MTF_FILE;
- else if (lex_match_id ("TABLE"))
- {
- file->type = MTF_TABLE;
- saw_table = true;
- }
- else
- assert (0);
- lex_match ('=');
-
- file->by = NULL;
- file->handle = NULL;
- file->reader = NULL;
- file->dict = NULL;
- file->in_name = NULL;
- file->in_var = NULL;
- case_nullify (&file->input);
-
- /* FILEs go first, then TABLEs. */
- if (file->type == MTF_TABLE || first_table == NULL)
- {
- file->next = NULL;
- file->prev = mtf.tail;
- if (mtf.tail)
- mtf.tail->next = file;
- mtf.tail = file;
- if (mtf.head == NULL)
- mtf.head = file;
- if (file->type == MTF_TABLE && first_table == NULL)
- first_table = file;
- }
- else
- {
- assert (file->type == MTF_FILE);
- file->next = first_table;
- file->prev = first_table->prev;
- if (first_table->prev)
- first_table->prev->next = file;
- else
- mtf.head = file;
- first_table->prev = file;
- }
-
- if (lex_match ('*'))
- {
- file->handle = NULL;
- file->reader = NULL;
-
- if (used_active_file)
- {
- msg (SE, _("The active file may not be specified more "
- "than once."));
- goto error;
- }
- used_active_file = true;
-
- assert (pgm_state != STATE_INPUT);
- if (pgm_state == STATE_INIT)
- {
- msg (SE, _("Cannot specify the active file since no active "
- "file has been defined."));
- goto error;
- }
-
- if (temporary != 0)
- {
- msg (SE,
- _("MATCH FILES may not be used after TEMPORARY when "
- "the active file is an input source. "
- "Temporary transformations will be made permanent."));
- cancel_temporary ();
- }
-
- file->dict = default_dict;
- }
- else
- {
- file->handle = fh_parse (FH_REF_FILE | FH_REF_SCRATCH);
- if (file->handle == NULL)
- goto error;
-
- file->reader = any_reader_open (file->handle, &file->dict);
- if (file->reader == NULL)
- goto error;
-
- case_create (&file->input, dict_get_next_value_idx (file->dict));
- }
-
- while (lex_match ('/'))
- if (lex_match_id ("RENAME"))
- {
- if (!rename_variables (file->dict))
- goto error;
- }
- else if (lex_match_id ("IN"))
- {
- lex_match ('=');
- if (token != T_ID)
- {
- lex_error (NULL);
- goto error;
- }
-
- if (file->in_name != NULL)
- {
- msg (SE, _("Multiple IN subcommands for a single FILE or "
- "TABLE."));
- goto error;
- }
- file->in_name = xstrdup (tokid);
- lex_get ();
- saw_in = true;
- }
-
- mtf_merge_dictionary (mtf.dict, file);
- }
-
- while (token != '.')
- {
- if (lex_match (T_BY))
- {
- struct variable **by;
-
- if (mtf.by_cnt)
- {
- msg (SE, _("BY may appear at most once."));
- goto error;
- }
-
- lex_match ('=');
- if (!parse_variables (mtf.dict, &by, &mtf.by_cnt,
- PV_NO_DUPLICATE | PV_NO_SCRATCH))
- goto error;
-
- for (iter = mtf.head; iter != NULL; iter = iter->next)
- {
- size_t i;
-
- iter->by = xnmalloc (mtf.by_cnt, sizeof *iter->by);
-
- for (i = 0; i < mtf.by_cnt; i++)
- {
- iter->by[i] = dict_lookup_var (iter->dict, by[i]->name);
- if (iter->by[i] == NULL)
- {
- msg (SE, _("File %s lacks BY variable %s."),
- iter->handle ? fh_get_name (iter->handle) : "*",
- by[i]->name);
- free (by);
- goto error;
- }
- }
- }
- free (by);
- }
- else if (lex_match_id ("FIRST"))
- {
- if (mtf.first[0] != '\0')
- {
- msg (SE, _("FIRST may appear at most once."));
- goto error;
- }
-
- lex_match ('=');
- if (!lex_force_id ())
- goto error;
- strcpy (mtf.first, tokid);
- lex_get ();
- }
- else if (lex_match_id ("LAST"))
- {
- if (mtf.last[0] != '\0')
- {
- msg (SE, _("LAST may appear at most once."));
- goto error;
- }
-
- lex_match ('=');
- if (!lex_force_id ())
- goto error;
- strcpy (mtf.last, tokid);
- lex_get ();
- }
- else if (lex_match_id ("MAP"))
- {
- /* FIXME. */
- }
- else if (lex_match_id ("DROP"))
- {
- if (!drop_variables (mtf.dict))
- goto error;
- }
- else if (lex_match_id ("KEEP"))
- {
- if (!keep_variables (mtf.dict))
- goto error;
- }
- else
- {
- lex_error (NULL);
- goto error;
- }
-
- if (!lex_match ('/') && token != '.')
- {
- lex_end_of_command ();
- goto error;
- }
- }
-
- if (mtf.by_cnt == 0)
- {
- if (saw_table)
- {
- msg (SE, _("BY is required when TABLE is specified."));
- goto error;
- }
- if (saw_in)
- {
- msg (SE, _("BY is required when IN is specified."));
- goto error;
- }
- }
-
- /* Set up mapping from each file's variables to master
- variables. */
- for (iter = mtf.head; iter != NULL; iter = iter->next)
- {
- struct dictionary *d = iter->dict;
- int i;
-
- for (i = 0; i < dict_get_var_cnt (d); i++)
- {
- struct variable *v = dict_get_var (d, i);
- struct variable *mv = dict_lookup_var (mtf.dict, v->name);
- if (mv != NULL)
- set_master (v, mv);
- }
- }
-
- /* Add IN variables to master dictionary. */
- for (iter = mtf.head; iter != NULL; iter = iter->next)
- if (iter->in_name != NULL)
- {
- iter->in_var = dict_create_var (mtf.dict, iter->in_name, 0);
- if (iter->in_var == NULL)
- {
- msg (SE, _("IN variable name %s duplicates an "
- "existing variable name."),
- iter->in_var->name);
- goto error;
- }
- iter->in_var->print = iter->in_var->write
- = make_output_format (FMT_F, 1, 0);
- }
-
- /* MATCH FILES performs an n-way merge on all its input files.
- Abstract algorithm:
-
- 1. Read one input record from every input FILE.
-
- 2. If no FILEs are left, stop. Otherwise, proceed to step 3.
-
- 3. Find the FILE input record(s) that have minimum BY
- values. Store all the values from these input records into
- the output record.
-
- 4. For every TABLE, read another record as long as the BY values
- on the TABLE's input record are less than the FILEs' BY values.
- If an exact match is found, store all the values from the TABLE
- input record into the output record.
-
- 5. Write the output record.
-
- 6. Read another record from each input file FILE and TABLE that
- we stored values from above. If we come to the end of one of the
- input files, remove it from the list of input files.
-
- 7. Repeat from step 2.
-
- Unfortunately, this algorithm can't be implemented in a
- straightforward way because there's no function to read a
- record from the active file. Instead, it has to be written
- as a state machine.
-
- FIXME: For merging large numbers of files (more than 10?) a
- better algorithm would use a heap for finding minimum
- values. */
-
- if (!used_active_file)
- discard_variables ();
-
- dict_compact_values (mtf.dict);
- mtf.sink = create_case_sink (&storage_sink_class, mtf.dict, NULL);
- if (mtf.sink->class->open != NULL)
- mtf.sink->class->open (mtf.sink);
-
- mtf.seq_nums = xcalloc (dict_get_var_cnt (mtf.dict), sizeof *mtf.seq_nums);
- case_create (&mtf.mtf_case, dict_get_next_value_idx (mtf.dict));
-
- mtf_read_nonactive_records (&mtf);
- if (used_active_file)
- procedure (mtf_processing, &mtf);
- mtf_processing_finish (&mtf);
-
- free_case_source (vfm_source);
- vfm_source = NULL;
-
- dict_destroy (default_dict);
- default_dict = mtf.dict;
- mtf.dict = NULL;
- vfm_source = mtf.sink->class->make_source (mtf.sink);
- free_case_sink (mtf.sink);
-
- mtf_free (&mtf);
- return CMD_SUCCESS;
-
- error:
- mtf_free (&mtf);
- return CMD_FAILURE;
-}
-
-/* Repeats 2...7 an arbitrary number of times. */
-static void
-mtf_processing_finish (void *mtf_)
-{
- struct mtf_proc *mtf = mtf_;
- struct mtf_file *iter;
-
- /* Find the active file and delete it. */
- for (iter = mtf->head; iter; iter = iter->next)
- if (iter->handle == NULL)
- {
- mtf_delete_file_in_place (mtf, &iter);
- break;
- }
-
- while (mtf->head && mtf->head->type == MTF_FILE)
- if (!mtf_processing (NULL, mtf))
- break;
-}
-
-/* Return a string in a static buffer describing V's variable type and
- width. */
-static char *
-var_type_description (struct variable *v)
-{
- static char buf[2][32];
- static int x = 0;
- char *s;
-
- x ^= 1;
- s = buf[x];
-
- if (v->type == NUMERIC)
- strcpy (s, "numeric");
- else
- {
- assert (v->type == ALPHA);
- sprintf (s, "string with width %d", v->width);
- }
- return s;
-}
-
-/* Free FILE and associated data. */
-static void
-mtf_free_file (struct mtf_file *file)
-{
- free (file->by);
- any_reader_close (file->reader);
- if (file->dict != default_dict)
- dict_destroy (file->dict);
- case_destroy (&file->input);
- free (file->in_name);
- free (file);
-}
-
-/* Free all the data for the MATCH FILES procedure. */
-static void
-mtf_free (struct mtf_proc *mtf)
-{
- struct mtf_file *iter, *next;
-
- for (iter = mtf->head; iter; iter = next)
- {
- next = iter->next;
- mtf_free_file (iter);
- }
-
- if (mtf->dict)
- dict_destroy (mtf->dict);
- case_destroy (&mtf->mtf_case);
- free (mtf->seq_nums);
-}
-
-/* Remove *FILE from the mtf_file chain. Make *FILE point to the next
- file in the chain, or to NULL if was the last in the chain. */
-static void
-mtf_delete_file_in_place (struct mtf_proc *mtf, struct mtf_file **file)
-{
- struct mtf_file *f = *file;
- int i;
-
- if (f->prev)
- f->prev->next = f->next;
- if (f->next)
- f->next->prev = f->prev;
- if (f == mtf->head)
- mtf->head = f->next;
- if (f == mtf->tail)
- mtf->tail = f->prev;
- *file = f->next;
-
- if (f->in_var != NULL)
- case_data_rw (&mtf->mtf_case, f->in_var->fv)->f = 0.;
- for (i = 0; i < dict_get_var_cnt (f->dict); i++)
- {
- struct variable *v = dict_get_var (f->dict, i);
- struct variable *mv = get_master (v);
- if (mv != NULL)
- {
- union value *out = case_data_rw (&mtf->mtf_case, mv->fv);
-
- if (v->type == NUMERIC)
- out->f = SYSMIS;
- else
- memset (out->s, ' ', v->width);
- }
- }
-
- mtf_free_file (f);
-}
-
-/* Read a record from every input file except the active file. */
-static void
-mtf_read_nonactive_records (void *mtf_)
-{
- struct mtf_proc *mtf = mtf_;
- struct mtf_file *iter, *next;
-
- for (iter = mtf->head; iter != NULL; iter = next)
- {
- next = iter->next;
- if (iter->handle && !any_reader_read (iter->reader, &iter->input))
- mtf_delete_file_in_place (mtf, &iter);
- }
-}
-
-/* Compare the BY variables for files A and B; return -1 if A < B, 0
- if A == B, 1 if A > B. */
-static inline int
-mtf_compare_BY_values (struct mtf_proc *mtf,
- struct mtf_file *a, struct mtf_file *b,
- struct ccase *c)
-{
- struct ccase *ca = case_is_null (&a->input) ? c : &a->input;
- struct ccase *cb = case_is_null (&b->input) ? c : &b->input;
- assert ((a == NULL) + (b == NULL) + (c == NULL) <= 1);
- return case_compare_2dict (ca, cb, a->by, b->by, mtf->by_cnt);
-}
-
-/* Perform one iteration of steps 3...7 above. */
-static int
-mtf_processing (struct ccase *c, void *mtf_)
-{
- struct mtf_proc *mtf = mtf_;
-
- /* Do we need another record from the active file? */
- bool read_active_file;
-
- assert (mtf->head != NULL);
- if (mtf->head->type == MTF_TABLE)
- return 1;
-
- do
- {
- struct mtf_file *min_head, *min_tail; /* Files with minimum BY values. */
- struct mtf_file *max_head, *max_tail; /* Files with non-minimum BYs. */
- struct mtf_file *iter, *next;
-
- read_active_file = false;
-
- /* 3. Find the FILE input record(s) that have minimum BY
- values. Store all the values from these input records into
- the output record. */
- min_head = min_tail = mtf->head;
- max_head = max_tail = NULL;
- for (iter = mtf->head->next; iter && iter->type == MTF_FILE;
- iter = iter->next)
- {
- int cmp = mtf_compare_BY_values (mtf, min_head, iter, c);
- if (cmp < 0)
- {
- if (max_head)
- max_tail = max_tail->next_min = iter;
- else
- max_head = max_tail = iter;
- }
- else if (cmp == 0)
- min_tail = min_tail->next_min = iter;
- else /* cmp > 0 */
- {
- if (max_head)
- {
- max_tail->next_min = min_head;
- max_tail = min_tail;
- }
- else
- {
- max_head = min_head;
- max_tail = min_tail;
- }
- min_head = min_tail = iter;
- }
- }
-
- /* 4. For every TABLE, read another record as long as the BY
- values on the TABLE's input record are less than the FILEs'
- BY values. If an exact match is found, store all the values
- from the TABLE input record into the output record. */
- for (; iter != NULL; iter = next)
- {
- assert (iter->type == MTF_TABLE);
-
- next = iter->next;
- for (;;)
- {
- int cmp = mtf_compare_BY_values (mtf, min_head, iter, c);
- if (cmp < 0)
- {
- if (max_head)
- max_tail = max_tail->next_min = iter;
- else
- max_head = max_tail = iter;
- }
- else if (cmp == 0)
- min_tail = min_tail->next_min = iter;
- else /* cmp > 0 */
- {
- if (iter->handle == NULL)
- return 1;
- if (any_reader_read (iter->reader, &iter->input))
- continue;
- mtf_delete_file_in_place (mtf, &iter);
- }
- break;
- }
- }
-
- /* Next sequence number. */
- mtf->seq_num++;
-
- /* Store data to all the records we are using. */
- if (min_tail)
- min_tail->next_min = NULL;
- for (iter = min_head; iter; iter = iter->next_min)
- {
- int i;
-
- for (i = 0; i < dict_get_var_cnt (iter->dict); i++)
- {
- struct variable *v = dict_get_var (iter->dict, i);
- struct variable *mv = get_master (v);
-
- if (mv != NULL && mtf->seq_nums[mv->index] != mtf->seq_num)
- {
- struct ccase *record
- = case_is_null (&iter->input) ? c : &iter->input;
- union value *out = case_data_rw (&mtf->mtf_case, mv->fv);
-
- mtf->seq_nums[mv->index] = mtf->seq_num;
- if (v->type == NUMERIC)
- out->f = case_num (record, v->fv);
- else
- memcpy (out->s, case_str (record, v->fv), v->width);
- }
- }
- if (iter->in_var != NULL)
- case_data_rw (&mtf->mtf_case, iter->in_var->fv)->f = 1.;
-
- if (iter->type == MTF_FILE && iter->handle == NULL)
- read_active_file = true;
- }
-
- /* Store missing values to all the records we're not
- using. */
- if (max_tail)
- max_tail->next_min = NULL;
- for (iter = max_head; iter; iter = iter->next_min)
- {
- int i;
-
- for (i = 0; i < dict_get_var_cnt (iter->dict); i++)
- {
- struct variable *v = dict_get_var (iter->dict, i);
- struct variable *mv = get_master (v);
-
- if (mv != NULL && mtf->seq_nums[mv->index] != mtf->seq_num)
- {
- union value *out = case_data_rw (&mtf->mtf_case, mv->fv);
- mtf->seq_nums[mv->index] = mtf->seq_num;
-
- if (v->type == NUMERIC)
- out->f = SYSMIS;
- else
- memset (out->s, ' ', v->width);
- }
- }
- if (iter->in_var != NULL)
- case_data_rw (&mtf->mtf_case, iter->in_var->fv)->f = 0.;
- }
-
- /* 5. Write the output record. */
- mtf->sink->class->write (mtf->sink, &mtf->mtf_case);
-
- /* 6. Read another record from each input file FILE and TABLE
- that we stored values from above. If we come to the end of
- one of the input files, remove it from the list of input
- files. */
- for (iter = min_head; iter && iter->type == MTF_FILE; iter = next)
- {
- next = iter->next_min;
- if (iter->reader != NULL
- && !any_reader_read (iter->reader, &iter->input))
- mtf_delete_file_in_place (mtf, &iter);
- }
- }
- while (!read_active_file
- && mtf->head != NULL && mtf->head->type == MTF_FILE);
-
- return mtf->head != NULL && mtf->head->type == MTF_FILE;
-}
-
-/* Merge the dictionary for file F into master dictionary M. */
-static int
-mtf_merge_dictionary (struct dictionary *const m, struct mtf_file *f)
-{
- struct dictionary *d = f->dict;
- const char *d_docs, *m_docs;
- int i;
-
- if (dict_get_label (m) == NULL)
- dict_set_label (m, dict_get_label (d));
-
- d_docs = dict_get_documents (d);
- m_docs = dict_get_documents (m);
- if (d_docs != NULL)
- {
- if (m_docs == NULL)
- dict_set_documents (m, d_docs);
- else
- {
- char *new_docs;
- size_t new_len;
-
- new_len = strlen (m_docs) + strlen (d_docs);
- new_docs = xmalloc (new_len + 1);
- strcpy (new_docs, m_docs);
- strcat (new_docs, d_docs);
- dict_set_documents (m, new_docs);
- free (new_docs);
- }
- }
-
- for (i = 0; i < dict_get_var_cnt (d); i++)
- {
- struct variable *dv = dict_get_var (d, i);
- struct variable *mv = dict_lookup_var (m, dv->name);
-
- if (dict_class_from_id (dv->name) == DC_SCRATCH)
- continue;
-
- if (mv != NULL)
- {
- if (mv->width != dv->width)
- {
- msg (SE, _("Variable %s in file %s (%s) has different "
- "type or width from the same variable in "
- "earlier file (%s)."),
- dv->name, fh_get_name (f->handle),
- var_type_description (dv), var_type_description (mv));
- return 0;
- }
-
- if (dv->width == mv->width)
- {
- if (val_labs_count (dv->val_labs)
- && !val_labs_count (mv->val_labs))
- mv->val_labs = val_labs_copy (dv->val_labs);
- if (!mv_is_empty (&dv->miss) && mv_is_empty (&mv->miss))
- mv_copy (&mv->miss, &dv->miss);
- }
-
- if (dv->label && !mv->label)
- mv->label = xstrdup (dv->label);
- }
- else
- mv = dict_clone_var_assert (m, dv, dv->name);
- }
-
- return 1;
-}
-
-/* Marks V's master variable as MASTER. */
-static void
-set_master (struct variable *v, struct variable *master)
-{
- var_attach_aux (v, master, NULL);
-}
-
-/* Returns the master variable corresponding to V,
- as set with set_master(). */
-static struct variable *
-get_master (struct variable *v)
-{
- return v->aux;
-}
-\f
-
-\f
-/* Case map.
-
- A case map copies data from a case that corresponds for one
- dictionary to a case that corresponds to a second dictionary
- derived from the first by, optionally, deleting, reordering,
- or renaming variables. (No new variables may be created.)
- */
-
-/* A case map. */
-struct case_map
- {
- size_t value_cnt; /* Number of values in map. */
- int *map; /* For each destination index, the
- corresponding source index. */
- };
-
-/* Prepares dictionary D for producing a case map. Afterward,
- the caller may delete, reorder, or rename variables within D
- at will before using finish_case_map() to produce the case
- map.
-
- Uses D's aux members, which must otherwise not be in use. */
-static void
-start_case_map (struct dictionary *d)
-{
- size_t var_cnt = dict_get_var_cnt (d);
- size_t i;
-
- for (i = 0; i < var_cnt; i++)
- {
- struct variable *v = dict_get_var (d, i);
- int *src_fv = xmalloc (sizeof *src_fv);
- *src_fv = v->fv;
- var_attach_aux (v, src_fv, var_dtor_free);
- }
-}
-
-/* Produces a case map from dictionary D, which must have been
- previously prepared with start_case_map().
-
- Does not retain any reference to D, and clears the aux members
- set up by start_case_map().
-
- Returns the new case map, or a null pointer if no mapping is
- required (that is, no data has changed position). */
-static struct case_map *
-finish_case_map (struct dictionary *d)
-{
- struct case_map *map;
- size_t var_cnt = dict_get_var_cnt (d);
- size_t i;
- int identity_map;
-
- map = xmalloc (sizeof *map);
- map->value_cnt = dict_get_next_value_idx (d);
- map->map = xnmalloc (map->value_cnt, sizeof *map->map);
- for (i = 0; i < map->value_cnt; i++)
- map->map[i] = -1;
-
- identity_map = 1;
- for (i = 0; i < var_cnt; i++)
- {
- struct variable *v = dict_get_var (d, i);
- int *src_fv = (int *) var_detach_aux (v);
- size_t idx;
-
- if (v->fv != *src_fv)
- identity_map = 0;
-
- for (idx = 0; idx < v->nv; idx++)
- {
- int src_idx = *src_fv + idx;
- int dst_idx = v->fv + idx;
-
- assert (map->map[dst_idx] == -1);
- map->map[dst_idx] = src_idx;
- }
- free (src_fv);
- }
-
- if (identity_map)
- {
- destroy_case_map (map);
- return NULL;
- }
-
- while (map->value_cnt > 0 && map->map[map->value_cnt - 1] == -1)
- map->value_cnt--;
-
- return map;
-}
-
-/* Maps from SRC to DST, applying case map MAP. */
-static void
-map_case (const struct case_map *map,
- const struct ccase *src, struct ccase *dst)
-{
- size_t dst_idx;
-
- assert (map != NULL);
- assert (src != NULL);
- assert (dst != NULL);
- assert (src != dst);
-
- for (dst_idx = 0; dst_idx < map->value_cnt; dst_idx++)
- {
- int src_idx = map->map[dst_idx];
- if (src_idx != -1)
- *case_data_rw (dst, dst_idx) = *case_data (src, src_idx);
- }
-}
-
-/* Destroys case map MAP. */
-static void
-destroy_case_map (struct case_map *map)
-{
- if (map != NULL)
- {
- free (map->map);
- free (map);
- }
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "getl.h"
-#include "error.h"
-#include <stdio.h>
-#include <errno.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "command.h"
-#include "error.h"
-#include "filename.h"
-#include "lexer.h"
-#include "repeat.h"
-#include "settings.h"
-#include "str.h"
-#include "tab.h"
-#include "var.h"
-#include "version.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-static struct string getl_include_path;
-
-/* Number of levels of DO REPEAT structures we're nested inside. If
- this is greater than zero then DO REPEAT macro substitutions are
- performed. */
-static int DO_REPEAT_level;
-
-struct string getl_buf;
-
-
-/* Initialize getl. */
-void
-getl_initialize (void)
-{
- ds_create (&getl_include_path,
- fn_getenv_default ("STAT_INCLUDE_PATH", include_path));
- ds_init (&getl_buf, 256);
-}
-
-
-
-struct getl_script *getl_head;
-struct getl_script *getl_tail;
-
-
-/* Returns a string that represents the directory that the syntax file
- currently being read resides in. If there is no syntax file then
- returns the OS current working directory. Return value must be
- free()'d. */
-char *
-getl_get_current_directory (void)
-{
- return getl_head ? fn_dirname (getl_head->fn) : fn_get_cwd ();
-}
-
-/* Delete everything from the include path. */
-void
-getl_clear_include_path (void)
-{
- ds_clear (&getl_include_path);
-}
-
-/* Add to the include path. */
-void
-getl_add_include_dir (const char *path)
-{
- if (ds_length (&getl_include_path))
- ds_putc (&getl_include_path, PATH_DELIMITER);
-
- ds_puts (&getl_include_path, path);
-}
-
-/* Adds FN to the tail end of the list of script files to execute.
- OPTIONS is the value to stick in the options field of the
- getl_script struct. If WHERE is zero then the file is added after
- all other files; otherwise it is added before all other files (this
- can be done only if parsing has not yet begun). */
-void
-getl_add_file (const char *fn, int separate, int where)
-{
- struct getl_script *n = xmalloc (sizeof *n);
-
- assert (fn != NULL);
- n->next = NULL;
- if (getl_tail == NULL)
- getl_head = getl_tail = n;
- else if (!where)
- getl_tail = getl_tail->next = n;
- else
- {
- assert (getl_head->f == NULL);
- n->next = getl_head;
- getl_head = n;
- }
- n->included_from = n->includes = NULL;
- n->fn = xstrdup (fn);
- n->ln = 0;
- n->f = NULL;
- n->separate = separate;
- n->first_line = NULL;
-}
-
-/* Inserts the given file with filename FN into the current file after
- the current line. */
-void
-getl_include (const char *fn)
-{
- struct getl_script *n;
- char *real_fn;
-
- {
- char *cur_dir = getl_get_current_directory ();
- real_fn = fn_search_path (fn, ds_c_str (&getl_include_path), cur_dir);
- free (cur_dir);
- }
-
- if (!real_fn)
- {
- msg (SE, _("Can't find `%s' in include file search path."), fn);
- return;
- }
-
- if (!getl_head)
- {
- getl_add_file (real_fn, 0, 0);
- free (real_fn);
- }
- else
- {
- n = xmalloc (sizeof *n);
- n->included_from = getl_head;
- getl_head = getl_head->includes = n;
- n->includes = NULL;
- n->next = NULL;
- n->fn = real_fn;
- n->ln = 0;
- n->f = NULL;
- n->separate = 0;
- n->first_line = NULL;
- }
-}
-
-/* Add the virtual file FILE to the list of files to be processed.
- The first_line field in FILE must already have been initialized. */
-void
-getl_add_virtual_file (struct getl_script *file)
-{
- if (getl_tail == NULL)
- getl_head = getl_tail = file;
- else
- getl_tail = getl_tail->next = file;
- file->included_from = file->includes = NULL;
- file->next = NULL;
- file->fn = file->first_line->line;
- file->ln = -file->first_line->len - 1;
- file->separate = 0;
- file->f = NULL;
- file->cur_line = NULL;
- file->remaining_loops = 1;
- file->loop_index = -1;
- file->macros = NULL;
-}
-
-/* Causes the DO REPEAT virtual file passed in FILE to be included in
- the current file. The first_line, cur_line, remaining_loops,
- loop_index, and macros fields in FILE must already have been
- initialized. */
-void
-getl_add_DO_REPEAT_file (struct getl_script *file)
-{
- assert (getl_head);
-
- DO_REPEAT_level++;
- file->included_from = getl_head;
- getl_head = getl_head->includes = file;
- file->includes = NULL;
- file->next = NULL;
- assert (file->first_line->len < 0);
- file->fn = file->first_line->line;
- file->ln = -file->first_line->len - 1;
- file->separate = 0;
- file->f = NULL;
-}
-
-/* Reads a single line from the line buffer associated with getl_head.
- Returns 1 if a line was successfully read or 0 if no more lines are
- available. */
-int
-getl_handle_line_buffer (void)
-{
- struct getl_script *s = getl_head;
-
- /* Check that we're not all done. */
- do
- {
- if (s->cur_line == NULL)
- {
- s->loop_index++;
- if (s->remaining_loops-- == 0)
- return 0;
- s->cur_line = s->first_line;
- }
-
- if (s->cur_line->len < 0)
- {
- s->ln = -s->cur_line->len - 1;
- s->fn = s->cur_line->line;
- s->cur_line = s->cur_line->next;
- continue;
- }
- }
- while (s->cur_line == NULL);
-
- ds_concat (&getl_buf, s->cur_line->line, s->cur_line->len);
-
- /* Advance pointers. */
- s->cur_line = s->cur_line->next;
- s->ln++;
-
- return 1;
-}
-
-/* Closes the current file, whether it be a main file or included
- file, then moves getl_head to the next file in the chain. */
-void
-getl_close_file (void)
-{
- struct getl_script *s = getl_head;
-
- if (!s)
- return;
- assert (getl_tail != NULL);
-
- if (s->first_line)
- {
- struct getl_line_list *cur, *next;
-
- s->fn = NULL; /* It will be freed below. */
- for (cur = s->first_line; cur; cur = next)
- {
- next = cur->next;
- free (cur->line);
- free (cur);
- }
-
- DO_REPEAT_level--;
- }
-
- if (s->f && EOF == fn_close (s->fn, s->f))
- msg (MW, _("Closing `%s': %s."), s->fn, strerror (errno));
- free (s->fn);
-
- if (s->included_from)
- {
- getl_head = s->included_from;
- getl_head->includes = NULL;
- }
- else
- {
- getl_head = s->next;
- if (NULL == getl_head)
- getl_tail = NULL;
- }
-
- free (s);
-}
-
-/* Closes all files. */
-void
-getl_close_all (void)
-{
- while (getl_head)
- getl_close_file ();
-}
-
-bool
-getl_is_separate(void)
-{
- return (getl_head && getl_head->separate);
-}
-
-void
-getl_set_separate(bool sep)
-{
- assert (getl_head);
-
- getl_head->separate = sep ;
-}
-
-
-/* Puts the current file and line number in *FN and *LN, respectively,
- or NULL and -1 if none. */
-void
-getl_location (const char **fn, int *ln)
-{
- if (fn != NULL)
- *fn = getl_head ? getl_head->fn : NULL;
- if (ln != NULL)
- *ln = getl_head ? getl_head->ln : -1;
-}
-
-bool
-getl_reading_script (void)
-{
- return (getl_head != NULL);
-}
-
-/* File locator stack. */
-static const struct file_locator **file_loc;
-static int nfile_loc, mfile_loc;
-\f
-/* Close getl. */
-void
-getl_uninitialize (void)
-{
- getl_close_all();
- ds_destroy (&getl_buf);
- ds_destroy (&getl_include_path);
- free(file_loc);
- file_loc = NULL;
- nfile_loc = mfile_loc = 0;
-}
-
-
-/* File locator stack functions. */
-
-/* Pushes F onto the stack of file locations. */
-void
-err_push_file_locator (const struct file_locator *f)
-{
- if (nfile_loc >= mfile_loc)
- {
- if (mfile_loc == 0)
- mfile_loc = 8;
- else
- mfile_loc *= 2;
-
- file_loc = xnrealloc (file_loc, mfile_loc, sizeof *file_loc);
- }
-
- file_loc[nfile_loc++] = f;
-}
-
-/* Pops F off the stack of file locations.
- Argument F is only used for verification that that is actually the
- item on top of the stack. */
-void
-err_pop_file_locator (const struct file_locator *f)
-{
- assert (nfile_loc >= 0 && file_loc[nfile_loc - 1] == f);
- nfile_loc--;
-}
-
-/* Puts the current file and line number in F, or NULL and -1 if
- none. */
-void
-err_location (struct file_locator *f)
-{
- if (nfile_loc)
- *f = *file_loc[nfile_loc - 1];
- else
- getl_location (&f->filename, &f->line_number);
-}
-
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !getl_h
-#define getl_h 1
-
-#include <stdbool.h>
-#include <stdio.h>
-
-/* Defines a list of lines used by DO REPEAT. */
-/* Special case: if LEN is negative then it is a line number; in this
- case LINE is a file name. This is used to allow errors to be
- reported for the correct file and line number when DO REPEAT spans
- files. */
-struct getl_line_list
- {
- char *line; /* Line contents. */
- int len; /* Line length. */
- struct getl_line_list *next; /* Next line. */
- };
-
-/* Source file. */
-struct getl_script
- {
- struct getl_script *included_from; /* File that this is nested inside. */
- struct getl_script *includes; /* File nested inside this file. */
- struct getl_script *next; /* Next file in list. */
- char *fn; /* Filename. */
- int ln; /* Line number. */
- int separate; /* !=0 means this is a separate job. */
- FILE *f; /* File handle. */
-
- /* Used only if F is NULL. Used for DO REPEAT. */
- struct getl_line_list *first_line; /* First line in line buffer. */
- struct getl_line_list *cur_line; /* Current line in line buffer. */
- int remaining_loops; /* Number of remaining loops through LINES. */
- int loop_index; /* Number of loops through LINES so far. */
- void *macros; /* Pointer to macro table. */
- int print; /* 1=Print lines as executed. */
- };
-
-/* List of script files. */
-extern struct getl_script *getl_head; /* Current file. */
-extern struct getl_script *getl_tail; /* End of list. */
-
-/* If getl_head==0 and getl_interactive!=0, lines will be read from
- the console rather than terminating. */
-extern int getl_interactive;
-
-/* 1=the welcome message has been printed. */
-extern int getl_welcomed;
-
-/* Prompt styles. */
-enum
- {
- GETL_PRPT_STANDARD, /* Just asks for a command. */
- GETL_PRPT_CONTINUATION, /* Continuation lines for a single command. */
- GETL_PRPT_DATA /* Between BEGIN DATA and END DATA. */
- };
-
-/* Current mode. */
-enum
- {
- GETL_MODE_BATCH, /* Batch mode. */
- GETL_MODE_INTERACTIVE /* Interactive mode. */
- };
-
-/* One of GETL_MODE_*, representing the current mode. */
-extern int getl_mode;
-
-/* Current prompting style: one of GETL_PRPT_*. */
-extern int getl_prompt;
-
-/* Are we reading a script? Are we interactive? */
-#define getl_am_interactive (getl_head == NULL)
-
-bool getl_reading_script (void);
-
-/* Current line. This line may be modified by modules other than
- getl.c, and by lexer.c in particular. */
-extern struct string getl_buf;
-
-/* Name of the command history file. */
-#if HAVE_LIBREADLINE && HAVE_LIBHISTORY
-extern char *getl_history;
-#endif
-
-void getl_initialize (void);
-void getl_uninitialize (void);
-void getl_clear_include_path (void);
-char *getl_get_current_directory (void);
-void getl_add_include_dir (const char *);
-void getl_add_file (const char *fn, int separate, int where);
-void getl_include (const char *fn);
-int getl_read_line (void);
-void getl_close_file (void);
-void getl_close_all (void);
-int getl_perform_delayed_reset (void);
-void getl_add_DO_REPEAT_file (struct getl_script *);
-void getl_add_virtual_file (struct getl_script *);
-void getl_location (const char **, int *);
-int getl_handle_line_buffer (void);
-
-bool getl_is_separate(void);
-
-void getl_set_separate(bool sep);
-
-
-#endif /* getl_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "glob.h"
-#include <time.h>
-#include "str.h"
-#include "strftime.h"
-
-/* var.h */
-struct dictionary *default_dict;
-struct expression *process_if_expr;
-
-struct transformation *t_trns;
-size_t n_trns, m_trns, f_trns;
-
-int FILTER_before_TEMPORARY;
-\f
-/* Functions. */
-
-static void
-get_cur_date (char cur_date[12])
-{
- time_t now = time (NULL);
-
- if (now != (time_t) -1)
- {
- struct tm *tm = localtime (&now);
- if (tm != NULL)
- {
- strftime (cur_date, 12, "%d %b %Y", tm);
- return;
- }
- }
- strcpy (cur_date, "?? ??? 2???");
-}
-
-const char *
-get_start_date (void)
-{
- static char start_date[12];
-
- if (start_date[0] == '\0')
- get_cur_date (start_date);
- return start_date;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !GLOB_H
-#define GLOB_H 1
-
-const char *get_start_date (void);
-
-#endif /* glob.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "font.h"
-#include "error.h"
-#include <stdio.h>
-#include <errno.h>
-#include <stdlib.h>
-#include <limits.h>
-#include <stdarg.h>
-#include "alloc.h"
-#include "error.h"
-#include "filename.h"
-#include "getline.h"
-#include "hash.h"
-#include "pool.h"
-#include "str.h"
-#include "version.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-int font_number_to_index (int);
-
-int space_index;
-
-static int font_msg (int, const char *,...)
- PRINTF_FORMAT (2, 3);
-static void scan_badchars (char *, int);
-static void dup_char_metric (struct font_desc * font, int dest, int src);
-static void add_char_metric (struct font_desc * font, struct char_metrics *metrics,
- int code);
-static void add_kern (struct font_desc * font, int ch1, int ch2, int adjust);
-
-/* Typical whitespace characters for tokenizing. */
-static const char whitespace[] = " \t\n\r\v";
-
-/* Some notes on the groff_font manpage:
-
- DESC file format: A typical PostScript `res' would be 72000, with
- `hor' and `vert' set to 1 to indicate that all those positions are
- valid. `sizescale' of 1000 would indicate that a scaled point is
- 1/1000 of a point (which is 1/72000 of an inch, the same as the
- number of machine units per inch indicated on `res'). `unitwidth'
- of 1000 would indicate that font files are set up for fonts with
- point size of 1000 scaled points, which would equal 1/72 inch or 1
- point (this would tell Groff's postprocessor that it needs to scale
- the font 12 times larger to get a 12-point font). */
-
-/* Reads a Groff font description file and converts it to a usable
- binary format in memory. Installs the binary format in the global
- font table. See groff_font for a description of the font
- description format supported. Returns nonzero on success. */
-struct font_desc *
-groff_read_font (const char *fn)
-{
- struct char_metrics *metrics;
-
- /* Pool created for font, font being created, font file. */
- struct pool *font_pool = NULL;
- struct font_desc *font = NULL;
- FILE *f = NULL;
-
- /* Current line, size of line buffer, length of line. */
- char *line = NULL;
- size_t size;
- int len;
-
- /* Tokenization saved pointer. */
- char *sp;
-
- /* First token on line. */
- char *key;
-
- /* 0=kernpairs section, 1=charset section. */
- int charset = 0;
-
- /* Index for previous line. */
- int prev_index = -1;
-
- /* Current location in file, used for error reporting. */
- struct file_locator where;
-
-#ifdef unix
- fn = fn_tilde_expand (fn);
-#endif
-
- msg (VM (1), _("%s: Opening Groff font file..."), fn);
-
- where.filename = fn;
- where.line_number = 1;
- err_push_file_locator (&where);
-
- f = fopen (fn, "r");
- if (!f)
- goto file_lossage;
-
- font_pool = pool_create ();
- font = pool_alloc (font_pool, sizeof *font);
- font->owner = font_pool;
- font->name = NULL;
- font->internal_name = NULL;
- font->encoding = NULL;
- font->space_width = 0;
- font->slant = 0.0;
- font->ligatures = 0;
- font->special = 0;
- font->deref = NULL;
- font->deref_size = 0;
- font->metric = NULL;
- font->metric_size = 0;
- font->metric_used = 0;
- font->kern = NULL;
- font->kern_size = 8;
- font->kern_used = 0;
- font->kern_max_used = 0;
-
- /* Parses first section of font file. */
- for (;;)
- {
- /* Location of '#' in line. */
- char *p;
-
- len = getline (&line, &size, f);
- if (len == -1)
- break;
-
- scan_badchars (line, len);
- p = strchr (line, '#');
- if (p)
- *p = '\0'; /* Reject comments. */
-
- key = strtok_r (line, whitespace, &sp);
- if (!key)
- goto next_iteration;
-
- if (!strcmp (key, "internalname"))
- {
- font->internal_name = strtok_r (NULL, whitespace, &sp);
- if (font->internal_name == NULL)
- {
- font_msg (SE, _("Missing font name."));
- goto lose;
- }
- font->internal_name = pool_strdup (font_pool, font->internal_name);
- }
- else if (!strcmp (key, "encoding"))
- {
- font->encoding = strtok_r (NULL, whitespace, &sp);
- if (font->encoding == NULL)
- {
- font_msg (SE, _("Missing encoding filename."));
- goto lose;
- }
- font->encoding = pool_strdup (font_pool, font->encoding);
- }
- else if (!strcmp (key, "spacewidth"))
- {
- char *n = strtok_r (NULL, whitespace, &sp);
- char *tail;
- if (n)
- font->space_width = strtol (n, &tail, 10);
- if (n == NULL || tail == n)
- {
- font_msg (SE, _("Bad spacewidth value."));
- goto lose;
- }
- }
- else if (!strcmp (key, "slant"))
- {
- char *n = strtok_r (NULL, whitespace, &sp);
- char *tail;
- if (n)
- font->slant = strtod (n, &tail);
- if (n == NULL || tail == n)
- {
- font_msg (SE, _("Bad slant value."));
- goto lose;
- }
- }
- else if (!strcmp (key, "ligatures"))
- {
- char *lig;
-
- for (;;)
- {
- lig = strtok_r (NULL, whitespace, &sp);
- if (!lig || !strcmp (lig, "0"))
- break;
- else if (!strcmp (lig, "ff"))
- font->ligatures |= LIG_ff;
- else if (!strcmp (lig, "ffi"))
- font->ligatures |= LIG_ffi;
- else if (!strcmp (lig, "ffl"))
- font->ligatures |= LIG_ffl;
- else if (!strcmp (lig, "fi"))
- font->ligatures |= LIG_fi;
- else if (!strcmp (lig, "fl"))
- font->ligatures |= LIG_fl;
- else
- {
- font_msg (SE, _("Unknown ligature `%s'."), lig);
- goto lose;
- }
- }
- }
- else if (!strcmp (key, "special"))
- font->special = 1;
- else if (!strcmp (key, "charset") || !strcmp (key, "kernpairs"))
- break;
-
- where.line_number++;
- }
- if (ferror (f))
- goto file_lossage;
-
- /* Parses second section of font file (metrics & kerning data). */
- do
- {
- key = strtok_r (line, whitespace, &sp);
- if (!key)
- goto next_iteration;
-
- if (!strcmp (key, "charset"))
- charset = 1;
- else if (!strcmp (key, "kernpairs"))
- charset = 0;
- else if (charset)
- {
- struct char_metrics *metrics = pool_alloc (font_pool,
- sizeof *metrics);
- char *m, *type, *code, *tail;
-
- m = strtok_r (NULL, whitespace, &sp);
- if (!m)
- {
- font_msg (SE, _("Unexpected end of line reading character "
- "set."));
- goto lose;
- }
- if (!strcmp (m, "\""))
- {
- if (!prev_index)
- {
- font_msg (SE, _("Can't use ditto mark for first character."));
- goto lose;
- }
- if (!strcmp (key, "---"))
- {
- font_msg (SE, _("Can't ditto into an unnamed character."));
- goto lose;
- }
- dup_char_metric (font, font_char_name_to_index (key), prev_index);
- where.line_number++;
- goto next_iteration;
- }
-
- if (m)
- {
- metrics->code = metrics->width
- = metrics->height = metrics->depth = 0;
- }
-
- if (m == NULL || 1 > sscanf (m, "%d,%d,%d", &metrics->width,
- &metrics->height, &metrics->depth))
- {
- font_msg (SE, _("Missing metrics for character `%s'."), key);
- goto lose;
- }
-
- type = strtok_r (NULL, whitespace, &sp);
- if (type)
- metrics->type = strtol (type, &tail, 10);
- if (!type || tail == type)
- {
- font_msg (SE, _("Missing type for character `%s'."), key);
- goto lose;
- }
-
- code = strtok_r (NULL, whitespace, &sp);
- if (code)
- metrics->code = strtol (code, &tail, 0);
- if (tail == code)
- {
- font_msg (SE, _("Missing code for character `%s'."), key);
- goto lose;
- }
-
- if (strcmp (key, "---"))
- prev_index = font_char_name_to_index (key);
- else
- prev_index = font_number_to_index (metrics->code);
- add_char_metric (font, metrics, prev_index);
- }
- else
- {
- char *c1 = key;
- char *c2 = strtok_r (NULL, whitespace, &sp);
- char *n, *tail;
- int adjust;
-
- if (c2 == NULL)
- {
- font_msg (SE, _("Malformed kernpair."));
- goto lose;
- }
-
- n = strtok_r (NULL, whitespace, &sp);
- if (!n)
- {
- font_msg (SE, _("Unexpected end of line reading kernpairs."));
- goto lose;
- }
- adjust = strtol (n, &tail, 10);
- if (tail == n || *tail)
- {
- font_msg (SE, _("Bad kern value."));
- goto lose;
- }
- add_kern (font, font_char_name_to_index (c1),
- font_char_name_to_index (c2), adjust);
- }
-
- next_iteration:
- where.line_number++;
-
- len = getline (&line, &size, f);
- }
- while (len != -1);
-
- if (ferror (f))
- goto file_lossage;
- if (fclose (f) == EOF)
- {
- f = NULL;
- goto file_lossage;
- }
- free (line);
-#ifdef unix
- free ((char *) fn);
-#endif
-
- /* Get font ascent and descent. */
- metrics = font_get_char_metrics (font, font_char_name_to_index ("d"));
- font->ascent = metrics ? metrics->height : 0;
- metrics = font_get_char_metrics (font, font_char_name_to_index ("p"));
- font->descent = metrics ? metrics->depth : 0;
-
- msg (VM (2), _("Font read successfully with internal name %s."),
- font->internal_name == NULL ? "<none>" : font->internal_name);
-
- err_pop_file_locator (&where);
-
- return font;
-
- /* Come here on a file error. */
-file_lossage:
- msg (ME, "%s: %s", fn, strerror (errno));
-
- /* Come here on any error. */
-lose:
- if (f != NULL)
- fclose (f);
- pool_destroy (font_pool);
-#ifdef unix
- free ((char *) fn);
-#endif
- err_pop_file_locator (&where);
-
- msg (VM (1), _("Error reading font."));
- return NULL;
-}
-
-/* Prints a font error on stderr. */
-static int
-font_msg (int class, const char *format,...)
-{
- struct error error;
- va_list args;
-
- error.class = class;
- err_location (&error.where);
- error.title = _("installation error: Groff font error: ");
-
- va_start (args, format);
- err_vmsg (&error, format, args);
- va_end (args);
-
- return 0;
-}
-
-/* Scans string LINE of length LEN (not incl. null terminator) for bad
- characters, converts to spaces; reports warnings on file FN. */
-static void
-scan_badchars (char *line, int len)
-{
- char *cp = line;
-
- /* Same bad characters as Groff. */
- static unsigned char badchars[32] =
- {
- 0x01, 0xe8, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0xff, 0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- };
-
- for (; len--; cp++)
- {
- int c = (unsigned char) *cp;
- if (badchars[c >> 3] & (1 << (c & 7)))
- {
- font_msg (SE, _("Bad character \\%3o."), *cp);
- *cp = ' ';
- }
- }
-}
-\f
-/* Character name hashing. */
-
-/* Associates a character index with a character name. */
-struct index_hash
- {
- char *name;
- int index;
- };
-
-/* Character index hash table. */
-static struct
- {
- int size; /* Size of table (must be power of 2). */
- int used; /* Number of full entries. */
- int next_index; /* Next index to allocate. */
- struct index_hash *tab; /* Hash table proper. */
- struct pool *ar; /* Pool for names. */
- }
-hash;
-
-void
-groff_init (void)
-{
- space_index = font_char_name_to_index ("space");
-}
-
-void
-groff_done (void)
-{
- free (hash.tab) ;
- pool_destroy(hash.ar);
-}
-
-
-/* Searches for NAME in the global character code table, returns the
- index if found; otherwise inserts NAME and returns the new
- index. */
-int
-font_char_name_to_index (const char *name)
-{
- int i;
-
- if (name[0] == ' ')
- return space_index;
- if (name[0] == '\0' || name[1] == '\0')
- return name[0];
- if (0 == strncmp (name, "char", 4))
- {
- char *tail;
- int x = strtol (name + 4, &tail, 10);
- if (tail != name + 4 && *tail == 0 && x >= 0 && x <= 255)
- return x;
- }
-
- if (!hash.tab)
- {
- hash.size = 128;
- hash.used = 0;
- hash.next_index = 256;
- hash.tab = xnmalloc (hash.size, sizeof *hash.tab);
- hash.ar = pool_create ();
- for (i = 0; i < hash.size; i++)
- hash.tab[i].name = NULL;
- }
-
- for (i = hsh_hash_string (name) & (hash.size - 1); hash.tab[i].name; )
- {
- if (!strcmp (hash.tab[i].name, name))
- return hash.tab[i].index;
- if (++i >= hash.size)
- i = 0;
- }
-
- hash.used++;
- if (hash.used >= hash.size / 2)
- {
- struct index_hash *old_tab = hash.tab;
- int old_size = hash.size;
- int i, j;
-
- hash.size *= 2;
- hash.tab = xnmalloc (hash.size, sizeof *hash.tab);
- for (i = 0; i < hash.size; i++)
- hash.tab[i].name = NULL;
- for (i = 0; i < old_size; i++)
- if (old_tab[i].name)
- {
- for (j = hsh_hash_string (old_tab[i].name) & (hash.size - 1);
- hash.tab[j].name;)
- if (++j >= hash.size)
- j = 0;
- hash.tab[j] = old_tab[i];
- }
- free (old_tab);
- }
-
- hash.tab[i].name = pool_strdup (hash.ar, name);
- hash.tab[i].index = hash.next_index;
- return hash.next_index++;
-}
-
-/* Returns an index for a character that has only a code, not a
- name. */
-int
-font_number_to_index (int x)
-{
- char name[INT_DIGITS + 2];
-
- /* Note that space is the only character that can't appear in a
- character name. That makes it an excellent choice for a name
- that won't conflict. */
- sprintf (name, " %d", x);
- return font_char_name_to_index (name);
-}
-\f
-/* Font character metric entries. */
-
-/* Ensures room for at least MIN_SIZE metric indexes in deref of
- FONT. */
-static void
-check_deref_space (struct font_desc *font, int min_size)
-{
- if (min_size >= font->deref_size)
- {
- int i = font->deref_size;
-
- font->deref_size = min_size + 16;
- if (font->deref_size < 256)
- font->deref_size = 256;
- font->deref = pool_nrealloc (font->owner, font->deref,
- font->deref_size, sizeof *font->deref);
- for (; i < font->deref_size; i++)
- font->deref[i] = -1;
- }
-}
-
-/* Inserts METRICS for character with code CODE into FONT. */
-static void
-add_char_metric (struct font_desc *font, struct char_metrics *metrics, int code)
-{
- check_deref_space (font, code);
- if (font->metric_used >= font->metric_size)
- {
- font->metric_size += 64;
- font->metric = pool_nrealloc (font->owner, font->metric,
- font->metric_size, sizeof *font->metric);
- }
- font->metric[font->metric_used] = metrics;
- font->deref[code] = font->metric_used++;
-}
-
-/* Copies metric in FONT from character with code SRC to character
- with code DEST. */
-static void
-dup_char_metric (struct font_desc *font, int dest, int src)
-{
- check_deref_space (font, dest);
- assert (font->deref[src] != -1);
- font->deref[dest] = font->deref[src];
-}
-\f
-/* Kerning. */
-
-/* Returns a hash value for characters with codes CH1 and CH2. */
-#define hash_kern(CH1, CH2) \
- ((unsigned) (((CH1) << 16) ^ (CH2)))
-
-/* Adds an ADJUST-size kern to FONT between characters with codes CH1
- and CH2. */
-static void
-add_kern (struct font_desc *font, int ch1, int ch2, int adjust)
-{
- int i;
-
- if (font->kern_used >= font->kern_max_used)
- {
- struct kern_pair *old_kern = font->kern;
- int old_kern_size = font->kern_size;
- int j;
-
- font->kern_size *= 2;
- font->kern_max_used = font->kern_size / 2;
- font->kern = pool_nmalloc (font->owner,
- font->kern_size, sizeof *font->kern);
- for (i = 0; i < font->kern_size; i++)
- font->kern[i].ch1 = -1;
-
- if (old_kern)
- {
- for (i = 0; i < old_kern_size; i++)
- {
- if (old_kern[i].ch1 == -1)
- continue;
-
- j = (hash_kern (old_kern[i].ch1, old_kern[i].ch2)
- & (font->kern_size - 1));
- while (font->kern[j].ch1 != -1)
- if (0 == j--)
- j = font->kern_size - 1;
- font->kern[j] = old_kern[i];
- }
- pool_free (font->owner, old_kern);
- }
- }
-
- for (i = hash_kern (ch1, ch2) & (font->kern_size - 1);
- font->kern[i].ch1 != -1; )
- if (0 == i--)
- i = font->kern_size - 1;
- font->kern[i].ch1 = ch1;
- font->kern[i].ch2 = ch2;
- font->kern[i].adjust = adjust;
- font->kern_used++;
-}
-
-/* Finds a font file corresponding to font NAME for device DEV. */
-static char *
-find_font_file (const char *dev, const char *name)
-{
- char *basename = xmalloc (3 + strlen (dev) + 1 + strlen (name) + 1);
- char *cp;
- char *filename;
- char *path;
-
- cp = stpcpy (basename, "dev");
- cp = stpcpy (cp, dev);
- *cp++ = DIR_SEPARATOR;
- strcpy (cp, name);
-
- /* Search order:
- 1. $STAT_GROFF_FONT_PATH
- 2. $GROFF_FONT_PATH
- 3. GROFF_FONT_PATH from pref.h
- 4. config_path
- */
- if ((path = getenv ("STAT_GROFF_FONT_PATH")) != NULL
- && (filename = fn_search_path (basename, path, NULL)) != NULL)
- goto win;
-
- if ((path = getenv ("GROFF_FONT_PATH")) != NULL
- && (filename = fn_search_path (basename, path, NULL)) != NULL)
- goto win;
-
- if ((filename = fn_search_path (basename, groff_font_path, NULL)) != NULL)
- goto win;
-
- if ((filename = fn_search_path (basename, config_path, NULL)) != NULL)
- goto win;
-
- msg (IE, _("Groff font error: Cannot find \"%s\"."), basename);
-
-win:
- free (basename);
- return filename;
-}
-
-/* Finds a font for device DEV with name NAME, reads it with
- groff_read_font(), and returns the resultant font. */
-struct font_desc *
-groff_find_font (const char *dev, const char *name)
-{
- char *filename = find_font_file (dev, name);
- struct font_desc *fd;
-
- if (!filename)
- return NULL;
- fd = groff_read_font (filename);
- free (filename);
- return fd;
-}
-
-/* Reads a DESC file for device DEV and sets the appropriate fields in
- output driver *DRIVER, which must be previously allocated. Returns
- nonzero on success. */
-int
-groff_read_DESC (const char *dev_name, struct groff_device_info * dev)
-{
- char *filename; /* Full name of DESC file. */
- FILE *f; /* DESC file. */
-
- char *line = NULL; /* Current line. */
- int line_len; /* Number of chars in current line. */
- size_t line_size = 0; /* Number of chars allocated for line. */
-
- char *token; /* strtok()'d token inside line. */
-
- unsigned found = 0; /* Bitmask showing what settings
- have been encountered. */
-
- int m_sizes = 0; /* Number of int[2] items that
- can fit in driver->sizes. */
-
- char *sp; /* Tokenization string pointer. */
- struct file_locator where;
-
- int i;
-
- dev->horiz = 1;
- dev->vert = 1;
- dev->size_scale = 1;
- dev->n_sizes = 0;
- dev->sizes = NULL;
- dev->family = NULL;
- for (i = 0; i < 4; i++)
- dev->font_name[i] = NULL;
-
- filename = find_font_file (dev_name, "DESC");
- if (!filename)
- return 0;
-
- where.filename = filename;
- where.line_number = 0;
- err_push_file_locator (&where);
-
- msg (VM (1), _("%s: Opening Groff description file..."), filename);
- f = fopen (filename, "r");
- if (!f)
- goto file_lossage;
-
- while ((line_len = getline (&line, &line_size, f)) != -1)
- {
- where.line_number++;
-
- token = strtok_r (line, whitespace, &sp);
- if (!token)
- continue;
-
- if (!strcmp (token, "sizes"))
- {
- if (found & 0x10000)
- font_msg (SW, _("Multiple `sizes' declarations."));
- for (;;)
- {
- char *tail;
- int lower, upper;
-
- for (;;)
- {
- token = strtok_r (NULL, whitespace, &sp);
- if (token)
- break;
-
- where.line_number++;
- if ((line_len = getline (&line, &line_size, f)) != -1)
- {
- if (ferror (f))
- goto file_lossage;
- font_msg (SE, _("Unexpected end of file. "
- "Missing 0 terminator to `sizes' command?"));
- goto lossage;
- }
- }
-
- if (!strcmp (token, "0"))
- break;
-
- errno = 0;
- if (0 == (lower = strtol (token, &tail, 0)) || errno == ERANGE)
- {
- font_msg (SE, _("Bad argument to `sizes'."));
- goto lossage;
- }
- if (*tail == '-')
- {
- if (0 == (upper = strtol (&tail[1], &tail, 0)) || errno == ERANGE)
- {
- font_msg (SE, _("Bad argument to `sizes'."));
- goto lossage;
- }
- if (lower < upper)
- {
- font_msg (SE, _("Bad range in argument to `sizes'."));
- goto lossage;
- }
- }
- else
- upper = lower;
- if (*tail)
- {
- font_msg (SE, _("Bad argument to `sizes'."));
- goto lossage;
- }
-
- if (dev->n_sizes + 2 >= m_sizes)
- {
- m_sizes += 1;
- dev->sizes = xnrealloc (dev->sizes,
- m_sizes, sizeof *dev->sizes);
- }
- dev->sizes[dev->n_sizes++][0] = lower;
- dev->sizes[dev->n_sizes][1] = upper;
-
- found |= 0x10000;
- }
- }
- else if (!strcmp (token, "family"))
- {
- token = strtok_r (NULL, whitespace, &sp);
- if (!token)
- {
- font_msg (SE, _("Family name expected."));
- goto lossage;
- }
- if (found & 0x20000)
- {
- font_msg (SE, _("This command already specified."));
- goto lossage;
- }
- dev->family = xstrdup (token);
- }
- else if (!strcmp (token, "charset"))
- break;
- else
- {
- static const char *id[]
- = {"res", "hor", "vert", "sizescale", "unitwidth", NULL};
- const char **cp;
- int value;
-
- for (cp = id; *cp; cp++)
- if (!strcmp (token, *cp))
- break;
- if (*cp == NULL)
- continue; /* completely ignore unrecognized lines */
- if (found & (1 << (cp - id)))
- font_msg (SW, _("%s: Device characteristic already defined."), *cp);
-
- token = strtok_r (NULL, whitespace, &sp);
- errno = 0;
- if (!token || (value = strtol (token, NULL, 0)) <= 0 || errno == ERANGE)
- {
- font_msg (SE, _("%s: Invalid numeric format."), *cp);
- goto lossage;
- }
- found |= (1 << (cp - id));
- switch (cp - id)
- {
- case 0:
- dev->res = value;
- break;
- case 1:
- dev->horiz = value;
- break;
- case 2:
- dev->vert = value;
- break;
- case 3:
- dev->size_scale = value;
- break;
- case 4:
- dev->unit_width = value;
- break;
- default:
- assert (0);
- }
- }
- }
- if (ferror (f))
- goto file_lossage;
- if ((found & 0x10011) != 0x10011)
- {
- font_msg (SE, _("Missing `res', `unitwidth', and/or `sizes' line(s)."));
- goto lossage;
- }
-
- /* Font name = family name + suffix. */
- {
- static const char *suffix[4] =
- {"R", "I", "B", "BI"}; /* match OUTP_F_* */
- int len; /* length of family name */
- int i;
-
- if (!dev->family)
- dev->family = xstrdup ("");
- len = strlen (dev->family);
- for (i = 0; i < 4; i++)
- {
- char *cp;
- dev->font_name[i] = xmalloc (len + strlen (suffix[i]) + 1);
- cp = stpcpy (dev->font_name[i], dev->family);
- strcpy (cp, suffix[i]);
- }
- }
-
- dev->sizes[dev->n_sizes][0] = 0;
- dev->sizes[dev->n_sizes][1] = 0;
-
- msg (VM (2), _("Description file read successfully."));
-
- err_pop_file_locator (&where);
- free (filename);
- free (line);
- return 1;
-
- /* Come here on a file error. */
-file_lossage:
- msg (ME, "%s: %s", filename, strerror (errno));
-
- /* Come here on any error. */
-lossage:
- fclose (f);
- free (line);
- free (dev->family);
- dev->family = NULL;
- free (filename);
- free (dev->sizes);
- dev->sizes = NULL;
- dev->n_sizes = 0;
-#if 0 /* at the moment, no errors can come here when dev->font_name[*] are
- nonzero. */
- for (i = 0; i < 4; i++)
- {
- free (dev->font_name[i]);
- dev->font_name[i] = NULL;
- }
-#endif
-
- err_pop_file_locator (&where);
-
- msg (VM (1), _("Error reading description file."));
-
- return 0;
-}
-
-/* Finds character with index CH (as returned by name_to_index() or
- number_to_index()) in font FONT and returns the associated metrics.
- Nonexistent characters have width 0. */
-struct char_metrics *
-font_get_char_metrics (const struct font_desc *font, int ch)
-{
- short index;
-
- if (ch < 0 || ch >= font->deref_size)
- return 0;
-
- index = font->deref[ch];
- if (index == -1)
- return 0;
-
- return font->metric[index];
-}
-
-/* Finds kernpair consisting of CH1 and CH2, in that order, in font
- FONT and returns the associated kerning adjustment. */
-int
-font_get_kern_adjust (const struct font_desc *font, int ch1, int ch2)
-{
- unsigned i;
-
- if (!font->kern)
- return 0;
- for (i = hash_kern (ch1, ch2) & (font->kern_size - 1);
- font->kern[i].ch1 != -1;)
- {
- if (font->kern[i].ch1 == ch1 && font->kern[i].ch2 == ch2)
- return font->kern[i].adjust;
- if (0 == i--)
- i = font->kern_size - 1;
- }
- return 0;
-}
-
-/* Returns a twelve-point fixed-pitch font that can be used as a
- last-resort fallback. */
-struct font_desc *
-default_font (void)
-{
- struct pool *font_pool;
- static struct font_desc *font;
-
- if (font)
- return font;
- font_pool = pool_create ();
- font = pool_alloc (font_pool, sizeof *font);
- font->owner = font_pool;
- font->name = NULL;
- font->internal_name = pool_strdup (font_pool, _("<<fallback>>"));
- font->encoding = pool_strdup (font_pool, "text.enc");
- font->space_width = 12000;
- font->slant = 0.0;
- font->ligatures = 0;
- font->special = 0;
- font->ascent = 8000;
- font->descent = 4000;
- font->deref = NULL;
- font->deref_size = 0;
- font->metric = NULL;
- font->metric_size = 0;
- font->metric_used = 0;
- font->kern = NULL;
- font->kern_size = 8;
- font->kern_used = 0;
- font->kern_max_used = 0;
- return font;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "hash.h"
-#include "group.h"
-#include "group_proc.h"
-#include "str.h"
-#include "var.h"
-#include "misc.h"
-
-
-/* Return -1 if the id of a is less than b; +1 if greater than and
- 0 if equal */
-int
-compare_group(const struct group_statistics *a,
- const struct group_statistics *b,
- int width)
-{
- return compare_values(&a->id, &b->id, width);
-}
-
-
-
-unsigned
-hash_group(const struct group_statistics *g, int width)
-{
- unsigned id_hash;
-
- id_hash = hash_value(&g->id, width);
-
- return id_hash;
-}
-
-
-void
-free_group(struct group_statistics *v, void *aux UNUSED)
-{
- free(v);
-}
-
-
-struct group_proc *
-group_proc_get (struct variable *v)
-{
- /* This is not ideal, obviously. */
- if (v->aux == NULL)
- var_attach_aux (v, xmalloc (sizeof (struct group_proc)), var_dtor_free);
- return v->aux;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-
-#ifndef GROUP_H
-#define GROUP_H
-
-
-#include "val.h"
-
-
-/* Statistics for grouped data */
-struct group_statistics
- {
- /* The value of the independent variable for this group */
- union value id;
-
- /* The arithmetic mean */
- double mean;
-
- /* Population std. deviation */
- double std_dev;
-
- /* Sample std. deviation */
- double s_std_dev;
-
- /* count */
- double n;
-
- double sum;
-
- /* Sum of squares */
- double ssq;
-
- /* Std Err of Mean */
- double se_mean;
-
- /* Sum of differences */
- double sum_diff;
-
- /* Mean of differences */
- double mean_diff ;
-
- /* Running total of the Levene for this group */
- double lz_total;
-
- /* Group mean of Levene */
- double lz_mean;
-
-
- /* min and max values */
- double minimum ;
- double maximum ;
-
-
- };
-
-
-
-
-/* These funcs are useful for hash tables */
-
-/* Return -1 if the id of a is less than b; +1 if greater than and
- 0 if equal */
-int compare_group(const struct group_statistics *a,
- const struct group_statistics *b,
- int width);
-
-unsigned hash_group(const struct group_statistics *g, int width);
-
-void free_group(struct group_statistics *v, void *aux);
-
-
-
-#endif
+++ /dev/null
-/* PSPP - computes sample statistics.
-
- Copyright (C) 2004 Free Software Foundation, Inc.
-
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef GROUP_DATA_H
-#define GROUP_DATA_H
-
-#include "group.h"
-
-/* private data for commands dealing with grouped data*/
-struct group_proc
-{
- /* Stats for the `universal group' (ie the totals) */
- struct group_statistics ugs;
-
- /* The number of groups */
- int n_groups;
-
- /* The levene statistic */
- double levene ;
-
- /* A hash of group statistics keyed by the value of the
- independent variable */
- struct hsh_table *group_hash;
-
- /* Mean square error */
- double mse ;
-
-};
-
-struct variable;
-struct group_proc *group_proc_get (struct variable *);
-
-#endif
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "hash.h"
-#include "error.h"
-#include <assert.h>
-#include <ctype.h>
-#include <limits.h>
-#include <stdlib.h>
-#include "algorithm.h"
-#include "alloc.h"
-#include <stdbool.h>
-#include "misc.h"
-#include "str.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* Note for constructing hash functions:
-
- You can store the hash values in the records, then compare hash
- values (in the compare function) before bothering to compare keys.
- Hash values can simply be returned from the records instead of
- recalculating when rehashing. */
-
-/* Debugging note:
-
- Since hash_probe and hash_find take void * pointers, it's easy to
- pass a void ** to your data by accidentally inserting an `&'
- reference operator where one shouldn't go. It took me an hour to
- hunt down a bug like that once. */
-\f
-/* Prime numbers and hash functions. */
-
-/* Returns smallest power of 2 greater than X. */
-static size_t
-next_power_of_2 (size_t x)
-{
- assert (x != 0);
-
- for (;;)
- {
- /* Turn off rightmost 1-bit in x. */
- size_t y = x & (x - 1);
-
- /* If y is 0 then x only had a single 1-bit. */
- if (y == 0)
- return 2 * x;
-
- /* Otherwise turn off the next. */
- x = y;
- }
-}
-
-/* Fowler-Noll-Vo hash constants, for 32-bit word sizes. */
-#define FNV_32_PRIME 16777619u
-#define FNV_32_BASIS 2166136261u
-
-/* Fowler-Noll-Vo 32-bit hash, for bytes. */
-unsigned
-hsh_hash_bytes (const void *buf_, size_t size)
-{
- const unsigned char *buf = (const unsigned char *) buf_;
- unsigned hash;
-
- assert (buf != NULL);
-
- hash = FNV_32_BASIS;
- while (size-- > 0)
- hash = (hash * FNV_32_PRIME) ^ *buf++;
-
- return hash;
-}
-
-/* Fowler-Noll-Vo 32-bit hash, for strings. */
-unsigned
-hsh_hash_string (const char *s_)
-{
- const unsigned char *s = (const unsigned char *) s_;
- unsigned hash;
-
- assert (s != NULL);
-
- hash = FNV_32_BASIS;
- while (*s != '\0')
- hash = (hash * FNV_32_PRIME) ^ *s++;
-
- return hash;
-}
-
-/* Fowler-Noll-Vo 32-bit hash, for case-insensitive strings. */
-unsigned
-hsh_hash_case_string (const char *s_)
-{
- const unsigned char *s = (const unsigned char *) s_;
- unsigned hash;
-
- assert (s != NULL);
-
- hash = FNV_32_BASIS;
- while (*s != '\0')
- hash = (hash * FNV_32_PRIME) ^ toupper (*s++);
-
- return hash;
-}
-
-/* Hash for ints. */
-unsigned
-hsh_hash_int (int i)
-{
- return hsh_hash_bytes (&i, sizeof i);
-}
-
-/* Hash for double. */
-unsigned
-hsh_hash_double (double d)
-{
- if (!isnan (d))
- return hsh_hash_bytes (&d, sizeof d);
- else
- return 0;
-}
-\f
-/* Hash tables. */
-
-/* Hash table. */
-struct hsh_table
- {
- size_t used; /* Number of filled entries. */
- size_t size; /* Number of entries (a power of 2). */
- void **entries; /* Hash table proper. */
-
- void *aux; /* Auxiliary data for comparison functions. */
- hsh_compare_func *compare;
- hsh_hash_func *hash;
- hsh_free_func *free;
-
-#ifndef NDEBUG
- /* Set to false if hsh_data() or hsh_sort() has been called,
- so that most hsh_*() functions may no longer be called. */
- bool hash_ordered;
-#endif
- };
-
-/* Creates a hash table with at least M entries. COMPARE is a
- function that compares two entries and returns 0 if they are
- identical, nonzero otherwise; HASH returns a nonnegative hash value
- for an entry; FREE destroys an entry. */
-struct hsh_table *
-hsh_create (int size, hsh_compare_func *compare, hsh_hash_func *hash,
- hsh_free_func *free, void *aux)
-{
- struct hsh_table *h;
- int i;
-
- assert (compare != NULL);
- assert (hash != NULL);
-
- h = xmalloc (sizeof *h);
- h->used = 0;
- if (size < 4)
- size = 4;
- h->size = next_power_of_2 (size);
- h->entries = xnmalloc (h->size, sizeof *h->entries);
- for (i = 0; i < h->size; i++)
- h->entries[i] = NULL;
- h->aux = aux;
- h->compare = compare;
- h->hash = hash;
- h->free = free;
-#ifndef NDEBUG
- h->hash_ordered = true;
-#endif
- return h;
-}
-
-/* Destroys the contents of table H. */
-void
-hsh_clear (struct hsh_table *h)
-{
- int i;
-
- assert (h != NULL);
- if (h->free)
- for (i = 0; i < h->size; i++)
- if (h->entries[i] != NULL)
- h->free (h->entries[i], h->aux);
-
- for (i = 0; i < h->size; i++)
- h->entries[i] = NULL;
-
- h->used = 0;
-
-#ifndef NDEBUG
- h->hash_ordered = true;
-#endif
-}
-
-/* Destroys table H and all its contents. */
-void
-hsh_destroy (struct hsh_table *h)
-{
- int i;
-
- if (h != NULL)
- {
- if (h->free)
- for (i = 0; i < h->size; i++)
- if (h->entries[i] != NULL)
- h->free (h->entries[i], h->aux);
- free (h->entries);
- free (h);
- }
-}
-
-/* Locates an entry matching TARGET. Returns a pointer to the
- entry, or a null pointer on failure. */
-static inline unsigned
-locate_matching_entry (struct hsh_table *h, const void *target)
-{
- unsigned i = h->hash (target, h->aux);
-
- assert (h->hash_ordered);
- for (;;)
- {
- void *entry;
- i &= h->size - 1;
- entry = h->entries[i];
- if (entry == NULL || !h->compare (entry, target, h->aux))
- return i;
- i--;
- }
-}
-
-/* Changes the capacity of H to NEW_SIZE, which must be a
- positive power of 2 at least as large as the number of
- elements in H. */
-static void
-rehash (struct hsh_table *h, size_t new_size)
-{
- void **begin, **end, **table_p;
- int i;
-
- assert (h != NULL);
- assert (new_size >= h->used);
-
- /* Verify that NEW_SIZE is a positive power of 2. */
- assert (new_size > 0 && (new_size & (new_size - 1)) == 0);
-
- begin = h->entries;
- end = begin + h->size;
-
- h->size = new_size;
- h->entries = xnmalloc (h->size, sizeof *h->entries);
- for (i = 0; i < h->size; i++)
- h->entries[i] = NULL;
- for (table_p = begin; table_p < end; table_p++)
- {
- void *entry = *table_p;
- if (entry != NULL)
- h->entries[locate_matching_entry (h, entry)] = entry;
- }
- free (begin);
-
-#ifndef NDEBUG
- h->hash_ordered = true;
-#endif
-}
-
-/* A "algo_predicate_func" that returns nonzero if DATA points
- to a non-null void. */
-static int
-not_null (const void *data_, void *aux UNUSED)
-{
- void *const *data = data_;
-
- return *data != NULL;
-}
-
-/* Compacts hash table H and returns a pointer to its data. The
- returned data consists of hsh_count(H) non-null pointers, in
- no particular order, followed by a null pointer.
-
- After calling this function, only hsh_destroy() and
- hsh_count() should be applied to H. hsh_first() and
- hsh_next() could also be used, but you're better off just
- iterating through the returned array.
-
- This function is intended for use in situations where data
- processing occurs in two phases. In the first phase, data is
- added, removed, and searched for within a hash table. In the
- second phase, the contents of the hash table are output and
- the hash property itself is no longer of interest.
-
- Use hsh_sort() instead, if the second phase wants data in
- sorted order. Use hsh_data_copy() or hsh_sort_copy() instead,
- if the second phase still needs to search the hash table. */
-void *const *
-hsh_data (struct hsh_table *h)
-{
- size_t n;
-
- assert (h != NULL);
- n = partition (h->entries, h->size, sizeof *h->entries, not_null, NULL);
- assert (n == h->used);
-#ifndef NDEBUG
- h->hash_ordered = false;
-#endif
- return h->entries;
-}
-
-/* Dereferences void ** pointers and passes them to the hash
- comparison function. */
-static int
-comparison_helper (const void *a_, const void *b_, void *h_)
-{
- void *const *a = a_;
- void *const *b = b_;
- struct hsh_table *h = h_;
-
- assert(a);
- assert(b);
-
- return h->compare (*a, *b, h->aux);
-}
-
-/* Sorts hash table H based on hash comparison function. The
- returned data consists of hsh_count(H) non-null pointers,
- sorted in order of the hash comparison function, followed by a
- null pointer.
-
- After calling this function, only hsh_destroy() and
- hsh_count() should be applied to H. hsh_first() and
- hsh_next() could also be used, but you're better off just
- iterating through the returned array.
-
- This function is intended for use in situations where data
- processing occurs in two phases. In the first phase, data is
- added, removed, and searched for within a hash table. In the
- second phase, the contents of the hash table are output and
- the hash property itself is no longer of interest.
-
- Use hsh_data() instead, if the second phase doesn't need the
- data in any particular order. Use hsh_data_copy() or
- hsh_sort_copy() instead, if the second phase still needs to
- search the hash table. */
-void *const *
-hsh_sort (struct hsh_table *h)
-{
- assert (h != NULL);
-
- hsh_data (h);
- sort (h->entries, h->used, sizeof *h->entries, comparison_helper, h);
- return h->entries;
-}
-
-/* Makes and returns a copy of the pointers to the data in H.
- The returned data consists of hsh_count(H) non-null pointers,
- in no particular order, followed by a null pointer. The hash
- table is not modified. The caller is responsible for freeing
- the allocated data.
-
- If you don't need to search or modify the hash table, then
- hsh_data() is a more efficient choice. */
-void **
-hsh_data_copy (struct hsh_table *h)
-{
- void **copy;
-
- assert (h != NULL);
- copy = xnmalloc ((h->used + 1), sizeof *copy);
- copy_if (h->entries, h->size, sizeof *h->entries, copy, not_null, NULL);
- copy[h->used] = NULL;
- return copy;
-}
-
-/* Makes and returns a copy of the pointers to the data in H.
- The returned data consists of hsh_count(H) non-null pointers,
- sorted in order of the hash comparison function, followed by a
- null pointer. The hash table is not modified. The caller is
- responsible for freeing the allocated data.
-
- If you don't need to search or modify the hash table, then
- hsh_sort() is a more efficient choice. */
-void **
-hsh_sort_copy (struct hsh_table *h)
-{
- void **copy;
-
- assert (h != NULL);
- copy = hsh_data_copy (h);
- sort (copy, h->used, sizeof *copy, comparison_helper, h);
- return copy;
-}
-\f
-/* Hash entries. */
-
-/* Searches hash table H for TARGET. If found, returns a pointer
- to a pointer to that entry; otherwise returns a pointer to a
- NULL entry which *must* be used to insert a new entry having
- the same key data. */
-inline void **
-hsh_probe (struct hsh_table *h, const void *target)
-{
- unsigned i;
-
- assert (h != NULL);
- assert (target != NULL);
- assert (h->hash_ordered);
-
- if (h->used > h->size / 2)
- rehash (h, h->size * 2);
- i = locate_matching_entry (h, target);
- if (h->entries[i] == NULL)
- h->used++;
- return &h->entries[i];
-}
-
-/* Searches hash table H for TARGET. If not found, inserts
- TARGET and returns a null pointer. If found, returns the
- match, without replacing it in the table. */
-void *
-hsh_insert (struct hsh_table *h, void *target)
-{
- void **entry;
-
- assert (h != NULL);
- assert (target != NULL);
-
- entry = hsh_probe (h, target);
- if (*entry == NULL)
- {
- *entry = target;
- return NULL;
- }
- else
- return *entry;
-}
-
-/* Searches hash table H for TARGET. If not found, inserts
- TARGET and returns a null pointer. If found, returns the
- match, after replacing it in the table by TARGET. */
-void *
-hsh_replace (struct hsh_table *h, void *target)
-{
- void **entry = hsh_probe (h, target);
- void *old = *entry;
- *entry = target;
- return old;
-}
-
-/* Returns the entry in hash table H that matches TARGET, or NULL
- if there is none. */
-void *
-hsh_find (struct hsh_table *h, const void *target)
-{
- return h->entries[locate_matching_entry (h, target)];
-}
-
-/* Deletes the entry in hash table H that matches TARGET.
- Returns nonzero if an entry was deleted.
-
- Uses Knuth's Algorithm 6.4R (Deletion with linear probing).
- Because our load factor is at most 1/2, the average number of
- moves that this algorithm makes should be at most 2 - ln 2 ~=
- 1.65. */
-int
-hsh_delete (struct hsh_table *h, const void *target)
-{
- unsigned i = locate_matching_entry (h, target);
- if (h->entries[i] != NULL)
- {
- h->used--;
- if (h->free != NULL)
- h->free (h->entries[i], h->aux);
-
- for (;;)
- {
- unsigned r;
- ptrdiff_t j;
-
- h->entries[i] = NULL;
- j = i;
- do
- {
- i = (i - 1) & (h->size - 1);
- if (h->entries[i] == NULL)
- return 1;
-
- r = h->hash (h->entries[i], h->aux) & (h->size - 1);
- }
- while ((i <= r && r < j) || (r < j && j < i) || (j < i && i <= r));
- h->entries[j] = h->entries[i];
- }
- }
- else
- return 0;
-}
-\f
-/* Iteration. */
-
-/* Finds and returns an entry in TABLE, and initializes ITER for
- use with hsh_next(). If TABLE is empty, returns a null
- pointer. */
-void *
-hsh_first (struct hsh_table *h, struct hsh_iterator *iter)
-{
- assert (h != NULL);
- assert (iter != NULL);
-
- iter->next = 0;
- return hsh_next (h, iter);
-}
-
-/* Iterates through TABLE with iterator ITER. Returns the next
- entry in TABLE, or a null pointer after the last entry.
-
- Entries are returned in an undefined order. Modifying TABLE
- during iteration may cause some entries to be returned
- multiple times or not at all. */
-void *
-hsh_next (struct hsh_table *h, struct hsh_iterator *iter)
-{
- size_t i;
-
- assert (h != NULL);
- assert (iter != NULL);
- assert (iter->next <= h->size);
-
- for (i = iter->next; i < h->size; i++)
- if (h->entries[i])
- {
- iter->next = i + 1;
- return h->entries[i];
- }
-
- iter->next = h->size;
- return NULL;
-}
-\f
-/* Returns the number of items in H. */
-size_t
-hsh_count (struct hsh_table *h)
-{
- assert (h != NULL);
-
- return h->used;
-}
-\f
-/* Debug helpers. */
-
-#if GLOBAL_DEBUGGING
-#undef NDEBUG
-#include "error.h"
-#include <stdio.h>
-
-/* Displays contents of hash table H on stdout. */
-void
-hsh_dump (struct hsh_table *h)
-{
- void **entry = h->entries;
- int i;
-
- printf (_("hash table:"));
- for (i = 0; i < h->size; i++)
- printf (" %p", *entry++);
- printf ("\n");
-}
-
-/* This wrapper around hsh_probe() assures that it returns a pointer
- to a NULL pointer. This function is used when it is known that the
- entry to be inserted does not already exist in the table. */
-void
-hsh_force_insert (struct hsh_table *h, void *p)
-{
- void **pp = hsh_probe (h, p);
- assert (*pp == NULL);
- *pp = p;
-}
-
-/* This wrapper around hsh_find() assures that it returns non-NULL.
- This function is for use when it is known that the entry being
- searched for must exist in the table. */
-void *
-hsh_force_find (struct hsh_table *h, const void *target)
-{
- void *found = hsh_find (h, target);
- assert (found != NULL);
- return found;
-}
-
-/* This wrapper for hsh_delete() verifies that an item really was
- deleted. */
-void
-hsh_force_delete (struct hsh_table *h, const void *target)
-{
- int found = hsh_delete (h, target);
- assert (found != 0);
-}
-#endif
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !hash_h
-#define hash_h 1
-
-#include <stddef.h>
-
-typedef int hsh_compare_func (const void *, const void *, void *aux);
-typedef unsigned hsh_hash_func (const void *, void *aux);
-typedef void hsh_free_func (void *, void *aux);
-
-/* Hash table iterator (opaque). */
-struct hsh_iterator
- {
- size_t next; /* Index of next entry. */
- };
-
-/* Hash functions. */
-unsigned hsh_hash_bytes (const void *, size_t);
-unsigned hsh_hash_string (const char *);
-unsigned hsh_hash_case_string (const char *);
-unsigned hsh_hash_int (int);
-unsigned hsh_hash_double (double);
-
-/* Hash tables. */
-struct hsh_table *hsh_create (int m, hsh_compare_func *,
- hsh_hash_func *, hsh_free_func *,
- void *aux);
-void hsh_clear (struct hsh_table *);
-void hsh_destroy (struct hsh_table *);
-void *const *hsh_sort (struct hsh_table *);
-void *const *hsh_data (struct hsh_table *);
-void **hsh_sort_copy (struct hsh_table *);
-void **hsh_data_copy (struct hsh_table *);
-
-/* Search and insertion. */
-void **hsh_probe (struct hsh_table *, const void *);
-void *hsh_insert (struct hsh_table *, void *);
-void *hsh_replace (struct hsh_table *, void *);
-void *hsh_find (struct hsh_table *, const void *);
-int hsh_delete (struct hsh_table *, const void *);
-
-/* Iteration. */
-void *hsh_first (struct hsh_table *, struct hsh_iterator *);
-void *hsh_next (struct hsh_table *, struct hsh_iterator *);
-
-/* Search and insertion with assertion. */
-#if GLOBAL_DEBUGGING
-void hsh_force_insert (struct hsh_table *, void *);
-void *hsh_force_find (struct hsh_table *, const void *);
-void hsh_force_delete (struct hsh_table *, const void *);
-#else
-#define hsh_force_insert(A, B) ((void) (*hsh_probe (A, B) = B))
-#define hsh_force_find(A, B) (hsh_find (A, B))
-#define hsh_force_delete(A, B) ((void) hsh_delete (A, B))
-#endif
-
-/* Number of entries in hash table H. */
-size_t hsh_count (struct hsh_table *);
-
-/* Debugging. */
-#if GLOBAL_DEBUGGING
-void hsh_dump (struct hsh_table *);
-#endif
-
-#endif /* hash_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <math.h>
-#include <gsl/gsl_histogram.h>
-#include <assert.h>
-#include "histogram.h"
-#include "chart.h"
-
-
-gsl_histogram *
-histogram_create(double bins, double x_min, double x_max)
-{
- int n;
- double bin_width ;
- double bin_width_2 ;
- double upper_limit, lower_limit;
-
- gsl_histogram *hist = gsl_histogram_alloc(bins);
-
-
- bin_width = chart_rounded_tick((x_max - x_min)/ bins);
- bin_width_2 = bin_width / 2.0;
-
- n = ceil( x_max / (bin_width_2) ) ;
- if ( ! (n % 2 ) ) n++;
- upper_limit = n * bin_width_2;
-
- n = floor( x_min / (bin_width_2) ) ;
- if ( ! (n % 2 ) ) n--;
- lower_limit = n * bin_width_2;
-
- gsl_histogram_set_ranges_uniform(hist, lower_limit, upper_limit);
-
-
- return hist;
-}
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef HISTOGRAM_H
-#define HISTOGRAM_H
-
-#include <gsl/gsl_histogram.h>
-
-
-gsl_histogram * histogram_create(double bins, double x_min, double x_max);
-
-#endif
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-/* This #if encloses the rest of the file. */
-#if !NO_HTML
-
-#include <config.h>
-#include "htmlP.h"
-#include "error.h"
-#include <errno.h>
-#include <stdlib.h>
-#include <ctype.h>
-#include <time.h>
-
-#if HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
-#include "alloc.h"
-#include "error.h"
-#include "filename.h"
-#include "getl.h"
-#include "getline.h"
-#include "getlogin_r.h"
-#include "output.h"
-#include "som.h"
-#include "tab.h"
-#include "version.h"
-#include "mkfile.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* Prototypes. */
-static int postopen (struct file_ext *);
-static int preclose (struct file_ext *);
-
-static int
-html_open_global (struct outp_class *this UNUSED)
-{
- return 1;
-}
-
-static int
-html_close_global (struct outp_class *this UNUSED)
-{
- return 1;
-}
-
-static int
-html_preopen_driver (struct outp_driver *this)
-{
- struct html_driver_ext *x;
-
- assert (this->driver_open == 0);
- msg (VM (1), _("HTML driver initializing as `%s'..."), this->name);
-
- this->ext = x = xmalloc (sizeof *x);
- this->res = 0;
- this->horiz = this->vert = 0;
- this->width = this->length = 0;
-
- this->cp_x = this->cp_y = 0;
-
- x->prologue_fn = NULL;
-
- x->file.filename = NULL;
- x->file.mode = "w";
- x->file.file = NULL;
- x->file.sequence_no = &x->sequence_no;
- x->file.param = this;
- x->file.postopen = postopen;
- x->file.preclose = preclose;
-
- x->sequence_no = 0;
-
- return 1;
-}
-
-static int
-html_postopen_driver (struct outp_driver *this)
-{
- struct html_driver_ext *x = this->ext;
-
- assert (this->driver_open == 0);
- if (NULL == x->file.filename)
- x->file.filename = xstrdup ("pspp.html");
-
- if (x->prologue_fn == NULL)
- x->prologue_fn = xstrdup ("html-prologue");
-
- msg (VM (2), _("%s: Initialization complete."), this->name);
- this->driver_open = 1;
-
- return 1;
-}
-
-static int
-html_close_driver (struct outp_driver *this)
-{
- struct html_driver_ext *x = this->ext;
-
- assert (this->driver_open);
- msg (VM (2), _("%s: Beginning closing..."), this->name);
- fn_close_ext (&x->file);
- free (x->prologue_fn);
- free (x->file.filename);
- free (x);
- msg (VM (3), _("%s: Finished closing."), this->name);
- this->driver_open = 0;
-
- return 1;
-}
-
-
-/* Link the image contained in FILENAME to the
- HTML stream in file F. */
-static int
-link_image (struct file_ext *f, char *filename)
-{
- fprintf (f->file,
- "<IMG SRC=\"%s\"/>", filename);
-
- if (ferror (f->file))
- return 0;
-
- return 1;
-}
-
-
-/* Generic option types. */
-enum
-{
- boolean_arg = -10,
- string_arg,
- nonneg_int_arg
-};
-
-/* All the options that the HTML driver supports. */
-static struct outp_option option_tab[] =
-{
- /* *INDENT-OFF* */
- {"output-file", 1, 0},
- {"prologue-file", string_arg, 0},
- {"", 0, 0},
- /* *INDENT-ON* */
-};
-static struct outp_option_info option_info;
-
-static void
-html_option (struct outp_driver *this, const char *key, const struct string *val)
-{
- struct html_driver_ext *x = this->ext;
- int cat, subcat;
-
- cat = outp_match_keyword (key, option_tab, &option_info, &subcat);
- switch (cat)
- {
- case 0:
- msg (SE, _("Unknown configuration parameter `%s' for HTML device "
- "driver."), key);
- break;
- case 1:
- free (x->file.filename);
- x->file.filename = xstrdup (ds_c_str (val));
- break;
- case string_arg:
- {
- char **dest;
- switch (subcat)
- {
- case 0:
- dest = &x->prologue_fn;
- break;
- default:
- assert (0);
- abort ();
- }
- if (*dest)
- free (*dest);
- *dest = xstrdup (ds_c_str (val));
- }
- break;
- default:
- assert (0);
- }
-}
-
-/* Variables for the prologue. */
-struct html_variable
- {
- const char *key;
- const char *value;
- };
-
-static struct html_variable *html_var_tab;
-
-/* Searches html_var_tab for a html_variable with key KEY, and returns
- the associated value. */
-static const char *
-html_get_var (const char *key)
-{
- struct html_variable *v;
-
- for (v = html_var_tab; v->key; v++)
- if (!strcmp (key, v->key))
- return v->value;
- return NULL;
-}
-
-/* Writes the HTML prologue to file F. */
-static int
-postopen (struct file_ext *f)
-{
- static struct html_variable dict[] =
- {
- {"generator", 0},
- {"date", 0},
- {"user", 0},
- {"host", 0},
- {"title", 0},
- {"subtitle", 0},
- {"source-file", 0},
- {0, 0},
- };
- char login[128], host[128];
- time_t curtime;
- struct tm *loctime;
-
- struct outp_driver *this = f->param;
- struct html_driver_ext *x = this->ext;
-
- char *prologue_fn = fn_search_path (x->prologue_fn, config_path, NULL);
- FILE *prologue_file;
-
- char *buf = NULL;
- size_t buf_size = 0;
-
- if (prologue_fn == NULL)
- {
- msg (IE, _("Cannot find HTML prologue. The use of `-vv' "
- "on the command line is suggested as a debugging aid."));
- return 0;
- }
-
- msg (VM (1), _("%s: %s: Opening HTML prologue..."), this->name, prologue_fn);
- prologue_file = fopen (prologue_fn, "rb");
- if (prologue_file == NULL)
- {
- fclose (prologue_file);
- free (prologue_fn);
- msg (IE, "%s: %s", prologue_fn, strerror (errno));
- goto error;
- }
-
- dict[0].value = version;
-
- curtime = time (NULL);
- loctime = localtime (&curtime);
- dict[1].value = asctime (loctime);
- {
- char *cp = strchr (dict[1].value, '\n');
- if (cp)
- *cp = 0;
- }
-
- if (getenv ("LOGNAME") != NULL)
- str_copy_rpad (login, sizeof login, getenv ("LOGNAME"));
- else if (getlogin_r (login, sizeof login))
- strcpy (login, _("nobody"));
- dict[2].value = login;
-
-#ifdef HAVE_UNISTD_H
- if (gethostname (host, 128) == -1)
- {
- if (errno == ENAMETOOLONG)
- host[127] = 0;
- else
- strcpy (host, _("nowhere"));
- }
-#else
- strcpy (host, _("nowhere"));
-#endif
- dict[3].value = host;
-
- dict[4].value = outp_title ? outp_title : "";
- dict[5].value = outp_subtitle ? outp_subtitle : "";
-
- getl_location (&dict[6].value, NULL);
- if (dict[6].value == NULL)
- dict[6].value = "<stdin>";
-
- html_var_tab = dict;
- while (-1 != getline (&buf, &buf_size, prologue_file))
- {
- char *buf2;
- int len;
-
- if (strstr (buf, "!!!"))
- continue;
-
- {
- char *cp = strstr (buf, "!title");
- if (cp)
- {
- if (outp_title == NULL)
- continue;
- else
- *cp = '\0';
- }
- }
-
- {
- char *cp = strstr (buf, "!subtitle");
- if (cp)
- {
- if (outp_subtitle == NULL)
- continue;
- else
- *cp = '\0';
- }
- }
-
- /* PORTME: Line terminator. */
- buf2 = fn_interp_vars (buf, html_get_var);
- len = strlen (buf2);
- fwrite (buf2, len, 1, f->file);
- if (buf2[len - 1] != '\n')
- putc ('\n', f->file);
- free (buf2);
- }
- if (ferror (f->file))
- msg (IE, _("Reading `%s': %s."), prologue_fn, strerror (errno));
- fclose (prologue_file);
-
- free (prologue_fn);
- free (buf);
-
- if (ferror (f->file))
- goto error;
-
- msg (VM (2), _("%s: HTML prologue read successfully."), this->name);
- return 1;
-
-error:
- msg (VM (1), _("%s: Error reading HTML prologue."), this->name);
- return 0;
-}
-
-/* Writes the HTML epilogue to file F. */
-static int
-preclose (struct file_ext *f)
-{
- fprintf (f->file,
- "</BODY>\n"
- "</HTML>\n"
- "<!-- end of file -->\n");
-
- if (ferror (f->file))
- return 0;
- return 1;
-}
-
-static int
-html_open_page (struct outp_driver *this)
-{
- struct html_driver_ext *x = this->ext;
-
- assert (this->driver_open && this->page_open == 0);
- x->sequence_no++;
- if (!fn_open_ext (&x->file))
- {
- if (errno)
- msg (ME, _("HTML output driver: %s: %s"), x->file.filename,
- strerror (errno));
- return 0;
- }
-
- if (!ferror (x->file.file))
- this->page_open = 1;
- return !ferror (x->file.file);
-}
-
-static int
-html_close_page (struct outp_driver *this)
-{
- struct html_driver_ext *x = this->ext;
-
- assert (this->driver_open && this->page_open);
- this->page_open = 0;
- return !ferror (x->file.file);
-}
-
-static void output_tab_table (struct outp_driver *, struct tab_table *);
-
-static void
-html_submit (struct outp_driver *this, struct som_entity *s)
-{
- extern struct som_table_class tab_table_class;
- struct html_driver_ext *x = this->ext;
-
- assert (this->driver_open && this->page_open);
- if (x->sequence_no == 0 && !html_open_page (this))
- {
- msg (ME, _("Cannot open first page on HTML device %s."), this->name);
- return;
- }
-
- assert ( s->class == &tab_table_class ) ;
-
- switch (s->type)
- {
- case SOM_TABLE:
- output_tab_table ( this, (struct tab_table *) s->ext);
- break;
- case SOM_CHART:
- link_image( &x->file, ((struct chart *)s->ext)->filename);
- break;
- default:
- assert(0);
- break;
- }
-
-}
-
-/* Write string S of length LEN to file F, escaping characters as
- necessary for HTML. */
-static void
-escape_string (FILE *f, char *s, int len)
-{
- char *ep = &s[len];
- char *bp, *cp;
-
- for (bp = cp = s; bp < ep; bp = cp)
- {
- while (cp < ep && *cp != '&' && *cp != '<' && *cp != '>' && *cp)
- cp++;
- if (cp > bp)
- fwrite (bp, 1, cp - bp, f);
- if (cp < ep)
- switch (*cp++)
- {
- case '&':
- fputs ("&", f);
- break;
- case '<':
- fputs ("<", f);
- break;
- case '>':
- fputs (">", f);
- break;
- case 0:
- break;
- default:
- assert (0);
- }
- }
-}
-
-/* Write table T to THIS output driver. */
-static void
-output_tab_table (struct outp_driver *this, struct tab_table *t)
-{
- struct html_driver_ext *x = this->ext;
-
- if (t->nr == 1 && t->nc == 1)
- {
- fputs ("<P>", x->file.file);
- if (!ls_empty_p (t->cc))
- escape_string (x->file.file, ls_c_str (t->cc), ls_length (t->cc));
- fputs ("</P>\n", x->file.file);
-
- return;
- }
-
- fputs ("<TABLE BORDER=1>\n", x->file.file);
-
- if (!ls_empty_p (&t->title))
- {
- fprintf (x->file.file, " <TR>\n <TH COLSPAN=%d>", t->nc);
- escape_string (x->file.file, ls_c_str (&t->title),
- ls_length (&t->title));
- fputs ("</TH>\n </TR>\n", x->file.file);
- }
-
- {
- int r;
- unsigned char *ct = t->ct;
-
- for (r = 0; r < t->nr; r++)
- {
- int c;
-
- fputs (" <TR>\n", x->file.file);
- for (c = 0; c < t->nc; c++, ct++)
- {
- struct fixed_string *cc;
- int tag;
- char header[128];
- char *cp;
- struct tab_joined_cell *j = NULL;
-
- cc = t->cc + c + r * t->nc;
- if (*ct & TAB_JOIN)
- {
- j = (struct tab_joined_cell *) ls_c_str (cc);
- cc = &j->contents;
- if (j->x1 != c || j->y1 != r)
- continue;
- }
-
- if (r < t->t || r >= t->nr - t->b
- || c < t->l || c >= t->nc - t->r)
- tag = 'H';
- else
- tag = 'D';
- cp = stpcpy (header, " <T");
- *cp++ = tag;
-
- switch (*ct & TAB_ALIGN_MASK)
- {
- case TAB_RIGHT:
- cp = stpcpy (cp, " ALIGN=RIGHT");
- break;
- case TAB_LEFT:
- break;
- case TAB_CENTER:
- cp = stpcpy (cp, " ALIGN=CENTER");
- break;
- default:
- assert (0);
- }
-
- if (*ct & TAB_JOIN)
- {
- if (j->x2 - j->x1 > 1)
- cp = spprintf (cp, " COLSPAN=%d", j->x2 - j->x1);
- if (j->y2 - j->y1 > 1)
- cp = spprintf (cp, " ROWSPAN=%d", j->y2 - j->y1);
-
- cc = &j->contents;
- }
-
- strcpy (cp, ">");
- fputs (header, x->file.file);
-
- if ( ! (*ct & TAB_EMPTY) )
- {
- char *s = ls_c_str (cc);
- size_t l = ls_length (cc);
-
- while (l && isspace ((unsigned char) *s))
- {
- l--;
- s++;
- }
-
- escape_string (x->file.file, s, l);
- }
-
- fprintf (x->file.file, "</T%c>\n", tag);
- }
- fputs (" </TR>\n", x->file.file);
- }
- }
-
- fputs ("</TABLE>\n\n", x->file.file);
-}
-
-static void
-html_initialise_chart(struct outp_driver *d UNUSED, struct chart *ch)
-{
-
- FILE *fp;
-
- make_unique_file_stream(&fp, &ch->filename);
-
-#ifdef NO_CHARTS
- ch->lp = 0;
-#else
- ch->pl_params = pl_newplparams();
- ch->lp = pl_newpl_r ("png", 0, fp, stderr, ch->pl_params);
-#endif
-
-}
-
-static void
-html_finalise_chart(struct outp_driver *d UNUSED, struct chart *ch)
-{
- free(ch->filename);
-}
-
-
-
-/* HTML driver class. */
-struct outp_class html_class =
-{
- "html",
- 0xfaeb,
- 1,
-
- html_open_global,
- html_close_global,
- NULL,
-
- html_preopen_driver,
- html_option,
- html_postopen_driver,
- html_close_driver,
-
- html_open_page,
- html_close_page,
-
- html_submit,
-
- NULL,
- NULL,
- NULL,
-
- NULL,
- NULL,
- NULL,
- NULL,
-
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
-
- html_initialise_chart,
- html_finalise_chart
-
-};
-
-#endif /* !NO_HTML */
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !htmlP_h
-#define htmlP_h 1
-
-#include "filename.h"
-
-/* HTML output driver extension record. */
-struct html_driver_ext
- {
- /* User parameters. */
- char *prologue_fn; /* Prologue's filename relative to font dir. */
-
- /* Internal state. */
- struct file_ext file; /* Output file. */
- int sequence_no; /* Sequence number. */
- };
-
-extern struct outp_class html_class;
-
-#endif /* !htmlP_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <ctype.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "command.h"
-#include "error.h"
-#include "getl.h"
-#include "lexer.h"
-#include "str.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-int
-cmd_include (void)
-{
- /* Skip optional FILE=. */
- if (lex_match_id ("FILE"))
- lex_match ('=');
-
- /* Filename can be identifier or string. */
- if (token != T_ID && token != T_STRING)
- {
- lex_error (_("expecting filename"));
- return CMD_FAILURE;
- }
- getl_include (ds_c_str (&tokstr));
-
- lex_get ();
- return lex_end_of_command ();
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <float.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "case.h"
-#include "command.h"
-#include "data-list.h"
-#include "dfm-read.h"
-#include "dictionary.h"
-#include "error.h"
-#include "expressions/public.h"
-#include "file-handle.h"
-#include "lexer.h"
-#include "misc.h"
-#include "str.h"
-#include "var.h"
-#include "vfm.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-/* Indicates how a `union value' should be initialized. */
-enum value_init_type
- {
- INP_NUMERIC = 01, /* Numeric. */
- INP_STRING = 0, /* String. */
-
- INP_INIT_ONCE = 02, /* Initialize only once. */
- INP_REINIT = 0, /* Reinitialize for each iteration. */
- };
-
-struct input_program_pgm
- {
- enum value_init_type *init; /* How to initialize each `union value'. */
- size_t init_cnt; /* Number of elements in inp_init. */
- size_t case_size; /* Size of case in bytes. */
- };
-
-static trns_proc_func end_case_trns_proc, reread_trns_proc, end_file_trns_proc;
-static trns_free_func reread_trns_free;
-
-int
-cmd_input_program (void)
-{
- discard_variables ();
-
- /* FIXME: we shouldn't do this here, but I'm afraid that other
- code will check the class of vfm_source. */
- vfm_source = create_case_source (&input_program_source_class, NULL);
-
- return lex_end_of_command ();
-}
-
-int
-cmd_end_input_program (void)
-{
- struct input_program_pgm *inp;
- size_t i;
-
- if (!case_source_is_class (vfm_source, &input_program_source_class))
- {
- msg (SE, _("No matching INPUT PROGRAM command."));
- return CMD_FAILURE;
- }
-
- if (dict_get_next_value_idx (default_dict) == 0)
- msg (SW, _("No data-input or transformation commands specified "
- "between INPUT PROGRAM and END INPUT PROGRAM."));
-
- /* Mark the boundary between INPUT PROGRAM transformations and
- ordinary transformations. */
- f_trns = n_trns;
-
- /* Figure out how to initialize each input case. */
- inp = xmalloc (sizeof *inp);
- inp->init_cnt = dict_get_next_value_idx (default_dict);
- inp->init = xnmalloc (inp->init_cnt, sizeof *inp->init);
- for (i = 0; i < inp->init_cnt; i++)
- inp->init[i] = -1;
- for (i = 0; i < dict_get_var_cnt (default_dict); i++)
- {
- struct variable *var = dict_get_var (default_dict, i);
- enum value_init_type value_init;
- size_t j;
-
- value_init = var->type == NUMERIC ? INP_NUMERIC : INP_STRING;
- value_init |= var->reinit ? INP_REINIT : INP_INIT_ONCE;
-
- for (j = 0; j < var->nv; j++)
- inp->init[j + var->fv] = value_init;
- }
- for (i = 0; i < inp->init_cnt; i++)
- assert (inp->init[i] != -1);
- inp->case_size = dict_get_case_size (default_dict);
-
- /* Put inp into vfm_source for later use. */
- vfm_source->aux = inp;
-
- return lex_end_of_command ();
-}
-
-/* Initializes case C. Called before the first case is read. */
-static void
-init_case (const struct input_program_pgm *inp, struct ccase *c)
-{
- size_t i;
-
- for (i = 0; i < inp->init_cnt; i++)
- switch (inp->init[i])
- {
- case INP_NUMERIC | INP_INIT_ONCE:
- case_data_rw (c, i)->f = 0.0;
- break;
- case INP_NUMERIC | INP_REINIT:
- case_data_rw (c, i)->f = SYSMIS;
- break;
- case INP_STRING | INP_INIT_ONCE:
- case INP_STRING | INP_REINIT:
- memset (case_data_rw (c, i)->s, ' ', sizeof case_data_rw (c, i)->s);
- break;
- default:
- assert (0);
- }
-}
-
-/* Clears case C. Called between reading successive records. */
-static void
-clear_case (const struct input_program_pgm *inp, struct ccase *c)
-{
- size_t i;
-
- for (i = 0; i < inp->init_cnt; i++)
- switch (inp->init[i])
- {
- case INP_NUMERIC | INP_INIT_ONCE:
- break;
- case INP_NUMERIC | INP_REINIT:
- case_data_rw (c, i)->f = SYSMIS;
- break;
- case INP_STRING | INP_INIT_ONCE:
- break;
- case INP_STRING | INP_REINIT:
- memset (case_data_rw (c, i)->s, ' ', sizeof case_data_rw (c, i)->s);
- break;
- default:
- assert (0);
- }
-}
-
-/* Executes each transformation in turn on a `blank' case. When a
- transformation fails, returning -2, then that's the end of the
- file. -1 means go on to the next transformation. Otherwise the
- return value is the index of the transformation to go to next. */
-static void
-input_program_source_read (struct case_source *source,
- struct ccase *c,
- write_case_func *write_case,
- write_case_data wc_data)
-{
- struct input_program_pgm *inp = source->aux;
- size_t i;
-
- /* Nonzero if there were any END CASE commands in the set of
- transformations. If so, we don't automatically write out
- cases. */
- int end_case = 0;
-
- /* FIXME? This is the number of cases sent out of the input
- program, not the number of cases written to the procedure.
- The difference should only show up in $CASENUM in COMPUTE.
- We should check behavior against SPSS. */
- int cases_written = 0;
-
- assert (inp != NULL);
-
- /* Figure end_case. */
- for (i = 0; i < f_trns; i++)
- if (t_trns[i].proc == end_case_trns_proc)
- end_case = 1;
-
- /* FIXME: This is an ugly kluge. */
- for (i = 0; i < f_trns; i++)
- if (t_trns[i].proc == repeating_data_trns_proc)
- repeating_data_set_write_case (t_trns[i].private, write_case, wc_data);
-
- init_case (inp, c);
- for (;;)
- {
- /* Perform transformations on `blank' case. */
- for (i = 0; i < f_trns; )
- {
- int code; /* Return value of last-called transformation. */
-
- if (t_trns[i].proc == end_case_trns_proc)
- {
- cases_written++;
- if (!write_case (wc_data))
- goto done;
- clear_case (inp, c);
- i++;
- continue;
- }
-
- code = t_trns[i].proc (t_trns[i].private, c, cases_written + 1);
- switch (code)
- {
- case -1:
- i++;
- break;
- case -2:
- goto done;
- case -3:
- goto next_case;
- default:
- i = code;
- break;
- }
- }
-
- /* Write the case if appropriate. */
- if (!end_case)
- {
- cases_written++;
- if (!write_case (wc_data))
- break;
- }
-
- /* Blank out the case for the next iteration. */
- next_case:
- clear_case (inp, c);
- }
- done: ;
-}
-
-/* Destroys an INPUT PROGRAM source. */
-static void
-input_program_source_destroy (struct case_source *source)
-{
- struct input_program_pgm *inp = source->aux;
-
- cancel_transformations ();
-
- if (inp != NULL)
- {
- free (inp->init);
- free (inp);
- }
-}
-
-const struct case_source_class input_program_source_class =
- {
- "INPUT PROGRAM",
- NULL,
- input_program_source_read,
- input_program_source_destroy,
- };
-\f
-int
-cmd_end_case (void)
-{
- if (!case_source_is_class (vfm_source, &input_program_source_class))
- {
- msg (SE, _("This command may only be executed between INPUT PROGRAM "
- "and END INPUT PROGRAM."));
- return CMD_FAILURE;
- }
-
- add_transformation (end_case_trns_proc, NULL, NULL);
-
- return lex_end_of_command ();
-}
-
-/* Should never be called, because this is handled in
- input_program_source_read(). */
-int
-end_case_trns_proc (void *trns_ UNUSED, struct ccase *c UNUSED,
- int case_num UNUSED)
-{
- assert (0);
- abort ();
-}
-
-/* REREAD transformation. */
-struct reread_trns
- {
- struct dfm_reader *reader; /* File to move file pointer back on. */
- struct expression *column; /* Column to reset file pointer to. */
- };
-
-/* Parses REREAD command. */
-int
-cmd_reread (void)
-{
- struct file_handle *fh; /* File to be re-read. */
- struct expression *e; /* Expression for column to set. */
- struct reread_trns *t; /* Created transformation. */
-
- fh = fh_get_default_handle ();
- e = NULL;
- while (token != '.')
- {
- if (lex_match_id ("COLUMN"))
- {
- lex_match ('=');
-
- if (e)
- {
- msg (SE, _("COLUMN subcommand multiply specified."));
- expr_free (e);
- return CMD_FAILURE;
- }
-
- e = expr_parse (default_dict, EXPR_NUMBER);
- if (!e)
- return CMD_FAILURE;
- }
- else if (lex_match_id ("FILE"))
- {
- lex_match ('=');
- fh = fh_parse (FH_REF_FILE | FH_REF_INLINE);
- if (fh == NULL)
- {
- expr_free (e);
- return CMD_FAILURE;
- }
- lex_get ();
- }
- else
- {
- lex_error (NULL);
- expr_free (e);
- }
- }
-
- t = xmalloc (sizeof *t);
- t->reader = dfm_open_reader (fh);
- t->column = e;
- add_transformation (reread_trns_proc, reread_trns_free, t);
-
- return CMD_SUCCESS;
-}
-
-/* Executes a REREAD transformation. */
-static int
-reread_trns_proc (void *t_, struct ccase *c, int case_num)
-{
- struct reread_trns *t = t_;
-
- if (t->column == NULL)
- dfm_reread_record (t->reader, 1);
- else
- {
- double column = expr_evaluate_num (t->column, c, case_num);
- if (!finite (column) || column < 1)
- {
- msg (SE, _("REREAD: Column numbers must be positive finite "
- "numbers. Column set to 1."));
- dfm_reread_record (t->reader, 1);
- }
- else
- dfm_reread_record (t->reader, column);
- }
- return -1;
-}
-
-/* Frees a REREAD transformation. */
-static void
-reread_trns_free (void *t_)
-{
- struct reread_trns *t = t_;
- expr_free (t->column);
- dfm_close_reader (t->reader);
-}
-
-/* Parses END FILE command. */
-int
-cmd_end_file (void)
-{
- if (!case_source_is_class (vfm_source, &input_program_source_class))
- {
- msg (SE, _("This command may only be executed between INPUT PROGRAM "
- "and END INPUT PROGRAM."));
- return CMD_FAILURE;
- }
-
- add_transformation (end_file_trns_proc, NULL, NULL);
-
- return lex_end_of_command ();
-}
-
-/* Executes an END FILE transformation. */
-static int
-end_file_trns_proc (void *trns_ UNUSED, struct ccase *c UNUSED,
- int case_num UNUSED)
-{
- return -2;
-}
+++ /dev/null
-/* This file is part of GNU PSPP
- Computes Levene test statistic.
-
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "levene.h"
-#include "error.h"
-#include "case.h"
-#include "casefile.h"
-#include "dictionary.h"
-#include "group_proc.h"
-#include "hash.h"
-#include "str.h"
-#include "var.h"
-#include "vfm.h"
-#include "alloc.h"
-#include "misc.h"
-#include "group.h"
-
-#include <math.h>
-#include <stdlib.h>
-
-
-/* This module calculates the Levene statistic for variables.
-
- Just for reference, the Levene Statistic is a defines as follows:
-
- W = \frac{ (n-k)\sum_{i=1}^k n_i(Z_{iL} - Z_{LL})^2}
- { (k-1)\sum_{i=1}^k \sum_{j=1}^{n_i} (Z_{ij} - Z_{iL})^2}
-
- where:
- k is the number of groups
- n is the total number of samples
- n_i is the number of samples in the ith group
- Z_{ij} is | Y_{ij} - Y_{iL} | where Y_{iL} is the mean of the ith group
- Z_{iL} is the mean of Z_{ij} over the ith group
- Z_{LL} is the grand mean of Z_{ij}
-
- Imagine calculating that with pencil and paper!
-
- */
-
-
-struct levene_info
-{
-
- /* Per group statistics */
- struct t_test_proc **group_stats;
-
- /* The independent variable */
- struct variable *v_indep;
-
- /* Number of dependent variables */
- size_t n_dep;
-
- /* The dependent variables */
- struct variable **v_dep;
-
- /* How to treat missing values */
- enum lev_missing missing;
-
- /* Function to test for missing values */
- is_missing_func *is_missing;
-};
-
-/* First pass */
-static void levene_precalc (const struct levene_info *l);
-static int levene_calc (const struct ccase *, void *);
-static void levene_postcalc (void *);
-
-
-/* Second pass */
-static void levene2_precalc (void *);
-static int levene2_calc (const struct ccase *, void *);
-static void levene2_postcalc (void *);
-
-
-void
-levene(const struct casefile *cf,
- struct variable *v_indep, size_t n_dep, struct variable **v_dep,
- enum lev_missing missing, is_missing_func value_is_missing)
-{
- struct casereader *r;
- struct ccase c;
- struct levene_info l;
-
- l.n_dep = n_dep;
- l.v_indep = v_indep;
- l.v_dep = v_dep;
- l.missing = missing;
- l.is_missing = value_is_missing;
-
-
-
- levene_precalc(&l);
- for(r = casefile_get_reader (cf);
- casereader_read (r, &c) ;
- case_destroy (&c))
- {
- levene_calc(&c,&l);
- }
- casereader_destroy (r);
- levene_postcalc(&l);
-
- levene2_precalc(&l);
- for(r = casefile_get_reader (cf);
- casereader_read (r, &c) ;
- case_destroy (&c))
- {
- levene2_calc(&c,&l);
- }
- casereader_destroy (r);
- levene2_postcalc(&l);
-
-}
-
-/* Internal variables used in calculating the Levene statistic */
-
-/* Per variable statistics */
-struct lz_stats
-{
- /* Total of all lz */
- double grand_total;
-
- /* Mean of all lz */
- double grand_mean;
-
- /* The total number of cases */
- double total_n ;
-
- /* Number of groups */
- int n_groups;
-};
-
-/* An array of lz_stats for each variable */
-static struct lz_stats *lz;
-
-
-static void
-levene_precalc (const struct levene_info *l)
-{
- size_t i;
-
- lz = xnmalloc (l->n_dep, sizeof *lz);
-
- for(i = 0; i < l->n_dep ; ++i )
- {
- struct variable *var = l->v_dep[i];
- struct group_proc *gp = group_proc_get (var);
- struct group_statistics *gs;
- struct hsh_iterator hi;
-
- lz[i].grand_total = 0;
- lz[i].total_n = 0;
- lz[i].n_groups = gp->n_groups ;
-
-
- for ( gs = hsh_first(gp->group_hash, &hi);
- gs != 0;
- gs = hsh_next(gp->group_hash, &hi))
- {
- gs->lz_total = 0;
- }
-
- }
-
-}
-
-static int
-levene_calc (const struct ccase *c, void *_l)
-{
- size_t i;
- int warn = 0;
- struct levene_info *l = (struct levene_info *) _l;
- const union value *gv = case_data (c, l->v_indep->fv);
- struct group_statistics key;
- double weight = dict_get_case_weight(default_dict,c,&warn);
-
- /* Skip the entire case if /MISSING=LISTWISE is set */
- if ( l->missing == LEV_LISTWISE )
- {
- for (i = 0; i < l->n_dep; ++i)
- {
- struct variable *v = l->v_dep[i];
- const union value *val = case_data (c, v->fv);
-
- if (l->is_missing (&v->miss, val) )
- {
- return 0;
- }
- }
- }
-
-
- key.id = *gv;
-
- for (i = 0; i < l->n_dep; ++i)
- {
- struct variable *var = l->v_dep[i];
- struct group_proc *gp = group_proc_get (var);
- double levene_z;
- const union value *v = case_data (c, var->fv);
- struct group_statistics *gs;
-
- gs = hsh_find(gp->group_hash,(void *) &key );
-
- if ( 0 == gs )
- continue ;
-
- if ( ! l->is_missing(&var->miss, v))
- {
- levene_z= fabs(v->f - gs->mean);
- lz[i].grand_total += levene_z * weight;
- lz[i].total_n += weight;
-
- gs->lz_total += levene_z * weight;
- }
-
- }
- return 0;
-}
-
-
-static void
-levene_postcalc (void *_l)
-{
- size_t v;
-
- struct levene_info *l = (struct levene_info *) _l;
-
- for (v = 0; v < l->n_dep; ++v)
- {
- /* This is Z_LL */
- lz[v].grand_mean = lz[v].grand_total / lz[v].total_n ;
- }
-
-
-}
-
-
-/* The denominator for the expression for the Levene */
-static double *lz_denominator;
-
-static void
-levene2_precalc (void *_l)
-{
- size_t v;
-
- struct levene_info *l = (struct levene_info *) _l;
-
- lz_denominator = xnmalloc (l->n_dep, sizeof *lz_denominator);
-
- /* This stuff could go in the first post calc . . . */
- for (v = 0; v < l->n_dep; ++v)
- {
- struct hsh_iterator hi;
- struct group_statistics *g;
-
- struct variable *var = l->v_dep[v] ;
- struct hsh_table *hash = group_proc_get (var)->group_hash;
-
-
- for(g = (struct group_statistics *) hsh_first(hash,&hi);
- g != 0 ;
- g = (struct group_statistics *) hsh_next(hash,&hi) )
- {
- g->lz_mean = g->lz_total / g->n ;
- }
- lz_denominator[v] = 0;
- }
-}
-
-static int
-levene2_calc (const struct ccase *c, void *_l)
-{
- size_t i;
- int warn = 0;
-
- struct levene_info *l = (struct levene_info *) _l;
-
- double weight = dict_get_case_weight(default_dict,c,&warn);
-
- const union value *gv = case_data (c, l->v_indep->fv);
- struct group_statistics key;
-
- /* Skip the entire case if /MISSING=LISTWISE is set */
- if ( l->missing == LEV_LISTWISE )
- {
- for (i = 0; i < l->n_dep; ++i)
- {
- struct variable *v = l->v_dep[i];
- const union value *val = case_data (c, v->fv);
-
- if (l->is_missing(&v->miss, val) )
- {
- return 0;
- }
- }
- }
-
- key.id = *gv;
-
- for (i = 0; i < l->n_dep; ++i)
- {
- double levene_z;
- struct variable *var = l->v_dep[i] ;
- const union value *v = case_data (c, var->fv);
- struct group_statistics *gs;
-
- gs = hsh_find(group_proc_get (var)->group_hash,(void *) &key );
-
- if ( 0 == gs )
- continue;
-
- if ( ! l->is_missing (&var->miss, v) )
- {
- levene_z = fabs(v->f - gs->mean);
- lz_denominator[i] += weight * pow2(levene_z - gs->lz_mean);
- }
- }
-
- return 0;
-}
-
-
-static void
-levene2_postcalc (void *_l)
-{
- size_t v;
-
- struct levene_info *l = (struct levene_info *) _l;
-
- for (v = 0; v < l->n_dep; ++v)
- {
- double lz_numerator = 0;
- struct hsh_iterator hi;
- struct group_statistics *g;
-
- struct variable *var = l->v_dep[v] ;
- struct group_proc *gp = group_proc_get (var);
- struct hsh_table *hash = gp->group_hash;
-
- for(g = (struct group_statistics *) hsh_first(hash,&hi);
- g != 0 ;
- g = (struct group_statistics *) hsh_next(hash,&hi) )
- {
- lz_numerator += g->n * pow2(g->lz_mean - lz[v].grand_mean );
- }
- lz_numerator *= ( gp->ugs.n - gp->n_groups );
-
- lz_denominator[v] *= (gp->n_groups - 1);
-
- gp->levene = lz_numerator / lz_denominator[v] ;
-
- }
-
- /* Now clear up after ourselves */
- free(lz_denominator);
- free(lz);
-}
-
+++ /dev/null
-/* This file is part of GNU PSPP
- Computes Levene test statistic.
-
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !levene_h
-#define levene_h 1
-
-
-#include "var.h"
-#include "casefile.h"
-
-/* What to do with missing values */
-enum lev_missing { LEV_ANALYSIS, LEV_LISTWISE };
-
-/* Calculate the Levene statistic
-
-The independent variable : v_indep;
-
-Number of dependent variables : n_dep;
-
-The dependent variables : v_dep;
-
-*/
-
-
-void levene(const struct casefile *cf,
- struct variable *v_indep, size_t n_dep, struct variable **v_dep,
- enum lev_missing, is_missing_func);
-
-
-
-#endif /* levene_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000, 2005 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-/*
- This file is concerned with the definition of the PSPP syntax, NOT the
- action of scanning/parsing code .
-*/
-
-#include <config.h>
-#include "lex-def.h"
-
-
-#include <assert.h>
-#include <string.h>
-
-
-/* Table of keywords. */
-const char *keywords[T_N_KEYWORDS + 1] =
- {
- "AND", "OR", "NOT",
- "EQ", "GE", "GT", "LE", "LT", "NE",
- "ALL", "BY", "TO", "WITH",
- NULL,
- };
-
-
-
-/* Comparing identifiers. */
-
-/* Keywords match if one of the following is true: KW and TOK are
- identical (except for differences in case), or TOK is at least 3
- characters long and those characters are identical to KW. KW_LEN
- is the length of KW, TOK_LEN is the length of TOK. */
-int
-lex_id_match_len (const char *kw, size_t kw_len,
- const char *tok, size_t tok_len)
-{
- size_t i = 0;
-
- assert (kw && tok);
- for (;;)
- {
- if (i == kw_len && i == tok_len)
- return 1;
- else if (i == tok_len)
- return i >= 3;
- else if (i == kw_len)
- return 0;
- else if (toupper ((unsigned char) kw[i])
- != toupper ((unsigned char) tok[i]))
- return 0;
-
- i++;
- }
-}
-
-/* Same as lex_id_match_len() minus the need to pass in the lengths. */
-int
-lex_id_match (const char *kw, const char *tok)
-{
- return lex_id_match_len (kw, strlen (kw), tok, strlen (tok));
-}
-
-
-
-/* Returns the proper token type, either T_ID or a reserved keyword
- enum, for ID[], which must contain LEN characters. */
-int
-lex_id_to_token (const char *id, size_t len)
-{
- const char **kwp;
-
- if (len < 2 || len > 4)
- return T_ID;
-
- for (kwp = keywords; *kwp; kwp++)
- if (!strcasecmp (*kwp, id))
- return T_FIRST_KEYWORD + (kwp - keywords);
-
- return T_ID;
-}
-\f
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !lex_def_h
-#define lex_def_h 1
-
-#include <ctype.h>
-#include <stdbool.h>
-#include <sys/types.h>
-
-/* Returns nonzero if character CH may be the first character in an
- identifier. */
-#define CHAR_IS_ID1(CH) \
- (isalpha ((unsigned char) (CH)) \
- || (CH) == '@' \
- || (CH) == '#' \
- || (CH) == '$')
-
-/* Returns nonzero if character CH may be a character in an
- identifier other than the first. */
-#define CHAR_IS_IDN(CH) \
- (CHAR_IS_ID1 (CH) \
- || isdigit ((unsigned char) (CH)) \
- || (CH) == '.' \
- || (CH) == '_')
-
-/* Token types. */
-/* The order of the enumerals below is important. Do not change it. */
-enum
- {
- T_ID = 256, /* Identifier. */
- T_POS_NUM, /* Positive number. */
- T_NEG_NUM, /* Negative number. */
- T_STRING, /* Quoted string. */
- T_STOP, /* End of input. */
-
- T_AND, /* AND */
- T_OR, /* OR */
- T_NOT, /* NOT */
-
- T_EQ, /* EQ */
- T_GE, /* GE or >= */
- T_GT, /* GT or > */
- T_LE, /* LE or <= */
- T_LT, /* LT or < */
- T_NE, /* NE or ~= */
-
- T_ALL, /* ALL */
- T_BY, /* BY */
- T_TO, /* TO */
- T_WITH, /* WITH */
-
- T_EXP, /* ** */
-
- T_FIRST_KEYWORD = T_AND,
- T_LAST_KEYWORD = T_WITH,
- T_N_KEYWORDS = T_LAST_KEYWORD - T_FIRST_KEYWORD + 1
- };
-
-
-/* Comparing identifiers. */
-int lex_id_match_len (const char *keyword_string, size_t keyword_len,
- const char *token_string, size_t token_len);
-int lex_id_match (const char *keyword_string, const char *token_string);
-int lex_id_to_token (const char *id, size_t len);
-
-#endif /* !lex_def_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "lexer.h"
-#include "error.h"
-#include <ctype.h>
-#include <errno.h>
-#include <limits.h>
-#include <math.h>
-#include <stdarg.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "command.h"
-#include "error.h"
-#include "getl.h"
-#include "magic.h"
-#include "settings.h"
-#include "str.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-#define N_(msgid) msgid
-
-/*
-#define DUMP_TOKENS 1
-*/
-
-\f
-/* Global variables. */
-
-extern const char *keywords[T_N_KEYWORDS + 1];
-
-
-/* Current token. */
-int token;
-
-/* T_POS_NUM, T_NEG_NUM: the token's value. */
-double tokval;
-
-/* T_ID: the identifier. */
-char tokid[LONG_NAME_LEN + 1];
-
-/* T_ID, T_STRING: token string value.
- For T_ID, this is not truncated as is tokid. */
-struct string tokstr;
-\f
-/* Static variables. */
-
-/* Pointer to next token in getl_buf. */
-static char *prog;
-
-/* Nonzero only if this line ends with a terminal dot. */
-static int dot;
-
-/* Nonzero only if the last token returned was T_STOP. */
-static int eof;
-
-/* If nonzero, next token returned by lex_get().
- Used only in exceptional circumstances. */
-static int put_token;
-static struct string put_tokstr;
-static double put_tokval;
-
-static void unexpected_eof (void);
-static void convert_numeric_string_to_char_string (int type);
-static int parse_string (int type);
-
-#if DUMP_TOKENS
-static void dump_token (void);
-#endif
-\f
-/* Initialization. */
-
-/* Initializes the lexer. */
-void
-lex_init (void)
-{
- ds_init (&tokstr, 64);
- ds_init (&put_tokstr, 64);
- if (!lex_get_line ())
- unexpected_eof ();
-}
-
-void
-lex_done (void)
-{
- ds_destroy (&put_tokstr);
- ds_destroy (&tokstr);
-}
-
-\f
-/* Common functions. */
-
-/* Copies put_token, put_tokstr, put_tokval into token, tokstr,
- tokval, respectively, and sets tokid appropriately. */
-static void
-restore_token (void)
-{
- assert (put_token != 0);
- token = put_token;
- ds_replace (&tokstr, ds_c_str (&put_tokstr));
- str_copy_trunc (tokid, sizeof tokid, ds_c_str (&tokstr));
- tokval = put_tokval;
- put_token = 0;
-}
-
-/* Copies token, tokstr, tokval into put_token, put_tokstr,
- put_tokval respectively. */
-static void
-save_token (void)
-{
- put_token = token;
- ds_replace (&put_tokstr, ds_c_str (&tokstr));
- put_tokval = tokval;
-}
-
-/* Parses a single token, setting appropriate global variables to
- indicate the token's attributes. */
-void
-lex_get (void)
-{
- /* If a token was pushed ahead, return it. */
- if (put_token)
- {
- restore_token ();
-#if DUMP_TOKENS
- dump_token ();
-#endif
- return;
- }
-
- /* Find a token. */
- for (;;)
- {
- char *cp;
-
- /* Skip whitespace. */
- if (eof)
- unexpected_eof ();
-
- for (;;)
- {
- while (isspace ((unsigned char) *prog))
- prog++;
- if (*prog)
- break;
-
- if (dot)
- {
- dot = 0;
- token = '.';
-#if DUMP_TOKENS
- dump_token ();
-#endif
- return;
- }
- else if (!lex_get_line ())
- {
- eof = 1;
- token = T_STOP;
-#if DUMP_TOKENS
- dump_token ();
-#endif
- return;
- }
-
- if (put_token)
- {
- restore_token ();
-#if DUMP_TOKENS
- dump_token ();
-#endif
- return;
- }
- }
-
-
- /* Actually parse the token. */
- cp = prog;
- ds_clear (&tokstr);
-
- switch (*prog)
- {
- case '-': case '.':
- case '0': case '1': case '2': case '3': case '4':
- case '5': case '6': case '7': case '8': case '9':
- {
- char *tail;
-
- /* `-' can introduce a negative number, or it can be a
- token by itself. If it is not followed by a digit or a
- decimal point, it is definitely not a number.
- Otherwise, it might be either, but most of the time we
- want it as a number. When the syntax calls for a `-'
- token, lex_negative_to_dash() must be used to break
- negative numbers into two tokens. */
- if (*cp == '-')
- {
- ds_putc (&tokstr, *prog++);
- while (isspace ((unsigned char) *prog))
- prog++;
-
- if (!isdigit ((unsigned char) *prog) && *prog != '.')
- {
- token = '-';
- break;
- }
- token = T_NEG_NUM;
- }
- else
- token = T_POS_NUM;
-
- /* Parse the number, copying it into tokstr. */
- while (isdigit ((unsigned char) *prog))
- ds_putc (&tokstr, *prog++);
- if (*prog == '.')
- {
- ds_putc (&tokstr, *prog++);
- while (isdigit ((unsigned char) *prog))
- ds_putc (&tokstr, *prog++);
- }
- if (*prog == 'e' || *prog == 'E')
- {
- ds_putc (&tokstr, *prog++);
- if (*prog == '+' || *prog == '-')
- ds_putc (&tokstr, *prog++);
- while (isdigit ((unsigned char) *prog))
- ds_putc (&tokstr, *prog++);
- }
-
- /* Parse as floating point. */
- tokval = strtod (ds_c_str (&tokstr), &tail);
- if (*tail)
- {
- msg (SE, _("%s does not form a valid number."),
- ds_c_str (&tokstr));
- tokval = 0.0;
-
- ds_clear (&tokstr);
- ds_putc (&tokstr, '0');
- }
-
- break;
- }
-
- case '\'': case '"':
- token = parse_string (0);
- break;
-
- case '(': case ')': case ',': case '=': case '+': case '/':
- token = *prog++;
- break;
-
- case '*':
- if (*++prog == '*')
- {
- prog++;
- token = T_EXP;
- }
- else
- token = '*';
- break;
-
- case '<':
- if (*++prog == '=')
- {
- prog++;
- token = T_LE;
- }
- else if (*prog == '>')
- {
- prog++;
- token = T_NE;
- }
- else
- token = T_LT;
- break;
-
- case '>':
- if (*++prog == '=')
- {
- prog++;
- token = T_GE;
- }
- else
- token = T_GT;
- break;
-
- case '~':
- if (*++prog == '=')
- {
- prog++;
- token = T_NE;
- }
- else
- token = T_NOT;
- break;
-
- case '&':
- prog++;
- token = T_AND;
- break;
-
- case '|':
- prog++;
- token = T_OR;
- break;
-
- case 'a': case 'b': case 'c': case 'd': case 'e':
- case 'f': case 'g': case 'h': case 'i': case 'j':
- case 'k': case 'l': case 'm': case 'n': case 'o':
- case 'p': case 'q': case 'r': case 's': case 't':
- case 'u': case 'v': case 'w': case 'x': case 'y':
- case 'z':
- case 'A': case 'B': case 'C': case 'D': case 'E':
- case 'F': case 'G': case 'H': case 'I': case 'J':
- case 'K': case 'L': case 'M': case 'N': case 'O':
- case 'P': case 'Q': case 'R': case 'S': case 'T':
- case 'U': case 'V': case 'W': case 'X': case 'Y':
- case 'Z':
- case '#': case '$': case '@':
- /* Strings can be specified in binary, octal, or hex using
- this special syntax. */
- if (prog[1] == '\'' || prog[1] == '"')
- {
- static const char special[3] = "box";
- const char *p;
-
- p = strchr (special, tolower ((unsigned char) *prog));
- if (p)
- {
- prog++;
- token = parse_string (p - special + 1);
- break;
- }
- }
-
- /* Copy id to tokstr. */
- ds_putc (&tokstr, *prog++);
- while (CHAR_IS_IDN (*prog))
- ds_putc (&tokstr, *prog++);
-
- /* Copy tokstr to tokid, possibly truncating it.*/
- str_copy_trunc (tokid, sizeof tokid, ds_c_str (&tokstr));
-
- /* Determine token type. */
- token = lex_id_to_token (ds_c_str (&tokstr), ds_length (&tokstr));
- break;
-
- default:
- if (isgraph ((unsigned char) *prog))
- msg (SE, _("Bad character in input: `%c'."), *prog++);
- else
- msg (SE, _("Bad character in input: `\\%o'."), *prog++);
- continue;
- }
-
- break;
- }
-
-#if DUMP_TOKENS
- dump_token ();
-#endif
-}
-
-/* Reports an error to the effect that subcommand SBC may only be
- specified once. */
-void
-lex_sbc_only_once (const char *sbc)
-{
- msg (SE, _("Subcommand %s may only be specified once."), sbc);
-}
-
-/* Reports an error to the effect that subcommand SBC is
- missing. */
-void
-lex_sbc_missing (const char *sbc)
-{
- lex_error (_("missing required subcommand %s"), sbc);
-}
-
-/* Prints a syntax error message containing the current token and
- given message MESSAGE (if non-null). */
-void
-lex_error (const char *message, ...)
-{
- char *token_rep;
- char where[128];
-
- token_rep = lex_token_representation ();
- if (token == T_STOP)
- strcpy (where, "end of file");
- else if (token == '.')
- strcpy (where, "end of command");
- else
- snprintf (where, sizeof where, "`%s'", token_rep);
- free (token_rep);
-
- if (message)
- {
- char buf[1024];
- va_list args;
-
- va_start (args, message);
- vsnprintf (buf, 1024, message, args);
- va_end (args);
-
- msg (SE, _("Syntax error %s at %s."), buf, where);
- }
- else
- msg (SE, _("Syntax error at %s."), where);
-}
-
-/* Checks that we're at end of command.
- If so, returns a successful command completion code.
- If not, flags a syntax error and returns an error command
- completion code. */
-int
-lex_end_of_command (void)
-{
- if (token != '.')
- {
- lex_error (_("expecting end of command"));
- return CMD_TRAILING_GARBAGE;
- }
- else
- return CMD_SUCCESS;
-}
-\f
-/* Token testing functions. */
-
-/* Returns true if the current token is a number. */
-bool
-lex_is_number (void)
-{
- return token == T_POS_NUM || token == T_NEG_NUM;
-}
-
-/* Returns the value of the current token, which must be a
- floating point number. */
-double
-lex_number (void)
-{
- assert (lex_is_number ());
- return tokval;
-}
-
-/* Returns true iff the current token is an integer. */
-bool
-lex_is_integer (void)
-{
- return (lex_is_number ()
- && tokval != NOT_LONG
- && tokval >= LONG_MIN
- && tokval <= LONG_MAX
- && floor (tokval) == tokval);
-}
-
-/* Returns the value of the current token, which must be an
- integer. */
-long
-lex_integer (void)
-{
- assert (lex_is_integer ());
- return tokval;
-}
-\f
-/* Token matching functions. */
-
-/* If TOK is the current token, skips it and returns nonzero.
- Otherwise, returns zero. */
-int
-lex_match (int t)
-{
- if (token == t)
- {
- lex_get ();
- return 1;
- }
- else
- return 0;
-}
-
-/* If the current token is the identifier S, skips it and returns
- nonzero. The identifier may be abbreviated to its first three
- letters.
- Otherwise, returns zero. */
-int
-lex_match_id (const char *s)
-{
- if (token == T_ID && lex_id_match (s, tokid))
- {
- lex_get ();
- return 1;
- }
- else
- return 0;
-}
-
-/* If the current token is integer N, skips it and returns nonzero.
- Otherwise, returns zero. */
-int
-lex_match_int (int x)
-{
- if (lex_is_integer () && lex_integer () == x)
- {
- lex_get ();
- return 1;
- }
- else
- return 0;
-}
-\f
-/* Forced matches. */
-
-/* If this token is identifier S, fetches the next token and returns
- nonzero.
- Otherwise, reports an error and returns zero. */
-int
-lex_force_match_id (const char *s)
-{
- if (token == T_ID && lex_id_match (s, tokid))
- {
- lex_get ();
- return 1;
- }
- else
- {
- lex_error (_("expecting `%s'"), s);
- return 0;
- }
-}
-
-/* If the current token is T, skips the token. Otherwise, reports an
- error and returns from the current function with return value 0. */
-int
-lex_force_match (int t)
-{
- if (token == t)
- {
- lex_get ();
- return 1;
- }
- else
- {
- lex_error (_("expecting `%s'"), lex_token_name (t));
- return 0;
- }
-}
-
-/* If this token is a string, does nothing and returns nonzero.
- Otherwise, reports an error and returns zero. */
-int
-lex_force_string (void)
-{
- if (token == T_STRING)
- return 1;
- else
- {
- lex_error (_("expecting string"));
- return 0;
- }
-}
-
-/* If this token is an integer, does nothing and returns nonzero.
- Otherwise, reports an error and returns zero. */
-int
-lex_force_int (void)
-{
- if (lex_is_integer ())
- return 1;
- else
- {
- lex_error (_("expecting integer"));
- return 0;
- }
-}
-
-/* If this token is a number, does nothing and returns nonzero.
- Otherwise, reports an error and returns zero. */
-int
-lex_force_num (void)
-{
- if (lex_is_number ())
- return 1;
- else
- {
- lex_error (_("expecting number"));
- return 0;
- }
-}
-
-/* If this token is an identifier, does nothing and returns nonzero.
- Otherwise, reports an error and returns zero. */
-int
-lex_force_id (void)
-{
- if (token == T_ID)
- return 1;
- else
- {
- lex_error (_("expecting identifier"));
- return 0;
- }
-}
-/* Weird token functions. */
-
-/* Returns the first character of the next token, except that if the
- next token is not an identifier, the character returned will not be
- a character that can begin an identifier. Specifically, the
- hexstring lead-in X' causes lookahead() to return '. Note that an
- alphanumeric return value doesn't guarantee an ID token, it could
- also be a reserved-word token. */
-int
-lex_look_ahead (void)
-{
- if (put_token)
- return put_token;
-
- for (;;)
- {
- if (eof)
- unexpected_eof ();
-
- for (;;)
- {
- while (isspace ((unsigned char) *prog))
- prog++;
- if (*prog)
- break;
-
- if (dot)
- return '.';
- else if (!lex_get_line ())
- unexpected_eof ();
-
- if (put_token)
- return put_token;
- }
-
- if ((toupper ((unsigned char) *prog) == 'X'
- || toupper ((unsigned char) *prog) == 'B')
- && (prog[1] == '\'' || prog[1] == '"'))
- return '\'';
-
- return *prog;
- }
-}
-
-/* Makes the current token become the next token to be read; the
- current token is set to T. */
-void
-lex_put_back (int t)
-{
- save_token ();
- token = t;
-}
-
-/* Makes the current token become the next token to be read; the
- current token is set to the identifier ID. */
-void
-lex_put_back_id (const char *id)
-{
- assert (lex_id_to_token (id, strlen (id)) == T_ID);
- save_token ();
- token = T_ID;
- ds_replace (&tokstr, id);
- str_copy_trunc (tokid, sizeof tokid, ds_c_str (&tokstr));
-}
-\f
-/* Weird line processing functions. */
-
-/* Returns the entire contents of the current line. */
-const char *
-lex_entire_line (void)
-{
- return ds_c_str (&getl_buf);
-}
-
-/* As lex_entire_line(), but only returns the part of the current line
- that hasn't already been tokenized.
- If END_DOT is non-null, stores nonzero into *END_DOT if the line
- ends with a terminal dot, or zero if it doesn't. */
-const char *
-lex_rest_of_line (int *end_dot)
-{
- if (end_dot)
- *end_dot = dot;
- return prog;
-}
-
-/* Causes the rest of the current input line to be ignored for
- tokenization purposes. */
-void
-lex_discard_line (void)
-{
- prog = ds_end (&getl_buf);
- dot = put_token = 0;
-}
-
-/* Sets the current position in the current line to P, which must be
- in getl_buf. */
-void
-lex_set_prog (char *p)
-{
- prog = p;
-}
-\f
-/* Weird line reading functions. */
-
-/* Read a line for use by the tokenizer. */
-int
-lex_get_line (void)
-{
- if (!getl_read_line ())
- return 0;
-
- lex_preprocess_line ();
- return 1;
-}
-
-/* Preprocesses getl_buf by removing comments, stripping trailing
- whitespace and the terminal dot, and removing leading indentors. */
-void
-lex_preprocess_line (void)
-{
- /* Strips comments. */
- {
- /* getl_buf iterator. */
- char *cp;
-
- /* Nonzero inside a comment. */
- int comment;
-
- /* Nonzero inside a quoted string. */
- int quote;
-
- /* Remove C-style comments begun by slash-star and terminated by
- star-slash or newline. */
- quote = comment = 0;
- for (cp = ds_c_str (&getl_buf); *cp; )
- {
- /* If we're not commented out, toggle quoting. */
- if (!comment)
- {
- if (*cp == quote)
- quote = 0;
- else if (*cp == '\'' || *cp == '"')
- quote = *cp;
- }
-
- /* If we're not quoting, toggle commenting. */
- if (!quote)
- {
- if (cp[0] == '/' && cp[1] == '*')
- {
- comment = 1;
- *cp++ = ' ';
- *cp++ = ' ';
- continue;
- }
- else if (cp[0] == '*' && cp[1] == '/' && comment)
- {
- comment = 0;
- *cp++ = ' ';
- *cp++ = ' ';
- continue;
- }
- }
-
- /* Check commenting. */
- if (!comment)
- cp++;
- else
- *cp++ = ' ';
- }
- }
-
- /* Strip trailing whitespace and terminal dot. */
- {
- size_t len = ds_length (&getl_buf);
- char *s = ds_c_str (&getl_buf);
-
- /* Strip trailing whitespace. */
- while (len > 0 && isspace ((unsigned char) s[len - 1]))
- len--;
-
- /* Check for and remove terminal dot. */
- if (len > 0 && s[len - 1] == get_endcmd ())
- {
- dot = 1;
- len--;
- }
- else if (len == 0 && get_nulline ())
- dot = 1;
- else
- dot = 0;
-
- /* Set length. */
- ds_truncate (&getl_buf, len);
- }
-
- /* In batch mode, strip leading indentors and insert a terminal dot
- as necessary. */
- if (getl_interactive != 2 && getl_mode == GETL_MODE_BATCH)
- {
- char *s = ds_c_str (&getl_buf);
-
- if (s[0] == '+' || s[0] == '-' || s[0] == '.')
- s[0] = ' ';
- else if (s[0] && !isspace ((unsigned char) s[0]))
- put_token = '.';
- }
-
- prog = ds_c_str (&getl_buf);
-}
-\f
-/* Token names. */
-
-/* Returns the name of a token in a static buffer. */
-const char *
-lex_token_name (int token)
-{
- if (token >= T_FIRST_KEYWORD && token <= T_LAST_KEYWORD)
- return keywords[token - T_FIRST_KEYWORD];
-
- if (token < 256)
- {
- static char t[2];
- t[0] = token;
- return t;
- }
-
- return _("<ERROR>");
-}
-
-/* Returns an ASCII representation of the current token as a
- malloc()'d string. */
-char *
-lex_token_representation (void)
-{
- char *token_rep;
-
- switch (token)
- {
- case T_ID:
- case T_POS_NUM:
- case T_NEG_NUM:
- return xstrdup (ds_c_str (&tokstr));
- break;
-
- case T_STRING:
- {
- int hexstring = 0;
- char *sp, *dp;
-
- for (sp = ds_c_str (&tokstr); sp < ds_end (&tokstr); sp++)
- if (!isprint ((unsigned char) *sp))
- {
- hexstring = 1;
- break;
- }
-
- token_rep = xmalloc (2 + ds_length (&tokstr) * 2 + 1 + 1);
-
- dp = token_rep;
- if (hexstring)
- *dp++ = 'X';
- *dp++ = '\'';
-
- if (!hexstring)
- for (sp = ds_c_str (&tokstr); *sp; )
- {
- if (*sp == '\'')
- *dp++ = '\'';
- *dp++ = (unsigned char) *sp++;
- }
- else
- for (sp = ds_c_str (&tokstr); sp < ds_end (&tokstr); sp++)
- {
- *dp++ = (((unsigned char) *sp) >> 4)["0123456789ABCDEF"];
- *dp++ = (((unsigned char) *sp) & 15)["0123456789ABCDEF"];
- }
- *dp++ = '\'';
- *dp = '\0';
-
- return token_rep;
- }
- break;
-
- case T_STOP:
- token_rep = xmalloc (1);
- *token_rep = '\0';
- return token_rep;
-
- case T_EXP:
- return xstrdup ("**");
-
- default:
- if (token >= T_FIRST_KEYWORD && token <= T_LAST_KEYWORD)
- return xstrdup (keywords [token - T_FIRST_KEYWORD]);
- else
- {
- token_rep = xmalloc (2);
- token_rep[0] = token;
- token_rep[1] = '\0';
- return token_rep;
- }
- }
-
- assert (0);
-}
-\f
-/* Really weird functions. */
-
-/* Most of the time, a `-' is a lead-in to a negative number. But
- sometimes it's actually part of the syntax. If a dash can be part
- of syntax then this function is called to rip it off of a
- number. */
-void
-lex_negative_to_dash (void)
-{
- if (token == T_NEG_NUM)
- {
- token = T_POS_NUM;
- tokval = -tokval;
- ds_replace (&tokstr, ds_c_str (&tokstr) + 1);
- save_token ();
- token = '-';
- }
-}
-
-/* We're not at eof any more. */
-void
-lex_reset_eof (void)
-{
- eof = 0;
-}
-
-/* Skip a COMMENT command. */
-void
-lex_skip_comment (void)
-{
- for (;;)
- {
- if (!lex_get_line ())
- {
- put_token = T_STOP;
- eof = 1;
- return;
- }
-
- if (put_token == '.')
- break;
-
- prog = ds_end (&getl_buf);
- if (dot)
- break;
- }
-}
-\f
-/* Private functions. */
-
-/* Unexpected end of file. */
-static void
-unexpected_eof (void)
-{
- msg (FE, _("Unexpected end of file."));
-}
-
-/* When invoked, tokstr contains a string of binary, octal, or hex
- digits, for values of TYPE of 0, 1, or 2, respectively. The string
- is converted to characters having the specified values. */
-static void
-convert_numeric_string_to_char_string (int type)
-{
- static const char *base_names[] = {N_("binary"), N_("octal"), N_("hex")};
- static const int bases[] = {2, 8, 16};
- static const int chars_per_byte[] = {8, 3, 2};
-
- const char *const base_name = base_names[type];
- const int base = bases[type];
- const int cpb = chars_per_byte[type];
- const int nb = ds_length (&tokstr) / cpb;
- int i;
- char *p;
-
- assert (type >= 0 && type <= 2);
-
- if (ds_length (&tokstr) % cpb)
- msg (SE, _("String of %s digits has %d characters, which is not a "
- "multiple of %d."),
- gettext (base_name), ds_length (&tokstr), cpb);
-
- p = ds_c_str (&tokstr);
- for (i = 0; i < nb; i++)
- {
- int value;
- int j;
-
- value = 0;
- for (j = 0; j < cpb; j++, p++)
- {
- int v;
-
- if (*p >= '0' && *p <= '9')
- v = *p - '0';
- else
- {
- static const char alpha[] = "abcdef";
- const char *q = strchr (alpha, tolower ((unsigned char) *p));
-
- if (q)
- v = q - alpha + 10;
- else
- v = base;
- }
-
- if (v >= base)
- msg (SE, _("`%c' is not a valid %s digit."), *p, base_name);
-
- value = value * base + v;
- }
-
- ds_c_str (&tokstr)[i] = (unsigned char) value;
- }
-
- ds_truncate (&tokstr, nb);
-}
-
-/* Parses a string from the input buffer into tokstr. The input
- buffer pointer prog must point to the initial single or double
- quote. TYPE is 0 if it is an ordinary string, or 1, 2, or 3 for a
- binary, octal, or hexstring, respectively. Returns token type. */
-static int
-parse_string (int type)
-{
- /* Accumulate the entire string, joining sections indicated by +
- signs. */
- for (;;)
- {
- /* Single or double quote. */
- int c = *prog++;
-
- /* Accumulate section. */
- for (;;)
- {
- /* Check end of line. */
- if (*prog == 0)
- {
- msg (SE, _("Unterminated string constant."));
- goto finish;
- }
-
- /* Double quote characters to embed them in strings. */
- if (*prog == c)
- {
- if (prog[1] == c)
- prog++;
- else
- break;
- }
-
- ds_putc (&tokstr, *prog++);
- }
- prog++;
-
- /* Skip whitespace after final quote mark. */
- if (eof)
- break;
- for (;;)
- {
- while (isspace ((unsigned char) *prog))
- prog++;
- if (*prog)
- break;
-
- if (dot)
- goto finish;
-
- if (!lex_get_line ())
- unexpected_eof ();
- }
-
- /* Skip plus sign. */
- if (*prog != '+')
- break;
- prog++;
-
- /* Skip whitespace after plus sign. */
- if (eof)
- break;
- for (;;)
- {
- while (isspace ((unsigned char) *prog))
- prog++;
- if (*prog)
- break;
-
- if (dot)
- goto finish;
-
- if (!lex_get_line ())
- unexpected_eof ();
- }
-
- /* Ensure that a valid string follows. */
- if (*prog != '\'' && *prog != '"')
- {
- msg (SE, "String expected following `+'.");
- goto finish;
- }
- }
-
- /* We come here when we've finished concatenating all the string sections
- into one large string. */
-finish:
- if (type != 0)
- convert_numeric_string_to_char_string (type - 1);
-
- if (ds_length (&tokstr) > 255)
- {
- msg (SE, _("String exceeds 255 characters in length (%d characters)."),
- ds_length (&tokstr));
- ds_truncate (&tokstr, 255);
- }
-
- {
- /* FIXME. */
- size_t i;
- int warned = 0;
-
- for (i = 0; i < ds_length (&tokstr); i++)
- if (ds_c_str (&tokstr)[i] == 0)
- {
- if (!warned)
- {
- msg (SE, _("Sorry, literal strings may not contain null "
- "characters. Replacing with spaces."));
- warned = 1;
- }
- ds_c_str (&tokstr)[i] = ' ';
- }
- }
-
- return T_STRING;
-}
-\f
-#if DUMP_TOKENS
-/* Reads one token from the lexer and writes a textual representation
- on stdout for debugging purposes. */
-static void
-dump_token (void)
-{
- {
- const char *curfn;
- int curln;
-
- getl_location (&curfn, &curln);
- if (curfn)
- fprintf (stderr, "%s:%d\t", curfn, curln);
- }
-
- switch (token)
- {
- case T_ID:
- fprintf (stderr, "ID\t%s\n", tokid);
- break;
-
- case T_POS_NUM:
- case T_NEG_NUM:
- fprintf (stderr, "NUM\t%f\n", tokval);
- break;
-
- case T_STRING:
- fprintf (stderr, "STRING\t\"%s\"\n", ds_c_str (&tokstr));
- break;
-
- case T_STOP:
- fprintf (stderr, "STOP\n");
- break;
-
- case T_EXP:
- fprintf (stderr, "MISC\tEXP\"");
- break;
-
- case 0:
- fprintf (stderr, "MISC\tEOF\n");
- break;
-
- default:
- if (token >= T_FIRST_KEYWORD && token <= T_LAST_KEYWORD)
- fprintf (stderr, "KEYWORD\t%s\n", lex_token_name (token));
- else
- fprintf (stderr, "PUNCT\t%c\n", token);
- break;
- }
-}
-#endif /* DUMP_TOKENS */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !lexer_h
-#define lexer_h 1
-
-#include "var.h"
-#include <ctype.h>
-#include <stdbool.h>
-
-#include "lex-def.h"
-
-
-extern int token;
-extern double tokval;
-extern char tokid[LONG_NAME_LEN + 1];
-extern struct string tokstr;
-
-#include <stddef.h>
-
-/* Initialization. */
-void lex_init (void);
-void lex_done (void);
-
-/* Common functions. */
-void lex_get (void);
-void lex_error (const char *, ...);
-void lex_sbc_only_once (const char *);
-void lex_sbc_missing (const char *);
-int lex_end_of_command (void);
-
-/* Token testing functions. */
-bool lex_is_number (void);
-double lex_number (void);
-bool lex_is_integer (void);
-long lex_integer (void);
-
-/* Token matching functions. */
-int lex_match (int);
-int lex_match_id (const char *);
-int lex_match_int (int);
-
-/* Forcible matching functions. */
-int lex_force_match (int);
-int lex_force_match_id (const char *);
-int lex_force_int (void);
-int lex_force_num (void);
-int lex_force_id (void);
-int lex_force_string (void);
-
-/* Weird token functions. */
-int lex_look_ahead (void);
-void lex_put_back (int);
-void lex_put_back_id (const char *tokid);
-
-/* Weird line processing functions. */
-const char *lex_entire_line (void);
-const char *lex_rest_of_line (int *end_dot);
-void lex_discard_line (void);
-void lex_set_prog (char *p);
-
-/* Weird line reading functions. */
-int lex_get_line (void);
-void lex_preprocess_line (void);
-
-/* Token names. */
-const char *lex_token_name (int);
-char *lex_token_representation (void);
-
-/* Really weird functions. */
-void lex_negative_to_dash (void);
-void lex_reset_eof (void);
-void lex_skip_comment (void);
-
-#endif /* !lexer_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <assert.h>
-#include <stdlib.h>
-
-#include "alloc.h"
-#include "linked-list.h"
-
-/* Iteration */
-
-/* Return the first element in LL */
-void *
-ll_first (const struct linked_list *ll, struct ll_iterator *li)
-{
- assert(ll);
-
- li->p = ll->head;
-
- return ll->head->entry;
-}
-
-/* Return the next element in LL iterated by LI */
-void *
-ll_next (const struct linked_list *ll UNUSED, struct ll_iterator *li)
-{
- assert( ll ) ;
-
- li->p = li->p->next;
-
- if ( ! li->p )
- return 0;
-
- return li->p->entry;
-}
-
-
-/* Create a linked list.
- Elements will be freed using F and AUX
-*/
-struct linked_list *
-ll_create( ll_free_func *f , void *aux)
-{
- struct linked_list *ll = xmalloc ( sizeof(struct linked_list) ) ;
-
- ll->head = 0;
- ll->free = f;
- ll->aux = aux;
-
- return ll;
-}
-
-
-/* Destroy a linked list */
-void
-ll_destroy(struct linked_list *ll)
-{
- struct node *n = ll->head;
-
- while (n)
- {
- struct node *nn = n->next;
- if ( ll->free )
- ll->free(n->entry, ll->aux);
- free (n);
- n = nn;
- }
-
- free (ll);
-}
-
-
-/* Push a an element ENTRY onto the list LL */
-void
-ll_push_front(struct linked_list *ll, void *entry)
-{
- struct node *n ;
- assert (ll);
-
- n = xmalloc (sizeof(struct node) );
- n->next = ll->head;
- n->entry = entry;
- ll->head = n;
-}
-
+++ /dev/null
-#ifndef LL_H
-#define LL_H
-
-
-struct node
-{
- void *entry;
- struct node *next;
-};
-
-
-
-typedef void ll_free_func (void *, void *aux);
-
-struct linked_list
-{
- struct node *head;
- ll_free_func *free;
- void *aux;
-};
-
-
-struct ll_iterator
-{
- struct node *p;
-};
-
-
-/* Iteration */
-
-/* Return the first element in LL */
-void * ll_first (const struct linked_list *ll, struct ll_iterator *li);
-
-/* Return the next element in LL iterated by LI */
-void * ll_next (const struct linked_list *ll, struct ll_iterator *li);
-
-/* Create a linked list.
- Elements will be freed using F and AUX
-*/
-struct linked_list * ll_create( ll_free_func *F , void *aux);
-
-/* Destroy a linked list LL */
-void ll_destroy(struct linked_list *ll);
-
-/* Push a an element ENTRY onto the list LL */
-void ll_push_front(struct linked_list *ll, void *entry);
-
-#endif
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "case.h"
-#include "command.h"
-#include "dictionary.h"
-#include "lexer.h"
-#include "error.h"
-#include "magic.h"
-#include "misc.h"
-#include "htmlP.h"
-#include "output.h"
-#include "size_max.h"
-#include "som.h"
-#include "tab.h"
-#include "var.h"
-#include "vfm.h"
-#include "format.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* (headers) */
-
-#include "debug-print.h"
-
-/* (specification)
- list (lst_):
- *variables=varlist("PV_NO_SCRATCH");
- cases=:from n:first,"%s>0"/by n:step,"%s>0"/ *to n:last,"%s>0";
- format=numbering:numbered/!unnumbered,
- wrap:!wrap/single,
- weight:weight/!noweight.
-*/
-/* (declarations) */
-/* (functions) */
-
-/* Layout for one output driver. */
-struct list_ext
- {
- int type; /* 0=Values and labels fit across the page. */
- size_t n_vertical; /* Number of labels to list vertically. */
- size_t header_rows; /* Number of header rows. */
- char **header; /* The header itself. */
- };
-
-/* Parsed command. */
-static struct cmd_list cmd;
-
-/* Current case number. */
-static int case_idx;
-
-/* Line buffer. */
-static char *line_buf;
-
-/* TTY-style output functions. */
-static unsigned n_lines_remaining (struct outp_driver *d);
-static unsigned n_chars_width (struct outp_driver *d);
-static void write_line (struct outp_driver *d, char *s);
-
-/* Other functions. */
-static int list_cases (struct ccase *, void *);
-static void determine_layout (void);
-static void clean_up (void);
-static void write_header (struct outp_driver *);
-static void write_all_headers (void *);
-
-/* Returns the number of text lines that can fit on the remainder of
- the page. */
-static inline unsigned
-n_lines_remaining (struct outp_driver *d)
-{
- int diff;
-
- diff = d->length - d->cp_y;
- return (diff > 0) ? (diff / d->font_height) : 0;
-}
-
-/* Returns the number of fixed-width character that can fit across the
- page. */
-static inline unsigned
-n_chars_width (struct outp_driver *d)
-{
- return d->width / d->fixed_width;
-}
-
-/* Writes the line S at the current position and advances to the next
- line. */
-static void
-write_line (struct outp_driver *d, char *s)
-{
- struct outp_text text;
-
- assert (d->cp_y + d->font_height <= d->length);
- text.options = OUTP_T_JUST_LEFT;
- ls_init (&text.s, s, strlen (s));
- text.x = d->cp_x;
- text.y = d->cp_y;
- d->class->text_draw (d, &text);
- d->cp_x = 0;
- d->cp_y += d->font_height;
-}
-
-/* Parses and executes the LIST procedure. */
-int
-cmd_list (void)
-{
- struct variable casenum_var;
-
- if (!parse_list (&cmd))
- return CMD_FAILURE;
-
- /* Fill in defaults. */
- if (cmd.step == NOT_LONG)
- cmd.step = 1;
- if (cmd.first == NOT_LONG)
- cmd.first = 1;
- if (cmd.last == NOT_LONG)
- cmd.last = LONG_MAX;
- if (!cmd.sbc_variables)
- dict_get_vars (default_dict, &cmd.v_variables, &cmd.n_variables,
- (1u << DC_SYSTEM) | (1u << DC_SCRATCH));
- if (cmd.n_variables == 0)
- {
- msg (SE, _("No variables specified."));
- return CMD_FAILURE;
- }
-
- /* Verify arguments. */
- if (cmd.first > cmd.last)
- {
- int t;
- msg (SW, _("The first case (%ld) specified precedes the last case (%ld) "
- "specified. The values will be swapped."), cmd.first, cmd.last);
- t = cmd.first;
- cmd.first = cmd.last;
- cmd.last = t;
- }
- if (cmd.first < 1)
- {
- msg (SW, _("The first case (%ld) to list is less than 1. The value is "
- "being reset to 1."), cmd.first);
- cmd.first = 1;
- }
- if (cmd.last < 1)
- {
- msg (SW, _("The last case (%ld) to list is less than 1. The value is "
- "being reset to 1."), cmd.last);
- cmd.last = 1;
- }
- if (cmd.step < 1)
- {
- msg (SW, _("The step value %ld is less than 1. The value is being "
- "reset to 1."), cmd.step);
- cmd.step = 1;
- }
-
- /* Weighting variable. */
- if (cmd.weight == LST_WEIGHT)
- {
- if (dict_get_weight (default_dict) != NULL)
- {
- size_t i;
-
- for (i = 0; i < cmd.n_variables; i++)
- if (cmd.v_variables[i] == dict_get_weight (default_dict))
- break;
- if (i >= cmd.n_variables)
- {
- /* Add the weight variable to the end of the variable list. */
- cmd.n_variables++;
- cmd.v_variables = xnrealloc (cmd.v_variables, cmd.n_variables,
- sizeof *cmd.v_variables);
- cmd.v_variables[cmd.n_variables - 1]
- = dict_get_weight (default_dict);
- }
- }
- else
- msg (SW, _("`/FORMAT WEIGHT' specified, but weighting is not on."));
- }
-
- /* Case number. */
- if (cmd.numbering == LST_NUMBERED)
- {
- /* Initialize the case-number variable. */
- strcpy (casenum_var.name, "Case#");
- casenum_var.type = NUMERIC;
- casenum_var.fv = -1;
- casenum_var.print = make_output_format (FMT_F,
- (cmd.last == LONG_MAX
- ? 5 : intlog10 (cmd.last)), 0);
-
- /* Add the weight variable at the beginning of the variable list. */
- cmd.n_variables++;
- cmd.v_variables = xnrealloc (cmd.v_variables,
- cmd.n_variables, sizeof *cmd.v_variables);
- memmove (&cmd.v_variables[1], &cmd.v_variables[0],
- (cmd.n_variables - 1) * sizeof *cmd.v_variables);
- cmd.v_variables[0] = &casenum_var;
- }
-
- determine_layout ();
-
- case_idx = 0;
- procedure_with_splits (write_all_headers, list_cases, NULL, NULL);
- free (line_buf);
-
- clean_up ();
-
- return CMD_SUCCESS;
-}
-
-/* Writes headers to all devices. This is done at the beginning of
- each SPLIT FILE group. */
-static void
-write_all_headers (void *aux UNUSED)
-{
- struct outp_driver *d;
-
- for (d = outp_drivers (NULL); d; d = outp_drivers (d))
- {
- if (!d->class->special)
- {
- d->cp_y += d->font_height; /* Blank line. */
- write_header (d);
- }
- else if (d->class == &html_class)
- {
- struct html_driver_ext *x = d->ext;
-
- assert (d->driver_open);
- if (x->sequence_no == 0 && !d->class->open_page (d))
- {
- msg (ME, _("Cannot open first page on HTML device %s."),
- d->name);
- return;
- }
-
- fputs ("<TABLE BORDER=1>\n <TR>\n", x->file.file);
-
- {
- size_t i;
-
- for (i = 0; i < cmd.n_variables; i++)
- fprintf (x->file.file, " <TH><I><B>%s</B></I></TH>\n",
- cmd.v_variables[i]->name);
- }
-
- fputs (" <TR>\n", x->file.file);
- }
- else
- assert (0);
- }
-}
-
-/* Writes the headers. Some of them might be vertical; most are
- probably horizontal. */
-static void
-write_header (struct outp_driver *d)
-{
- struct list_ext *prc = d->prc;
-
- if (!prc->header_rows)
- return;
-
- if (n_lines_remaining (d) < prc->header_rows + 1)
- {
- outp_eject_page (d);
- assert (n_lines_remaining (d) >= prc->header_rows + 1);
- }
-
- /* Design the header. */
- if (!prc->header)
- {
- size_t i;
- size_t x;
-
- /* Allocate, initialize header. */
- prc->header = xnmalloc (prc->header_rows, sizeof *prc->header);
- {
- int w = n_chars_width (d);
- for (i = 0; i < prc->header_rows; i++)
- {
- prc->header[i] = xmalloc (w + 1);
- memset (prc->header[i], ' ', w);
- }
- }
-
- /* Put in vertical names. */
- for (i = x = 0; i < prc->n_vertical; i++)
- {
- struct variable *v = cmd.v_variables[i];
- size_t j;
-
- memset (&prc->header[prc->header_rows - 1][x], '-', v->print.w);
- x += v->print.w - 1;
- for (j = 0; j < strlen (v->name); j++)
- prc->header[strlen (v->name) - j - 1][x] = v->name[j];
- x += 2;
- }
-
- /* Put in horizontal names. */
- for (; i < cmd.n_variables; i++)
- {
- struct variable *v = cmd.v_variables[i];
-
- memset (&prc->header[prc->header_rows - 1][x], '-',
- max (v->print.w, (int) strlen (v->name)));
- if ((int) strlen (v->name) < v->print.w)
- x += v->print.w - strlen (v->name);
- memcpy (&prc->header[0][x], v->name, strlen (v->name));
- x += strlen (v->name) + 1;
- }
-
- /* Add null bytes. */
- for (i = 0; i < prc->header_rows; i++)
- {
- for (x = n_chars_width (d); x >= 1; x--)
- if (prc->header[i][x - 1] != ' ')
- {
- prc->header[i][x] = 0;
- break;
- }
- assert (x);
- }
- }
-
- /* Write out the header, in back-to-front order except for the last line. */
- if (prc->header_rows >= 2)
- {
- size_t i;
-
- for (i = prc->header_rows - 1; i-- != 0; )
- write_line (d, prc->header[i]);
- }
- write_line (d, prc->header[prc->header_rows - 1]);
-}
-
-
-/* Frees up all the memory we've allocated. */
-static void
-clean_up (void)
-{
- struct outp_driver *d;
-
- for (d = outp_drivers (NULL); d; d = outp_drivers (d))
- if (d->class->special == 0)
- {
- struct list_ext *prc = d->prc;
- size_t i;
-
- if (prc->header)
- {
- for (i = 0; i < prc->header_rows; i++)
- free (prc->header[i]);
- free (prc->header);
- }
- free (prc);
-
- d->class->text_set_font_by_name (d, "PROP");
- }
- else if (d->class == &html_class)
- {
- if (d->driver_open && d->page_open)
- {
- struct html_driver_ext *x = d->ext;
-
- fputs ("</TABLE>\n", x->file.file);
- }
- }
- else
- assert (0);
-
- free (cmd.v_variables);
-}
-
-/* Writes string STRING at the current position. If the text would
- fall off the side of the page, then advance to the next line,
- indenting by amount INDENT. */
-static void
-write_varname (struct outp_driver *d, char *string, int indent)
-{
- struct outp_text text;
-
- text.options = OUTP_T_JUST_LEFT;
- ls_init (&text.s, string, strlen (string));
- d->class->text_metrics (d, &text);
-
- if (d->cp_x + text.h > d->width)
- {
- d->cp_y += d->font_height;
- if (d->cp_y + d->font_height > d->length)
- outp_eject_page (d);
- d->cp_x = indent;
- }
-
- text.x = d->cp_x;
- text.y = d->cp_y;
- d->class->text_draw (d, &text);
- d->cp_x += text.h;
-}
-
-/* When we can't fit all the values across the page, we write out all
- the variable names just once. This is where we do it. */
-static void
-write_fallback_headers (struct outp_driver *d)
-{
- const int max_width = n_chars_width(d) - 10;
-
- int index = 0;
- int width = 0;
- int line_number = 0;
-
- const char *Line = _("Line");
- char *leader = local_alloc (strlen (Line) + INT_DIGITS + 1 + 1);
-
- while (index < cmd.n_variables)
- {
- struct outp_text text;
-
- /* Ensure that there is enough room for a line of text. */
- if (d->cp_y + d->font_height > d->length)
- outp_eject_page (d);
-
- /* The leader is a string like `Line 1: '. Write the leader. */
- sprintf(leader, "%s %d:", Line, ++line_number);
- text.options = OUTP_T_JUST_LEFT;
- ls_init (&text.s, leader, strlen (leader));
- text.x = 0;
- text.y = d->cp_y;
- d->class->text_draw (d, &text);
- d->cp_x = text.h;
-
- goto entry;
- do
- {
- width++;
-
- entry:
- {
- int var_width = cmd.v_variables[index]->print.w;
- if (width + var_width > max_width && width != 0)
- {
- width = 0;
- d->cp_x = 0;
- d->cp_y += d->font_height;
- break;
- }
- width += var_width;
- }
-
- {
- char varname[10];
- sprintf (varname, " %s", cmd.v_variables[index]->name);
- write_varname (d, varname, text.h);
- }
- }
- while (++index < cmd.n_variables);
-
- }
- d->cp_x = 0;
- d->cp_y += d->font_height;
-
- local_free (leader);
-}
-
-/* There are three possible layouts for the LIST procedure:
-
- 1. If the values and their variables' name fit across the page,
- then they are listed across the page in that way.
-
- 2. If the values can fit across the page, but not the variable
- names, then as many variable names as necessary are printed
- vertically to compensate.
-
- 3. If not even the values can fit across the page, the variable
- names are listed just once, at the beginning, in a compact format,
- and the values are listed with a variable name label at the
- beginning of each line for easier reference.
-
- This is complicated by the fact that we have to do all this for
- every output driver, not just once. */
-static void
-determine_layout (void)
-{
- struct outp_driver *d;
-
- /* This is the largest page width of any driver, so we can tell what
- size buffer to allocate. */
- int largest_page_width = 0;
-
- for (d = outp_drivers (NULL); d; d = outp_drivers (d))
- {
- size_t column; /* Current column. */
- int width; /* Accumulated width. */
- int height; /* Height of vertical names. */
- int max_width; /* Page width. */
-
- struct list_ext *prc;
-
- if (d->class == &html_class)
- continue;
-
- assert (d->class->special == 0);
-
- if (!d->page_open)
- d->class->open_page (d);
-
- max_width = n_chars_width (d);
- largest_page_width = max (largest_page_width, max_width);
-
- prc = d->prc = xmalloc (sizeof *prc);
- prc->type = 0;
- prc->n_vertical = 0;
- prc->header = NULL;
-
- /* Try layout #1. */
- for (width = cmd.n_variables - 1, column = 0; column < cmd.n_variables; column++)
- {
- struct variable *v = cmd.v_variables[column];
- width += max (v->print.w, (int) strlen (v->name));
- }
- if (width <= max_width)
- {
- prc->header_rows = 2;
- d->class->text_set_font_by_name (d, "FIXED");
- continue;
- }
-
- /* Try layout #2. */
- for (width = cmd.n_variables - 1, height = 0, column = 0;
- column < cmd.n_variables && width <= max_width;
- column++)
- {
- struct variable *v = cmd.v_variables[column];
- width += v->print.w;
- if (strlen (v->name) > height)
- height = strlen (v->name);
- }
-
- /* If it fit then we need to determine how many labels can be
- written horizontally. */
- if (width <= max_width && height <= SHORT_NAME_LEN)
- {
-#ifndef NDEBUG
- prc->n_vertical = SIZE_MAX;
-#endif
- for (column = cmd.n_variables; column-- != 0; )
- {
- struct variable *v = cmd.v_variables[column];
- int trial_width = (width - v->print.w
- + max (v->print.w, (int) strlen (v->name)));
-
- if (trial_width > max_width)
- {
- prc->n_vertical = column + 1;
- break;
- }
- width = trial_width;
- }
- assert (prc->n_vertical != SIZE_MAX);
-
- prc->n_vertical = cmd.n_variables;
- /* Finally determine the length of the headers. */
- for (prc->header_rows = 0, column = 0;
- column < prc->n_vertical;
- column++)
- prc->header_rows = max (prc->header_rows,
- strlen (cmd.v_variables[column]->name));
- prc->header_rows++;
-
- d->class->text_set_font_by_name (d, "FIXED");
- continue;
- }
-
- /* Otherwise use the ugly fallback listing format. */
- prc->type = 1;
- prc->header_rows = 0;
-
- d->cp_y += d->font_height;
- write_fallback_headers (d);
- d->cp_y += d->font_height;
- d->class->text_set_font_by_name (d, "FIXED");
- }
-
- line_buf = xmalloc (max (1022, largest_page_width) + 2);
-}
-
-static int
-list_cases (struct ccase *c, void *aux UNUSED)
-{
- struct outp_driver *d;
-
- case_idx++;
- if (case_idx < cmd.first || case_idx > cmd.last
- || (cmd.step != 1 && (case_idx - cmd.first) % cmd.step))
- return 1;
-
- for (d = outp_drivers (NULL); d; d = outp_drivers (d))
- if (d->class->special == 0)
- {
- const struct list_ext *prc = d->prc;
- const int max_width = n_chars_width (d);
- int column;
- int x = 0;
-
- if (!prc->header_rows)
- x = nsprintf (line_buf, "%8s: ", cmd.v_variables[0]->name);
-
- for (column = 0; column < cmd.n_variables; column++)
- {
- struct variable *v = cmd.v_variables[column];
- int width;
-
- if (prc->type == 0 && column >= prc->n_vertical)
- width = max ((int) strlen (v->name), v->print.w);
- else
- width = v->print.w;
-
- if (width + x > max_width && x != 0)
- {
- if (!n_lines_remaining (d))
- {
- outp_eject_page (d);
- write_header (d);
- }
-
- line_buf[x] = 0;
- write_line (d, line_buf);
-
- x = 0;
- if (!prc->header_rows)
- x = nsprintf (line_buf, "%8s: ", v->name);
- }
-
- if (width > v->print.w)
- {
- memset(&line_buf[x], ' ', width - v->print.w);
- x += width - v->print.w;
- }
-
- if ((formats[v->print.type].cat & FCAT_STRING) || v->fv != -1)
- data_out (&line_buf[x], &v->print, case_data (c, v->fv));
- else
- {
- union value case_idx_value;
- case_idx_value.f = case_idx;
- data_out (&line_buf[x], &v->print, &case_idx_value);
- }
- x += v->print.w;
-
- line_buf[x++] = ' ';
- }
-
- if (!n_lines_remaining (d))
- {
- outp_eject_page (d);
- write_header (d);
- }
-
- line_buf[x] = 0;
- write_line (d, line_buf);
- }
- else if (d->class == &html_class)
- {
- struct html_driver_ext *x = d->ext;
- int column;
-
- fputs (" <TR>\n", x->file.file);
-
- for (column = 0; column < cmd.n_variables; column++)
- {
- struct variable *v = cmd.v_variables[column];
- char buf[41];
-
- if ((formats[v->print.type].cat & FCAT_STRING) || v->fv != -1)
- data_out (buf, &v->print, case_data (c, v->fv));
- else
- {
- union value case_idx_value;
- case_idx_value.f = case_idx;
- data_out (buf, &v->print, &case_idx_value);
- }
- buf[v->print.w] = 0;
-
- fprintf (x->file.file, " <TD ALIGN=RIGHT>%s</TD>\n",
- &buf[strspn (buf, " ")]);
- }
-
- fputs (" </TR>\n", x->file.file);
- }
- else
- assert (0);
-
- return 1;
-}
-
-/*
- Local Variables:
- mode: c
- End:
-*/
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include "alloc.h"
-#include "case.h"
-#include "command.h"
-#include "dictionary.h"
-#include "ctl-stack.h"
-#include "error.h"
-#include "expressions/public.h"
-#include "lexer.h"
-#include "misc.h"
-#include "pool.h"
-#include "settings.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* LOOP outputs a transformation that is executed only on the
- first pass through the loop. On this trip, it initializes for
- the first pass by resetting the pass number, setting up the
- indexing clause, and testing the LOOP IF clause. If the loop
- is not to be entered at all, it jumps forward just past the
- END LOOP transformation; otherwise, it continues to the
- transformation following LOOP.
-
- END LOOP outputs a transformation that executes at the end of
- each trip through the loop. It checks the END LOOP IF clause,
- then updates the pass number, increments the indexing clause,
- and tests the LOOP IF clause. If another pass through the
- loop is due, it jumps backward to just after the LOOP
- transformation; otherwise, it continues to the transformation
- following END LOOP. */
-
-struct loop_trns
- {
- struct pool *pool;
-
- /* Iteration limit. */
- int max_pass_count; /* Maximum number of passes (-1=unlimited). */
- int pass; /* Number of passes thru the loop so far. */
-
- /* a=a TO b [BY c]. */
- struct variable *index_var; /* Index variable. */
- struct expression *first_expr; /* Starting index. */
- struct expression *by_expr; /* Index increment (default 1.0 if null). */
- struct expression *last_expr; /* Terminal index. */
- double cur, by, last; /* Current value, increment, last value. */
-
- /* IF condition for LOOP or END LOOP. */
- struct expression *loop_condition;
- struct expression *end_loop_condition;
-
- /* Transformation indexes. */
- int past_LOOP_index; /* Just past LOOP transformation. */
- int past_END_LOOP_index; /* Just past END LOOP transformation. */
- };
-
-static struct ctl_class loop_class;
-
-static trns_proc_func loop_trns_proc, end_loop_trns_proc, break_trns_proc;
-static trns_free_func loop_trns_free;
-
-static struct loop_trns *create_loop_trns (void);
-static bool parse_if_clause (struct loop_trns *, struct expression **);
-static bool parse_index_clause (struct loop_trns *, char index_var_name[]);
-static void close_loop (void *);
-\f
-/* LOOP. */
-
-/* Parses LOOP. */
-int
-cmd_loop (void)
-{
- struct loop_trns *loop;
- char index_var_name[LONG_NAME_LEN + 1];
- bool ok = true;
-
- loop = create_loop_trns ();
- while (token != '.' && ok)
- {
- if (lex_match_id ("IF"))
- ok = parse_if_clause (loop, &loop->loop_condition);
- else
- ok = parse_index_clause (loop, index_var_name);
- }
-
- /* Find index variable and create if necessary. */
- if (ok && index_var_name[0] != '\0')
- {
- loop->index_var = dict_lookup_var (default_dict, index_var_name);
- if (loop->index_var == NULL)
- loop->index_var = dict_create_var (default_dict, index_var_name, 0);
- }
-
- if (!ok)
- loop->max_pass_count = 0;
- return ok ? CMD_SUCCESS : CMD_PART_SUCCESS;
-}
-
-/* Parses END LOOP. */
-int
-cmd_end_loop (void)
-{
- struct loop_trns *loop;
- bool ok = true;
-
- loop = ctl_stack_top (&loop_class);
- if (loop == NULL)
- return CMD_FAILURE;
-
- /* Parse syntax. */
- if (lex_match_id ("IF"))
- ok = parse_if_clause (loop, &loop->end_loop_condition);
- if (ok)
- ok = lex_end_of_command () == CMD_SUCCESS;
-
- if (!ok)
- loop->max_pass_count = 0;
-
- ctl_stack_pop (loop);
-
- return ok ? CMD_SUCCESS : CMD_PART_SUCCESS;
-}
-
-/* Parses BREAK. */
-int
-cmd_break (void)
-{
- struct ctl_stmt *loop = ctl_stack_search (&loop_class);
- if (loop == NULL)
- return CMD_FAILURE;
-
- add_transformation (break_trns_proc, NULL, loop);
-
- return lex_end_of_command ();
-}
-
-/* Closes a LOOP construct by emitting the END LOOP
- transformation and finalizing its members appropriately. */
-static void
-close_loop (void *loop_)
-{
- struct loop_trns *loop = loop_;
-
- add_transformation (end_loop_trns_proc, NULL, loop);
- loop->past_END_LOOP_index = next_transformation ();
-
- /* If there's nothing else limiting the number of loops, use
- MXLOOPS as a limit. */
- if (loop->max_pass_count == -1
- && loop->index_var == NULL
- && loop->loop_condition == NULL
- && loop->end_loop_condition == NULL)
- loop->max_pass_count = get_mxloops ();
-}
-
-/* Parses an IF clause for LOOP or END LOOP and stores the
- resulting expression to *CONDITION.
- Returns true if successful, false on failure. */
-static bool
-parse_if_clause (struct loop_trns *loop, struct expression **condition)
-{
- *condition = expr_parse_pool (loop->pool, default_dict, EXPR_BOOLEAN);
- return *condition != NULL;
-}
-
-/* Parses an indexing clause into LOOP.
- Stores the index variable's name in INDEX_VAR_NAME[].
- Returns true if successful, false on failure. */
-static bool
-parse_index_clause (struct loop_trns *loop, char index_var_name[])
-{
- if (token != T_ID)
- {
- lex_error (NULL);
- return false;
- }
- strcpy (index_var_name, tokid);
- lex_get ();
-
- if (!lex_force_match ('='))
- return false;
-
- loop->first_expr = expr_parse_pool (loop->pool, default_dict, EXPR_NUMBER);
- if (loop->first_expr == NULL)
- return false;
-
- for (;;)
- {
- struct expression **e;
- if (lex_match (T_TO))
- e = &loop->last_expr;
- else if (lex_match (T_BY))
- e = &loop->by_expr;
- else
- break;
-
- if (*e != NULL)
- {
- lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
- return false;
- }
- *e = expr_parse_pool (loop->pool, default_dict, EXPR_NUMBER);
- if (*e == NULL)
- return false;
- }
- if (loop->last_expr == NULL)
- {
- lex_sbc_missing ("TO");
- return false;
- }
- if (loop->by_expr == NULL)
- loop->by = 1.0;
-
- return true;
-}
-
-/* Creates, initializes, and returns a new loop_trns. */
-static struct loop_trns *
-create_loop_trns (void)
-{
- struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
- loop->max_pass_count = -1;
- loop->pass = 0;
- loop->index_var = NULL;
- loop->first_expr = loop->by_expr = loop->last_expr = NULL;
- loop->loop_condition = loop->end_loop_condition = NULL;
-
- add_transformation (loop_trns_proc, loop_trns_free, loop);
- loop->past_LOOP_index = next_transformation ();
-
- ctl_stack_push (&loop_class, loop);
-
- return loop;
-}
-
-/* Sets up LOOP for the first pass. */
-static int
-loop_trns_proc (void *loop_, struct ccase *c, int case_num)
-{
- struct loop_trns *loop = loop_;
-
- if (loop->index_var != NULL)
- {
- /* Evaluate loop index expressions. */
- loop->cur = expr_evaluate_num (loop->first_expr, c, case_num);
- if (loop->by_expr != NULL)
- loop->by = expr_evaluate_num (loop->by_expr, c, case_num);
- loop->last = expr_evaluate_num (loop->last_expr, c, case_num);
-
- /* Even if the loop is never entered, set the index
- variable to the initial value. */
- case_data_rw (c, loop->index_var->fv)->f = loop->cur;
-
- /* Throw out pathological cases. */
- if (!finite (loop->cur) || !finite (loop->by) || !finite (loop->last)
- || loop->by == 0.0
- || (loop->by > 0.0 && loop->cur > loop->last)
- || (loop->by < 0.0 && loop->cur < loop->last))
- goto zero_pass;
- }
-
- /* Initialize pass count. */
- loop->pass = 0;
- if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
- goto zero_pass;
-
- /* Check condition. */
- if (loop->loop_condition != NULL
- && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
- goto zero_pass;
-
- return loop->past_LOOP_index;
-
- zero_pass:
- return loop->past_END_LOOP_index;
-}
-
-/* Frees LOOP. */
-static void
-loop_trns_free (void *loop_)
-{
- struct loop_trns *loop = loop_;
-
- pool_destroy (loop->pool);
-}
-
-/* Finishes a pass through the loop and starts the next. */
-static int
-end_loop_trns_proc (void *loop_, struct ccase *c, int case_num UNUSED)
-{
- struct loop_trns *loop = loop_;
-
- if (loop->end_loop_condition != NULL
- && expr_evaluate_num (loop->end_loop_condition, c, case_num) != 1.0)
- goto break_out;
-
- /* MXLOOPS limiter. */
- if (loop->max_pass_count >= 0)
- {
- if (loop->pass >= loop->max_pass_count)
- goto break_out;
- loop->pass++;
- }
-
- /* Indexing clause limiter: counting downward. */
- if (loop->index_var != NULL)
- {
- loop->cur += loop->by;
- if ((loop->by > 0.0 && loop->cur > loop->last)
- || (loop->by < 0.0 && loop->cur < loop->last))
- goto break_out;
- case_data_rw (c, loop->index_var->fv)->f = loop->cur;
- }
-
- if (loop->loop_condition != NULL
- && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
- goto break_out;
-
- return loop->past_LOOP_index;
-
- break_out:
- return loop->past_END_LOOP_index;
-}
-
-/* Executes BREAK. */
-static int
-break_trns_proc (void *loop_, struct ccase *c UNUSED, int case_num UNUSED)
-{
- struct loop_trns *loop = loop_;
-
- return loop->past_END_LOOP_index;
-}
-
-/* LOOP control structure class definition. */
-static struct ctl_class loop_class =
- {
- "LOOP",
- "END LOOP",
- close_loop,
- };
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "magic.h"
-
-#if ENDIAN==UNKNOWN
-/* BIG or LITTLE, depending on this machine's endianness, as detected
- at program startup. */
-int endian;
-#endif
-
-/* magic.h */
-#ifndef __GNUC__
-union cvt_dbl second_lowest_value_union = {SECOND_LOWEST_BYTES};
-#endif
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !magic_h
-#define magic_h 1
-
-/* Magic numbers. */
-
-#include <float.h>
-#include <limits.h>
-
-/* Check that the floating-point representation is one that we
- understand. */
-#ifndef FPREP_IEEE754
-#error Only IEEE-754 floating point currently supported.
-#endif
-
-/* Allows us to specify individual bytes of a double. */
-union cvt_dbl {
- unsigned char cvt_dbl_i[8];
- double cvt_dbl_d;
-};
-
-
-/* "Second-lowest value" bytes for an IEEE-754 double. */
-#if WORDS_BIGENDIAN
-#define SECOND_LOWEST_BYTES {0xff,0xef,0xff,0xff, 0xff,0xff,0xff,0xfe}
-#else
-#define SECOND_LOWEST_BYTES {0xfe,0xff,0xff,0xff, 0xff,0xff,0xef,0xff}
-#endif
-
-/* "Second-lowest value" for a double. */
-#if __GNUC__
-#define second_lowest_value \
- (__extension__ ((union cvt_dbl) {SECOND_LOWEST_BYTES}).cvt_dbl_d)
-#else /* not GNU C */
-extern union cvt_dbl second_lowest_value_union;
-#define second_lowest_value (second_lowest_value_union.cvt_dbl_d)
-#endif
-
-/* Used when we want a "missing value". */
-#define NOT_DOUBLE (-DBL_MAX)
-#define NOT_LONG LONG_MIN
-#define NOT_INT INT_MIN
-
-#endif /* magic.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "main.h"
-#include <gsl/gsl_errno.h>
-#include <signal.h>
-#include <stdio.h>
-#include "cmdline.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "file-handle-def.h"
-#include "filename.h"
-#include "getl.h"
-#include "glob.h"
-#include "lexer.h"
-#include "output.h"
-#include "progname.h"
-#include "random.h"
-#include "readln.h"
-#include "settings.h"
-#include "var.h"
-#include "version.h"
-
-#if HAVE_FPU_CONTROL_H
-#include <fpu_control.h>
-#endif
-
-#if HAVE_LOCALE_H
-#include <locale.h>
-#endif
-
-#if HAVE_FENV_H
-#include <fenv.h>
-#endif
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include <stdlib.h>
-
-#include "debug-print.h"
-
-static void i18n_init (void);
-static void fpu_init (void);
-static void handle_error (int code);
-static int execute_command (void);
-
-/* Whether FINISH. has been executed. */
-int finished;
-
-/* If a segfault happens, issue a message to that effect and halt */
-void bug_handler(int sig);
-
-/* Handle quit/term/int signals */
-void interrupt_handler(int sig);
-
-/* Whether we're dropping down to interactive mode immediately because
- we hit end-of-file unexpectedly (or whatever). */
-int start_interactive;
-
-/* Program entry point. */
-int
-main (int argc, char **argv)
-{
- signal (SIGSEGV, bug_handler);
- signal (SIGFPE, bug_handler);
- signal (SIGINT, interrupt_handler);
-
- set_program_name ("pspp");
- i18n_init ();
- fpu_init ();
- gsl_set_error_handler_off ();
-
- outp_init ();
- fn_init ();
- fh_init ();
- getl_initialize ();
- readln_initialize ();
- settings_init ();
- random_init ();
-
- default_dict = dict_create ();
-
- parse_command_line (argc, argv);
- outp_read_devices ();
-
- lex_init ();
-
- while (!finished)
- {
- err_check_count ();
- handle_error (execute_command ());
- }
-
- terminate (err_error_count == 0);
- abort ();
-}
-
-/* Terminate PSPP. SUCCESS should be true to exit successfully,
- false to exit as a failure. */
-void
-terminate (bool success)
-{
- static bool terminating = false;
- if (terminating)
- return;
- terminating = true;
-
- err_done ();
- outp_done ();
-
- cancel_transformations ();
- dict_destroy (default_dict);
-
- random_done ();
- settings_done ();
- fh_done ();
- lex_done ();
- getl_uninitialize ();
-
- exit (success ? EXIT_SUCCESS : EXIT_FAILURE);
-}
-
-/* Parse and execute a command, returning its return code. */
-static int
-execute_command (void)
-{
- int result;
-
- /* Read the command's first token.
- We may hit end of file.
- If so, give the line reader a chance to proceed to the next file.
- End of file is not handled transparently since the user may want
- the dictionary cleared between files. */
- getl_prompt = GETL_PRPT_STANDARD;
- for (;;)
- {
- lex_get ();
- if (token != T_STOP)
- break;
-
- /* Sets the options flag of the current script to 0, thus allowing it
- to be read in. Returns nonzero if this action was taken, zero
- otherwise. */
- if (getl_head && getl_head->separate)
- {
- getl_head->separate = 0;
- discard_variables ();
- lex_reset_eof ();
- }
- else
- terminate (err_error_count == 0);
- }
-
- /* Parse the command. */
- getl_prompt = GETL_PRPT_CONTINUATION;
- result = cmd_parse ();
-
- /* Unset the /ALGORITHM subcommand if it was used */
- unset_cmd_algorithm ();
-
- /* Clear any auxiliary data from the dictionary. */
- dict_clear_aux (default_dict);
-
- return result;
-}
-
-/* Print an error message corresponding to the command return code
- CODE. */
-static void
-handle_error (int code)
-{
- switch (code)
- {
- case CMD_SUCCESS:
- return;
-
- case CMD_FAILURE:
- msg (SW, _("This command not executed."));
- break;
-
- case CMD_PART_SUCCESS_MAYBE:
- msg (SW, _("Skipping the rest of this command. Part of "
- "this command may have been executed."));
- break;
-
- case CMD_PART_SUCCESS:
- msg (SW, _("Skipping the rest of this command. This "
- "command was fully executed up to this point."));
- break;
-
- case CMD_TRAILING_GARBAGE:
- msg (SW, _("Trailing garbage was encountered following "
- "this command. The command was fully executed "
- "to this point."));
- break;
-
- default:
- assert (0);
- }
-
- if (getl_reading_script())
- {
- err_break ();
- while (token != T_STOP && token != '.')
- lex_get ();
- }
- else
- {
- msg (SW, _("The rest of this command has been discarded."));
- lex_discard_line ();
- }
-}
-\f
-static void
-i18n_init (void)
-{
-#if ENABLE_NLS
-#if HAVE_LC_MESSAGES
- setlocale (LC_MESSAGES, "");
-#endif
- setlocale (LC_MONETARY, "");
- bindtextdomain (PACKAGE, locale_dir);
- textdomain (PACKAGE);
-#endif /* ENABLE_NLS */
-}
-
-static void
-fpu_init (void)
-{
-#if HAVE_FEHOLDEXCEPT
- fenv_t foo;
- feholdexcept (&foo);
-#elif HAVE___SETFPUCW && defined(_FPU_IEEE)
- __setfpucw (_FPU_IEEE);
-#endif
-}
-
-/* If a segfault happens, issue a message to that effect and halt */
-void
-bug_handler(int sig)
-{
- switch (sig)
- {
- case SIGFPE:
- request_bug_report_and_abort("Floating Point Exception");
- break;
- case SIGSEGV:
- request_bug_report_and_abort("Segmentation Violation");
- break;
- default:
- request_bug_report_and_abort("");
- break;
- }
-}
-
-
-void
-interrupt_handler(int sig UNUSED)
-{
- terminate (false);
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !MAIN_H
-#define MAIN_H 1
-
-#include <stdbool.h>
-
-extern int start_interactive;
-extern int finished;
-
-void terminate (bool success);
-
-#endif /* main.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <stdlib.h>
-#include <ctype.h>
-#include <float.h>
-#include "algorithm.h"
-#include "alloc.h"
-#include "case.h"
-#include "command.h"
-#include "data-in.h"
-#include "dfm-read.h"
-#include "dictionary.h"
-#include "error.h"
-#include "file-handle.h"
-#include "lexer.h"
-#include "misc.h"
-#include "pool.h"
-#include "str.h"
-#include "var.h"
-#include "vfm.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-/* FIXME: /N subcommand not implemented. It should be pretty simple,
- too. */
-
-/* Different types of variables for MATRIX DATA procedure. Order is
- important: these are used for sort keys. */
-enum
- {
- MXD_SPLIT, /* SPLIT FILE variables. */
- MXD_ROWTYPE, /* ROWTYPE_. */
- MXD_FACTOR, /* Factor variables. */
- MXD_VARNAME, /* VARNAME_. */
- MXD_CONTINUOUS, /* Continuous variables. */
-
- MXD_COUNT
- };
-
-/* Format type enums. */
-enum format_type
- {
- LIST,
- FREE
- };
-
-/* Matrix section enums. */
-enum matrix_section
- {
- LOWER,
- UPPER,
- FULL
- };
-
-/* Diagonal inclusion enums. */
-enum include_diagonal
- {
- DIAGONAL,
- NODIAGONAL
- };
-
-/* CONTENTS types. */
-enum content_type
- {
- N_VECTOR,
- N_SCALAR,
- N_MATRIX,
- MEAN,
- STDDEV,
- COUNT,
- MSE,
- DFE,
- MAT,
- COV,
- CORR,
- PROX,
-
- LPAREN,
- RPAREN,
- EOC
- };
-
-/* 0=vector, 1=matrix, 2=scalar. */
-static const int content_type[PROX + 1] =
- {
- 0, 2, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1,
- };
-
-/* Name of each content type. */
-static const char *content_names[PROX + 1] =
- {
- "N", "N", "N_MATRIX", "MEAN", "STDDEV", "COUNT", "MSE",
- "DFE", "MAT", "COV", "CORR", "PROX",
- };
-
-/* A MATRIX DATA input program. */
-struct matrix_data_pgm
- {
- struct pool *container; /* Arena used for all allocations. */
- struct dfm_reader *reader; /* Data file to read. */
-
- /* Format. */
- enum format_type fmt; /* LIST or FREE. */
- enum matrix_section section;/* LOWER or UPPER or FULL. */
- enum include_diagonal diag; /* DIAGONAL or NODIAGONAL. */
-
- int explicit_rowtype; /* ROWTYPE_ specified explicitly in data? */
- struct variable *rowtype_, *varname_; /* ROWTYPE_, VARNAME_ variables. */
-
- struct variable *single_split; /* Single SPLIT FILE variable. */
-
- /* Factor variables. */
- size_t n_factors; /* Number of factor variables. */
- struct variable **factors; /* Factor variables. */
- int is_per_factor[PROX + 1]; /* Is there per-factor data? */
-
- int cells; /* Number of cells, or -1 if none. */
-
- int pop_n; /* Population N specified by user. */
-
- /* CONTENTS subcommand. */
- int contents[EOC * 3 + 1]; /* Contents. */
- int n_contents; /* Number of entries. */
-
- /* Continuous variables. */
- int n_continuous; /* Number of continuous variables. */
- int first_continuous; /* Index into default_dict.var of
- first continuous variable. */
- };
-
-/* Auxiliary data attached to MATRIX DATA variables. */
-struct mxd_var
- {
- int var_type; /* Variable type. */
- int sub_type; /* Subtype. */
- };
-
-static const struct case_source_class matrix_data_with_rowtype_source_class;
-static const struct case_source_class matrix_data_without_rowtype_source_class;
-
-static int compare_variables_by_mxd_var_type (const void *pa,
- const void *pb);
-static void read_matrices_without_rowtype (struct matrix_data_pgm *);
-static void read_matrices_with_rowtype (struct matrix_data_pgm *);
-static int string_to_content_type (char *, int *);
-static void attach_mxd_aux (struct variable *, int var_type, int sub_type);
-
-int
-cmd_matrix_data (void)
-{
- struct pool *pool;
- struct matrix_data_pgm *mx;
- struct file_handle *fh = fh_inline_file ();
-
- unsigned seen = 0;
-
- discard_variables ();
-
- pool = pool_create ();
- mx = pool_alloc (pool, sizeof *mx);
- mx->container = pool;
- mx->reader = NULL;
- mx->fmt = LIST;
- mx->section = LOWER;
- mx->diag = DIAGONAL;
- mx->explicit_rowtype = 0;
- mx->rowtype_ = NULL;
- mx->varname_ = NULL;
- mx->single_split = NULL;
- mx->n_factors = 0;
- mx->factors = NULL;
- memset (mx->is_per_factor, 0, sizeof mx->is_per_factor);
- mx->cells = -1;
- mx->pop_n = -1;
- mx->n_contents = 0;
- mx->n_continuous = 0;
- mx->first_continuous = 0;
- while (token != '.')
- {
- lex_match ('/');
-
- if (lex_match_id ("VARIABLES"))
- {
- char **v;
- size_t nv;
-
- if (seen & 1)
- {
- msg (SE, _("VARIABLES subcommand multiply specified."));
- goto lossage;
- }
- seen |= 1;
-
- lex_match ('=');
- if (!parse_DATA_LIST_vars (&v, &nv, PV_NO_DUPLICATE))
- goto lossage;
-
- {
- size_t i;
-
- for (i = 0; i < nv; i++)
- if (!strcasecmp (v[i], "VARNAME_"))
- {
- msg (SE, _("VARNAME_ cannot be explicitly specified on "
- "VARIABLES."));
- for (i = 0; i < nv; i++)
- free (v[i]);
- free (v);
- goto lossage;
- }
- }
-
- {
- size_t i;
-
- for (i = 0; i < nv; i++)
- {
- struct variable *new_var;
-
- if (strcasecmp (v[i], "ROWTYPE_"))
- {
- new_var = dict_create_var_assert (default_dict, v[i], 0);
- attach_mxd_aux (new_var, MXD_CONTINUOUS, i);
- }
- else
- mx->explicit_rowtype = 1;
- free (v[i]);
- }
- free (v);
- }
-
- mx->rowtype_ = dict_create_var_assert (default_dict,
- "ROWTYPE_", 8);
- attach_mxd_aux (mx->rowtype_, MXD_ROWTYPE, 0);
- }
- else if (lex_match_id ("FILE"))
- {
- lex_match ('=');
- fh = fh_parse (FH_REF_FILE | FH_REF_INLINE);
- if (fh == NULL)
- goto lossage;
- }
- else if (lex_match_id ("FORMAT"))
- {
- lex_match ('=');
-
- while (token == T_ID)
- {
- if (lex_match_id ("LIST"))
- mx->fmt = LIST;
- else if (lex_match_id ("FREE"))
- mx->fmt = FREE;
- else if (lex_match_id ("LOWER"))
- mx->section = LOWER;
- else if (lex_match_id ("UPPER"))
- mx->section = UPPER;
- else if (lex_match_id ("FULL"))
- mx->section = FULL;
- else if (lex_match_id ("DIAGONAL"))
- mx->diag = DIAGONAL;
- else if (lex_match_id ("NODIAGONAL"))
- mx->diag = NODIAGONAL;
- else
- {
- lex_error (_("in FORMAT subcommand"));
- goto lossage;
- }
- }
- }
- else if (lex_match_id ("SPLIT"))
- {
- lex_match ('=');
-
- if (seen & 2)
- {
- msg (SE, _("SPLIT subcommand multiply specified."));
- goto lossage;
- }
- seen |= 2;
-
- if (token != T_ID)
- {
- lex_error (_("in SPLIT subcommand"));
- goto lossage;
- }
-
- if (dict_lookup_var (default_dict, tokid) == NULL
- && (lex_look_ahead () == '.' || lex_look_ahead () == '/'))
- {
- if (!strcasecmp (tokid, "ROWTYPE_")
- || !strcasecmp (tokid, "VARNAME_"))
- {
- msg (SE, _("Split variable may not be named ROWTYPE_ "
- "or VARNAME_."));
- goto lossage;
- }
-
- mx->single_split = dict_create_var_assert (default_dict,
- tokid, 0);
- attach_mxd_aux (mx->single_split, MXD_CONTINUOUS, 0);
- lex_get ();
-
- dict_set_split_vars (default_dict, &mx->single_split, 1);
- }
- else
- {
- struct variable **split;
- size_t n;
-
- if (!parse_variables (default_dict, &split, &n, PV_NO_DUPLICATE))
- goto lossage;
-
- dict_set_split_vars (default_dict, split, n);
- }
-
- {
- struct variable *const *split = dict_get_split_vars (default_dict);
- size_t split_cnt = dict_get_split_cnt (default_dict);
- int i;
-
- for (i = 0; i < split_cnt; i++)
- {
- struct mxd_var *mv = split[i]->aux;
- assert (mv != NULL);
- if (mv->var_type != MXD_CONTINUOUS)
- {
- msg (SE, _("Split variable %s is already another type."),
- tokid);
- goto lossage;
- }
- var_clear_aux (split[i]);
- attach_mxd_aux (split[i], MXD_SPLIT, i);
- }
- }
- }
- else if (lex_match_id ("FACTORS"))
- {
- lex_match ('=');
-
- if (seen & 4)
- {
- msg (SE, _("FACTORS subcommand multiply specified."));
- goto lossage;
- }
- seen |= 4;
-
- if (!parse_variables (default_dict, &mx->factors, &mx->n_factors,
- PV_NONE))
- goto lossage;
-
- {
- size_t i;
-
- for (i = 0; i < mx->n_factors; i++)
- {
- struct variable *v = mx->factors[i];
- struct mxd_var *mv = v->aux;
- assert (mv != NULL);
- if (mv->var_type != MXD_CONTINUOUS)
- {
- msg (SE, _("Factor variable %s is already another type."),
- tokid);
- goto lossage;
- }
- var_clear_aux (v);
- attach_mxd_aux (v, MXD_FACTOR, i);
- }
- }
- }
- else if (lex_match_id ("CELLS"))
- {
- lex_match ('=');
-
- if (mx->cells != -1)
- {
- msg (SE, _("CELLS subcommand multiply specified."));
- goto lossage;
- }
-
- if (!lex_is_integer () || lex_integer () < 1)
- {
- lex_error (_("expecting positive integer"));
- goto lossage;
- }
-
- mx->cells = lex_integer ();
- lex_get ();
- }
- else if (lex_match_id ("N"))
- {
- lex_match ('=');
-
- if (mx->pop_n != -1)
- {
- msg (SE, _("N subcommand multiply specified."));
- goto lossage;
- }
-
- if (!lex_is_integer () || lex_integer () < 1)
- {
- lex_error (_("expecting positive integer"));
- goto lossage;
- }
-
- mx->pop_n = lex_integer ();
- lex_get ();
- }
- else if (lex_match_id ("CONTENTS"))
- {
- int inside_parens = 0;
- unsigned collide = 0;
- int item;
-
- if (seen & 8)
- {
- msg (SE, _("CONTENTS subcommand multiply specified."));
- goto lossage;
- }
- seen |= 8;
-
- lex_match ('=');
-
- {
- int i;
-
- for (i = 0; i <= PROX; i++)
- mx->is_per_factor[i] = 0;
- }
-
- for (;;)
- {
- if (lex_match ('('))
- {
- if (inside_parens)
- {
- msg (SE, _("Nested parentheses not allowed."));
- goto lossage;
- }
- inside_parens = 1;
- item = LPAREN;
- }
- else if (lex_match (')'))
- {
- if (!inside_parens)
- {
- msg (SE, _("Mismatched right parenthesis (`(')."));
- goto lossage;
- }
- if (mx->contents[mx->n_contents - 1] == LPAREN)
- {
- msg (SE, _("Empty parentheses not allowed."));
- goto lossage;
- }
- inside_parens = 0;
- item = RPAREN;
- }
- else
- {
- int content_type;
- int collide_index;
-
- if (token != T_ID)
- {
- lex_error (_("in CONTENTS subcommand"));
- goto lossage;
- }
-
- content_type = string_to_content_type (tokid,
- &collide_index);
- if (content_type == -1)
- {
- lex_error (_("in CONTENTS subcommand"));
- goto lossage;
- }
- lex_get ();
-
- if (collide & (1 << collide_index))
- {
- msg (SE, _("Content multiply specified for %s."),
- content_names[content_type]);
- goto lossage;
- }
- collide |= (1 << collide_index);
-
- item = content_type;
- mx->is_per_factor[item] = inside_parens;
- }
- mx->contents[mx->n_contents++] = item;
-
- if (token == '/' || token == '.')
- break;
- }
-
- if (inside_parens)
- {
- msg (SE, _("Missing right parenthesis."));
- goto lossage;
- }
- mx->contents[mx->n_contents] = EOC;
- }
- else
- {
- lex_error (NULL);
- goto lossage;
- }
- }
-
- if (token != '.')
- {
- lex_error (_("expecting end of command"));
- goto lossage;
- }
-
- if (!(seen & 1))
- {
- msg (SE, _("Missing VARIABLES subcommand."));
- goto lossage;
- }
-
- if (!mx->n_contents && !mx->explicit_rowtype)
- {
- msg (SW, _("CONTENTS subcommand not specified: assuming file "
- "contains only CORR matrix."));
-
- mx->contents[0] = CORR;
- mx->contents[1] = EOC;
- mx->n_contents = 0;
- }
-
- if (mx->n_factors && !mx->explicit_rowtype && mx->cells == -1)
- {
- msg (SE, _("Missing CELLS subcommand. CELLS is required "
- "when ROWTYPE_ is not given in the data and "
- "factors are present."));
- goto lossage;
- }
-
- if (mx->explicit_rowtype && mx->single_split)
- {
- msg (SE, _("Split file values must be present in the data when "
- "ROWTYPE_ is present."));
- goto lossage;
- }
-
- /* Create VARNAME_. */
- mx->varname_ = dict_create_var_assert (default_dict, "VARNAME_", 8);
- attach_mxd_aux (mx->varname_, MXD_VARNAME, 0);
-
- /* Sort the dictionary variables into the desired order for the
- system file output. */
- {
- struct variable **v;
- size_t nv;
-
- dict_get_vars (default_dict, &v, &nv, 0);
- qsort (v, nv, sizeof *v, compare_variables_by_mxd_var_type);
- dict_reorder_vars (default_dict, v, nv);
- free (v);
- }
-
- /* Set formats. */
- {
- static const struct fmt_spec fmt_tab[MXD_COUNT] =
- {
- {FMT_F, 4, 0},
- {FMT_A, 8, 0},
- {FMT_F, 4, 0},
- {FMT_A, 8, 0},
- {FMT_F, 10, 4},
- };
-
- int i;
-
- mx->first_continuous = -1;
- for (i = 0; i < dict_get_var_cnt (default_dict); i++)
- {
- struct variable *v = dict_get_var (default_dict, i);
- struct mxd_var *mv = v->aux;
- int type = mv->var_type;
-
- assert (type >= 0 && type < MXD_COUNT);
- v->print = v->write = fmt_tab[type];
-
- if (type == MXD_CONTINUOUS)
- mx->n_continuous++;
- if (mx->first_continuous == -1 && type == MXD_CONTINUOUS)
- mx->first_continuous = i;
- }
- }
-
- if (mx->n_continuous == 0)
- {
- msg (SE, _("No continuous variables specified."));
- goto lossage;
- }
-
- mx->reader = dfm_open_reader (fh);
- if (mx->reader == NULL)
- goto lossage;
-
- if (mx->explicit_rowtype)
- read_matrices_with_rowtype (mx);
- else
- read_matrices_without_rowtype (mx);
-
- dfm_close_reader (mx->reader);
-
- pool_destroy (mx->container);
-
- return CMD_SUCCESS;
-
-lossage:
- discard_variables ();
- free (mx->factors);
- pool_destroy (mx->container);
- return CMD_FAILURE;
-}
-
-/* Look up string S as a content-type name and return the
- corresponding enumerated value, or -1 if there is no match. If
- COLLIDE is non-NULL then *COLLIDE returns a value (suitable for use
- as a bit-index) which can be used for determining whether a related
- statistic has already been used. */
-static int
-string_to_content_type (char *s, int *collide)
-{
- static const struct
- {
- int value;
- int collide;
- const char *string;
- }
- *tp,
- tab[] =
- {
- {N_VECTOR, 0, "N_VECTOR"},
- {N_VECTOR, 0, "N"},
- {N_SCALAR, 0, "N_SCALAR"},
- {N_MATRIX, 1, "N_MATRIX"},
- {MEAN, 2, "MEAN"},
- {STDDEV, 3, "STDDEV"},
- {STDDEV, 3, "SD"},
- {COUNT, 4, "COUNT"},
- {MSE, 5, "MSE"},
- {DFE, 6, "DFE"},
- {MAT, 7, "MAT"},
- {COV, 8, "COV"},
- {CORR, 9, "CORR"},
- {PROX, 10, "PROX"},
- {-1, -1, NULL},
- };
-
- for (tp = tab; tp->value != -1; tp++)
- if (!strcasecmp (s, tp->string))
- {
- if (collide)
- *collide = tp->collide;
-
- return tp->value;
- }
- return -1;
-}
-
-/* Compare two variables using p.mxd.var_type and p.mxd.sub_type
- fields. */
-static int
-compare_variables_by_mxd_var_type (const void *a_, const void *b_)
-{
- struct variable *const *pa = a_;
- struct variable *const *pb = b_;
- const struct mxd_var *a = (*pa)->aux;
- const struct mxd_var *b = (*pb)->aux;
-
- if (a->var_type != b->var_type)
- return a->var_type > b->var_type ? 1 : -1;
- else
- return a->sub_type < b->sub_type ? -1 : a->sub_type > b->sub_type;
-}
-
-/* Attaches a struct mxd_var with the specific member values to
- V. */
-static void
-attach_mxd_aux (struct variable *v, int var_type, int sub_type)
-{
- struct mxd_var *mv;
-
- assert (v->aux == NULL);
- mv = xmalloc (sizeof *mv);
- mv->var_type = var_type;
- mv->sub_type = sub_type;
- var_attach_aux (v, mv, var_dtor_free);
-}
-\f
-/* Matrix tokenizer. */
-
-/* Matrix token types. */
-enum matrix_token_type
- {
- MNUM, /* Number. */
- MSTR /* String. */
- };
-
-/* A MATRIX DATA parsing token. */
-struct matrix_token
- {
- enum matrix_token_type type;
- double number; /* MNUM: token value. */
- char *string; /* MSTR: token string; not null-terminated. */
- int length; /* MSTR: tokstr length. */
- };
-
-static int mget_token (struct matrix_token *, struct dfm_reader *);
-
-#if DEBUGGING
-#define mget_token(TOKEN, READER) mget_token_dump(TOKEN, READER)
-
-static void
-mdump_token (const struct matrix_token *token)
-{
- switch (token->type)
- {
- case MNUM:
- printf (" #%g", token->number);
- break;
- case MSTR:
- printf (" '%.*s'", token->length, token->string);
- break;
- default:
- assert (0);
- }
- fflush (stdout);
-}
-
-static int
-mget_token_dump (struct matrix_token *token, struct dfm_reader *reader)
-{
- int result = (mget_token) (token, reader);
- mdump_token (token);
- return result;
-}
-#endif
-
-/* Return the current position in READER. */
-static const char *
-context (struct dfm_reader *reader)
-{
- static char buf[32];
-
- if (dfm_eof (reader))
- strcpy (buf, "at end of file");
- else
- {
- struct fixed_string line;
- const char *sp;
-
- dfm_get_record (reader, &line);
- sp = ls_c_str (&line);
- while (sp < ls_end (&line) && isspace ((unsigned char) *sp))
- sp++;
- if (sp >= ls_end (&line))
- strcpy (buf, "at end of line");
- else
- {
- char *dp;
- size_t copy_cnt = 0;
-
- dp = stpcpy (buf, "before `");
- while (sp < ls_end (&line) && !isspace ((unsigned char) *sp)
- && copy_cnt < 10)
- {
- *dp++ = *sp++;
- copy_cnt++;
- }
- strcpy (dp, "'");
- }
- }
-
- return buf;
-}
-
-/* Is there at least one token left in the data file? */
-static int
-another_token (struct dfm_reader *reader)
-{
- for (;;)
- {
- struct fixed_string line;
- const char *cp;
-
- if (dfm_eof (reader))
- return 0;
- dfm_get_record (reader, &line);
-
- cp = ls_c_str (&line);
- while (isspace ((unsigned char) *cp) && cp < ls_end (&line))
- cp++;
-
- if (cp < ls_end (&line))
- {
- dfm_forward_columns (reader, cp - ls_c_str (&line));
- return 1;
- }
-
- dfm_forward_record (reader);
- }
-}
-
-/* Parse a MATRIX DATA token from READER into TOKEN. */
-static int
-(mget_token) (struct matrix_token *token, struct dfm_reader *reader)
-{
- struct fixed_string line;
- int first_column;
- char *cp;
-
- if (!another_token (reader))
- return 0;
-
- dfm_get_record (reader, &line);
- first_column = dfm_column_start (reader);
-
- /* Three types of fields: quoted with ', quoted with ", unquoted. */
- cp = ls_c_str (&line);
- if (*cp == '\'' || *cp == '"')
- {
- int quote = *cp;
-
- token->type = MSTR;
- token->string = ++cp;
- while (cp < ls_end (&line) && *cp != quote)
- cp++;
- token->length = cp - token->string;
- if (cp < ls_end (&line))
- cp++;
- else
- msg (SW, _("Scope of string exceeds line."));
- }
- else
- {
- int is_num = isdigit ((unsigned char) *cp) || *cp == '.';
-
- token->string = cp++;
- while (cp < ls_end (&line)
- && !isspace ((unsigned char) *cp) && *cp != ','
- && *cp != '-' && *cp != '+')
- {
- if (isdigit ((unsigned char) *cp))
- is_num = 1;
-
- if ((tolower ((unsigned char) *cp) == 'd'
- || tolower ((unsigned char) *cp) == 'e')
- && (cp[1] == '+' || cp[1] == '-'))
- cp += 2;
- else
- cp++;
- }
-
- token->length = cp - token->string;
- assert (token->length);
-
- if (is_num)
- {
- struct data_in di;
-
- di.s = token->string;
- di.e = token->string + token->length;
- di.v = (union value *) &token->number;
- di.f1 = first_column;
- di.format = make_output_format (FMT_F, token->length, 0);
-
- if (!data_in (&di))
- return 0;
- }
- else
- token->type = MSTR;
- }
-
- dfm_forward_columns (reader, cp - ls_c_str (&line));
-
- return 1;
-}
-
-/* Forcibly skip the end of a line for content type CONTENT in
- READER. */
-static int
-force_eol (struct dfm_reader *reader, const char *content)
-{
- struct fixed_string line;
- const char *cp;
-
- if (dfm_eof (reader))
- return 0;
- dfm_get_record (reader, &line);
-
- cp = ls_c_str (&line);
- while (isspace ((unsigned char) *cp) && cp < ls_end (&line))
- cp++;
-
- if (cp < ls_end (&line))
- {
- msg (SE, _("End of line expected %s while reading %s."),
- context (reader), content);
- return 0;
- }
-
- dfm_forward_record (reader);
- return 1;
-}
-\f
-/* Back end, omitting ROWTYPE_. */
-
-struct nr_aux_data
- {
- struct matrix_data_pgm *mx; /* MATRIX DATA program. */
- double ***data; /* MATRIX DATA data. */
- double *factor_values; /* Factor values. */
- int max_cell_idx; /* Max-numbered cell that we have
- read so far, plus one. */
- double *split_values; /* SPLIT FILE variable values. */
- };
-
-static int nr_read_splits (struct nr_aux_data *, int compare);
-static int nr_read_factors (struct nr_aux_data *, int cell);
-static void nr_output_data (struct nr_aux_data *, struct ccase *,
- write_case_func *, write_case_data);
-static void matrix_data_read_without_rowtype (struct case_source *source,
- struct ccase *,
- write_case_func *,
- write_case_data);
-
-/* Read from the data file and write it to the active file. */
-static void
-read_matrices_without_rowtype (struct matrix_data_pgm *mx)
-{
- struct nr_aux_data nr;
-
- if (mx->cells == -1)
- mx->cells = 1;
-
- nr.mx = mx;
- nr.data = NULL;
- nr.factor_values = xnmalloc (mx->n_factors * mx->cells,
- sizeof *nr.factor_values);
- nr.max_cell_idx = 0;
- nr.split_values = xnmalloc (dict_get_split_cnt (default_dict),
- sizeof *nr.split_values);
-
- vfm_source = create_case_source (&matrix_data_without_rowtype_source_class, &nr);
-
- procedure (NULL, NULL);
-
- free (nr.split_values);
- free (nr.factor_values);
-}
-
-/* Mirror data across the diagonal of matrix CP which contains
- CONTENT type data. */
-static void
-fill_matrix (struct matrix_data_pgm *mx, int content, double *cp)
-{
- int type = content_type[content];
-
- if (type == 1 && mx->section != FULL)
- {
- if (mx->diag == NODIAGONAL)
- {
- const double fill = content == CORR ? 1.0 : SYSMIS;
- int i;
-
- for (i = 0; i < mx->n_continuous; i++)
- cp[i * (1 + mx->n_continuous)] = fill;
- }
-
- {
- int c, r;
-
- if (mx->section == LOWER)
- {
- int n_lines = mx->n_continuous;
- if (mx->section != FULL && mx->diag == NODIAGONAL)
- n_lines--;
-
- for (r = 1; r < n_lines; r++)
- for (c = 0; c < r; c++)
- cp[r + c * mx->n_continuous] = cp[c + r * mx->n_continuous];
- }
- else
- {
- assert (mx->section == UPPER);
- for (r = 1; r < mx->n_continuous; r++)
- for (c = 0; c < r; c++)
- cp[c + r * mx->n_continuous] = cp[r + c * mx->n_continuous];
- }
- }
- }
- else if (type == 2)
- {
- int c;
-
- for (c = 1; c < mx->n_continuous; c++)
- cp[c] = cp[0];
- }
-}
-
-/* Read data lines for content type CONTENT from the data file.
- If PER_FACTOR is nonzero, then factor information is read from
- the data file. Data is for cell number CELL. */
-static int
-nr_read_data_lines (struct nr_aux_data *nr,
- int per_factor, int cell, int content, int compare)
-{
- struct matrix_data_pgm *mx = nr->mx;
- const int type = content_type[content]; /* Content type. */
- int n_lines; /* Number of lines to parse from data file for this type. */
- double *cp; /* Current position in vector or matrix. */
- int i;
-
- if (type != 1)
- n_lines = 1;
- else
- {
- n_lines = mx->n_continuous;
- if (mx->section != FULL && mx->diag == NODIAGONAL)
- n_lines--;
- }
-
- cp = nr->data[content][cell];
- if (type == 1 && mx->section == LOWER && mx->diag == NODIAGONAL)
- cp += mx->n_continuous;
-
- for (i = 0; i < n_lines; i++)
- {
- int n_cols;
-
- if (!nr_read_splits (nr, 1))
- return 0;
- if (per_factor && !nr_read_factors (nr, cell))
- return 0;
- compare = 1;
-
- switch (type)
- {
- case 0:
- n_cols = mx->n_continuous;
- break;
- case 1:
- switch (mx->section)
- {
- case LOWER:
- n_cols = i + 1;
- break;
- case UPPER:
- cp += i;
- n_cols = mx->n_continuous - i;
- if (mx->diag == NODIAGONAL)
- {
- n_cols--;
- cp++;
- }
- break;
- case FULL:
- n_cols = mx->n_continuous;
- break;
- default:
- assert (0);
- abort ();
- }
- break;
- case 2:
- n_cols = 1;
- break;
- default:
- assert (0);
- abort ();
- }
-
- {
- int j;
-
- for (j = 0; j < n_cols; j++)
- {
- struct matrix_token token;
- if (!mget_token (&token, mx->reader))
- return 0;
- if (token.type != MNUM)
- {
- msg (SE, _("expecting value for %s %s"),
- dict_get_var (default_dict, j)->name,
- context (mx->reader));
- return 0;
- }
-
- *cp++ = token.number;
- }
- if (mx->fmt != FREE
- && !force_eol (mx->reader, content_names[content]))
- return 0;
- debug_printf (("\n"));
- }
-
- if (mx->section == LOWER)
- cp += mx->n_continuous - n_cols;
- }
-
- fill_matrix (mx, content, nr->data[content][cell]);
-
- return 1;
-}
-
-/* When ROWTYPE_ does not appear in the data, reads the matrices and
- writes them to the output file. Returns success. */
-static void
-matrix_data_read_without_rowtype (struct case_source *source,
- struct ccase *c,
- write_case_func *write_case,
- write_case_data wc_data)
-{
- struct nr_aux_data *nr = source->aux;
- struct matrix_data_pgm *mx = nr->mx;
-
- {
- int *cp;
-
- nr->data = pool_nalloc (mx->container, PROX + 1, sizeof *nr->data);
-
- {
- int i;
-
- for (i = 0; i <= PROX; i++)
- nr->data[i] = NULL;
- }
-
- for (cp = mx->contents; *cp != EOC; cp++)
- if (*cp != LPAREN && *cp != RPAREN)
- {
- int per_factor = mx->is_per_factor[*cp];
- int n_entries;
-
- n_entries = mx->n_continuous;
- if (content_type[*cp] == 1)
- n_entries *= mx->n_continuous;
-
- {
- int n_vectors = per_factor ? mx->cells : 1;
- int i;
-
- nr->data[*cp] = pool_nalloc (mx->container,
- n_vectors, sizeof **nr->data);
-
- for (i = 0; i < n_vectors; i++)
- nr->data[*cp][i] = pool_nalloc (mx->container,
- n_entries, sizeof ***nr->data);
- }
- }
- }
-
- for (;;)
- {
- int *bp, *ep, *np;
-
- if (!nr_read_splits (nr, 0))
- return;
-
- for (bp = mx->contents; *bp != EOC; bp = np)
- {
- int per_factor;
-
- /* Trap the CONTENTS that we should parse in this pass
- between bp and ep. Set np to the starting bp for next
- iteration. */
- if (*bp == LPAREN)
- {
- ep = ++bp;
- while (*ep != RPAREN)
- ep++;
- np = &ep[1];
- per_factor = 1;
- }
- else
- {
- ep = &bp[1];
- while (*ep != EOC && *ep != LPAREN)
- ep++;
- np = ep;
- per_factor = 0;
- }
-
- {
- int i;
-
- for (i = 0; i < (per_factor ? mx->cells : 1); i++)
- {
- int *cp;
-
- for (cp = bp; cp < ep; cp++)
- if (!nr_read_data_lines (nr, per_factor, i, *cp, cp != bp))
- return;
- }
- }
- }
-
- nr_output_data (nr, c, write_case, wc_data);
-
- if (dict_get_split_cnt (default_dict) == 0
- || !another_token (mx->reader))
- return;
- }
-}
-
-/* Read the split file variables. If COMPARE is 1, compares the
- values read to the last values read and returns 1 if they're equal,
- 0 otherwise. */
-static int
-nr_read_splits (struct nr_aux_data *nr, int compare)
-{
- struct matrix_data_pgm *mx = nr->mx;
- static int just_read = 0; /* FIXME: WTF? */
- size_t split_cnt;
- size_t i;
-
- if (compare && just_read)
- {
- just_read = 0;
- return 1;
- }
-
- if (dict_get_split_vars (default_dict) == NULL)
- return 1;
-
- if (mx->single_split)
- {
- if (!compare)
- {
- struct mxd_var *mv = dict_get_split_vars (default_dict)[0]->aux;
- nr->split_values[0] = ++mv->sub_type;
- }
- return 1;
- }
-
- if (!compare)
- just_read = 1;
-
- split_cnt = dict_get_split_cnt (default_dict);
- for (i = 0; i < split_cnt; i++)
- {
- struct matrix_token token;
- if (!mget_token (&token, mx->reader))
- return 0;
- if (token.type != MNUM)
- {
- msg (SE, _("Syntax error expecting SPLIT FILE value %s."),
- context (mx->reader));
- return 0;
- }
-
- if (!compare)
- nr->split_values[i] = token.number;
- else if (nr->split_values[i] != token.number)
- {
- msg (SE, _("Expecting value %g for %s."),
- nr->split_values[i],
- dict_get_split_vars (default_dict)[i]->name);
- return 0;
- }
- }
-
- return 1;
-}
-
-/* Read the factors for cell CELL. If COMPARE is 1, compares the
- values read to the last values read and returns 1 if they're equal,
- 0 otherwise. */
-static int
-nr_read_factors (struct nr_aux_data *nr, int cell)
-{
- struct matrix_data_pgm *mx = nr->mx;
- int compare;
-
- if (mx->n_factors == 0)
- return 1;
-
- assert (nr->max_cell_idx >= cell);
- if (cell != nr->max_cell_idx)
- compare = 1;
- else
- {
- compare = 0;
- nr->max_cell_idx++;
- }
-
- {
- size_t i;
-
- for (i = 0; i < mx->n_factors; i++)
- {
- struct matrix_token token;
- if (!mget_token (&token, mx->reader))
- return 0;
- if (token.type != MNUM)
- {
- msg (SE, _("Syntax error expecting factor value %s."),
- context (mx->reader));
- return 0;
- }
-
- if (!compare)
- nr->factor_values[i + mx->n_factors * cell] = token.number;
- else if (nr->factor_values[i + mx->n_factors * cell] != token.number)
- {
- msg (SE, _("Syntax error expecting value %g for %s %s."),
- nr->factor_values[i + mx->n_factors * cell],
- mx->factors[i]->name, context (mx->reader));
- return 0;
- }
- }
- }
-
- return 1;
-}
-
-/* Write the contents of a cell having content type CONTENT and data
- CP to the active file. */
-static void
-dump_cell_content (struct matrix_data_pgm *mx, int content, double *cp,
- struct ccase *c,
- write_case_func *write_case, write_case_data wc_data)
-{
- int type = content_type[content];
-
- {
- buf_copy_str_rpad (case_data_rw (c, mx->rowtype_->fv)->s, 8,
- content_names[content]);
-
- if (type != 1)
- memset (case_data_rw (c, mx->varname_->fv)->s, ' ', 8);
- }
-
- {
- int n_lines = (type == 1) ? mx->n_continuous : 1;
- int i;
-
- for (i = 0; i < n_lines; i++)
- {
- int j;
-
- for (j = 0; j < mx->n_continuous; j++)
- {
- int fv = dict_get_var (default_dict, mx->first_continuous + j)->fv;
- case_data_rw (c, fv)->f = *cp;
- cp++;
- }
- if (type == 1)
- buf_copy_str_rpad (case_data_rw (c, mx->varname_->fv)->s, 8,
- dict_get_var (default_dict,
- mx->first_continuous + i)->name);
- write_case (wc_data);
- }
- }
-}
-
-/* Finally dump out everything from nr_data[] to the output file. */
-static void
-nr_output_data (struct nr_aux_data *nr, struct ccase *c,
- write_case_func *write_case, write_case_data wc_data)
-{
- struct matrix_data_pgm *mx = nr->mx;
-
- {
- struct variable *const *split;
- size_t split_cnt;
- size_t i;
-
- split_cnt = dict_get_split_cnt (default_dict);
- split = dict_get_split_vars (default_dict);
- for (i = 0; i < split_cnt; i++)
- case_data_rw (c, split[i]->fv)->f = nr->split_values[i];
- }
-
- if (mx->n_factors)
- {
- int cell;
-
- for (cell = 0; cell < mx->cells; cell++)
- {
- {
- size_t factor;
-
- for (factor = 0; factor < mx->n_factors; factor++)
- {
- case_data_rw (c, mx->factors[factor]->fv)->f
- = nr->factor_values[factor + cell * mx->n_factors];
- debug_printf (("f:%s ", mx->factors[factor]->name));
- }
- }
-
- {
- int content;
-
- for (content = 0; content <= PROX; content++)
- if (mx->is_per_factor[content])
- {
- assert (nr->data[content] != NULL
- && nr->data[content][cell] != NULL);
-
- dump_cell_content (mx, content, nr->data[content][cell],
- c, write_case, wc_data);
- }
- }
- }
- }
-
- {
- int content;
-
- {
- size_t factor;
-
- for (factor = 0; factor < mx->n_factors; factor++)
- case_data_rw (c, mx->factors[factor]->fv)->f = SYSMIS;
- }
-
- for (content = 0; content <= PROX; content++)
- if (!mx->is_per_factor[content] && nr->data[content] != NULL)
- dump_cell_content (mx, content, nr->data[content][0],
- c, write_case, wc_data);
- }
-}
-\f
-/* Back end, with ROWTYPE_. */
-
-/* All the data for one set of factor values. */
-struct factor_data
- {
- double *factors;
- int n_rows[PROX + 1];
- double *data[PROX + 1];
- struct factor_data *next;
- };
-
-/* With ROWTYPE_ auxiliary data. */
-struct wr_aux_data
- {
- struct matrix_data_pgm *mx; /* MATRIX DATA program. */
- int content; /* Type of current row. */
- double *split_values; /* SPLIT FILE variable values. */
- struct factor_data *data; /* All the data. */
- struct factor_data *current; /* Current factor. */
- };
-
-static int wr_read_splits (struct wr_aux_data *, struct ccase *,
- write_case_func *, write_case_data);
-static int wr_output_data (struct wr_aux_data *, struct ccase *,
- write_case_func *, write_case_data);
-static int wr_read_rowtype (struct wr_aux_data *,
- const struct matrix_token *, struct dfm_reader *);
-static int wr_read_factors (struct wr_aux_data *);
-static int wr_read_indeps (struct wr_aux_data *);
-static void matrix_data_read_with_rowtype (struct case_source *,
- struct ccase *,
- write_case_func *,
- write_case_data);
-
-/* When ROWTYPE_ appears in the data, reads the matrices and writes
- them to the output file. */
-static void
-read_matrices_with_rowtype (struct matrix_data_pgm *mx)
-{
- struct wr_aux_data wr;
-
- wr.mx = mx;
- wr.content = -1;
- wr.split_values = NULL;
- wr.data = NULL;
- wr.current = NULL;
- mx->cells = 0;
-
- vfm_source = create_case_source (&matrix_data_with_rowtype_source_class,
- &wr);
- procedure (NULL, NULL);
-
- free (wr.split_values);
-}
-
-/* Read from the data file and write it to the active file. */
-static void
-matrix_data_read_with_rowtype (struct case_source *source,
- struct ccase *c,
- write_case_func *write_case,
- write_case_data wc_data)
-{
- struct wr_aux_data *wr = source->aux;
- struct matrix_data_pgm *mx = wr->mx;
-
- do
- {
- if (!wr_read_splits (wr, c, write_case, wc_data))
- return;
-
- if (!wr_read_factors (wr))
- return;
-
- if (!wr_read_indeps (wr))
- return;
- }
- while (another_token (mx->reader));
-
- wr_output_data (wr, c, write_case, wc_data);
-}
-
-/* Read the split file variables. If they differ from the previous
- set of split variables then output the data. Returns success. */
-static int
-wr_read_splits (struct wr_aux_data *wr,
- struct ccase *c,
- write_case_func *write_case, write_case_data wc_data)
-{
- struct matrix_data_pgm *mx = wr->mx;
- int compare;
- size_t split_cnt;
-
- split_cnt = dict_get_split_cnt (default_dict);
- if (split_cnt == 0)
- return 1;
-
- if (wr->split_values)
- compare = 1;
- else
- {
- compare = 0;
- wr->split_values = xnmalloc (split_cnt, sizeof *wr->split_values);
- }
-
- {
- int different = 0;
- int i;
-
- for (i = 0; i < split_cnt; i++)
- {
- struct matrix_token token;
- if (!mget_token (&token, mx->reader))
- return 0;
- if (token.type != MNUM)
- {
- msg (SE, _("Syntax error %s expecting SPLIT FILE value."),
- context (mx->reader));
- return 0;
- }
-
- if (compare && wr->split_values[i] != token.number && !different)
- {
- if (!wr_output_data (wr, c, write_case, wc_data))
- return 0;
- different = 1;
- mx->cells = 0;
- }
- wr->split_values[i] = token.number;
- }
- }
-
- return 1;
-}
-
-/* Compares doubles A and B, treating SYSMIS as greatest. */
-static int
-compare_doubles (const void *a_, const void *b_, void *aux UNUSED)
-{
- const double *a = a_;
- const double *b = b_;
-
- if (*a == *b)
- return 0;
- else if (*a == SYSMIS)
- return 1;
- else if (*b == SYSMIS)
- return -1;
- else if (*a > *b)
- return 1;
- else
- return -1;
-}
-
-/* Return strcmp()-type comparison of the MX->n_factors factors at _A and
- _B. Sort missing values toward the end. */
-static int
-compare_factors (const void *a_, const void *b_, void *mx_)
-{
- struct matrix_data_pgm *mx = mx_;
- struct factor_data *const *pa = a_;
- struct factor_data *const *pb = b_;
- const double *a = (*pa)->factors;
- const double *b = (*pb)->factors;
-
- return lexicographical_compare_3way (a, mx->n_factors,
- b, mx->n_factors,
- sizeof *a,
- compare_doubles, NULL);
-}
-
-/* Write out the data for the current split file to the active
- file. */
-static int
-wr_output_data (struct wr_aux_data *wr,
- struct ccase *c,
- write_case_func *write_case, write_case_data wc_data)
-{
- struct matrix_data_pgm *mx = wr->mx;
-
- {
- struct variable *const *split;
- size_t split_cnt;
- size_t i;
-
- split_cnt = dict_get_split_cnt (default_dict);
- split = dict_get_split_vars (default_dict);
- for (i = 0; i < split_cnt; i++)
- case_data_rw (c, split[i]->fv)->f = wr->split_values[i];
- }
-
- /* Sort the wr->data list. */
- {
- struct factor_data **factors;
- struct factor_data *iter;
- int i;
-
- factors = xnmalloc (mx->cells, sizeof *factors);
-
- for (i = 0, iter = wr->data; iter; iter = iter->next, i++)
- factors[i] = iter;
-
- sort (factors, mx->cells, sizeof *factors, compare_factors, mx);
-
- wr->data = factors[0];
- for (i = 0; i < mx->cells - 1; i++)
- factors[i]->next = factors[i + 1];
- factors[mx->cells - 1]->next = NULL;
-
- free (factors);
- }
-
- /* Write out records for every set of factor values. */
- {
- struct factor_data *iter;
-
- for (iter = wr->data; iter; iter = iter->next)
- {
- {
- size_t factor;
-
- for (factor = 0; factor < mx->n_factors; factor++)
- case_data_rw (c, mx->factors[factor]->fv)->f
- = iter->factors[factor];
- }
-
- {
- int content;
-
- for (content = 0; content <= PROX; content++)
- {
- if (!iter->n_rows[content])
- continue;
-
- {
- int type = content_type[content];
- int n_lines = (type == 1
- ? (mx->n_continuous
- - (mx->section != FULL && mx->diag == NODIAGONAL))
- : 1);
-
- if (n_lines != iter->n_rows[content])
- {
- msg (SE, _("Expected %d lines of data for %s content; "
- "actually saw %d lines. No data will be "
- "output for this content."),
- n_lines, content_names[content],
- iter->n_rows[content]);
- continue;
- }
- }
-
- fill_matrix (mx, content, iter->data[content]);
-
- dump_cell_content (mx, content, iter->data[content],
- c, write_case, wc_data);
- }
- }
- }
- }
-
- pool_destroy (mx->container);
- mx->container = pool_create ();
-
- wr->data = wr->current = NULL;
-
- return 1;
-}
-
-/* Sets ROWTYPE_ based on the given TOKEN read from READER.
- Return success. */
-static int
-wr_read_rowtype (struct wr_aux_data *wr,
- const struct matrix_token *token,
- struct dfm_reader *reader)
-{
- if (wr->content != -1)
- {
- msg (SE, _("Multiply specified ROWTYPE_ %s."), context (reader));
- return 0;
- }
- if (token->type != MSTR)
- {
- msg (SE, _("Syntax error %s expecting ROWTYPE_ string."),
- context (reader));
- return 0;
- }
-
- {
- char s[16];
- char *cp;
-
- memcpy (s, token->string, min (15, token->length));
- s[min (15, token->length)] = 0;
-
- for (cp = s; *cp; cp++)
- *cp = toupper ((unsigned char) *cp);
-
- wr->content = string_to_content_type (s, NULL);
- }
-
- if (wr->content == -1)
- {
- msg (SE, _("Syntax error %s."), context (reader));
- return 0;
- }
-
- return 1;
-}
-
-/* Read the factors for the current row. Select a set of factors and
- point wr_current to it. */
-static int
-wr_read_factors (struct wr_aux_data *wr)
-{
- struct matrix_data_pgm *mx = wr->mx;
- double *factor_values = local_alloc (sizeof *factor_values * mx->n_factors);
-
- wr->content = -1;
- {
- size_t i;
-
- for (i = 0; i < mx->n_factors; i++)
- {
- struct matrix_token token;
- if (!mget_token (&token, mx->reader))
- goto lossage;
- if (token.type == MSTR)
- {
- if (!wr_read_rowtype (wr, &token, mx->reader))
- goto lossage;
- if (!mget_token (&token, mx->reader))
- goto lossage;
- }
- if (token.type != MNUM)
- {
- msg (SE, _("Syntax error expecting factor value %s."),
- context (mx->reader));
- goto lossage;
- }
-
- factor_values[i] = token.number;
- }
- }
- if (wr->content == -1)
- {
- struct matrix_token token;
- if (!mget_token (&token, mx->reader))
- goto lossage;
- if (!wr_read_rowtype (wr, &token, mx->reader))
- goto lossage;
- }
-
- /* Try the most recent factor first as a simple caching
- mechanism. */
- if (wr->current)
- {
- size_t i;
-
- for (i = 0; i < mx->n_factors; i++)
- if (factor_values[i] != wr->current->factors[i])
- goto cache_miss;
- goto winnage;
- }
-
- /* Linear search through the list. */
-cache_miss:
- {
- struct factor_data *iter;
-
- for (iter = wr->data; iter; iter = iter->next)
- {
- size_t i;
-
- for (i = 0; i < mx->n_factors; i++)
- if (factor_values[i] != iter->factors[i])
- goto next_item;
-
- wr->current = iter;
- goto winnage;
-
- next_item: ;
- }
- }
-
- /* Not found. Make a new item. */
- {
- struct factor_data *new = pool_alloc (mx->container, sizeof *new);
-
- new->factors = pool_nalloc (mx->container,
- mx->n_factors, sizeof *new->factors);
-
- {
- size_t i;
-
- for (i = 0; i < mx->n_factors; i++)
- new->factors[i] = factor_values[i];
- }
-
- {
- int i;
-
- for (i = 0; i <= PROX; i++)
- {
- new->n_rows[i] = 0;
- new->data[i] = NULL;
- }
- }
-
- new->next = wr->data;
- wr->data = wr->current = new;
- mx->cells++;
- }
-
-winnage:
- local_free (factor_values);
- return 1;
-
-lossage:
- local_free (factor_values);
- return 0;
-}
-
-/* Read the independent variables into wr->current. */
-static int
-wr_read_indeps (struct wr_aux_data *wr)
-{
- struct matrix_data_pgm *mx = wr->mx;
- struct factor_data *c = wr->current;
- const int type = content_type[wr->content];
- const int n_rows = c->n_rows[wr->content];
- double *cp;
- int n_cols;
-
- /* Allocate room for data if necessary. */
- if (c->data[wr->content] == NULL)
- {
- int n_items = mx->n_continuous;
- if (type == 1)
- n_items *= mx->n_continuous;
-
- c->data[wr->content] = pool_nalloc (mx->container,
- n_items, sizeof **c->data);
- }
-
- cp = &c->data[wr->content][n_rows * mx->n_continuous];
-
- /* Figure out how much to read from this line. */
- switch (type)
- {
- case 0:
- case 2:
- if (n_rows > 0)
- {
- msg (SE, _("Duplicate specification for %s."),
- content_names[wr->content]);
- return 0;
- }
- if (type == 0)
- n_cols = mx->n_continuous;
- else
- n_cols = 1;
- break;
- case 1:
- if (n_rows >= mx->n_continuous - (mx->section != FULL && mx->diag == NODIAGONAL))
- {
- msg (SE, _("Too many rows of matrix data for %s."),
- content_names[wr->content]);
- return 0;
- }
-
- switch (mx->section)
- {
- case LOWER:
- n_cols = n_rows + 1;
- if (mx->diag == NODIAGONAL)
- cp += mx->n_continuous;
- break;
- case UPPER:
- cp += n_rows;
- n_cols = mx->n_continuous - n_rows;
- if (mx->diag == NODIAGONAL)
- {
- n_cols--;
- cp++;
- }
- break;
- case FULL:
- n_cols = mx->n_continuous;
- break;
- default:
- assert (0);
- abort ();
- }
- break;
- default:
- assert (0);
- abort ();
- }
- c->n_rows[wr->content]++;
-
- debug_printf ((" (c=%p,r=%d,n=%d)", c, n_rows + 1, n_cols));
-
- /* Read N_COLS items at CP. */
- {
- int j;
-
- for (j = 0; j < n_cols; j++)
- {
- struct matrix_token token;
- if (!mget_token (&token, mx->reader))
- return 0;
- if (token.type != MNUM)
- {
- msg (SE, _("Syntax error expecting value for %s %s."),
- dict_get_var (default_dict, mx->first_continuous + j)->name,
- context (mx->reader));
- return 0;
- }
-
- *cp++ = token.number;
- }
- if (mx->fmt != FREE
- && !force_eol (mx->reader, content_names[wr->content]))
- return 0;
- debug_printf (("\n"));
- }
-
- return 1;
-}
-\f
-/* Matrix source. */
-
-static const struct case_source_class matrix_data_with_rowtype_source_class =
- {
- "MATRIX DATA",
- NULL,
- matrix_data_read_with_rowtype,
- NULL,
- };
-
-static const struct case_source_class
-matrix_data_without_rowtype_source_class =
- {
- "MATRIX DATA",
- NULL,
- matrix_data_read_without_rowtype,
- NULL,
- };
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <stdlib.h>
-#include <stdio.h>
-#include "dictionary.h"
-#include "error.h"
-#include "alloc.h"
-#include "command.h"
-#include "hash.h"
-#include "lexer.h"
-#include "error.h"
-#include "magic.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* (headers) */
-
-#include "debug-print.h"
-
-/* (specification)
- means (mns_):
- *tables=custom;
- +format=lab:!labels/nolabels/nocatlabs,
- name:!names/nonames,
- val:!values/novalues,
- fmt:!table/tree;
- +missing=miss:!table/include/dependent;
- +cells[cl_]=default,count,sum,mean,stddev,variance,all;
- +statistics[st_]=anova,linearity,all,none.
-*/
-/* (declarations) */
-/* (functions) */
-
-/* TABLES: Variable lists for each dimension. */
-int n_dim; /* Number of dimensions. */
-size_t *nv_dim; /* Number of variables in each dimension. */
-struct variable ***v_dim; /* Variables in each dimension. */
-
-/* VARIABLES: List of variables. */
-int n_var;
-struct variable **v_var;
-
-/* Parses and executes the T-TEST procedure. */
-int
-cmd_means (void)
-{
- struct cmd_means cmd;
- int success = CMD_FAILURE;
-
- n_dim = 0;
- nv_dim = NULL;
- v_dim = NULL;
- v_var = NULL;
-
- if (!parse_means (&cmd))
- goto free;
-
- if (cmd.sbc_cells)
- {
- int i;
- for (i = 0; i < MNS_CL_count; i++)
- if (cmd.a_cells[i])
- break;
- if (i >= MNS_CL_count)
- cmd.a_cells[MNS_CL_ALL] = 1;
- }
- else
- cmd.a_cells[MNS_CL_DEFAULT] = 1;
- if (cmd.a_cells[MNS_CL_DEFAULT] || cmd.a_cells[MNS_CL_ALL])
- cmd.a_cells[MNS_CL_MEAN] = cmd.a_cells[MNS_CL_STDDEV] = cmd.a_cells[MNS_CL_COUNT] = 1;
- if (cmd.a_cells[MNS_CL_ALL])
- cmd.a_cells[MNS_CL_SUM] = cmd.a_cells[MNS_CL_VARIANCE] = 1;
-
- if (cmd.sbc_statistics)
- {
- if (!cmd.a_statistics[MNS_ST_ANOVA] && !cmd.a_statistics[MNS_ST_LINEARITY])
- cmd.a_statistics[MNS_ST_ANOVA] = 1;
- if (cmd.a_statistics[MNS_ST_ALL])
- cmd.a_statistics[MNS_ST_ANOVA] = cmd.a_statistics[MNS_ST_LINEARITY] = 1;
- }
-
- if (!cmd.sbc_tables)
- {
- msg (SE, _("Missing required subcommand TABLES."));
- goto free;
- }
-
- success = CMD_SUCCESS;
-
-free:
- {
- int i;
-
- for (i = 0; i < n_dim; i++)
- free (v_dim[i]);
- free (nv_dim);
- free (v_dim);
- free (v_var);
- }
-
- return success;
-}
-
-/* Parses the TABLES subcommand. */
-static int
-mns_custom_tables (struct cmd_means *cmd)
-{
- struct var_set *var_set;
-
- if (!lex_match_id ("TABLES")
- && (token != T_ID || dict_lookup_var (default_dict, tokid) == NULL)
- && token != T_ALL)
- return 2;
- lex_match ('=');
-
- if (cmd->sbc_tables)
- {
- msg (SE, _("TABLES subcommand may not appear more "
- "than once."));
- return 0;
- }
-
- var_set = var_set_create_from_dict (default_dict);
- assert (var_set != NULL);
-
- do
- {
- size_t nvl;
- struct variable **vl;
-
- if (!parse_var_set_vars (var_set, &vl, &nvl,
- PV_NO_DUPLICATE | PV_NO_SCRATCH))
- goto lossage;
-
- n_dim++;
- nv_dim = xnrealloc (nv_dim, n_dim, sizeof *nv_dim);
- v_dim = xnrealloc (v_dim, n_dim, sizeof *v_dim);
-
- nv_dim[n_dim - 1] = nvl;
- v_dim[n_dim - 1] = vl;
- }
- while (lex_match (T_BY));
-
- var_set_destroy (var_set);
- return 1;
-
- lossage:
- var_set_destroy (var_set);
- return 0;
-}
-
-/*
- Local Variables:
- mode: c
- End:
-*/
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <stdlib.h>
-#include "command.h"
-#include "data-in.h"
-#include "error.h"
-#include "lexer.h"
-#include "magic.h"
-#include "range-prs.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-int
-cmd_missing_values (void)
-{
- struct variable **v;
- size_t nv;
-
- int retval = CMD_PART_SUCCESS_MAYBE;
- bool deferred_errors = false;
-
- while (token != '.')
- {
- size_t i;
-
- if (!parse_variables (default_dict, &v, &nv, PV_NONE))
- goto done;
-
- if (!lex_match ('('))
- {
- lex_error (_("expecting `('"));
- goto done;
- }
-
- for (i = 0; i < nv; i++)
- mv_init (&v[i]->miss, v[i]->width);
-
- if (!lex_match (')'))
- {
- struct missing_values mv;
-
- for (i = 0; i < nv; i++)
- if (v[i]->type != v[0]->type)
- {
- const struct variable *n = v[0]->type == NUMERIC ? v[0] : v[i];
- const struct variable *s = v[0]->type == NUMERIC ? v[i] : v[0];
- msg (SE, _("Cannot mix numeric variables (e.g. %s) and "
- "string variables (e.g. %s) within a single list."),
- n->name, s->name);
- goto done;
- }
-
- if (v[0]->type == NUMERIC)
- {
- mv_init (&mv, 0);
- while (!lex_match (')'))
- {
- double x, y;
- bool ok;
-
- if (!parse_num_range (&x, &y, &v[0]->print))
- goto done;
-
- ok = (x == y
- ? mv_add_num (&mv, x)
- : mv_add_num_range (&mv, x, y));
- if (!ok)
- deferred_errors = true;
-
- lex_match (',');
- }
- }
- else
- {
- mv_init (&mv, MAX_SHORT_STRING);
- while (!lex_match (')'))
- {
- if (!lex_force_string ())
- {
- deferred_errors = true;
- break;
- }
-
- if (ds_length (&tokstr) > MAX_SHORT_STRING)
- {
- ds_truncate (&tokstr, MAX_SHORT_STRING);
- msg (SE, _("Truncating missing value to short string "
- "length (%d characters)."),
- MAX_SHORT_STRING);
- }
- else
- ds_rpad (&tokstr, MAX_SHORT_STRING, ' ');
-
- if (!mv_add_str (&mv, ds_data (&tokstr)))
- deferred_errors = true;
-
- lex_get ();
- lex_match (',');
- }
- }
-
- for (i = 0; i < nv; i++)
- {
- if (!mv_is_resizable (&mv, v[i]->width))
- {
- msg (SE, _("Missing values provided are too long to assign "
- "to variable of width %d."),
- v[i]->width);
- deferred_errors = true;
- }
- else
- {
- mv_copy (&v[i]->miss, &mv);
- mv_resize (&v[i]->miss, v[i]->width);
- }
- }
- }
-
- lex_match ('/');
- free (v);
- v = NULL;
- }
- retval = lex_end_of_command ();
-
- done:
- free (v);
- if (deferred_errors)
- retval = CMD_PART_SUCCESS_MAYBE;
- return retval;
-}
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "misc.h"
-
-/* Returns the number of digits in X. */
-int
-intlog10 (unsigned x)
-{
- int digits = 0;
-
- do
- {
- digits++;
- x /= 10;
- }
- while (x > 0);
-
- return digits;
-}
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !math_misc_h
-#define math_misc_h 1
-
-#include <float.h>
-#include <math.h>
-
-#define EPSILON (10 * DBL_EPSILON)
-
-/* HUGE_VAL is traditionally defined as positive infinity, or
- alternatively, DBL_MAX. */
-#if !HAVE_ISINF
-#define isinf(X) (fabs (X) == HUGE_VAL)
-#endif
-
-/* A Not a Number is not equal to itself. */
-#if !HAVE_ISNAN
-#define isnan(X) ((X) != (X))
-#endif
-
-/* Finite numbers are not infinities or NaNs. */
-#if !HAVE_FINITE
-#define finite(X) (!isinf (X) && !isnan (X))
-#elif HAVE_IEEEFP_H
-#include <ieeefp.h> /* Declares finite() under Solaris. */
-#endif
-
-#ifndef min
-#define min(A, B) ((A) < (B) ? (A) : (B))
-#endif
-
-#ifndef max
-#define max(A, B) ((A) > (B) ? (A) : (B))
-#endif
-
-/* Clamps A to be between B and C. */
-#define range(A, B, C) ((A) < (B) ? (B) : ((A) > (C) ? (C) : (A)))
-
-/* Divides nonnegative X by positive Y, rounding up. */
-#define DIV_RND_UP(X, Y) (((X) + ((Y) - 1)) / (Y))
-
-/* Returns nonnegative difference between {nonnegative X} and {the
- least multiple of positive Y greater than or equal to X}. */
-#define REM_RND_UP(X, Y) ((X) % (Y) ? (Y) - (X) % (Y) : 0)
-
-/* Rounds X up to the next multiple of Y. */
-#define ROUND_UP(X, Y) (((X) + ((Y) - 1)) / (Y) * (Y))
-
-/* Rounds X down to the previous multiple of Y. */
-#define ROUND_DOWN(X, Y) ((X) / (Y) * (Y))
-
-int intlog10 (unsigned);
-
-/* Returns the square of X. */
-static inline double
-pow2 (double x)
-{
- return x * x;
-}
-
-/* Returns the cube of X. */
-static inline double
-pow3 (double x)
-{
- return x * x * x;
-}
-
-/* Returns the fourth power of X. */
-static inline double
-pow4 (double x)
-{
- double y = x * x;
- y *= y;
- return y;
-}
-
-#endif /* math/misc.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "missing-values.h"
-#include <assert.h>
-#include <stdlib.h>
-#include "str.h"
-
-
-/* Initializes MV as a set of missing values for a variable of
- the given WIDTH. Although only numeric variables and short
- string variables may have missing values, WIDTH may be any
- valid variable width. */
-void
-mv_init (struct missing_values *mv, int width)
-{
- assert (width >= 0 && width <= MAX_STRING);
- mv->type = MV_NONE;
- mv->width = width;
-}
-
-void
-mv_set_type(struct missing_values *mv, enum mv_type type)
-{
- mv->type = type;
-}
-
-
-/* Copies SRC to MV. */
-void
-mv_copy (struct missing_values *mv, const struct missing_values *src)
-{
- assert(src);
-
- *mv = *src;
-}
-
-/* Returns true if MV is an empty set of missing values. */
-bool
-mv_is_empty (const struct missing_values *mv)
-{
- return mv->type == MV_NONE;
-}
-
-/* Returns the width of the missing values that MV may
- contain. */
-int
-mv_get_width (const struct missing_values *mv)
-{
- return mv->width;
-}
-
-/* Attempts to add individual value V to the set of missing
- values MV. Returns true if successful, false if MV has no
- more room for missing values. (Long string variables never
- accept missing values.) */
-bool
-mv_add_value (struct missing_values *mv, const union value *v)
-{
- if (mv->width > MAX_SHORT_STRING)
- return false;
- switch (mv->type)
- {
- case MV_NONE:
- case MV_1:
- case MV_2:
- case MV_RANGE:
- mv->values[mv->type & 3] = *v;
- mv->type++;
- return true;
-
- case MV_3:
- case MV_RANGE_1:
- return false;
- }
- abort ();
-}
-
-/* Attempts to add S to the set of string missing values MV. S
- must contain exactly as many characters as MV's width.
- Returns true if successful, false if MV has no more room for
- missing values. (Long string variables never accept missing
- values.) */
-bool
-mv_add_str (struct missing_values *mv, const char s[])
-{
- assert (mv->width > 0);
- return mv_add_value (mv, (union value *) s);
-}
-
-/* Attempts to add D to the set of numeric missing values MV.
- Returns true if successful, false if MV has no more room for
- missing values. */
-bool
-mv_add_num (struct missing_values *mv, double d)
-{
- assert (mv->width == 0);
- return mv_add_value (mv, (union value *) &d);
-}
-
-/* Attempts to add range [LOW, HIGH] to the set of numeric
- missing values MV. Returns true if successful, false if MV
- has no room for a range, or if LOW > HIGH. */
-bool
-mv_add_num_range (struct missing_values *mv, double low, double high)
-{
- assert (mv->width == 0);
- if (low > high)
- return false;
- switch (mv->type)
- {
- case MV_NONE:
- case MV_1:
- mv->values[1].f = low;
- mv->values[2].f = high;
- mv->type |= 4;
- return true;
-
- case MV_2:
- case MV_3:
- case MV_RANGE:
- case MV_RANGE_1:
- return false;
- }
- abort ();
-}
-
-/* Returns true if MV contains an individual value,
- false if MV is empty (or contains only a range). */
-bool
-mv_has_value (const struct missing_values *mv)
-{
- switch (mv->type)
- {
- case MV_1:
- case MV_2:
- case MV_3:
- case MV_RANGE_1:
- return true;
-
- case MV_NONE:
- case MV_RANGE:
- return false;
- }
- abort ();
-}
-
-/* Removes one individual value from MV and stores it in *V.
- MV must contain an individual value (as determined by
- mv_has_value()). */
-void
-mv_pop_value (struct missing_values *mv, union value *v)
-{
- assert (mv_has_value (mv));
- mv->type--;
- *v = mv->values[mv->type & 3];
-}
-
-/* Stores a value in *V.
- MV must contain an individual value (as determined by
- mv_has_value()).
- IDX is the zero based index of the value to get
-*/
-void
-mv_peek_value (const struct missing_values *mv, union value *v, int idx)
-{
- assert (idx >= 0 ) ;
- assert (idx < 3);
-
- assert (mv_has_value (mv));
- *v = mv->values[idx];
-}
-
-void
-mv_replace_value (struct missing_values *mv, const union value *v, int idx)
-{
- assert (idx >= 0) ;
- assert (idx < mv_n_values(mv));
-
- mv->values[idx] = *v;
-}
-
-
-
-int
-mv_n_values (const struct missing_values *mv)
-{
- assert(mv_has_value(mv));
- return mv->type & 3;
-}
-
-
-/* Returns true if MV contains a numeric range,
- false if MV is empty (or contains only individual values). */
-bool
-mv_has_range (const struct missing_values *mv)
-{
- switch (mv->type)
- {
- case MV_RANGE:
- case MV_RANGE_1:
- return true;
-
- case MV_NONE:
- case MV_1:
- case MV_2:
- case MV_3:
- return false;
- }
- abort ();
-}
-
-/* Removes the numeric range from MV and stores it in *LOW and
- *HIGH. MV must contain a individual range (as determined by
- mv_has_range()). */
-void
-mv_pop_range (struct missing_values *mv, double *low, double *high)
-{
- assert (mv_has_range (mv));
- *low = mv->values[1].f;
- *high = mv->values[2].f;
- mv->type &= 3;
-}
-
-
-/* Returns the numeric range from MV into *LOW and
- *HIGH. MV must contain a individual range (as determined by
- mv_has_range()). */
-void
-mv_peek_range (const struct missing_values *mv, double *low, double *high)
-{
- assert (mv_has_range (mv));
- *low = mv->values[1].f;
- *high = mv->values[2].f;
-}
-
-
-/* Returns true if values[IDX] is in use when the `type' member
- is set to TYPE (in struct missing_values),
- false otherwise. */
-static bool
-using_element (unsigned type, int idx)
-{
- assert (idx >= 0 && idx < 3);
-
- switch (type)
- {
- case MV_NONE:
- return false;
- case MV_1:
- return idx < 1;
- case MV_2:
- return idx < 2;
- case MV_3:
- return true;
- case MV_RANGE:
- return idx > 0;
- case MV_RANGE_1:
- return true;
- }
- abort ();
-}
-
-/* Returns true if S contains only spaces between indexes
- NEW_WIDTH (inclusive) and OLD_WIDTH (exclusive),
- false otherwise. */
-static bool
-can_resize_string (const char *s, int old_width, int new_width)
-{
- int i;
-
- assert (new_width < old_width);
- for (i = new_width; i < old_width; i++)
- if (s[i] != ' ')
- return false;
- return true;
-}
-
-/* Returns true if MV can be resized to the given WIDTH with
- mv_resize(), false otherwise. Resizing to the same width is
- always possible. Resizing to a long string WIDTH is only
- possible if MV is an empty set of missing values; otherwise,
- resizing to a larger WIDTH is always possible. Resizing to a
- shorter width is possible only when each missing value
- contains only spaces in the characters that will be
- trimmed. */
-bool
-mv_is_resizable (struct missing_values *mv, int width)
-{
- assert ((width == 0) == (mv->width == 0));
- if (width > MAX_SHORT_STRING && mv->type != MV_NONE)
- return false;
- else if (width >= mv->width)
- return true;
- else
- {
- int i;
-
- for (i = 0; i < 3; i++)
- if (using_element (mv->type, i)
- && !can_resize_string (mv->values[i].s, mv->width, width))
- return false;
- return true;
- }
-}
-
-/* Resizes MV to the given WIDTH. WIDTH must fit the constraints
- explained for mv_is_resizable(). */
-void
-mv_resize (struct missing_values *mv, int width)
-{
- assert (mv_is_resizable (mv, width));
- if (width > mv->width)
- {
- int i;
-
- for (i = 0; i < 3; i++)
- memset (mv->values[i].s + mv->width, ' ', width - mv->width);
- }
- mv->width = width;
-}
-
-/* Returns true if V is system missing or a missing value in MV,
- false otherwise. */
-bool
-mv_is_value_missing (const struct missing_values *mv, const union value *v)
-{
- return (mv->width == 0
- ? mv_is_num_missing (mv, v->f)
- : mv_is_str_missing (mv, v->s));
-}
-
-/* Returns true if D is system missing or a missing value in MV,
- false otherwise.
- MV must be a set of numeric missing values. */
-bool
-mv_is_num_missing (const struct missing_values *mv, double d)
-{
- assert (mv->width == 0);
- return d == SYSMIS || mv_is_num_user_missing (mv, d);
-}
-
-/* Returns true if S[] is a missing value in MV, false otherwise.
- MV must be a set of string missing values.
- S[] must contain exactly as many characters as MV's width. */
-bool
-mv_is_str_missing (const struct missing_values *mv, const char s[])
-{
- return mv_is_str_user_missing (mv, s);
-}
-
-/* Returns true if V is a missing value in MV, false otherwise. */
-bool
-mv_is_value_user_missing (const struct missing_values *mv,
- const union value *v)
-{
- return (mv->width == 0
- ? mv_is_num_user_missing (mv, v->f)
- : mv_is_str_user_missing (mv, v->s));
-}
-
-/* Returns true if D is a missing value in MV, false otherwise.
- MV must be a set of numeric missing values. */
-bool
-mv_is_num_user_missing (const struct missing_values *mv, double d)
-{
- const union value *v = mv->values;
- assert (mv->width == 0);
- switch (mv->type)
- {
- case MV_NONE:
- return false;
- case MV_1:
- return v[0].f == d;
- case MV_2:
- return v[0].f == d || v[1].f == d;
- case MV_3:
- return v[0].f == d || v[1].f == d || v[2].f == d;
- case MV_RANGE:
- return v[1].f <= d && d <= v[2].f;
- case MV_RANGE_1:
- return v[0].f == d || (v[1].f <= d && d <= v[2].f);
- }
- abort ();
-}
-
-/* Returns true if S[] is a missing value in MV, false otherwise.
- MV must be a set of string missing values.
- S[] must contain exactly as many characters as MV's width. */
-bool
-mv_is_str_user_missing (const struct missing_values *mv,
- const char s[])
-{
- const union value *v = mv->values;
- assert (mv->width > 0);
- switch (mv->type)
- {
- case MV_NONE:
- return false;
- case MV_1:
- return !memcmp (v[0].s, s, mv->width);
- case MV_2:
- return (!memcmp (v[0].s, s, mv->width)
- || !memcmp (v[1].s, s, mv->width));
- case MV_3:
- return (!memcmp (v[0].s, s, mv->width)
- || !memcmp (v[1].s, s, mv->width)
- || !memcmp (v[2].s, s, mv->width));
- case MV_RANGE:
- case MV_RANGE_1:
- abort ();
- }
- abort ();
-}
-
-/* Returns true if MV is a set of numeric missing values and V is
- the system missing value. */
-bool
-mv_is_value_system_missing (const struct missing_values *mv,
- const union value *v)
-{
- return mv->width == 0 ? v->f == SYSMIS : false;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !missing_values_h
-#define missing_values_h 1
-
-#include <stdbool.h>
-#include "val.h"
-
-/* Types of user-missing values.
- Invisible--use access functions defined below instead. */
-enum mv_type
- {
- MV_NONE = 0, /* No user-missing values. */
- MV_1 = 1, /* One user-missing value. */
- MV_2 = 2, /* Two user-missing values. */
- MV_3 = 3, /* Three user-missing values. */
- MV_RANGE = 4, /* A range of user-missing values. */
- MV_RANGE_1 = 5 /* A range plus an individual value. */
- };
-
-/* Missing values.
- Opaque--use access functions defined below. */
-struct missing_values
- {
- unsigned type; /* Number and type of missing values. */
- int width; /* 0=numeric, otherwise string width. */
- union value values[3]; /* Missing values. [y,z] are the range. */
- };
-
-
-void mv_init (struct missing_values *, int width);
-void mv_set_type(struct missing_values *mv, enum mv_type type);
-
-void mv_copy (struct missing_values *, const struct missing_values *);
-bool mv_is_empty (const struct missing_values *);
-int mv_get_width (const struct missing_values *);
-
-bool mv_add_value (struct missing_values *, const union value *);
-bool mv_add_str (struct missing_values *, const char[]);
-bool mv_add_num (struct missing_values *, double);
-bool mv_add_num_range (struct missing_values *, double low, double high);
-
-bool mv_has_value (const struct missing_values *);
-void mv_pop_value (struct missing_values *, union value *);
-void mv_peek_value (const struct missing_values *mv, union value *v, int idx);
-void mv_replace_value (struct missing_values *mv, const union value *v, int idx);
-
-int mv_n_values (const struct missing_values *mv);
-
-
-bool mv_has_range (const struct missing_values *);
-void mv_pop_range (struct missing_values *, double *low, double *high);
-void mv_peek_range (const struct missing_values *, double *low, double *high);
-
-bool mv_is_resizable (struct missing_values *, int width);
-void mv_resize (struct missing_values *, int width);
-
-typedef bool is_missing_func (const struct missing_values *,
- const union value *);
-
-/* Is a value system or user missing? */
-bool mv_is_value_missing (const struct missing_values *, const union value *);
-bool mv_is_num_missing (const struct missing_values *, double);
-bool mv_is_str_missing (const struct missing_values *, const char[]);
-
-/* Is a value user missing? */
-bool mv_is_value_user_missing (const struct missing_values *,
- const union value *);
-bool mv_is_num_user_missing (const struct missing_values *, double);
-bool mv_is_str_user_missing (const struct missing_values *, const char[]);
-
-/* Is a value system missing? */
-bool mv_is_value_system_missing (const struct missing_values *,
- const union value *);
-
-#endif /* missing-values.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <assert.h>
-#include <stdlib.h>
-#include <string.h>
-#include <errno.h>
-#include <stdio.h>
-#include "mkfile.h"
-#include "error.h"
-#include "alloc.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* Creates a temporary file and stores its name in *FILENAME and
- a file descriptor for it in *FD. Returns success. Caller is
- responsible for freeing *FILENAME. */
-int
-make_temp_file (int *fd, char **filename)
-{
- const char *parent_dir;
-
- assert (filename != NULL);
- assert (fd != NULL);
-
- if (getenv ("TMPDIR") != NULL)
- parent_dir = getenv ("TMPDIR");
- else
- parent_dir = P_tmpdir;
-
- *filename = xmalloc (strlen (parent_dir) + 32);
- sprintf (*filename, "%s%cpsppXXXXXX", parent_dir, DIR_SEPARATOR);
- *fd = mkstemp (*filename);
- if (*fd < 0)
- {
- msg (FE, _("%s: Creating temporary file: %s."),
- *filename, strerror (errno));
- free (*filename);
- *filename = NULL;
- return 0;
- }
- return 1;
-}
-
-
-/* Creates a temporary file and stores its name in *FILENAME and
- a file stream for it in *FP. Returns success. Caller is
- responsible for freeing *FILENAME and for closing *FP */
-int
-make_unique_file_stream (FILE **fp, char **filename)
-{
- static int serial = 0;
- const char *parent_dir;
-
-
- /* FIXME:
- Need to check for pre-existing file name.
- Need also to pass in the directory instead of using /tmp
- */
-
- assert (filename != NULL);
- assert (fp != NULL);
-
- if (getenv ("TMPDIR") != NULL)
- parent_dir = getenv ("TMPDIR");
- else
- parent_dir = P_tmpdir;
-
- *filename = xmalloc (strlen (parent_dir) + 32);
-
-
- sprintf (*filename, "%s%cpspp%d.png", parent_dir, DIR_SEPARATOR, serial++);
-
- *fp = fopen(*filename, "w");
-
- if (! *fp )
- {
- msg (FE, _("%s: Creating file: %s."), *filename, strerror (errno));
- free (*filename);
- *filename = NULL;
- return 0;
- }
-
- return 1;
-}
-
-
-
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef MKFILE_H
-#define MKFILE_H
-
-
-/* Creates a temporary file and stores its name in *FILENAME and
- a file descriptor for it in *FD. Returns success. Caller is
- responsible for freeing *FILENAME. */
-int make_temp_file (int *fd, char **filename);
-
-
-/* Creates a temporary file and stores its name in *FILENAME and
- a file stream for it in *FP. Returns success. Caller is
- responsible for freeing *FILENAME. */
-int make_unique_file_stream (FILE **fp, char **filename) ;
-
-#endif /* mkfile.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <stdlib.h>
-#include "error.h"
-#include "algorithm.h"
-#include "alloc.h"
-#include "bitvector.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "hash.h"
-#include "lexer.h"
-#include "misc.h"
-#include "str.h"
-#include "var.h"
-#include "vfm.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* FIXME: should change weighting variable, etc. */
-/* These control the ordering produced by
- compare_variables_given_ordering(). */
-struct ordering
- {
- int forward; /* 1=FORWARD, 0=BACKWARD. */
- int positional; /* 1=POSITIONAL, 0=ALPHA. */
- };
-
-/* Increasing order of variable index. */
-static struct ordering forward_positional_ordering = {1, 1};
-
-static int compare_variables_given_ordering (const void *, const void *,
- void *ordering);
-
-/* Explains how to modify the variables in a dictionary. */
-struct var_modification
- {
- /* New variable ordering. */
- struct variable **reorder_vars;
- size_t reorder_cnt;
-
- /* DROP/KEEP information. */
- struct variable **drop_vars;
- size_t drop_cnt;
-
- /* New variable names. */
- struct variable **rename_vars;
- char **new_names;
- size_t rename_cnt;
- };
-
-static int rearrange_dict (struct dictionary *d,
- const struct var_modification *vm);
-
-/* Performs MODIFY VARS command. */
-int
-cmd_modify_vars (void)
-{
- /* Bits indicated whether we've already encountered a subcommand of
- this type. */
- unsigned already_encountered = 0;
-
- /* What we're gonna do to the active file. */
- struct var_modification vm;
-
- /* Return code. */
- int ret_code = CMD_FAILURE;
-
- size_t i;
-
- if (temporary != 0)
- {
- msg (SE, _("MODIFY VARS may not be used after TEMPORARY. "
- "Temporary transformations will be made permanent."));
- cancel_temporary ();
- }
-
- vm.reorder_vars = NULL;
- vm.reorder_cnt = 0;
- vm.rename_vars = NULL;
- vm.new_names = NULL;
- vm.rename_cnt = 0;
- vm.drop_vars = NULL;
- vm.drop_cnt = 0;
-
- /* Parse each subcommand. */
- lex_match ('/');
- for (;;)
- {
- if (lex_match_id ("REORDER"))
- {
- struct variable **v = NULL;
- size_t nv = 0;
-
- if (already_encountered & 1)
- {
- msg (SE, _("REORDER subcommand may be given at most once."));
- goto done;
- }
- already_encountered |= 1;
-
- lex_match ('=');
- do
- {
- struct ordering ordering;
- size_t prev_nv = nv;
-
- ordering.forward = ordering.positional = 1;
- if (lex_match_id ("FORWARD"));
- else if (lex_match_id ("BACKWARD"))
- ordering.forward = 0;
- if (lex_match_id ("POSITIONAL"));
- else if (lex_match_id ("ALPHA"))
- ordering.positional = 0;
-
- if (lex_match (T_ALL) || token == '/' || token == '.')
- {
- if (prev_nv != 0)
- {
- msg (SE, _("Cannot specify ALL after specifying a set "
- "of variables."));
- goto done;
- }
- dict_get_vars (default_dict, &v, &nv, 1u << DC_SYSTEM);
- }
- else
- {
- if (!lex_match ('('))
- {
- msg (SE, _("`(' expected on REORDER subcommand."));
- free (v);
- goto done;
- }
- if (!parse_variables (default_dict, &v, &nv,
- PV_APPEND | PV_NO_DUPLICATE))
- {
- free (v);
- goto done;
- }
- if (!lex_match (')'))
- {
- msg (SE, _("`)' expected following variable names on "
- "REORDER subcommand."));
- free (v);
- goto done;
- }
- }
- sort (&v[prev_nv], nv - prev_nv, sizeof *v,
- compare_variables_given_ordering, &ordering);
- }
- while (token != '/' && token != '.');
-
- vm.reorder_vars = v;
- vm.reorder_cnt = nv;
- }
- else if (lex_match_id ("RENAME"))
- {
- if (already_encountered & 2)
- {
- msg (SE, _("RENAME subcommand may be given at most once."));
- goto done;
- }
- already_encountered |= 2;
-
- lex_match ('=');
- do
- {
- size_t prev_nv_1 = vm.rename_cnt;
- size_t prev_nv_2 = vm.rename_cnt;
-
- if (!lex_match ('('))
- {
- msg (SE, _("`(' expected on RENAME subcommand."));
- goto done;
- }
- if (!parse_variables (default_dict, &vm.rename_vars, &vm.rename_cnt,
- PV_APPEND | PV_NO_DUPLICATE))
- goto done;
- if (!lex_match ('='))
- {
- msg (SE, _("`=' expected between lists of new and old variable "
- "names on RENAME subcommand."));
- goto done;
- }
- if (!parse_DATA_LIST_vars (&vm.new_names, &prev_nv_1, PV_APPEND))
- goto done;
- if (prev_nv_1 != vm.rename_cnt)
- {
- msg (SE, _("Differing number of variables in old name list "
- "(%d) and in new name list (%d)."),
- vm.rename_cnt - prev_nv_2, prev_nv_1 - prev_nv_2);
- for (i = 0; i < prev_nv_1; i++)
- free (vm.new_names[i]);
- free (vm.new_names);
- vm.new_names = NULL;
- goto done;
- }
- if (!lex_match (')'))
- {
- msg (SE, _("`)' expected after variable lists on RENAME "
- "subcommand."));
- goto done;
- }
- }
- while (token != '.' && token != '/');
- }
- else if (lex_match_id ("KEEP"))
- {
- struct variable **keep_vars, **all_vars, **drop_vars;
- size_t keep_cnt, all_cnt, drop_cnt;
-
- if (already_encountered & 4)
- {
- msg (SE, _("KEEP subcommand may be given at most once. It may not"
- "be given in conjunction with the DROP subcommand."));
- goto done;
- }
- already_encountered |= 4;
-
- lex_match ('=');
- if (!parse_variables (default_dict, &keep_vars, &keep_cnt, PV_NONE))
- goto done;
-
- /* Transform the list of variables to keep into a list of
- variables to drop. First sort the keep list, then figure
- out which variables are missing. */
- sort (keep_vars, keep_cnt, sizeof *keep_vars,
- compare_variables_given_ordering, &forward_positional_ordering);
-
- dict_get_vars (default_dict, &all_vars, &all_cnt, 0);
- assert (all_cnt >= keep_cnt);
-
- drop_cnt = all_cnt - keep_cnt;
- drop_vars = xnmalloc (drop_cnt, sizeof *keep_vars);
- if (set_difference (all_vars, all_cnt,
- keep_vars, keep_cnt,
- sizeof *all_vars,
- drop_vars,
- compare_variables_given_ordering,
- &forward_positional_ordering)
- != drop_cnt)
- assert (0);
-
- free (keep_vars);
- free (all_vars);
-
- vm.drop_vars = drop_vars;
- vm.drop_cnt = drop_cnt;
- }
- else if (lex_match_id ("DROP"))
- {
- struct variable **drop_vars;
- size_t drop_cnt;
-
- if (already_encountered & 4)
- {
- msg (SE, _("DROP subcommand may be given at most once. It may "
- "not be given in conjunction with the KEEP "
- "subcommand."));
- goto done;
- }
- already_encountered |= 4;
-
- lex_match ('=');
- if (!parse_variables (default_dict, &drop_vars, &drop_cnt, PV_NONE))
- goto done;
- vm.drop_vars = drop_vars;
- vm.drop_cnt = drop_cnt;
- }
- else if (lex_match_id ("MAP"))
- {
- struct dictionary *temp = dict_clone (default_dict);
- int success = rearrange_dict (temp, &vm);
- if (success)
- {
- /* FIXME: display new dictionary. */
- }
- dict_destroy (temp);
- }
- else
- {
- if (token == T_ID)
- msg (SE, _("Unrecognized subcommand name `%s'."), tokid);
- else
- msg (SE, _("Subcommand name expected."));
- goto done;
- }
-
- if (token == '.')
- break;
- if (token != '/')
- {
- msg (SE, _("`/' or `.' expected."));
- goto done;
- }
- lex_get ();
- }
-
- if (already_encountered & (1 | 4))
- {
- /* Read the data. */
- procedure (NULL, NULL);
- }
-
- if (!rearrange_dict (default_dict, &vm))
- goto done;
-
- ret_code = CMD_SUCCESS;
-
-done:
- free (vm.reorder_vars);
- free (vm.rename_vars);
- for (i = 0; i < vm.rename_cnt; i++)
- free (vm.new_names[i]);
- free (vm.new_names);
- free (vm.drop_vars);
- return ret_code;
-}
-
-/* Compares A and B according to the settings in
- ORDERING, returning a strcmp()-type result. */
-static int
-compare_variables_given_ordering (const void *a_, const void *b_,
- void *ordering_)
-{
- struct variable *const *pa = a_;
- struct variable *const *pb = b_;
- const struct variable *a = *pa;
- const struct variable *b = *pb;
- const struct ordering *ordering = ordering_;
-
- int result;
- if (ordering->positional)
- result = a->index < b->index ? -1 : a->index > b->index;
- else
- result = strcasecmp (a->name, b->name);
- if (!ordering->forward)
- result = -result;
- return result;
-}
-
-/* Pairs a variable with a new name. */
-struct var_renaming
- {
- struct variable *var;
- char new_name[LONG_NAME_LEN + 1];
- };
-
-/* A algo_compare_func that compares new_name members in struct
- var_renaming structures A and B. */
-static int
-compare_var_renaming_by_new_name (const void *a_, const void *b_,
- void *foo UNUSED)
-{
- const struct var_renaming *a = a_;
- const struct var_renaming *b = b_;
-
- return strcasecmp (a->new_name, b->new_name);
-}
-
-/* Returns true if performing VM on dictionary D would not cause
- problems such as duplicate variable names. Returns false
- otherwise, and issues an error message. */
-static int
-validate_var_modification (const struct dictionary *d,
- const struct var_modification *vm)
-{
- /* Variable reordering can't be a problem, so we don't simulate
- it. Variable renaming can cause duplicate names, but
- dropping variables can eliminate them, so we simulate both
- of those. */
- struct variable **all_vars;
- struct variable **keep_vars;
- struct variable **drop_vars;
- size_t keep_cnt, drop_cnt;
- size_t all_cnt;
-
- struct var_renaming *var_renaming;
- int valid;
- size_t i;
-
- /* All variables, in index order. */
- dict_get_vars (d, &all_vars, &all_cnt, 0);
-
- /* Drop variables, in index order. */
- drop_cnt = vm->drop_cnt;
- drop_vars = xnmalloc (drop_cnt, sizeof *drop_vars);
- memcpy (drop_vars, vm->drop_vars, drop_cnt * sizeof *drop_vars);
- sort (drop_vars, drop_cnt, sizeof *drop_vars,
- compare_variables_given_ordering, &forward_positional_ordering);
-
- /* Keep variables, in index order. */
- assert (all_cnt >= drop_cnt);
- keep_cnt = all_cnt - drop_cnt;
- keep_vars = xnmalloc (keep_cnt, sizeof *keep_vars);
- if (set_difference (all_vars, all_cnt,
- drop_vars, drop_cnt,
- sizeof *all_vars,
- keep_vars,
- compare_variables_given_ordering,
- &forward_positional_ordering) != keep_cnt)
- assert (0);
-
- /* Copy variables into var_renaming array. */
- var_renaming = xnmalloc (keep_cnt, sizeof *var_renaming);
- for (i = 0; i < keep_cnt; i++)
- {
- var_renaming[i].var = keep_vars[i];
- strcpy (var_renaming[i].new_name, keep_vars[i]->name);
- }
-
- /* Rename variables in var_renaming array. */
- for (i = 0; i < vm->rename_cnt; i++)
- {
- struct variable *const *kv;
- struct var_renaming *vr;
-
- /* Get the var_renaming element. */
- kv = binary_search (keep_vars, keep_cnt, sizeof *keep_vars,
- &vm->rename_vars[i],
- compare_variables_given_ordering,
- &forward_positional_ordering);
- if (kv == NULL)
- continue;
- vr = var_renaming + (kv - keep_vars);
-
- strcpy (vr->new_name, vm->new_names[i]);
- }
-
- /* Sort var_renaming array by new names and check for
- duplicates. */
- sort (var_renaming, keep_cnt, sizeof *var_renaming,
- compare_var_renaming_by_new_name, NULL);
- valid = adjacent_find_equal (var_renaming, keep_cnt, sizeof *var_renaming,
- compare_var_renaming_by_new_name, NULL) == NULL;
-
- /* Clean up. */
- free (all_vars);
- free (keep_vars);
- free (drop_vars);
- free (var_renaming);
-
- return valid;
-}
-
-/* Reoders, removes, and renames variables in dictionary D
- according to VM. Returns nonzero if successful, zero if there
- would have been duplicate variable names if the modifications
- had been carried out. In the latter case, the dictionary is
- not modified. */
-static int
-rearrange_dict (struct dictionary *d, const struct var_modification *vm)
-{
- char **rename_old_names;
-
- struct variable **rename_vars;
- char **rename_new_names;
- size_t rename_cnt;
-
- size_t i;
-
- /* Check whether the modifications will cause duplicate
- names. */
- if (!validate_var_modification (d, vm))
- return 0;
-
- /* Record the old names of variables to rename. After
- variables are deleted, we can't depend on the variables to
- still exist, but we can still look them up by name. */
- rename_old_names = xnmalloc (vm->rename_cnt, sizeof *rename_old_names);
- for (i = 0; i < vm->rename_cnt; i++)
- rename_old_names[i] = xstrdup (vm->rename_vars[i]->name);
-
- /* Reorder and delete variables. */
- dict_reorder_vars (d, vm->reorder_vars, vm->reorder_cnt);
- dict_delete_vars (d, vm->drop_vars, vm->drop_cnt);
-
- /* Compose lists of variables to rename and their new names. */
- rename_vars = xnmalloc (vm->rename_cnt, sizeof *rename_vars);
- rename_new_names = xnmalloc (vm->rename_cnt, sizeof *rename_new_names);
- rename_cnt = 0;
- for (i = 0; i < vm->rename_cnt; i++)
- {
- struct variable *var = dict_lookup_var (d, rename_old_names[i]);
- if (var == NULL)
- continue;
-
- rename_vars[rename_cnt] = var;
- rename_new_names[rename_cnt] = vm->new_names[i];
- rename_cnt++;
- }
-
- /* Do renaming. */
- if (dict_rename_vars (d, rename_vars, rename_new_names, rename_cnt,
- NULL) == 0)
- assert (0);
-
- /* Clean up. */
- for (i = 0; i < vm->rename_cnt; i++)
- free (rename_old_names[i]);
- free (rename_old_names);
- free (rename_vars);
- free (rename_new_names);
-
- return 1;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "moments.h"
-#include <assert.h>
-#include <math.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "misc.h"
-#include "val.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-\f
-/* Calculates variance, skewness, and kurtosis into *VARIANCE,
- *SKEWNESS, and *KURTOSIS if they are non-null and not greater
- moments than MAX_MOMENT. Accepts W as the total weight, D1 as
- the total deviation from the estimated mean, and D2, D3, and
- D4 as the sum of the squares, cubes, and 4th powers,
- respectively, of the deviation from the estimated mean. */
-static void
-calc_moments (enum moment max_moment,
- double w, double d1, double d2, double d3, double d4,
- double *variance, double *skewness, double *kurtosis)
-{
- assert (w > 0.);
-
- if (max_moment >= MOMENT_VARIANCE && w > 1.)
- {
- double s2;
-
- /* From _Numerical Recipes in C_, 2nd ed., 0-521-43108-5,
- section 14.1. */
- s2 = (d2 - pow2 (d1) / w) / (w - 1.);
- if (variance != NULL)
- *variance = s2;
-
- /* From _SPSS Statistical Algorithms, 2nd ed.,
- 0-918469-89-9, section "DESCRIPTIVES". */
- if (fabs (*variance) >= 1e-20)
- {
- if (max_moment >= MOMENT_SKEWNESS && skewness != NULL && w > 2.)
- {
- double s3 = s2 * sqrt (s2);
- double g1 = (w * d3) / ((w - 1.0) * (w - 2.0) * s3);
- if (finite (g1))
- *skewness = g1;
- }
- if (max_moment >= MOMENT_KURTOSIS && kurtosis != NULL && w > 3.)
- {
- double den = (w - 2.) * (w - 3.) * pow2 (s2);
- double g2 = (w * (w + 1) * d4 / (w - 1.) / den
- - 3. * pow2 (d2) / den);
- if (finite (g2))
- *kurtosis = g2;
- }
- }
- }
-}
-\f
-/* Two-pass moments. */
-
-/* A set of two-pass moments. */
-struct moments
- {
- enum moment max_moment; /* Highest-order moment we're computing. */
- int pass; /* Current pass (1 or 2). */
-
- /* Pass one. */
- double w1; /* Total weight for pass 1, so far. */
- double sum; /* Sum of values so far. */
- double mean; /* Mean = sum / w1. */
-
- /* Pass two. */
- double w2; /* Total weight for pass 2, so far. */
- double d1; /* Sum of deviations from the mean. */
- double d2; /* Sum of squared deviations from the mean. */
- double d3; /* Sum of cubed deviations from the mean. */
- double d4; /* Sum of (deviations from the mean)**4. */
- };
-
-/* Initializes moments M for calculating moment MAX_MOMENT and
- lower moments. */
-static void
-init_moments (struct moments *m, enum moment max_moment)
-{
- assert (m != NULL);
- assert (max_moment == MOMENT_MEAN || max_moment == MOMENT_VARIANCE
- || max_moment == MOMENT_SKEWNESS || max_moment == MOMENT_KURTOSIS);
- m->max_moment = max_moment;
- moments_clear (m);
-}
-
-/* Clears out a set of moments so that it can be reused for a new
- set of values. The moments to be calculated are not changed. */
-void
-moments_clear (struct moments *m)
-{
- m->pass = 1;
- m->w1 = m->w2 = 0.;
- m->sum = 0.;
-}
-
-/* Creates and returns a data structure for calculating moment
- MAX_MOMENT and lower moments on a data series. The user
- should call moments_pass_one() for each value in the series,
- then call moments_pass_two() for the same set of values in the
- same order, then call moments_calculate() to obtain the
- moments. The user may ask for the mean at any time during the
- first pass (using moments_calculate()), but otherwise no
- statistics may be requested until the end of the second pass.
- Call moments_destroy() when the moments are no longer
- needed. */
-struct moments *
-moments_create (enum moment max_moment)
-{
- struct moments *m = xmalloc (sizeof *m);
- init_moments (m, max_moment);
- return m;
-}
-
-/* Adds VALUE with the given WEIGHT to the calculation of
- moments for the first pass. */
-void
-moments_pass_one (struct moments *m, double value, double weight)
-{
- assert (m != NULL);
- assert (m->pass == 1);
-
- if (value != SYSMIS && weight > 0.)
- {
- m->sum += value * weight;
- m->w1 += weight;
- }
-}
-
-/* Adds VALUE with the given WEIGHT to the calculation of
- moments for the second pass. */
-void
-moments_pass_two (struct moments *m, double value, double weight)
-{
- double d, d_power;
-
- assert (m != NULL);
-
- if (m->pass == 1)
- {
- m->pass = 2;
- m->mean = m->w1 != 0. ? m->sum / m->w1 : 0.;
- m->d1 = m->d2 = m->d3 = m->d4 = 0.;
- }
-
- if (value != SYSMIS && weight >= 0.)
- {
- m->w2 += weight;
-
- d = d_power = value - m->mean;
- m->d1 += d_power * weight;
-
- if (m->max_moment >= MOMENT_VARIANCE)
- {
- d_power *= d;
- m->d2 += d_power * weight;
-
- if (m->max_moment >= MOMENT_SKEWNESS)
- {
- d_power *= d;
- m->d3 += d_power * weight;
-
- if (m->max_moment >= MOMENT_KURTOSIS)
- {
- d_power *= d;
- m->d4 += d_power * weight;
- }
- }
- }
- }
-}
-
-/* Calculates moments based on the input data. Stores the total
- weight in *WEIGHT, the mean in *MEAN, the variance in
- *VARIANCE, the skewness in *SKEWNESS, and the kurtosis in
- *KURTOSIS. Any of these result parameters may be null
- pointers, in which case the values are not calculated. If any
- result cannot be calculated, either because they are undefined
- based on the input data or because their moments are higher
- than the maximum requested on moments_create(), then SYSMIS is
- stored into that result. */
-void
-moments_calculate (const struct moments *m,
- double *weight,
- double *mean, double *variance,
- double *skewness, double *kurtosis)
-{
- assert (m != NULL);
-
- if (mean != NULL)
- *mean = SYSMIS;
- if (variance != NULL)
- *variance = SYSMIS;
- if (skewness != NULL)
- *skewness = SYSMIS;
- if (kurtosis != NULL)
- *kurtosis = SYSMIS;
-
- if (weight != NULL)
- *weight = m->w1;
-
- /* How many passes so far? */
- if (m->pass == 1)
- {
- /* In the first pass we can only calculate the mean. */
- if (mean != NULL && m->w1 > 0.)
- *mean = m->sum / m->w1;
- }
- else
- {
- /* After the second pass we can calculate any stat. We
- don't support "online" computation during the second
- pass, so As a simple self-check, the total weight for
- the passes must agree. */
- assert (m->pass == 2);
- assert (m->w1 == m->w2);
-
- if (m->w2 > 0.)
- {
- if (mean != NULL)
- *mean = m->mean;
- calc_moments (m->max_moment,
- m->w2, m->d1, m->d2, m->d3, m->d4,
- variance, skewness, kurtosis);
- }
- }
-}
-
-/* Destroys a set of moments. */
-void
-moments_destroy (struct moments *m)
-{
- free (m);
-}
-
-/* Calculates the requested moments on the CNT values in ARRAY.
- Each value is given a weight of 1. The total weight is stored
- into *WEIGHT (trivially) and the mean, variance, skewness, and
- kurtosis are stored into *MEAN, *VARIANCE, *SKEWNESS, and
- *KURTOSIS, respectively. Any of the result pointers may be
- null, in which case no value is stored. */
-void
-moments_of_doubles (const double *array, size_t cnt,
- double *weight,
- double *mean, double *variance,
- double *skewness, double *kurtosis)
-{
- enum moment max_moment;
- struct moments m;
- size_t idx;
-
- if (kurtosis != NULL)
- max_moment = MOMENT_KURTOSIS;
- else if (skewness != NULL)
- max_moment = MOMENT_SKEWNESS;
- else if (variance != NULL)
- max_moment = MOMENT_VARIANCE;
- else
- max_moment = MOMENT_MEAN;
-
- init_moments (&m, max_moment);
- for (idx = 0; idx < cnt; idx++)
- moments_pass_one (&m, array[idx], 1.);
- for (idx = 0; idx < cnt; idx++)
- moments_pass_two (&m, array[idx], 1.);
- moments_calculate (&m, weight, mean, variance, skewness, kurtosis);
-}
-
-/* Calculates the requested moments on the CNT numeric values in
- ARRAY. Each value is given a weight of 1. The total weight
- is stored into *WEIGHT (trivially) and the mean, variance,
- skewness, and kurtosis are stored into *MEAN, *VARIANCE,
- *SKEWNESS, and *KURTOSIS, respectively. Any of the result
- pointers may be null, in which case no value is stored. */
-void
-moments_of_values (const union value *array, size_t cnt,
- double *weight,
- double *mean, double *variance,
- double *skewness, double *kurtosis)
-{
- enum moment max_moment;
- struct moments m;
- size_t idx;
-
- if (kurtosis != NULL)
- max_moment = MOMENT_KURTOSIS;
- else if (skewness != NULL)
- max_moment = MOMENT_SKEWNESS;
- else if (variance != NULL)
- max_moment = MOMENT_VARIANCE;
- else
- max_moment = MOMENT_MEAN;
-
- init_moments (&m, max_moment);
- for (idx = 0; idx < cnt; idx++)
- moments_pass_one (&m, array[idx].f, 1.);
- for (idx = 0; idx < cnt; idx++)
- moments_pass_two (&m, array[idx].f, 1.);
- moments_calculate (&m, weight, mean, variance, skewness, kurtosis);
-}
-\f
-/* One-pass moments. */
-
-/* A set of one-pass moments. */
-struct moments1
- {
- enum moment max_moment; /* Highest-order moment we're computing. */
- double w; /* Total weight so far. */
- double d1; /* Sum of deviations from the mean. */
- double d2; /* Sum of squared deviations from the mean. */
- double d3; /* Sum of cubed deviations from the mean. */
- double d4; /* Sum of (deviations from the mean)**4. */
- };
-
-/* Initializes one-pass moments M for calculating moment
- MAX_MOMENT and lower moments. */
-static void
-init_moments1 (struct moments1 *m, enum moment max_moment)
-{
- assert (m != NULL);
- assert (max_moment == MOMENT_MEAN || max_moment == MOMENT_VARIANCE
- || max_moment == MOMENT_SKEWNESS || max_moment == MOMENT_KURTOSIS);
- m->max_moment = max_moment;
- moments1_clear (m);
-}
-
-/* Clears out a set of one-pass moments so that it can be reused
- for a new set of values. The moments to be calculated are not
- changed. */
-void
-moments1_clear (struct moments1 *m)
-{
- m->w = 0.;
- m->d1 = m->d2 = m->d3 = m->d4 = 0.;
-}
-
-/* Creates and returns a data structure for calculating moment
- MAX_MOMENT and lower moments on a data series in a single
- pass. The user should call moments1_add() for each value in
- the series. The user may call moments1_calculate() to obtain
- the current moments at any time. Call moments1_destroy() when
- the moments are no longer needed.
-
- One-pass moments should only be used when two passes over the
- data are impractical. */
-struct moments1 *
-moments1_create (enum moment max_moment)
-{
- struct moments1 *m = xmalloc (sizeof *m);
- init_moments1 (m, max_moment);
- return m;
-}
-
-/* Adds VALUE with the given WEIGHT to the calculation of
- one-pass moments. */
-void
-moments1_add (struct moments1 *m, double value, double weight)
-{
- assert (m != NULL);
-
- if (value != SYSMIS && weight > 0.)
- {
- double prev_w, v1;
-
- prev_w = m->w;
- m->w += weight;
- v1 = (weight / m->w) * (value - m->d1);
- m->d1 += v1;
-
- if (m->max_moment >= MOMENT_VARIANCE)
- {
- double v2 = v1 * v1;
- double w_prev_w = m->w * prev_w;
- double prev_m2 = m->d2;
-
- m->d2 += w_prev_w / weight * v2;
- if (m->max_moment >= MOMENT_SKEWNESS)
- {
- double w2 = weight * weight;
- double v3 = v2 * v1;
- double prev_m3 = m->d3;
-
- m->d3 += (-3. * v1 * prev_m2
- + w_prev_w / w2 * (m->w - 2. * weight) * v3);
- if (m->max_moment >= MOMENT_KURTOSIS)
- {
- double w3 = w2 * weight;
- double v4 = v2 * v2;
-
- m->d4 += (-4. * v1 * prev_m3
- + 6. * v2 * prev_m2
- + ((pow2 (m->w) - 3. * weight * prev_w)
- * v4 * w_prev_w / w3));
- }
- }
- }
- }
-}
-
-/* Calculates one-pass moments based on the input data. Stores
- the total weight in *WEIGHT, the mean in *MEAN, the variance
- in *VARIANCE, the skewness in *SKEWNESS, and the kurtosis in
- *KURTOSIS. Any of these result parameters may be null
- pointers, in which case the values are not calculated. If any
- result cannot be calculated, either because they are undefined
- based on the input data or because their moments are higher
- than the maximum requested on moments_create(), then SYSMIS is
- stored into that result. */
-void
-moments1_calculate (const struct moments1 *m,
- double *weight,
- double *mean, double *variance,
- double *skewness, double *kurtosis)
-{
- assert (m != NULL);
-
- if (mean != NULL)
- *mean = SYSMIS;
- if (variance != NULL)
- *variance = SYSMIS;
- if (skewness != NULL)
- *skewness = SYSMIS;
- if (kurtosis != NULL)
- *kurtosis = SYSMIS;
-
- if (weight != NULL)
- *weight = m->w;
-
- if (m->w > 0.)
- {
- if (mean != NULL)
- *mean = m->d1;
-
- calc_moments (m->max_moment,
- m->w, 0., m->d2, m->d3, m->d4,
- variance, skewness, kurtosis);
- }
-}
-
-/* Destroy one-pass moments M. */
-void
-moments1_destroy (struct moments1 *m)
-{
- free (m);
-}
-\f
-/* Returns the standard error of the skewness for the given total
- weight W.
-
- From _SPSS Statistical Algorithms, 2nd ed., 0-918469-89-9,
- section "DESCRIPTIVES". */
-double
-calc_seskew (double W)
-{
- return sqrt ((6. * W * (W - 1.)) / ((W - 2.) * (W + 1.) * (W + 3.)));
-}
-
-/* Returns the standard error of the kurtosis for the given total
- weight W.
-
- From _SPSS Statistical Algorithms, 2nd ed., 0-918469-89-9,
- section "DESCRIPTIVES", except that the sqrt symbol is omitted
- there. */
-double
-calc_sekurt (double W)
-{
- return sqrt ((4. * (pow2 (W) - 1.) * pow2 (calc_seskew (W)))
- / ((W - 3.) * (W + 5.)));
-}
-\f
-#include <stdio.h>
-#include "command.h"
-#include "lexer.h"
-
-static int
-read_values (double **values, double **weights, size_t *cnt)
-{
- size_t cap = 0;
-
- *values = NULL;
- *weights = NULL;
- *cnt = 0;
- while (lex_is_number ())
- {
- double value = tokval;
- double weight = 1.;
- lex_get ();
- if (lex_match ('*'))
- {
- if (!lex_is_number ())
- {
- lex_error (_("expecting weight value"));
- return 0;
- }
- weight = tokval;
- lex_get ();
- }
-
- if (*cnt >= cap)
- {
- cap = 2 * (cap + 8);
- *values = xnrealloc (*values, cap, sizeof **values);
- *weights = xnrealloc (*weights, cap, sizeof **weights);
- }
-
- (*values)[*cnt] = value;
- (*weights)[*cnt] = weight;
- (*cnt)++;
- }
-
- return 1;
-}
-
-int
-cmd_debug_moments (void)
-{
- int retval = CMD_FAILURE;
- double *values = NULL;
- double *weights = NULL;
- double weight, M[4];
- int two_pass = 1;
- size_t cnt;
- size_t i;
-
- if (lex_match_id ("ONEPASS"))
- two_pass = 0;
- if (token != '/')
- {
- lex_force_match ('/');
- goto done;
- }
- fprintf (stderr, "%s => ", lex_rest_of_line (NULL));
- lex_get ();
-
- if (two_pass)
- {
- struct moments *m = NULL;
-
- m = moments_create (MOMENT_KURTOSIS);
- if (!read_values (&values, &weights, &cnt))
- {
- moments_destroy (m);
- goto done;
- }
- for (i = 0; i < cnt; i++)
- moments_pass_one (m, values[i], weights[i]);
- for (i = 0; i < cnt; i++)
- moments_pass_two (m, values[i], weights[i]);
- moments_calculate (m, &weight, &M[0], &M[1], &M[2], &M[3]);
- moments_destroy (m);
- }
- else
- {
- struct moments1 *m = NULL;
-
- m = moments1_create (MOMENT_KURTOSIS);
- if (!read_values (&values, &weights, &cnt))
- {
- moments1_destroy (m);
- goto done;
- }
- for (i = 0; i < cnt; i++)
- moments1_add (m, values[i], weights[i]);
- moments1_calculate (m, &weight, &M[0], &M[1], &M[2], &M[3]);
- moments1_destroy (m);
- }
-
- fprintf (stderr, "W=%.3f", weight);
- for (i = 0; i < 4; i++)
- {
- fprintf (stderr, " M%d=", i + 1);
- if (M[i] == SYSMIS)
- fprintf (stderr, "sysmis");
- else if (fabs (M[i]) <= 0.0005)
- fprintf (stderr, "0.000");
- else
- fprintf (stderr, "%.3f", M[i]);
- }
- fprintf (stderr, "\n");
-
- retval = lex_end_of_command ();
-
- done:
- free (values);
- free (weights);
- return retval;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef HEADER_MOMENTS
-#define HEADER_MOMENTS
-
-#include <stddef.h>
-#include "val.h"
-
-/* Moments of the mean.
- Higher-order moments have higher values. */
-enum moment
- {
- MOMENT_NONE, /* No moments. */
- MOMENT_MEAN, /* First-order moment. */
- MOMENT_VARIANCE, /* Second-order moment. */
- MOMENT_SKEWNESS, /* Third-order moment. */
- MOMENT_KURTOSIS /* Fourth-order moment. */
- };
-
-struct moments;
-
-/* Two-pass moments. */
-struct moments *moments_create (enum moment max_moment);
-void moments_clear (struct moments *);
-void moments_pass_one (struct moments *, double value, double weight);
-void moments_pass_two (struct moments *, double value, double weight);
-void moments_calculate (const struct moments *,
- double *weight,
- double *mean, double *variance,
- double *skewness, double *kurtosis);
-void moments_destroy (struct moments *);
-
-/* Convenience functions for two-pass moments. */
-void moments_of_doubles (const double *array, size_t cnt,
- double *weight,
- double *mean, double *variance,
- double *skewness, double *kurtosis);
-void moments_of_values (const union value *array, size_t cnt,
- double *weight,
- double *mean, double *variance,
- double *skewness, double *kurtosis);
-
-/* One-pass moments. Use only if two passes are impractical. */
-struct moments1 *moments1_create (enum moment max_moment);
-void moments1_clear (struct moments1 *);
-void moments1_add (struct moments1 *, double value, double weight);
-void moments1_calculate (const struct moments1 *,
- double *weight,
- double *mean, double *variance,
- double *skewness, double *kurtosis);
-void moments1_destroy (struct moments1 *);
-
-/* Standard errors. */
-double calc_semean (double stddev, double weight);
-double calc_seskew (double weight);
-double calc_sekurt (double weight);
-
-#endif /* moments.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <stdlib.h>
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "lexer.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-/* Parses the NUMERIC command. */
-int
-cmd_numeric (void)
-{
- size_t i;
-
- /* Names of variables to create. */
- char **v;
- size_t nv;
-
- /* Format spec for variables to create. f.type==-1 if default is to
- be used. */
- struct fmt_spec f;
-
- do
- {
- if (!parse_DATA_LIST_vars (&v, &nv, PV_NONE))
- return CMD_PART_SUCCESS_MAYBE;
-
- /* Get the optional format specification. */
- if (lex_match ('('))
- {
- if (!parse_format_specifier (&f, 0))
- goto fail;
- if (formats[f.type].cat & FCAT_STRING)
- {
- msg (SE, _("Format type %s may not be used with a numeric "
- "variable."), fmt_to_string (&f));
- goto fail;
- }
-
- if (!lex_match (')'))
- {
- msg (SE, _("`)' expected after output format."));
- goto fail;
- }
- }
- else
- f.type = -1;
-
- /* Create each variable. */
- for (i = 0; i < nv; i++)
- {
- struct variable *new_var = dict_create_var (default_dict, v[i], 0);
- if (!new_var)
- msg (SE, _("There is already a variable named %s."), v[i]);
- else
- {
- if (f.type != -1)
- new_var->print = new_var->write = f;
- }
- }
-
- /* Clean up. */
- for (i = 0; i < nv; i++)
- free (v[i]);
- free (v);
- }
- while (lex_match ('/'));
-
- return lex_end_of_command ();
-
- /* If we have an error at a point where cleanup is required,
- flow-of-control comes here. */
-fail:
- for (i = 0; i < nv; i++)
- free (v[i]);
- free (v);
- return CMD_PART_SUCCESS_MAYBE;
-}
-
-/* Parses the STRING command. */
-int
-cmd_string (void)
-{
- size_t i;
-
- /* Names of variables to create. */
- char **v;
- size_t nv;
-
- /* Format spec for variables to create. */
- struct fmt_spec f;
-
- /* Width of variables to create. */
- int width;
-
- do
- {
- if (!parse_DATA_LIST_vars (&v, &nv, PV_NONE))
- return CMD_PART_SUCCESS_MAYBE;
-
- if (!lex_force_match ('(')
- || !parse_format_specifier (&f, 0))
- goto fail;
- if (!(formats[f.type].cat & FCAT_STRING))
- {
- msg (SE, _("Format type %s may not be used with a string "
- "variable."), fmt_to_string (&f));
- goto fail;
- }
-
- if (!lex_match (')'))
- {
- msg (SE, _("`)' expected after output format."));
- goto fail;
- }
-
- switch (f.type)
- {
- case FMT_A:
- width = f.w;
- break;
- case FMT_AHEX:
- width = f.w / 2;
- break;
- default:
- assert (0);
- abort ();
- }
-
- /* Create each variable. */
- for (i = 0; i < nv; i++)
- {
- struct variable *new_var = dict_create_var (default_dict, v[i],
- width);
- if (!new_var)
- msg (SE, _("There is already a variable named %s."), v[i]);
- else
- new_var->print = new_var->write = f;
- }
-
- /* Clean up. */
- for (i = 0; i < nv; i++)
- free (v[i]);
- free (v);
- }
- while (lex_match ('/'));
-
- return lex_end_of_command ();
-
- /* If we have an error at a point where cleanup is required,
- flow-of-control comes here. */
-fail:
- for (i = 0; i < nv; i++)
- free (v[i]);
- free (v);
- return CMD_PART_SUCCESS_MAYBE;
-}
-
-/* Parses the LEAVE command. */
-int
-cmd_leave (void)
-{
- struct variable **v;
- size_t nv;
-
- size_t i;
-
- if (!parse_variables (default_dict, &v, &nv, PV_NONE))
- return CMD_FAILURE;
- for (i = 0; i < nv; i++)
- {
- if (!v[i]->reinit)
- continue;
- v[i]->reinit = 0;
- v[i]->init = 1;
- }
- free (v);
-
- return lex_end_of_command ();
-}
+++ /dev/null
-/* PSPP - One way ANOVA. -*-c-*-
-
-Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
-Author: John Darrington 2004
-
-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 the Free Software Foundation; either version 2 of the
-License, or (at your option) any later version.
-
-This program is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA. */
-
-#include <config.h>
-#include <gsl/gsl_cdf.h>
-#include "error.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include <math.h>
-#include "alloc.h"
-#include "str.h"
-#include "case.h"
-#include "dictionary.h"
-#include "command.h"
-#include "lexer.h"
-#include "error.h"
-#include "magic.h"
-#include "misc.h"
-#include "tab.h"
-#include "som.h"
-#include "value-labels.h"
-#include "var.h"
-#include "vfm.h"
-#include "hash.h"
-#include "casefile.h"
-#include "group_proc.h"
-#include "group.h"
-#include "levene.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* (headers) */
-
-/* (specification)
- "ONEWAY" (oneway_):
- *^variables=custom;
- +missing=miss:!analysis/listwise,
- incl:include/!exclude;
- contrast= double list;
- statistics[st_]=descriptives,homogeneity.
-*/
-/* (declarations) */
-/* (functions) */
-
-
-
-static int bad_weight_warn = 1;
-
-
-static struct cmd_oneway cmd;
-
-/* The independent variable */
-static struct variable *indep_var;
-
-/* Number of dependent variables */
-static size_t n_vars;
-
-/* The dependent variables */
-static struct variable **vars;
-
-
-/* A hash table containing all the distinct values of the independent
- variables */
-static struct hsh_table *global_group_hash ;
-
-/* The number of distinct values of the independent variable, when all
- missing values are disregarded */
-static int ostensible_number_of_groups=-1;
-
-
-/* Function to use for testing for missing values */
-static is_missing_func *value_is_missing;
-
-
-static void run_oneway(const struct casefile *cf, void *_mode);
-
-
-/* Routines to show the output tables */
-static void show_anova_table(void);
-static void show_descriptives(void);
-static void show_homogeneity(void);
-
-static void show_contrast_coeffs(short *);
-static void show_contrast_tests(short *);
-
-
-enum stat_table_t {STAT_DESC = 1, STAT_HOMO = 2};
-
-static enum stat_table_t stat_tables ;
-
-void output_oneway(void);
-
-
-int
-cmd_oneway(void)
-{
- int i;
-
- if ( !parse_oneway(&cmd) )
- return CMD_FAILURE;
-
- /* If /MISSING=INCLUDE is set, then user missing values are ignored */
- if (cmd.incl == ONEWAY_INCLUDE )
- value_is_missing = mv_is_value_system_missing;
- else
- value_is_missing = mv_is_value_missing;
-
- /* What statistics were requested */
- if ( cmd.sbc_statistics )
- {
-
- for (i = 0 ; i < ONEWAY_ST_count ; ++i )
- {
- if ( ! cmd.a_statistics[i] ) continue;
-
- switch (i) {
- case ONEWAY_ST_DESCRIPTIVES:
- stat_tables |= STAT_DESC;
- break;
- case ONEWAY_ST_HOMOGENEITY:
- stat_tables |= STAT_HOMO;
- break;
- }
- }
- }
-
- multipass_procedure_with_splits (run_oneway, &cmd);
-
- free (vars);
- free_oneway (&cmd);
-
- return CMD_SUCCESS;
-}
-
-
-void
-output_oneway(void)
-{
- size_t i;
- short *bad_contrast ;
-
- bad_contrast = xnmalloc (cmd.sbc_contrast, sizeof *bad_contrast);
-
- /* Check the sanity of the given contrast values */
- for (i = 0 ; i < cmd.sbc_contrast ; ++i )
- {
- int j;
- double sum = 0;
-
- bad_contrast[i] = 0;
- if ( subc_list_double_count(&cmd.dl_contrast[i]) !=
- ostensible_number_of_groups )
- {
- msg(SW,
- _("Number of contrast coefficients must equal the number of groups"));
- bad_contrast[i] = 1;
- continue;
- }
-
- for (j=0; j < ostensible_number_of_groups ; ++j )
- sum += subc_list_double_at(&cmd.dl_contrast[i],j);
-
- if ( sum != 0.0 )
- msg(SW,_("Coefficients for contrast %d do not total zero"),i + 1);
- }
-
- if ( stat_tables & STAT_DESC )
- show_descriptives();
-
- if ( stat_tables & STAT_HOMO )
- show_homogeneity();
-
- show_anova_table();
-
- if (cmd.sbc_contrast )
- {
- show_contrast_coeffs(bad_contrast);
- show_contrast_tests(bad_contrast);
- }
-
-
- free(bad_contrast);
-
- /* Clean up */
- for (i = 0 ; i < n_vars ; ++i )
- {
- struct hsh_table *group_hash = group_proc_get (vars[i])->group_hash;
-
- hsh_destroy(group_hash);
- }
-
- hsh_destroy(global_group_hash);
-
-}
-
-
-
-
-/* Parser for the variables sub command */
-static int
-oneway_custom_variables(struct cmd_oneway *cmd UNUSED)
-{
-
- lex_match('=');
-
- if ((token != T_ID || dict_lookup_var (default_dict, tokid) == NULL)
- && token != T_ALL)
- return 2;
-
-
- if (!parse_variables (default_dict, &vars, &n_vars,
- PV_DUPLICATE
- | PV_NUMERIC | PV_NO_SCRATCH) )
- {
- free (vars);
- return 0;
- }
-
- assert(n_vars);
-
- if ( ! lex_match(T_BY))
- return 2;
-
-
- indep_var = parse_variable();
-
- if ( !indep_var )
- {
- msg(SE,_("`%s' is not a variable name"),tokid);
- return 0;
- }
-
-
- return 1;
-}
-
-
-/* Show the ANOVA table */
-static void
-show_anova_table(void)
-{
- size_t i;
- int n_cols =7;
- size_t n_rows = n_vars * 3 + 1;
-
- struct tab_table *t;
-
-
- t = tab_create (n_cols,n_rows,0);
- tab_headers (t, 2, 0, 1, 0);
- tab_dim (t, tab_natural_dimensions);
-
-
- tab_box (t,
- TAL_2, TAL_2,
- -1, TAL_1,
- 0, 0,
- n_cols - 1, n_rows - 1);
-
- tab_hline (t, TAL_2, 0, n_cols - 1, 1 );
- tab_vline (t, TAL_2, 2, 0, n_rows - 1);
- tab_vline (t, TAL_0, 1, 0, 0);
-
- tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Sum of Squares"));
- 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"));
-
-
- for ( i=0 ; i < n_vars ; ++i )
- {
- struct group_statistics *totals = &group_proc_get (vars[i])->ugs;
- struct hsh_table *group_hash = group_proc_get (vars[i])->group_hash;
- struct hsh_iterator g;
- struct group_statistics *gs;
- double ssa=0;
- const char *s = var_to_string(vars[i]);
-
- for (gs = hsh_first (group_hash,&g);
- gs != 0;
- gs = hsh_next(group_hash,&g))
- {
- ssa += (gs->sum * gs->sum)/gs->n;
- }
-
- ssa -= ( totals->sum * totals->sum ) / totals->n ;
-
- tab_text (t, 0, i * 3 + 1, TAB_LEFT | TAT_TITLE, s);
- tab_text (t, 1, i * 3 + 1, TAB_LEFT | TAT_TITLE, _("Between Groups"));
- tab_text (t, 1, i * 3 + 2, TAB_LEFT | TAT_TITLE, _("Within Groups"));
- tab_text (t, 1, i * 3 + 3, TAB_LEFT | TAT_TITLE, _("Total"));
-
- if (i > 0)
- tab_hline(t, TAL_1, 0, n_cols - 1 , i * 3 + 1);
-
- {
- struct group_proc *gp = group_proc_get (vars[i]);
- const double sst = totals->ssq - ( totals->sum * totals->sum) / totals->n ;
- const double df1 = gp->n_groups - 1;
- const double df2 = totals->n - gp->n_groups ;
- const double msa = ssa / df1;
-
- gp->mse = (sst - ssa) / df2;
-
-
- /* Sums of Squares */
- tab_float (t, 2, i * 3 + 1, 0, ssa, 10, 2);
- tab_float (t, 2, i * 3 + 3, 0, sst, 10, 2);
- tab_float (t, 2, i * 3 + 2, 0, sst - ssa, 10, 2);
-
-
- /* Degrees of freedom */
- tab_float (t, 3, i * 3 + 1, 0, df1, 4, 0);
- tab_float (t, 3, i * 3 + 2, 0, df2, 4, 0);
- tab_float (t, 3, i * 3 + 3, 0, totals->n - 1, 4, 0);
-
- /* Mean Squares */
- tab_float (t, 4, i * 3 + 1, TAB_RIGHT, msa, 8, 3);
- tab_float (t, 4, i * 3 + 2, TAB_RIGHT, gp->mse, 8, 3);
-
-
- {
- const double F = msa/gp->mse ;
-
- /* The F value */
- tab_float (t, 5, i * 3 + 1, 0, F, 8, 3);
-
- /* The significance */
- tab_float (t, 6, i * 3 + 1, 0, gsl_cdf_fdist_Q(F,df1,df2), 8, 3);
- }
-
- }
-
- }
-
-
- tab_title (t, 0, _("ANOVA"));
- tab_submit (t);
-
-
-}
-
-/* Show the descriptives table */
-static void
-show_descriptives(void)
-{
- size_t v;
- int n_cols =10;
- struct tab_table *t;
- int row;
-
- const double confidence=0.95;
- const double q = (1.0 - confidence) / 2.0;
-
-
- int n_rows = 2 ;
-
- for ( v = 0 ; v < n_vars ; ++v )
- n_rows += group_proc_get (vars[v])->n_groups + 1;
-
- t = tab_create (n_cols,n_rows,0);
- tab_headers (t, 2, 0, 2, 0);
- tab_dim (t, tab_natural_dimensions);
-
-
- /* Put a frame around the entire box, and vertical lines inside */
- tab_box (t,
- TAL_2, TAL_2,
- -1, TAL_1,
- 0, 0,
- n_cols - 1, n_rows - 1);
-
- /* Underline headers */
- tab_hline (t, TAL_2, 0, n_cols - 1, 2 );
- tab_vline (t, TAL_2, 2, 0, n_rows - 1);
-
- tab_text (t, 2, 1, TAB_CENTER | TAT_TITLE, _("N"));
- tab_text (t, 3, 1, TAB_CENTER | TAT_TITLE, _("Mean"));
- tab_text (t, 4, 1, TAB_CENTER | TAT_TITLE, _("Std. Deviation"));
- tab_text (t, 5, 1, TAB_CENTER | TAT_TITLE, _("Std. Error"));
-
-
- tab_vline(t, TAL_0, 7, 0, 0);
- tab_hline(t, TAL_1, 6, 7, 1);
- tab_joint_text (t, 6, 0, 7, 0, TAB_CENTER | TAT_TITLE | TAT_PRINTF, _("%g%% Confidence Interval for Mean"),confidence*100.0);
-
- tab_text (t, 6, 1, TAB_CENTER | TAT_TITLE, _("Lower Bound"));
- tab_text (t, 7, 1, TAB_CENTER | TAT_TITLE, _("Upper Bound"));
-
- tab_text (t, 8, 1, TAB_CENTER | TAT_TITLE, _("Minimum"));
- tab_text (t, 9, 1, TAB_CENTER | TAT_TITLE, _("Maximum"));
-
-
- tab_title (t, 0, _("Descriptives"));
-
-
- row = 2;
- for ( v=0 ; v < n_vars ; ++v )
- {
- double T;
- double std_error;
-
- struct group_proc *gp = group_proc_get (vars[v]);
-
- struct group_statistics *gs;
- struct group_statistics *totals = &gp->ugs;
-
- const char *s = var_to_string(vars[v]);
-
- struct group_statistics *const *gs_array = hsh_sort(gp->group_hash);
- int count = 0;
-
- tab_text (t, 0, row, TAB_LEFT | TAT_TITLE, s);
- if ( v > 0)
- tab_hline(t, TAL_1, 0, n_cols - 1 , row);
-
- for (count = 0 ; count < hsh_count(gp->group_hash) ; ++count)
- {
- gs = gs_array[count];
-
- tab_text (t, 1, row + count,
- TAB_LEFT | TAT_TITLE ,value_to_string(&gs->id,indep_var));
-
- /* Now fill in the numbers ... */
-
- tab_float (t, 2, row + count, 0, gs->n, 8,0);
-
- tab_float (t, 3, row + count, 0, gs->mean,8,2);
-
- tab_float (t, 4, row + count, 0, gs->std_dev,8,2);
-
- std_error = gs->std_dev/sqrt(gs->n) ;
- tab_float (t, 5, row + count, 0,
- std_error, 8,2);
-
- /* Now the confidence interval */
-
- T = gsl_cdf_tdist_Qinv(q,gs->n - 1);
-
- tab_float(t, 6, row + count, 0,
- gs->mean - T * std_error, 8, 2);
-
- tab_float(t, 7, row + count, 0,
- gs->mean + T * std_error, 8, 2);
-
- /* Min and Max */
-
- tab_float(t, 8, row + count, 0, gs->minimum, 8, 2);
- tab_float(t, 9, row + count, 0, gs->maximum, 8, 2);
-
- }
-
- tab_text (t, 1, row + count,
- TAB_LEFT | TAT_TITLE ,_("Total"));
-
- tab_float (t, 2, row + count, 0, totals->n, 8,0);
-
- tab_float (t, 3, row + count, 0, totals->mean, 8,2);
-
- tab_float (t, 4, row + count, 0, totals->std_dev,8,2);
-
- std_error = totals->std_dev/sqrt(totals->n) ;
-
- tab_float (t, 5, row + count, 0, std_error, 8,2);
-
- /* Now the confidence interval */
-
- T = gsl_cdf_tdist_Qinv(q,totals->n - 1);
-
- tab_float(t, 6, row + count, 0,
- totals->mean - T * std_error, 8, 2);
-
- tab_float(t, 7, row + count, 0,
- totals->mean + T * std_error, 8, 2);
-
- /* Min and Max */
-
- tab_float(t, 8, row + count, 0, totals->minimum, 8, 2);
- tab_float(t, 9, row + count, 0, totals->maximum, 8, 2);
-
- row += gp->n_groups + 1;
- }
-
-
- tab_submit (t);
-
-
-}
-
-/* Show the homogeneity table */
-static void
-show_homogeneity(void)
-{
- size_t v;
- int n_cols = 5;
- size_t n_rows = n_vars + 1;
-
- struct tab_table *t;
-
-
- t = tab_create (n_cols,n_rows,0);
- tab_headers (t, 1, 0, 1, 0);
- tab_dim (t, tab_natural_dimensions);
-
- /* Put a frame around the entire box, and vertical lines inside */
- tab_box (t,
- TAL_2, TAL_2,
- -1, TAL_1,
- 0, 0,
- n_cols - 1, n_rows - 1);
-
-
- tab_hline(t, TAL_2, 0, n_cols - 1, 1);
- tab_vline(t, TAL_2, 1, 0, n_rows - 1);
-
-
- 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_title (t, 0, _("Test of Homogeneity of Variances"));
-
- for ( v=0 ; v < n_vars ; ++v )
- {
- double F;
- const struct variable *var = vars[v];
- const struct group_proc *gp = group_proc_get (vars[v]);
- const char *s = var_to_string(var);
- const struct group_statistics *totals = &gp->ugs;
-
- const double df1 = gp->n_groups - 1;
- const double df2 = totals->n - gp->n_groups ;
-
- tab_text (t, 0, v + 1, TAB_LEFT | TAT_TITLE, s);
-
- F = gp->levene;
- tab_float (t, 1, v + 1, TAB_RIGHT, F, 8,3);
- tab_float (t, 2, v + 1, TAB_RIGHT, df1 ,8,0);
- tab_float (t, 3, v + 1, TAB_RIGHT, df2 ,8,0);
-
- /* Now the significance */
- tab_float (t, 4, v + 1, TAB_RIGHT,gsl_cdf_fdist_Q(F,df1,df2), 8, 3);
- }
-
- tab_submit (t);
-
-
-}
-
-
-/* Show the contrast coefficients table */
-static void
-show_contrast_coeffs(short *bad_contrast)
-{
- int n_cols = 2 + ostensible_number_of_groups;
- int n_rows = 2 + cmd.sbc_contrast;
- union value *group_value;
- int count = 0 ;
- void *const *group_values ;
-
- struct tab_table *t;
-
- t = tab_create (n_cols,n_rows,0);
- tab_headers (t, 2, 0, 2, 0);
- tab_dim (t, tab_natural_dimensions);
-
- /* Put a frame around the entire box, and vertical lines inside */
- tab_box (t,
- TAL_2, TAL_2,
- -1, TAL_1,
- 0, 0,
- n_cols - 1, n_rows - 1);
-
- tab_box (t,
- -1,-1,
- TAL_0, TAL_0,
- 2, 0,
- n_cols - 1, 0);
-
- tab_box (t,
- -1,-1,
- TAL_0, TAL_0,
- 0,0,
- 1,1);
-
- tab_hline(t, TAL_1, 2, n_cols - 1, 1);
- tab_hline(t, TAL_2, 0, n_cols - 1, 2);
-
- tab_vline(t, TAL_2, 2, 0, n_rows - 1);
-
- tab_title (t, 0, _("Contrast Coefficients"));
-
- tab_text (t, 0, 2, TAB_LEFT | TAT_TITLE, _("Contrast"));
-
-
- tab_joint_text (t, 2, 0, n_cols - 1, 0, TAB_CENTER | TAT_TITLE,
- var_to_string(indep_var));
-
- group_values = hsh_sort(global_group_hash);
- for (count = 0 ;
- count < hsh_count(global_group_hash) ;
- ++count)
- {
- int i;
- group_value = group_values[count];
-
- tab_text (t, count + 2, 1, TAB_CENTER | TAT_TITLE,
- value_to_string(group_value, indep_var));
-
- for (i = 0 ; i < cmd.sbc_contrast ; ++i )
- {
- tab_text(t, 1, i + 2, TAB_CENTER | TAT_PRINTF, "%d", i + 1);
-
- if ( bad_contrast[i] )
- tab_text(t, count + 2, i + 2, TAB_RIGHT, "?" );
- else
- tab_text(t, count + 2, i + 2, TAB_RIGHT | TAT_PRINTF, "%g",
- subc_list_double_at(&cmd.dl_contrast[i], count)
- );
- }
- }
-
- tab_submit (t);
-}
-
-
-/* Show the results of the contrast tests */
-static void
-show_contrast_tests(short *bad_contrast)
-{
- size_t v;
- int n_cols = 8;
- size_t n_rows = 1 + n_vars * 2 * cmd.sbc_contrast;
-
- struct tab_table *t;
-
- t = tab_create (n_cols,n_rows,0);
- tab_headers (t, 3, 0, 1, 0);
- tab_dim (t, tab_natural_dimensions);
-
- /* Put a frame around the entire box, and vertical lines inside */
- tab_box (t,
- TAL_2, TAL_2,
- -1, TAL_1,
- 0, 0,
- n_cols - 1, n_rows - 1);
-
- tab_box (t,
- -1,-1,
- TAL_0, TAL_0,
- 0, 0,
- 2, 0);
-
- tab_hline(t, TAL_2, 0, n_cols - 1, 1);
- tab_vline(t, TAL_2, 3, 0, n_rows - 1);
-
-
- tab_title (t, 0, _("Contrast Tests"));
-
- tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Contrast"));
- tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Value of Contrast"));
- tab_text (t, 4, 0, TAB_CENTER | TAT_TITLE, _("Std. Error"));
- tab_text (t, 5, 0, TAB_CENTER | TAT_TITLE, _("t"));
- tab_text (t, 6, 0, TAB_CENTER | TAT_TITLE, _("df"));
- tab_text (t, 7, 0, TAB_CENTER | TAT_TITLE, _("Sig. (2-tailed)"));
-
- for ( v = 0 ; v < n_vars ; ++v )
- {
- int i;
- int lines_per_variable = 2 * cmd.sbc_contrast;
-
-
- tab_text (t, 0, (v * lines_per_variable) + 1, TAB_LEFT | TAT_TITLE,
- var_to_string(vars[v]));
-
- for ( i = 0 ; i < cmd.sbc_contrast ; ++i )
- {
- int ci;
- double contrast_value = 0.0;
- double coef_msq = 0.0;
- struct group_proc *grp_data = group_proc_get (vars[v]);
- struct hsh_table *group_hash = grp_data->group_hash;
-
- void *const *group_stat_array;
-
- double T;
- double std_error_contrast ;
- double df;
- double sec_vneq=0.0;
-
-
- /* Note: The calculation of the degrees of freedom in the
- "variances not equal" case is painfull!!
- The following formula may help to understand it:
- \frac{\left(\sum_{i=1}^k{c_i^2\frac{s_i^2}{n_i}}\right)^2}
- {
- \sum_{i=1}^k\left(
- \frac{\left(c_i^2\frac{s_i^2}{n_i}\right)^2} {n_i-1}
- \right)
- }
- */
-
- double df_denominator = 0.0;
- double df_numerator = 0.0;
- if ( i == 0 )
- {
- tab_text (t, 1, (v * lines_per_variable) + i + 1,
- TAB_LEFT | TAT_TITLE,
- _("Assume equal variances"));
-
- tab_text (t, 1, (v * lines_per_variable) + i + 1 + cmd.sbc_contrast,
- TAB_LEFT | TAT_TITLE,
- _("Does not assume equal"));
- }
-
- tab_text (t, 2, (v * lines_per_variable) + i + 1,
- TAB_CENTER | TAT_TITLE | TAT_PRINTF, "%d",i+1);
-
-
- tab_text (t, 2, (v * lines_per_variable) + i + 1 + cmd.sbc_contrast,
- TAB_CENTER | TAT_TITLE | TAT_PRINTF, "%d",i+1);
-
-
- if ( bad_contrast[i])
- continue;
-
- group_stat_array = hsh_sort(group_hash);
-
- for (ci = 0 ; ci < hsh_count(group_hash) ; ++ci)
- {
- const double coef = subc_list_double_at(&cmd.dl_contrast[i], ci);
- struct group_statistics *gs = group_stat_array[ci];
-
- const double winv = (gs->std_dev * gs->std_dev) / gs->n;
-
- contrast_value += coef * gs->mean;
-
- coef_msq += (coef * coef) / gs->n ;
-
- sec_vneq += (coef * coef) * (gs->std_dev * gs->std_dev ) /gs->n ;
-
- df_numerator += (coef * coef) * winv;
- df_denominator += pow2((coef * coef) * winv) / (gs->n - 1);
- }
- sec_vneq = sqrt(sec_vneq);
-
- df_numerator = pow2(df_numerator);
-
- tab_float (t, 3, (v * lines_per_variable) + i + 1,
- TAB_RIGHT, contrast_value, 8,2);
-
- tab_float (t, 3, (v * lines_per_variable) + i + 1 +
- cmd.sbc_contrast,
- TAB_RIGHT, contrast_value, 8,2);
-
- std_error_contrast = sqrt(grp_data->mse * coef_msq);
-
- /* Std. Error */
- tab_float (t, 4, (v * lines_per_variable) + i + 1,
- TAB_RIGHT, std_error_contrast,
- 8,3);
-
- T = fabs(contrast_value / std_error_contrast) ;
-
- /* T Statistic */
-
- tab_float (t, 5, (v * lines_per_variable) + i + 1,
- TAB_RIGHT, T,
- 8,3);
-
- df = grp_data->ugs.n - grp_data->n_groups;
-
- /* Degrees of Freedom */
- tab_float (t, 6, (v * lines_per_variable) + i + 1,
- TAB_RIGHT, df,
- 8,0);
-
-
- /* Significance TWO TAILED !!*/
- tab_float (t, 7, (v * lines_per_variable) + i + 1,
- TAB_RIGHT, 2 * gsl_cdf_tdist_Q(T,df),
- 8,3);
-
-
- /* Now for the Variances NOT Equal case */
-
- /* Std. Error */
- tab_float (t, 4,
- (v * lines_per_variable) + i + 1 + cmd.sbc_contrast,
- TAB_RIGHT, sec_vneq,
- 8,3);
-
-
- T = contrast_value / sec_vneq;
- tab_float (t, 5,
- (v * lines_per_variable) + i + 1 + cmd.sbc_contrast,
- TAB_RIGHT, T,
- 8,3);
-
-
- df = df_numerator / df_denominator;
-
- tab_float (t, 6,
- (v * lines_per_variable) + i + 1 + cmd.sbc_contrast,
- TAB_RIGHT, df,
- 8,3);
-
- /* The Significance */
-
- tab_float (t, 7, (v * lines_per_variable) + i + 1 + cmd.sbc_contrast,
- TAB_RIGHT, 2 * gsl_cdf_tdist_Q(T,df),
- 8,3);
-
-
- }
-
- if ( v > 0 )
- tab_hline(t, TAL_1, 0, n_cols - 1, (v * lines_per_variable) + 1);
- }
-
- tab_submit (t);
-
-}
-
-
-/* ONEWAY ANOVA Calculations */
-
-static void postcalc ( struct cmd_oneway *cmd UNUSED );
-
-static void precalc ( struct cmd_oneway *cmd UNUSED );
-
-
-
-/* Pre calculations */
-static void
-precalc ( struct cmd_oneway *cmd UNUSED )
-{
- size_t i=0;
-
- for(i=0; i< n_vars ; ++i)
- {
- struct group_proc *gp = group_proc_get (vars[i]);
- struct group_statistics *totals = &gp->ugs;
-
- /* Create a hash for each of the dependent variables.
- The hash contains a group_statistics structure,
- and is keyed by value of the independent variable */
-
- gp->group_hash =
- hsh_create(4,
- (hsh_compare_func *) compare_group,
- (hsh_hash_func *) hash_group,
- (hsh_free_func *) free_group,
- (void *) indep_var->width );
-
-
- totals->sum=0;
- totals->n=0;
- totals->ssq=0;
- totals->sum_diff=0;
- totals->maximum = - DBL_MAX;
- totals->minimum = DBL_MAX;
- }
-}
-
-
-static void
-run_oneway(const struct casefile *cf, void *cmd_)
-{
- struct casereader *r;
- struct ccase c;
-
- struct cmd_oneway *cmd = (struct cmd_oneway *) cmd_;
-
- global_group_hash = hsh_create(4,
- (hsh_compare_func *) compare_values,
- (hsh_hash_func *) hash_value,
- 0,
- (void *) indep_var->width );
- precalc(cmd);
-
- for(r = casefile_get_reader (cf);
- casereader_read (r, &c) ;
- case_destroy (&c))
- {
- size_t i;
-
- const double weight =
- dict_get_case_weight(default_dict,&c,&bad_weight_warn);
-
- const union value *indep_val = case_data (&c, indep_var->fv);
-
- /* Deal with missing values */
- if ( value_is_missing(&indep_var->miss, indep_val) )
- continue;
-
- /* Skip the entire case if /MISSING=LISTWISE is set */
- if ( cmd->miss == ONEWAY_LISTWISE )
- {
- for(i = 0; i < n_vars ; ++i)
- {
- const struct variable *v = vars[i];
- const union value *val = case_data (&c, v->fv);
-
- if (value_is_missing(&v->miss, val) )
- break;
- }
- if ( i != n_vars )
- continue;
-
- }
-
-
- hsh_insert ( global_group_hash, (void *) indep_val );
-
- for ( i = 0 ; i < n_vars ; ++i )
- {
- const struct variable *v = vars[i];
-
- const union value *val = case_data (&c, v->fv);
-
- struct group_proc *gp = group_proc_get (vars[i]);
- struct hsh_table *group_hash = gp->group_hash;
-
- struct group_statistics *gs;
-
- gs = hsh_find(group_hash, (void *) indep_val );
-
- if ( ! gs )
- {
- gs = xmalloc (sizeof *gs);
- gs->id = *indep_val;
- gs->sum=0;
- gs->n=0;
- gs->ssq=0;
- gs->sum_diff=0;
- gs->minimum = DBL_MAX;
- gs->maximum = -DBL_MAX;
-
- hsh_insert ( group_hash, (void *) gs );
- }
-
- if (! value_is_missing(&v->miss, val) )
- {
- struct group_statistics *totals = &gp->ugs;
-
- totals->n+=weight;
- totals->sum+=weight * val->f;
- totals->ssq+=weight * val->f * val->f;
-
- if ( val->f * weight < totals->minimum )
- totals->minimum = val->f * weight;
-
- if ( val->f * weight > totals->maximum )
- totals->maximum = val->f * weight;
-
- gs->n+=weight;
- gs->sum+=weight * val->f;
- gs->ssq+=weight * val->f * val->f;
-
- if ( val->f * weight < gs->minimum )
- gs->minimum = val->f * weight;
-
- if ( val->f * weight > gs->maximum )
- gs->maximum = val->f * weight;
- }
-
- gp->n_groups = hsh_count ( group_hash );
- }
-
- }
- casereader_destroy (r);
-
- postcalc(cmd);
-
-
- if ( stat_tables & STAT_HOMO )
- levene(cf, indep_var, n_vars, vars,
- (cmd->miss == ONEWAY_LISTWISE) ? LEV_LISTWISE : LEV_ANALYSIS ,
- value_is_missing);
-
- ostensible_number_of_groups = hsh_count (global_group_hash);
-
-
- output_oneway();
-
-
-}
-
-
-/* Post calculations for the ONEWAY command */
-void
-postcalc ( struct cmd_oneway *cmd UNUSED )
-{
- size_t i=0;
-
-
- for(i = 0; i < n_vars ; ++i)
- {
- struct group_proc *gp = group_proc_get (vars[i]);
- struct hsh_table *group_hash = gp->group_hash;
- struct group_statistics *totals = &gp->ugs;
-
- struct hsh_iterator g;
- struct group_statistics *gs;
-
- for (gs = hsh_first (group_hash,&g);
- gs != 0;
- gs = hsh_next(group_hash,&g))
- {
- gs->mean=gs->sum / gs->n;
- gs->s_std_dev= sqrt(
- ( (gs->ssq / gs->n ) - gs->mean * gs->mean )
- ) ;
-
- gs->std_dev= sqrt(
- gs->n/(gs->n-1) *
- ( (gs->ssq / gs->n ) - gs->mean * gs->mean )
- ) ;
-
- gs->se_mean = gs->std_dev / sqrt(gs->n);
- gs->mean_diff= gs->sum_diff / gs->n;
-
- }
-
-
-
- totals->mean = totals->sum / totals->n;
- totals->std_dev= sqrt(
- totals->n/(totals->n-1) *
- ( (totals->ssq / totals->n ) - totals->mean * totals->mean )
- ) ;
-
- totals->se_mean = totals->std_dev / sqrt(totals->n);
-
- }
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "output.h"
-#include "error.h"
-#include <stdlib.h>
-#include <stdio.h>
-#include <errno.h>
-#include <ctype.h>
-#include "alloc.h"
-#include "error.h"
-#include "filename.h"
-#include "htmlP.h"
-#include "lexer.h"
-#include "misc.h"
-#include "settings.h"
-#include "str.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* FIXME? Should the output configuration format be changed to
- drivername:classname:devicetype:options, where devicetype is zero
- or more of screen, printer, listing? */
-
-/* FIXME: Have the reentrancy problems been solved? */
-
-/* Where the output driver name came from. */
-enum
- {
- OUTP_S_COMMAND_LINE, /* Specified by the user. */
- OUTP_S_INIT_FILE /* `default' or the init file. */
- };
-
-/* Names the output drivers to be used. */
-struct outp_names
- {
- char *name; /* Name of the output driver. */
- int source; /* OUTP_S_* */
- struct outp_names *next, *prev;
- };
-
-/* Defines an init file macro. */
-struct outp_defn
- {
- char *key;
- char *value;
- struct outp_defn *next, *prev;
- };
-
-static struct outp_defn *outp_macros;
-static struct outp_names *outp_configure_vec;
-
-struct outp_driver_class_list *outp_class_list;
-struct outp_driver *outp_driver_list;
-
-char *outp_title;
-char *outp_subtitle;
-
-/* A set of OUTP_DEV_* bits indicating the devices that are
- disabled. */
-static int disabled_devices;
-
-static void destroy_driver (struct outp_driver *);
-static void configure_driver_line (char *);
-static void configure_driver (const char *, const char *,
- const char *, const char *);
-
-#if GLOBAL_DEBUGGING
-/* This mechanism attempts to catch reentrant use of outp_driver_list. */
-static int iterating_driver_list;
-
-#define reentrancy() msg (FE, _("Attempt to iterate driver list reentrantly."))
-#endif
-
-/* Add a class to the class list. */
-static void
-add_class (struct outp_class *class)
-{
- struct outp_driver_class_list *new_list = xmalloc (sizeof *new_list);
-
- new_list->class = class;
- new_list->ref_count = 0;
-
- if (!outp_class_list)
- {
- outp_class_list = new_list;
- new_list->next = NULL;
- }
- else
- {
- new_list->next = outp_class_list;
- outp_class_list = new_list;
- }
-}
-
-/* Finds the outp_names in outp_configure_vec with name between BP and
- EP exclusive. */
-static struct outp_names *
-search_names (char *bp, char *ep)
-{
- struct outp_names *n;
-
- for (n = outp_configure_vec; n; n = n->next)
- if ((int) strlen (n->name) == ep - bp && !memcmp (n->name, bp, ep - bp))
- return n;
- return NULL;
-}
-
-/* Deletes outp_names NAME from outp_configure_vec. */
-static void
-delete_name (struct outp_names * n)
-{
- free (n->name);
- if (n->prev)
- n->prev->next = n->next;
- if (n->next)
- n->next->prev = n->prev;
- if (n == outp_configure_vec)
- outp_configure_vec = n->next;
- free (n);
-}
-
-/* Adds the name between BP and EP exclusive to list
- outp_configure_vec with source SOURCE. */
-static void
-add_name (char *bp, char *ep, int source)
-{
- struct outp_names *n = xmalloc (sizeof *n);
- n->name = xmalloc (ep - bp + 1);
- memcpy (n->name, bp, ep - bp);
- n->name[ep - bp] = 0;
- n->source = source;
- n->next = outp_configure_vec;
- n->prev = NULL;
- if (outp_configure_vec)
- outp_configure_vec->prev = n;
- outp_configure_vec = n;
-}
-
-/* Checks that outp_configure_vec is empty, bitches & clears it if it
- isn't. */
-static void
-check_configure_vec (void)
-{
- struct outp_names *n;
-
- for (n = outp_configure_vec; n; n = n->next)
- if (n->source == OUTP_S_COMMAND_LINE)
- msg (ME, _("Unknown output driver `%s'."), n->name);
- else
- msg (IE, _("Output driver `%s' referenced but never defined."), n->name);
- outp_configure_clear ();
-}
-
-/* Searches outp_configure_vec for the name between BP and EP
- exclusive. If found, it is deleted, then replaced by the names
- given in EP+1, if any. */
-static void
-expand_name (char *bp, char *ep)
-{
- struct outp_names *n = search_names (bp, ep);
- if (!n)
- return;
- delete_name (n);
-
- bp = ep + 1;
- for (;;)
- {
- while (isspace ((unsigned char) *bp))
- bp++;
- ep = bp;
- while (*ep && !isspace ((unsigned char) *ep))
- ep++;
- if (bp == ep)
- return;
- if (!search_names (bp, ep))
- add_name (bp, ep, OUTP_S_INIT_FILE);
- bp = ep;
- }
-}
-
-/* Looks for a macro with key KEY, and returns the corresponding value
- if found, or NULL if not. */
-static const char *
-find_defn_value (const char *key)
-{
- static char buf[INT_DIGITS + 1];
- struct outp_defn *d;
-
- for (d = outp_macros; d; d = d->next)
- if (!strcmp (key, d->key))
- return d->value;
- if (!strcmp (key, "viewwidth"))
- {
- sprintf (buf, "%d", get_viewwidth ());
- return buf;
- }
- else if (!strcmp (key, "viewlength"))
- {
- sprintf (buf, "%d", get_viewlength ());
- return buf;
- }
- else
- return getenv (key);
-}
-
-/* Initializes global variables. */
-void
-outp_init (void)
-{
- extern struct outp_class ascii_class;
-#if !NO_POSTSCRIPT
- extern struct outp_class postscript_class;
- extern struct outp_class epsf_class;
-#endif
-#if !NO_HTML
- extern struct outp_class html_class;
-#endif
-
- char def[] = "default";
-
-#if !NO_HTML
- add_class (&html_class);
-#endif
-#if !NO_POSTSCRIPT
- add_class (&epsf_class);
- add_class (&postscript_class);
-#endif
- add_class (&ascii_class);
-
- add_name (def, &def[strlen (def)], OUTP_S_INIT_FILE);
-}
-
-/* Deletes all the output macros. */
-static void
-delete_macros (void)
-{
- struct outp_defn *d, *next;
-
- for (d = outp_macros; d; d = next)
- {
- next = d->next;
- free (d->key);
- free (d->value);
- free (d);
- }
-}
-
-static void
-init_default_drivers (void)
-{
- msg (MM, _("Using default output driver configuration."));
- configure_driver ("list-ascii", "ascii", "listing",
- "length=66 width=79 char-set=ascii "
- "output-file=\"pspp.list\" "
- "bold-on=\"\" italic-on=\"\" bold-italic-on=\"\"");
-}
-
-/* Reads the initialization file; initializes
- outp_driver_list. */
-void
-outp_read_devices (void)
-{
- int result = 0;
-
- char *init_fn;
-
- FILE *f = NULL;
- struct string line;
- struct file_locator where;
-
-#if GLOBAL_DEBUGGING
- if (iterating_driver_list)
- reentrancy ();
-#endif
-
- init_fn = fn_search_path (fn_getenv_default ("STAT_OUTPUT_INIT_FILE",
- "devices"),
- fn_getenv_default ("STAT_OUTPUT_INIT_PATH",
- config_path),
- NULL);
- where.filename = init_fn;
- where.line_number = 0;
- err_push_file_locator (&where);
-
- ds_init (&line, 128);
-
- if (init_fn == NULL)
- {
- msg (IE, _("Cannot find output initialization file. "
- "Use `-vvvvv' to view search path."));
- goto exit;
- }
-
- msg (VM (1), _("%s: Opening device description file..."), init_fn);
- f = fopen (init_fn, "r");
- if (f == NULL)
- {
- msg (IE, _("Opening %s: %s."), init_fn, strerror (errno));
- goto exit;
- }
-
- for (;;)
- {
- char *cp;
-
- if (!ds_get_config_line (f, &line, &where))
- {
- if (ferror (f))
- msg (ME, _("Reading %s: %s."), init_fn, strerror (errno));
- break;
- }
- for (cp = ds_c_str (&line); isspace ((unsigned char) *cp); cp++);
- if (!strncmp ("define", cp, 6) && isspace ((unsigned char) cp[6]))
- outp_configure_macro (&cp[7]);
- else if (*cp)
- {
- char *ep;
- for (ep = cp; *ep && *ep != ':' && *ep != '='; ep++);
- if (*ep == '=')
- expand_name (cp, ep);
- else if (*ep == ':')
- {
- struct outp_names *n = search_names (cp, ep);
- if (n)
- {
- configure_driver_line (cp);
- delete_name (n);
- }
- }
- else
- msg (IS, _("Syntax error."));
- }
- }
- result = 1;
-
- check_configure_vec ();
-
-exit:
- err_pop_file_locator (&where);
- if (f && -1 == fclose (f))
- msg (MW, _("Closing %s: %s."), init_fn, strerror (errno));
- free (init_fn);
- ds_destroy (&line);
- delete_macros ();
-
- if (result)
- {
- msg (VM (2), _("Device definition file read successfully."));
- if (outp_driver_list == NULL)
- msg (MW, _("No output drivers are active."));
- }
- else
- msg (VM (1), _("Error reading device definition file."));
-
- if (!result || outp_driver_list == NULL)
- init_default_drivers ();
-}
-
-/* Clear the list of drivers to configure. */
-void
-outp_configure_clear (void)
-{
- struct outp_names *n, *next;
-
- for (n = outp_configure_vec; n; n = next)
- {
- next = n->next;
- free (n->name);
- free (n);
- }
- outp_configure_vec = NULL;
-}
-
-/* Adds the name BP to the list of drivers to configure into
- outp_driver_list. */
-void
-outp_configure_add (char *bp)
-{
- char *ep = &bp[strlen (bp)];
- if (!search_names (bp, ep))
- add_name (bp, ep, OUTP_S_COMMAND_LINE);
-}
-
-/* Defines one configuration macro based on the text in BP, which
- should be of the form `KEY=VALUE'. */
-void
-outp_configure_macro (char *bp)
-{
- struct outp_defn *d;
- char *ep;
-
- while (isspace ((unsigned char) *bp))
- bp++;
- ep = bp;
- while (*ep && !isspace ((unsigned char) *ep) && *ep != '=')
- ep++;
-
- d = xmalloc (sizeof *d);
- d->key = xmalloc (ep - bp + 1);
- memcpy (d->key, bp, ep - bp);
- d->key[ep - bp] = 0;
-
- /* Earlier definitions for a particular KEY override later ones. */
- if (find_defn_value (d->key))
- {
- free (d->key);
- free (d);
- return;
- }
-
- if (*ep == '=')
- ep++;
- while (isspace ((unsigned char) *ep))
- ep++;
- d->value = fn_interp_vars (ep, find_defn_value);
- d->next = outp_macros;
- d->prev = NULL;
- if (outp_macros)
- outp_macros->prev = d;
- outp_macros = d;
-}
-
-/* Destroys all the drivers in driver list *DL and sets *DL to
- NULL. */
-static void
-destroy_list (struct outp_driver ** dl)
-{
- struct outp_driver *d, *next;
-
- for (d = *dl; d; d = next)
- {
- destroy_driver (d);
- next = d->next;
- free (d);
- }
- *dl = NULL;
-}
-
-/* Closes all the output drivers. */
-void
-outp_done (void)
-{
- struct outp_driver_class_list *n = outp_class_list ;
-#if GLOBAL_DEBUGGING
- if (iterating_driver_list)
- reentrancy ();
-#endif
- destroy_list (&outp_driver_list);
-
- while (n)
- {
- struct outp_driver_class_list *next = n->next;
- free(n);
- n = next;
- }
- outp_class_list = NULL;
-
- free (outp_title);
- outp_title = NULL;
-
- free (outp_subtitle);
- outp_subtitle = NULL;
-}
-
-/* Display on stdout a list of all registered driver classes. */
-void
-outp_list_classes (void)
-{
- int width = get_viewwidth();
- struct outp_driver_class_list *c;
-
- printf (_("Driver classes:\n\t"));
- width -= 8;
- for (c = outp_class_list; c; c = c->next)
- {
- if ((int) strlen (c->class->name) + 1 > width)
- {
- printf ("\n\t");
- width = get_viewwidth() - 8;
- }
- else
- putc (' ', stdout);
- fputs (c->class->name, stdout);
- }
- putc('\n', stdout);
-}
-
-static int op_token; /* `=', 'a', 0. */
-static struct string op_tokstr;
-static const char *prog;
-
-/* Parses a token from prog into op_token, op_tokstr. Sets op_token
- to '=' on an equals sign, to 'a' on a string or identifier token,
- or to 0 at end of line. Returns the new op_token. */
-static int
-tokener (void)
-{
- if (op_token == 0)
- {
- msg (IS, _("Syntax error."));
- return 0;
- }
-
- while (isspace ((unsigned char) *prog))
- prog++;
- if (!*prog)
- {
- op_token = 0;
- return 0;
- }
-
- if (*prog == '=')
- op_token = *prog++;
- else
- {
- ds_clear (&op_tokstr);
-
- if (*prog == '\'' || *prog == '"')
- {
- int quote = *prog++;
-
- while (*prog && *prog != quote)
- {
- if (*prog != '\\')
- ds_putc (&op_tokstr, *prog++);
- else
- {
- int c;
-
- prog++;
- assert ((int) *prog); /* How could a line end in `\'? */
- switch (*prog++)
- {
- case '\'':
- c = '\'';
- break;
- case '"':
- c = '"';
- break;
- case '?':
- c = '?';
- break;
- case '\\':
- c = '\\';
- break;
- case '}':
- c = '}';
- break;
- case 'a':
- c = '\a';
- break;
- case 'b':
- c = '\b';
- break;
- case 'f':
- c = '\f';
- break;
- case 'n':
- c = '\n';
- break;
- case 'r':
- c = '\r';
- break;
- case 't':
- c = '\t';
- break;
- case 'v':
- c = '\v';
- break;
- case '0':
- case '1':
- case '2':
- case '3':
- case '4':
- case '5':
- case '6':
- case '7':
- {
- c = prog[-1] - '0';
- while (*prog >= '0' && *prog <= '7')
- c = c * 8 + *prog++ - '0';
- }
- break;
- case 'x':
- case 'X':
- {
- c = 0;
- while (isxdigit ((unsigned char) *prog))
- {
- c *= 16;
- if (isdigit ((unsigned char) *prog))
- c += *prog - '0';
- else
- c += (tolower ((unsigned char) (*prog))
- - 'a' + 10);
- prog++;
- }
- }
- break;
- default:
- msg (IS, _("Syntax error in string constant."));
- continue;
- }
- ds_putc (&op_tokstr, (unsigned char) c);
- }
- }
- prog++;
- }
- else
- while (*prog && !isspace ((unsigned char) *prog) && *prog != '=')
- ds_putc (&op_tokstr, *prog++);
- op_token = 'a';
- }
-
- return 1;
-}
-
-/* Applies the user-specified options in string S to output driver D
- (at configuration time). */
-static void
-parse_options (const char *s, struct outp_driver * d)
-{
- prog = s;
- op_token = -1;
-
- ds_init (&op_tokstr, 64);
- while (tokener ())
- {
- char key[65];
-
- if (op_token != 'a')
- {
- msg (IS, _("Syntax error in options."));
- break;
- }
-
- ds_truncate (&op_tokstr, 64);
- strcpy (key, ds_c_str (&op_tokstr));
-
- tokener ();
- if (op_token != '=')
- {
- msg (IS, _("Syntax error in options (`=' expected)."));
- break;
- }
-
- tokener ();
- if (op_token != 'a')
- {
- msg (IS, _("Syntax error in options (value expected after `=')."));
- break;
- }
- d->class->option (d, key, &op_tokstr);
- }
- ds_destroy (&op_tokstr);
-}
-
-/* Find the driver in outp_driver_list with name NAME. */
-static struct outp_driver *
-find_driver (char *name)
-{
- struct outp_driver *d;
-
-#if GLOBAL_DEBUGGING
- if (iterating_driver_list)
- reentrancy ();
-#endif
- for (d = outp_driver_list; d; d = d->next)
- if (!strcmp (d->name, name))
- return d;
- return NULL;
-}
-
-/* Tokenize string S into colon-separated fields, removing leading and
- trailing whitespace on tokens. Returns a pointer to the
- null-terminated token, which is formed by setting a NUL character
- into the string. After the first call, subsequent calls should set
- S to NULL. CP should be consistent across calls. Returns NULL
- after all fields have been used up.
-
- FIXME: Should ignore colons inside double quotes. */
-static const char *
-colon_tokenize (char *s, char **cp)
-{
- char *token;
-
- if (!s)
- {
- s = *cp;
- if (*s == 0)
- return NULL;
- }
- token = s += strspn (s, " \t\v\r");
- *cp = strchr (s, ':');
- if (*cp == NULL)
- s = *cp = strchr (s, 0);
- else
- s = (*cp)++;
- while (s > token && strchr (" \t\v\r", s[-1]))
- s--;
- *s = 0;
- return token;
-}
-
-/* String S is in format:
- DRIVERNAME:CLASSNAME:DEVICETYPE:OPTIONS
- Adds a driver to outp_driver_list pursuant to the specification
- provided. */
-static void
-configure_driver (const char *driver_name, const char *class_name,
- const char *device_type, const char *options)
-{
- struct outp_driver *d = NULL, *iter;
- struct outp_driver_class_list *c = NULL;
-
- d = xmalloc (sizeof *d);
- d->class = NULL;
- d->name = xstrdup (driver_name);
- d->driver_open = 0;
- d->page_open = 0;
- d->next = d->prev = NULL;
- d->device = OUTP_DEV_NONE;
- d->ext = NULL;
-
- for (c = outp_class_list; c; c = c->next)
- if (!strcmp (c->class->name, class_name))
- break;
- if (!c)
- {
- msg (IS, _("Unknown output driver class `%s'."), class_name);
- goto error;
- }
-
- d->class = c->class;
- if (!c->ref_count && !d->class->open_global (d->class))
- {
- msg (IS, _("Can't initialize output driver class `%s'."),
- d->class->name);
- goto error;
- }
- c->ref_count++;
- if (!d->class->preopen_driver (d))
- {
- msg (IS, _("Can't initialize output driver `%s' of class `%s'."),
- d->name, d->class->name);
- goto error;
- }
-
- /* Device types. */
- if (device_type != NULL)
- {
- char *copy = xstrdup (device_type);
- char *sp, *type;
-
- for (type = strtok_r (copy, " \t\r\v", &sp); type;
- type = strtok_r (NULL, " \t\r\v", &sp))
- {
- if (!strcmp (type, "listing"))
- d->device |= OUTP_DEV_LISTING;
- else if (!strcmp (type, "screen"))
- d->device |= OUTP_DEV_SCREEN;
- else if (!strcmp (type, "printer"))
- d->device |= OUTP_DEV_PRINTER;
- else
- {
- msg (IS, _("Unknown device type `%s'."), type);
- free (copy);
- goto error;
- }
- }
- free (copy);
- }
-
- /* Options. */
- if (options != NULL)
- parse_options (options, d);
- if (!d->class->postopen_driver (d))
- {
- msg (IS, _("Can't complete initialization of output driver `%s' of "
- "class `%s'."), d->name, d->class->name);
- goto error;
- }
-
- /* Find like-named driver and delete. */
- iter = find_driver (d->name);
- if (iter)
- destroy_driver (iter);
-
- /* Add to list. */
- d->next = outp_driver_list;
- d->prev = NULL;
- if (outp_driver_list)
- outp_driver_list->prev = d;
- outp_driver_list = d;
- return;
-
-error:
- if (d)
- destroy_driver (d);
- return;
-}
-
-/* String S is in format:
- DRIVERNAME:CLASSNAME:DEVICETYPE:OPTIONS
- Adds a driver to outp_driver_list pursuant to the specification
- provided. */
-static void
-configure_driver_line (char *s)
-{
- char *cp;
- const char *driver_name, *class_name, *device_type, *options;
-
- s = fn_interp_vars (s, find_defn_value);
-
- /* Driver name. */
- driver_name = colon_tokenize (s, &cp);
- class_name = colon_tokenize (NULL, &cp);
- device_type = colon_tokenize (NULL, &cp);
- options = colon_tokenize (NULL, &cp);
- if (driver_name == NULL || class_name == NULL)
- {
- msg (IS, _("Driver definition line contains fewer fields "
- "than expected"));
- return;
- }
-
- configure_driver (driver_name, class_name, device_type, options);
-}
-
-/* Destroys output driver D. */
-static void
-destroy_driver (struct outp_driver *d)
-{
- if (d->page_open)
- d->class->close_page (d);
- if (d->class)
- {
- struct outp_driver_class_list *c;
-
- if (d->driver_open)
- d->class->close_driver (d);
-
- for (c = outp_class_list; c; c = c->next)
- if (c->class == d->class)
- break;
- assert (c != NULL);
-
- c->ref_count--;
- if (c->ref_count == 0)
- {
- if (!d->class->close_global (d->class))
- msg (IS, _("Can't deinitialize output driver class `%s'."),
- d->class->name);
- }
- }
- free (d->name);
-
- /* Remove this driver from the global driver list. */
- if (d->prev)
- d->prev->next = d->next;
- if (d->next)
- d->next->prev = d->prev;
- if (d == outp_driver_list)
- outp_driver_list = d->next;
-}
-
-static int
-option_cmp (const void *a, const void *b)
-{
- const struct outp_option *o1 = a;
- const struct outp_option *o2 = b;
- return strcmp (o1->keyword, o2->keyword);
-}
-
-/* Tries to match S as one of the keywords in TAB, with corresponding
- information structure INFO. Returns category code or 0 on failure;
- if category code is negative then stores subcategory in *SUBCAT. */
-int
-outp_match_keyword (const char *s, struct outp_option *tab,
- struct outp_option_info *info, int *subcat)
-{
- char *cp;
- struct outp_option *oip;
-
- /* Form hash table. */
- if (NULL == info->initial)
- {
- /* Count items. */
- int count, i;
- char s[256], *cp;
- struct outp_option *ptr[255], **oip;
-
- for (count = 0; tab[count].keyword[0]; count++)
- ;
-
- /* Sort items. */
- qsort (tab, count, sizeof *tab, option_cmp);
-
- cp = s;
- oip = ptr;
- *cp = tab[0].keyword[0];
- *oip++ = &tab[0];
- for (i = 0; i < count; i++)
- if (tab[i].keyword[0] != *cp)
- {
- *++cp = tab[i].keyword[0];
- *oip++ = &tab[i];
- }
- *++cp = 0;
-
- info->initial = xstrdup (s);
- info->options = xnmalloc (cp - s, sizeof *info->options);
- memcpy (info->options, ptr, sizeof *info->options * (cp - s));
- }
-
- cp = info->initial;
- oip = *info->options;
-
- if (s[0] == 0)
- return 0;
- cp = strchr (info->initial, s[0]);
- if (!cp)
- return 0;
-#if 0
- printf (_("Trying to find keyword `%s'...\n"), s);
-#endif
- oip = info->options[cp - info->initial];
- while (oip->keyword[0] == s[0])
- {
-#if 0
- printf ("- %s\n", oip->keyword);
-#endif
- if (!strcmp (s, oip->keyword))
- {
- if (oip->cat < 0)
- *subcat = oip->subcat;
- return oip->cat;
- }
- oip++;
- }
-
- return 0;
-}
-
-/* Encapsulate two characters in a single int. */
-#define TWO_CHARS(A, B) \
- ((A) + ((B)<<8))
-
-/* Determines the size of a dimensional measurement and returns the
- size in units of 1/72000". Units if not specified explicitly are
- inches for values under 50, millimeters otherwise. Returns 0,
- stores NULL to *TAIL on error; otherwise returns dimension, stores
- address of next */
-int
-outp_evaluate_dimension (char *dimen, char **tail)
-{
- char *s = dimen;
- char *ptail;
- double value;
-
- value = strtod (s, &ptail);
- if (ptail == s)
- goto lossage;
- if (*ptail == '-')
- {
- double b, c;
- s = &ptail[1];
- b = strtod (s, &ptail);
- if (b <= 0.0 || ptail == s)
- goto lossage;
- if (*ptail != '/')
- goto lossage;
- s = &ptail[1];
- c = strtod (s, &ptail);
- if (c <= 0.0 || ptail == s)
- goto lossage;
- s = ptail;
- if (c == 0.0)
- goto lossage;
- if (value > 0)
- value += b / c;
- else
- value -= b / c;
- }
- else if (*ptail == '/')
- {
- double b;
- s = &ptail[1];
- b = strtod (s, &ptail);
- if (b <= 0.0 || ptail == s)
- goto lossage;
- s = ptail;
- value /= b;
- }
- else
- s = ptail;
- if (*s == 0 || isspace ((unsigned char) *s))
- {
- if (value < 50.0)
- value *= 72000;
- else
- value *= 72000 / 25.4;
- }
- else
- {
- double factor;
-
- /* Standard TeX units are supported. */
- if (*s == '"')
- factor = 72000, s++;
- else
- switch (TWO_CHARS (s[0], s[1]))
- {
- case TWO_CHARS ('p', 't'):
- factor = 72000 / 72.27;
- break;
- case TWO_CHARS ('p', 'c'):
- factor = 72000 / 72.27 * 12.0;
- break;
- case TWO_CHARS ('i', 'n'):
- factor = 72000;
- break;
- case TWO_CHARS ('b', 'p'):
- factor = 72000 / 72.0;
- break;
- case TWO_CHARS ('c', 'm'):
- factor = 72000 / 2.54;
- break;
- case TWO_CHARS ('m', 'm'):
- factor = 72000 / 25.4;
- break;
- case TWO_CHARS ('d', 'd'):
- factor = 72000 / 72.27 * 1.0700086;
- break;
- case TWO_CHARS ('c', 'c'):
- factor = 72000 / 72.27 * 12.840104;
- break;
- case TWO_CHARS ('s', 'p'):
- factor = 72000 / 72.27 / 65536.0;
- break;
- default:
- msg (SE, _("Unit \"%s\" is unknown in dimension \"%s\"."), s, dimen);
- *tail = NULL;
- return 0;
- }
- ptail += 2;
- value *= factor;
- }
- if (value <= 0.0)
- goto lossage;
- if (tail)
- *tail = ptail;
- return value + 0.5;
-
-lossage:
- *tail = NULL;
- msg (SE, _("Bad dimension \"%s\"."), dimen);
- return 0;
-}
-
-/* Stores the dimensions in 1/72000" units of paper identified by
- SIZE, which is of form `HORZ x VERT' or `HORZ by VERT' where each
- of HORZ and VERT are dimensions, into *H and *V. Return nonzero on
- success. */
-static int
-internal_get_paper_size (char *size, int *h, int *v)
-{
- char *tail;
-
- while (isspace ((unsigned char) *size))
- size++;
- *h = outp_evaluate_dimension (size, &tail);
- if (tail == NULL)
- return 0;
- while (isspace ((unsigned char) *tail))
- tail++;
- if (*tail == 'x')
- tail++;
- else if (*tail == 'b' && tail[1] == 'y')
- tail += 2;
- else
- {
- msg (SE, _("`x' expected in paper size `%s'."), size);
- return 0;
- }
- *v = outp_evaluate_dimension (tail, &tail);
- if (tail == NULL)
- return 0;
- while (isspace ((unsigned char) *tail))
- tail++;
- if (*tail)
- {
- msg (SE, _("Trailing garbage `%s' on paper size `%s'."), tail, size);
- return 0;
- }
-
- return 1;
-}
-
-/* Stores the dimensions, in 1/72000" units, of paper identified by
- SIZE into *H and *V. SIZE may be a pair of dimensions of form `H x
- V', or it may be a case-insensitive paper identifier, which is
- looked up in the `papersize' configuration file. Returns nonzero
- on success. May modify SIZE. */
-/* Don't read further unless you've got a strong stomach. */
-int
-outp_get_paper_size (char *size, int *h, int *v)
-{
- struct paper_size
- {
- char *name;
- int use;
- int h, v;
- };
-
- static struct paper_size cache[4];
- static int use;
-
- FILE *f;
- char *pprsz_fn;
-
- struct string line;
- struct file_locator where;
-
- int free_it = 0;
- int result = 0;
- int min_value, min_index;
- char *ep;
- int i;
-
- while (isspace ((unsigned char) *size))
- size++;
- if (isdigit ((unsigned char) *size))
- return internal_get_paper_size (size, h, v);
- ep = size;
- while (*ep)
- ep++;
- while (isspace ((unsigned char) *ep) && ep >= size)
- ep--;
- if (ep == size)
- {
- msg (SE, _("Paper size name must not be empty."));
- return 0;
- }
-
- ep++;
- if (*ep)
- *ep = 0;
-
- use++;
- for (i = 0; i < 4; i++)
- if (cache[i].name != NULL && !strcasecmp (cache[i].name, size))
- {
- *h = cache[i].h;
- *v = cache[i].v;
- cache[i].use = use;
- return 1;
- }
-
- pprsz_fn = fn_search_path (fn_getenv_default ("STAT_OUTPUT_PAPERSIZE_FILE",
- "papersize"),
- fn_getenv_default ("STAT_OUTPUT_INIT_PATH",
- config_path),
- NULL);
-
- where.filename = pprsz_fn;
- where.line_number = 0;
- err_push_file_locator (&where);
- ds_init (&line, 128);
-
- if (pprsz_fn == NULL)
- {
- msg (IE, _("Cannot find `papersize' configuration file."));
- goto exit;
- }
-
- msg (VM (1), _("%s: Opening paper size definition file..."), pprsz_fn);
- f = fopen (pprsz_fn, "r");
- if (!f)
- {
- msg (IE, _("Opening %s: %s."), pprsz_fn, strerror (errno));
- goto exit;
- }
-
- for (;;)
- {
- char *cp, *bp, *ep;
-
- if (!ds_get_config_line (f, &line, &where))
- {
- if (ferror (f))
- msg (ME, _("Reading %s: %s."), pprsz_fn, strerror (errno));
- break;
- }
- for (cp = ds_c_str (&line); isspace ((unsigned char) *cp); cp++);
- if (*cp == 0)
- continue;
- if (*cp != '"')
- goto lex_error;
- for (bp = ep = cp + 1; *ep && *ep != '"'; ep++);
- if (!*ep)
- goto lex_error;
- *ep = 0;
- if (0 != strcasecmp (bp, size))
- continue;
-
- for (cp = ep + 1; isspace ((unsigned char) *cp); cp++);
- if (*cp == '=')
- {
- size = xmalloc (ep - bp + 1);
- strcpy (size, bp);
- free_it = 1;
- continue;
- }
- size = &ep[1];
- break;
-
- lex_error:
- msg (IE, _("Syntax error in paper size definition."));
- }
-
- /* We found the one we want! */
- result = internal_get_paper_size (size, h, v);
- if (result)
- {
- min_value = cache[0].use;
- min_index = 0;
- for (i = 1; i < 4; i++)
- if (cache[0].use < min_value)
- {
- min_value = cache[i].use;
- min_index = i;
- }
- free (cache[min_index].name);
- cache[min_index].name = xstrdup (size);
- cache[min_index].use = use;
- cache[min_index].h = *h;
- cache[min_index].v = *v;
- }
-
-exit:
- err_pop_file_locator (&where);
- ds_destroy (&line);
- if (free_it)
- free (size);
-
- if (result)
- msg (VM (2), _("Paper size definition file read successfully."));
- else
- msg (VM (1), _("Error reading paper size definition file."));
-
- return result;
-}
-
-/* If D is NULL, returns the first enabled driver if any, NULL if
- none. Otherwise D must be the last driver returned by this
- function, in which case the next enabled driver is returned or NULL
- if that was the last. */
-struct outp_driver *
-outp_drivers (struct outp_driver *d)
-{
-#if GLOBAL_DEBUGGING
- struct outp_driver *orig_d = d;
-#endif
-
- for (;;)
- {
- if (d == NULL)
- d = outp_driver_list;
- else
- d = d->next;
-
- if (d == NULL
- || (d->driver_open
- && (d->device == 0
- || (d->device & disabled_devices) != d->device)))
- break;
- }
-
-#if GLOBAL_DEBUGGING
- if (d && !orig_d)
- {
- if (iterating_driver_list++)
- reentrancy ();
- }
- else if (orig_d && !d)
- {
- assert (iterating_driver_list == 1);
- iterating_driver_list = 0;
- }
-#endif
-
- return d;
-}
-
-/* Enables (if ENABLE is nonzero) or disables (if ENABLE is zero) the
- device(s) given in mask DEVICE. */
-void
-outp_enable_device (int enable, int device)
-{
- if (enable)
- disabled_devices &= ~device;
- else
- disabled_devices |= device;
-}
-
-/* Ejects the paper on device D, if the page is not blank. */
-int
-outp_eject_page (struct outp_driver *d)
-{
- if (d->page_open == 0)
- return 1;
-
- if (d->cp_y != 0)
- {
- d->cp_x = d->cp_y = 0;
-
- if (d->class->close_page (d) == 0)
- msg (ME, _("Error closing page on %s device of %s class."),
- d->name, d->class->name);
- if (d->class->open_page (d) == 0)
- {
- msg (ME, _("Error opening page on %s device of %s class."),
- d->name, d->class->name);
- return 0;
- }
- }
- return 1;
-}
-
-/* Returns the width of string S, in device units, when output on
- device D. */
-int
-outp_string_width (struct outp_driver *d, const char *s)
-{
- struct outp_text text;
-
- text.options = OUTP_T_JUST_LEFT;
- ls_init (&text.s, (char *) s, strlen (s));
- d->class->text_metrics (d, &text);
-
- return text.h;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !output_h
-#define output_h 1
-
-#include "str.h"
-#include "config.h"
-
-#include "chart.h"
-
-/* A rectangle. */
-struct rect
- {
- int x1, y1; /* Upper left. */
- int x2, y2; /* Lower right, not part of the rectangle. */
- };
-
-/* Color descriptor. */
-struct color
- {
- int flags; /* 0=normal, 1=transparent (ignore r,g,b). */
- int r; /* Red component, 0-65535. */
- int g; /* Green component, 0-65535. */
- int b; /* Blue component, 0-65535. */
- };
-
-/* Mount positions for the four basic fonts. Do not change the values. */
-enum
- {
- OUTP_F_R, /* Roman font. */
- OUTP_F_I, /* Italic font. */
- OUTP_F_B, /* Bold font. */
- OUTP_F_BI /* Bold-italic font. */
- };
-
-/* Line styles. These must match:
- som.h:SLIN_*
- ascii.c:ascii_line_*()
- postscript.c:ps_line_*() */
-enum
- {
- OUTP_L_NONE = 0, /* No line. */
- OUTP_L_SINGLE = 1, /* Single line. */
- OUTP_L_DOUBLE = 2, /* Double line. */
- OUTP_L_SPECIAL = 3, /* Special line of driver-defined style. */
-
- OUTP_L_COUNT /* Number of line styles. */
- };
-
-/* Contains a line style for each part of an intersection. */
-struct outp_styles
- {
- int l; /* left */
- int t; /* top */
- int r; /* right */
- int b; /* bottom */
- };
-
-/* Text display options. */
-enum
- {
- OUTP_T_NONE = 0,
-
- /* Must match tab.h:TAB_*. */
- OUTP_T_JUST_MASK = 00003, /* Justification mask. */
- OUTP_T_JUST_RIGHT = 00000, /* Right justification. */
- OUTP_T_JUST_LEFT = 00001, /* Left justification. */
- OUTP_T_JUST_CENTER = 00002, /* Center justification. */
-
- OUTP_T_HORZ = 00010, /* Horizontal size is specified. */
- OUTP_T_VERT = 00020, /* (Max) vertical size is specified. */
-
- OUTP_T_0 = 00140, /* Normal orientation. */
- OUTP_T_CC90 = 00040, /* 90 degrees counterclockwise. */
- OUTP_T_CC180 = 00100, /* 180 degrees counterclockwise. */
- OUTP_T_CC270 = 00140, /* 270 degrees counterclockwise. */
- OUTP_T_C90 = 00140, /* 90 degrees clockwise. */
- OUTP_T_C180 = 00100, /* 180 degrees clockwise. */
- OUTP_T_C270 = 00040, /* 270 degrees clockwise. */
-
- /* Internal use by drivers only. */
- OUTP_T_INTERNAL_DRAW = 01000 /* 1=Draw the text, 0=Metrics only. */
- };
-
-/* Describes text output. */
-struct outp_text
- {
- /* Public. */
- int options; /* What is specified. */
- struct fixed_string s; /* String. */
- int h, v; /* Horizontal, vertical size. */
- int x, y; /* Position. */
-
- /* Internal use only. */
- int w, l; /* Width, length. */
- };
-
-struct som_entity;
-struct outp_driver;
-
-/* Defines a class of output driver. */
-struct outp_class
- {
- /* Basic class information. */
- const char *name; /* Name of this driver class. */
- int magic; /* Driver-specific constant. */
- int special; /* Boolean value. */
-
- /* Static member functions. */
- int (*open_global) (struct outp_class *);
- int (*close_global) (struct outp_class *);
- int *(*font_sizes) (struct outp_class *, int *n_valid_sizes);
-
- /* Virtual member functions. */
- int (*preopen_driver) (struct outp_driver *);
- void (*option) (struct outp_driver *, const char *key,
- const struct string *value);
- int (*postopen_driver) (struct outp_driver *);
- int (*close_driver) (struct outp_driver *);
-
- int (*open_page) (struct outp_driver *);
- int (*close_page) (struct outp_driver *);
-
- /* special != 0: Used to submit entities for output. */
- void (*submit) (struct outp_driver *, struct som_entity *);
-
- /* special != 0: Methods below need not be defined. */
-
- /* Line methods. */
- void (*line_horz) (struct outp_driver *, const struct rect *,
- const struct color *, int style);
- void (*line_vert) (struct outp_driver *, const struct rect *,
- const struct color *, int style);
- void (*line_intersection) (struct outp_driver *, const struct rect *,
- const struct color *,
- const struct outp_styles *style);
-
- /* Drawing methods. */
- void (*box) (struct outp_driver *, const struct rect *,
- const struct color *bord, const struct color *fill);
- void (*polyline_begin) (struct outp_driver *, const struct color *);
- void (*polyline_point) (struct outp_driver *, int, int);
- void (*polyline_end) (struct outp_driver *);
-
- /* Text methods. */
- void (*text_set_font_by_name) (struct outp_driver *, const char *s);
- void (*text_set_font_by_position) (struct outp_driver *, int);
- void (*text_set_font_family) (struct outp_driver *, const char *s);
- const char *(*text_get_font_name) (struct outp_driver *);
- const char *(*text_get_font_family) (struct outp_driver *);
- int (*text_set_size) (struct outp_driver *, int);
- int (*text_get_size) (struct outp_driver *, int *em_width);
- void (*text_metrics) (struct outp_driver *, struct outp_text *);
- void (*text_draw) (struct outp_driver *, struct outp_text *);
-
- void (*initialise_chart)(struct outp_driver *, struct chart *);
- void (*finalise_chart)(struct outp_driver *, struct chart *);
-
- };
-
-/* Device types. */
-enum
- {
- OUTP_DEV_NONE = 0, /* None of the below. */
- OUTP_DEV_LISTING = 001, /* Listing device. */
- OUTP_DEV_SCREEN = 002, /* Screen device. */
- OUTP_DEV_PRINTER = 004, /* Printer device. */
- OUTP_DEV_DISABLED = 010 /* Broken device. */
- };
-
-/* Defines the configuration of an output driver. */
-struct outp_driver
- {
- struct outp_class *class; /* Driver class. */
- char *name; /* Name of this driver. */
- int driver_open; /* 1=driver is open, 0=driver is closed. */
- int page_open; /* 1=page is open, 0=page is closed. */
-
- struct outp_driver *next, *prev; /* Next, previous output driver in list. */
-
- int device; /* Zero or more of OUTP_DEV_*. */
- int res, horiz, vert; /* Device resolution. */
- int width, length; /* Page size. */
-
- int cp_x, cp_y; /* Current position. */
- int font_height; /* Default font character height. */
- int prop_em_width; /* Proportional font em width. */
- int fixed_width; /* Fixed-pitch font character width. */
- int horiz_line_width[OUTP_L_COUNT]; /* Width of horizontal lines. */
- int vert_line_width[OUTP_L_COUNT]; /* Width of vertical lines. */
- int horiz_line_spacing[1 << OUTP_L_COUNT];
- int vert_line_spacing[1 << OUTP_L_COUNT];
-
- void *ext; /* Private extension record. */
- void *prc; /* Per-procedure extension record. */
- };
-
-/* Option structure for the keyword recognizer. */
-struct outp_option
- {
- const char *keyword; /* Keyword name. */
- int cat; /* Category. */
- int subcat; /* Subcategory. */
- };
-
-/* Information structure for the keyword recognizer. */
-struct outp_option_info
- {
- char *initial; /* Initial characters. */
- struct outp_option **options; /* Search starting points. */
- };
-
-/* A list of driver classes. */
-struct outp_driver_class_list
- {
- int ref_count;
- struct outp_class *class;
- struct outp_driver_class_list *next;
- };
-
-/* List of configured output drivers. */
-extern struct outp_driver *outp_driver_list;
-
-/* Title, subtitle. */
-extern char *outp_title;
-extern char *outp_subtitle;
-
-void outp_init (void);
-void outp_read_devices (void);
-void outp_done (void);
-
-void outp_configure_clear (void);
-void outp_configure_add (char *);
-void outp_configure_macro (char *);
-
-void outp_list_classes (void);
-
-void outp_enable_device (int enable, int device);
-struct outp_driver *outp_drivers (struct outp_driver *);
-
-int outp_match_keyword (const char *, struct outp_option *,
- struct outp_option_info *, int *);
-
-int outp_evaluate_dimension (char *, char **);
-int outp_get_paper_size (char *, int *h, int *v);
-
-int outp_eject_page (struct outp_driver *);
-
-int outp_string_width (struct outp_driver *, const char *);
-
-/* Imported from som-frnt.c. */
-void som_destroy_driver (struct outp_driver *);
-
-#endif /* output.h */
+++ /dev/null
-/* PSPP - A program for statistical analysis . -*-c-*-
-
-Copyright (C) 2004 Free Software Foundation, Inc.
-Author: John Darrington 2004
-
-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 the Free Software Foundation; either version 2 of the
-License, or (at your option) any later version.
-
-This program is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA. */
-
-#include <config.h>
-#include "factor_stats.h"
-#include "percentiles.h"
-#include "misc.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-#define N_(msgid) msgid
-
-#include <assert.h>
-
-
-struct ptile_params
-{
- double g1, g1_star;
- double g2, g2_star;
- int k1, k2;
-};
-
-
-const char *ptile_alg_desc[] = {
- "",
- N_("HAverage"),
- N_("Weighted Average"),
- N_("Rounded"),
- N_("Empirical"),
- N_("Empirical with averaging")
-};
-
-
-
-
-/* Individual Percentile algorithms */
-
-/* Closest observation to tc1 */
-double ptile_round(const struct weighted_value **wv,
- const struct ptile_params *par);
-
-
-/* Weighted average at y_tc2 */
-double ptile_haverage(const struct weighted_value **wv,
- const struct ptile_params *par);
-
-
-/* Weighted average at y_tc1 */
-double ptile_waverage(const struct weighted_value **wv,
- const struct ptile_params *par);
-
-
-/* Empirical distribution function */
-double ptile_empirical(const struct weighted_value **wv,
- const struct ptile_params *par);
-
-
-/* Empirical distribution function with averaging*/
-double ptile_aempirical(const struct weighted_value **wv,
- const struct ptile_params *par);
-
-
-
-
-/* Closest observation to tc1 */
-double
-ptile_round(const struct weighted_value **wv,
- const struct ptile_params *par)
-{
- double x;
- double a=0;
-
- if ( par->k1 >= 0 )
- a = wv[par->k1]->v.f;
-
- if ( wv[par->k1 + 1]->w >= 1 )
- {
- if ( par->g1_star < 0.5 )
- x = a;
- else
- x = wv[par->k1 + 1]->v.f;
- }
- else
- {
- if ( par->g1 < 0.5 )
- x = a;
- else
- x = wv[par->k1 + 1]->v.f;
-
- }
-
- return x;
-}
-
-/* Weighted average at y_tc2 */
-double
-ptile_haverage(const struct weighted_value **wv,
- const struct ptile_params *par)
-{
-
- double a=0;
-
- if ( par->g2_star >= 1.0 )
- return wv[par->k2 + 1]->v.f ;
-
- /* Special case for k2 + 1 >= n_data
- (actually it's not a special case, but just avoids indexing errors )
- */
- if ( par->g2_star == 0 )
- {
- assert(par->g2 == 0 );
- return wv[par->k2]->v.f;
- }
-
- /* Ditto for k2 < 0 */
- if ( par->k2 >= 0 )
- {
- a = wv[par->k2]->v.f;
- }
-
- if ( wv[par->k2 + 1]->w >= 1.0 )
- return ( (1 - par->g2_star) * a +
- par->g2_star * wv[par->k2 + 1]->v.f);
- else
- return ( (1 - par->g2) * a +
- par->g2 * wv[par->k2 + 1]->v.f);
-
-}
-
-
-
-/* Weighted average at y_tc1 */
-double
-ptile_waverage(const struct weighted_value **wv,
- const struct ptile_params *par)
-{
- double a=0;
-
- if ( par->g1_star >= 1.0 )
- return wv[par->k1 + 1]->v.f ;
-
- if ( par->k1 >= 0 )
- {
- a = wv[par->k1]->v.f;
- }
-
- if ( wv[par->k1 + 1]->w >= 1.0 )
- return ( (1 - par->g1_star) * a +
- par->g1_star * wv[par->k1 + 1]->v.f);
- else
- return ( (1 - par->g1) * a +
- par->g1 * wv[par->k1 + 1]->v.f);
-}
-
-
-/* Empirical distribution function */
-double
-ptile_empirical(const struct weighted_value **wv,
- const struct ptile_params *par)
-{
- if ( par->g1_star > 0 )
- return wv[par->k1 + 1]->v.f;
- else
- return wv[par->k1]->v.f;
-}
-
-
-
-/* Empirical distribution function with averageing */
-double
-ptile_aempirical(const struct weighted_value **wv,
- const struct ptile_params *par)
-{
- if ( par->g1_star > 0 )
- return wv[par->k1 + 1]->v.f;
- else
- return (wv[par->k1]->v.f + wv[par->k1 + 1]->v.f ) / 2.0 ;
-}
-
-
-
-/* Compute the percentile p */
-double ptile(double p,
- const struct weighted_value **wv,
- int n_data,
- double w,
- enum pc_alg algorithm);
-
-
-
-double
-ptile(double p,
- const struct weighted_value **wv,
- int n_data,
- double w,
- enum pc_alg algorithm)
-{
- int i;
- double tc1, tc2;
- double result;
-
- struct ptile_params pp;
-
- assert( p <= 1.0);
-
- tc1 = w * p ;
- tc2 = (w + 1) * p ;
-
- pp.k1 = -1;
- pp.k2 = -1;
-
- for ( i = 0 ; i < n_data ; ++i )
- {
- if ( wv[i]->cc <= tc1 )
- pp.k1 = i;
-
- if ( wv[i]->cc <= tc2 )
- pp.k2 = i;
-
- }
-
-
- if ( pp.k1 >= 0 )
- {
- pp.g1 = ( tc1 - wv[pp.k1]->cc ) / wv[pp.k1 + 1]->w;
- pp.g1_star = tc1 - wv[pp.k1]->cc ;
- }
- else
- {
- pp.g1 = tc1 / wv[pp.k1 + 1]->w;
- pp.g1_star = tc1 ;
- }
-
-
- if ( pp.k2 + 1 >= n_data )
- {
- pp.g2 = 0 ;
- pp.g2_star = 0;
- }
- else
- {
- if ( pp.k2 >= 0 )
- {
- pp.g2 = ( tc2 - wv[pp.k2]->cc ) / wv[pp.k2 + 1]->w;
- pp.g2_star = tc2 - wv[pp.k2]->cc ;
- }
- else
- {
- pp.g2 = tc2 / wv[pp.k2 + 1]->w;
- pp.g2_star = tc2 ;
- }
- }
-
- switch ( algorithm )
- {
- case PC_HAVERAGE:
- result = ptile_haverage(wv, &pp);
- break;
- case PC_WAVERAGE:
- result = ptile_waverage(wv, &pp);
- break;
- case PC_ROUND:
- result = ptile_round(wv, &pp);
- break;
- case PC_EMPIRICAL:
- result = ptile_empirical(wv, &pp);
- break;
- case PC_AEMPIRICAL:
- result = ptile_aempirical(wv, &pp);
- break;
- default:
- result = SYSMIS;
- }
-
- return result;
-}
-
-
-/*
- Calculate the values of the percentiles in pc_hash.
- wv is a sorted array of weighted values of the data set.
-*/
-void
-ptiles(struct hsh_table *pc_hash,
- const struct weighted_value **wv,
- int n_data,
- double w,
- enum pc_alg algorithm)
-{
- struct hsh_iterator hi;
- struct percentile *p;
-
- if ( !pc_hash )
- return ;
- for ( p = hsh_first(pc_hash, &hi);
- p != 0 ;
- p = hsh_next(pc_hash, &hi))
- {
- p->v = ptile(p->p/100.0 , wv, n_data, w, algorithm);
- }
-
-}
-
-
-/* Calculate Tukey's Hinges */
-void
-tukey_hinges(const struct weighted_value **wv,
- int n_data,
- double w,
- double hinge[3]
- )
-{
- int i;
- double c_star = DBL_MAX;
- double d;
- double l[3];
- int h[3];
- double a, a_star;
-
- for ( i = 0 ; i < n_data ; ++i )
- {
- c_star = min(c_star, wv[i]->w);
- }
-
- if ( c_star > 1 ) c_star = 1;
-
- d = floor((w/c_star + 3 ) / 2.0)/ 2.0;
-
- l[0] = d*c_star;
- l[1] = w/2.0 + c_star/2.0;
- l[2] = w + c_star - d*c_star;
-
- h[0]=-1;
- h[1]=-1;
- h[2]=-1;
-
- for ( i = 0 ; i < n_data ; ++i )
- {
- if ( l[0] >= wv[i]->cc ) h[0] = i ;
- if ( l[1] >= wv[i]->cc ) h[1] = i ;
- if ( l[2] >= wv[i]->cc ) h[2] = i ;
- }
-
- for ( i = 0 ; i < 3 ; i++ )
- {
-
- if ( h[i] >= 0 )
- a_star = l[i] - wv[h[i]]->cc ;
- else
- a_star = l[i];
-
- if ( h[i] + 1 >= n_data )
- {
- assert( a_star < 1 ) ;
- hinge[i] = (1 - a_star) * wv[h[i]]->v.f;
- continue;
- }
- else
- {
- a = a_star / ( wv[h[i] + 1]->cc ) ;
- }
-
- if ( a_star >= 1.0 )
- {
- hinge[i] = wv[h[i] + 1]->v.f ;
- continue;
- }
-
- if ( wv[h[i] + 1]->w >= 1)
- {
- hinge[i] = ( 1 - a_star) * wv[h[i]]->v.f
- + a_star * wv[h[i] + 1]->v.f;
-
- continue;
- }
-
- hinge[i] = (1 - a) * wv[h[i]]->v.f + a * wv[h[i] + 1]->v.f;
-
- }
-
- assert(hinge[0] <= hinge[1]);
- assert(hinge[1] <= hinge[2]);
-
-}
-
-
-int
-ptile_compare(const struct percentile *p1,
- const struct percentile *p2,
- void *aux UNUSED)
-{
-
- int cmp;
-
- if ( p1->p == p2->p)
- cmp = 0 ;
- else if (p1->p < p2->p)
- cmp = -1 ;
- else
- cmp = +1;
-
- return cmp;
-}
-
-unsigned
-ptile_hash(const struct percentile *p, void *aux UNUSED)
-{
- return hsh_hash_double(p->p);
-}
-
-
+++ /dev/null
-/* PSPP - A program for statistical analysis . -*-c-*-
-
-Copyright (C) 2004 Free Software Foundation, Inc.
-Author: John Darrington 2004
-
-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 the Free Software Foundation; either version 2 of the
-License, or (at your option) any later version.
-
-This program is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA. */
-
-#ifndef PERCENTILES_H
-#define PERCENTILES_H
-
-
-#include "hash.h"
-
-struct weighted_value ;
-
-/* The algorithm used to calculate percentiles */
-enum pc_alg {
- PC_NONE=0,
- PC_HAVERAGE,
- PC_WAVERAGE,
- PC_ROUND,
- PC_EMPIRICAL,
- PC_AEMPIRICAL
-} ;
-
-
-
-extern const char *ptile_alg_desc[];
-
-
-
-
-struct percentile {
-
- /* The break point of the percentile */
- double p;
-
- /* The value of the percentile */
- double v;
-};
-
-
-/* Calculate the percentiles of the break points in pc_bp,
- placing the values in pc_val.
- wv is a sorted array of weighted values of the data set.
-*/
-void ptiles(struct hsh_table *pc_hash,
- const struct weighted_value **wv,
- int n_data,
- double w,
- enum pc_alg algorithm);
-
-
-/* Calculate Tukey's Hinges and the Whiskers for the box plot*/
-void tukey_hinges(const struct weighted_value **wv,
- int n_data,
- double w,
- double hinges[3]);
-
-
-
-/* Hash utility functions */
-int ptile_compare(const struct percentile *p1,
- const struct percentile *p2,
- void *aux);
-
-unsigned ptile_hash(const struct percentile *p, void *aux);
-
-
-#endif
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Author: John Darrington
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <stdlib.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <unistd.h>
-#include <errno.h>
-#include "settings.h"
-#include "command.h"
-#include "error.h"
-#include "lexer.h"
-#include "misc.h"
-#include "stat-macros.h"
-#include "str.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-enum PER {PER_RO, PER_RW};
-
-int change_permissions(const char *filename, enum PER per);
-
-
-/* Parses the PERMISSIONS command. */
-int
-cmd_permissions (void)
-{
- char *fn = 0;
-
- lex_match ('/');
-
- if (lex_match_id ("FILE"))
- lex_match ('=');
-
- fn = strdup(ds_c_str(&tokstr));
- lex_force_match(T_STRING);
-
-
- lex_match ('/');
-
- if ( ! lex_match_id ("PERMISSIONS"))
- goto error;
-
- lex_match('=');
-
- if ( lex_match_id("READONLY"))
- {
- if ( ! change_permissions(fn, PER_RO ) )
- goto error;
- }
- else if ( lex_match_id("WRITEABLE"))
- {
- if ( ! change_permissions(fn, PER_RW ) )
- goto error;
- }
- else
- {
- msg(ME, _("Expecting %s or %s."), "WRITEABLE", "READONLY");
- goto error;
- }
-
- free(fn);
-
- return CMD_SUCCESS;
-
- error:
-
- free(fn);
-
- return CMD_FAILURE;
-}
-
-
-
-int
-change_permissions(const char *filename, enum PER per)
-{
- struct stat buf;
- mode_t mode;
-
- if (get_safer_mode ())
- {
- msg (SE, _("This command not allowed when the SAFER option is set."));
- return CMD_FAILURE;
- }
-
-
- if ( -1 == stat(filename, &buf) )
- {
- const int errnum = errno;
- msg(ME,_("Cannot stat %s: %s"), filename, strerror(errnum));
- return 0;
- }
-
- if ( per == PER_RW )
- mode = buf.st_mode | S_IWUSR ;
- else
- mode = buf.st_mode & ~( S_IWOTH | S_IWUSR | S_IWGRP );
-
- if ( -1 == chmod(filename, mode))
-
- {
- const int errnum = errno;
- msg(ME,_("Cannot change mode of %s: %s"), filename, strerror(errnum));
- return 0;
- }
-
- return 1;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
- Code for parsing floating-point numbers adapted from GNU C
- library.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "pfm-read.h"
-#include "error.h"
-#include <stdarg.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <ctype.h>
-#include <errno.h>
-#include <math.h>
-#include <setjmp.h>
-#include "alloc.h"
-#include <stdbool.h>
-#include "case.h"
-#include "dictionary.h"
-#include "file-handle.h"
-#include "format.h"
-#include "getl.h"
-#include "hash.h"
-#include "magic.h"
-#include "misc.h"
-#include "pool.h"
-#include "str.h"
-#include "value-labels.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-/* portable_to_local[PORTABLE] translates the given portable
- character into the local character set. */
-static const char portable_to_local[256] =
- {
- " "
- "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz ."
- "<(+|&[]!$*);^-/|,%_>?`:$@'=\" ~- 0123456789 -() {}\\ "
- " "
- };
-
-/* Portable file reader. */
-struct pfm_reader
- {
- struct pool *pool; /* All the portable file state. */
-
- jmp_buf bail_out; /* longjmp() target for error handling. */
-
- struct file_handle *fh; /* File handle. */
- FILE *file; /* File stream. */
- char cc; /* Current character. */
- char *trans; /* 256-byte character set translation table. */
- int var_cnt; /* Number of variables. */
- int weight_index; /* 0-based index of weight variable, or -1. */
- int *widths; /* Variable widths, 0 for numeric. */
- int value_cnt; /* Number of `value's per case. */
- };
-
-static void
-error (struct pfm_reader *r, const char *msg,...)
- PRINTF_FORMAT (2, 3);
-
-/* Displays MSG as an error message and aborts reading the
- portable file via longjmp(). */
-static void
-error (struct pfm_reader *r, const char *msg, ...)
-{
- struct error e;
- const char *filename;
- char *title;
- va_list args;
-
- e.class = ME;
- getl_location (&e.where.filename, &e.where.line_number);
- filename = fh_get_filename (r->fh);
- e.title = title = pool_alloc (r->pool, strlen (filename) + 80);
- sprintf (title, _("portable file %s corrupt at offset %ld: "),
- filename, ftell (r->file));
-
- va_start (args, msg);
- err_vmsg (&e, msg, args);
- va_end (args);
-
- longjmp (r->bail_out, 1);
-}
-
-/* Closes portable file reader R, after we're done with it. */
-void
-pfm_close_reader (struct pfm_reader *r)
-{
- if (r != NULL)
- pool_destroy (r->pool);
-}
-
-/* Read a single character into cur_char. */
-static void
-advance (struct pfm_reader *r)
-{
- int c;
-
- while ((c = getc (r->file)) == '\r' || c == '\n')
- continue;
- if (c == EOF)
- error (r, _("unexpected end of file"));
-
- if (r->trans != NULL)
- c = r->trans[c];
- r->cc = c;
-}
-
-/* Skip a single character if present, and return whether it was
- skipped. */
-static inline bool
-match (struct pfm_reader *r, int c)
-{
- if (r->cc == c)
- {
- advance (r);
- return true;
- }
- else
- return false;
-}
-
-static void read_header (struct pfm_reader *);
-static void read_version_data (struct pfm_reader *, struct pfm_read_info *);
-static void read_variables (struct pfm_reader *, struct dictionary *);
-static void read_value_label (struct pfm_reader *, struct dictionary *);
-void dump_dictionary (struct dictionary *);
-
-/* Reads the dictionary from file with handle H, and returns it in a
- dictionary structure. This dictionary may be modified in order to
- rename, reorder, and delete variables, etc. */
-struct pfm_reader *
-pfm_open_reader (struct file_handle *fh, struct dictionary **dict,
- struct pfm_read_info *info)
-{
- struct pool *volatile pool = NULL;
- struct pfm_reader *volatile r = NULL;
-
- *dict = dict_create ();
- if (!fh_open (fh, FH_REF_FILE, "portable file", "rs"))
- goto error;
-
- /* Create and initialize reader. */
- pool = pool_create ();
- r = pool_alloc (pool, sizeof *r);
- r->pool = pool;
- if (setjmp (r->bail_out))
- goto error;
- r->fh = fh;
- r->file = pool_fopen (r->pool, fh_get_filename (r->fh), "rb");
- r->weight_index = -1;
- r->trans = NULL;
- r->var_cnt = 0;
- r->widths = NULL;
- r->value_cnt = 0;
-
- /* Check that file open succeeded, prime reading. */
- if (r->file == NULL)
- {
- msg (ME, _("An error occurred while opening \"%s\" for reading "
- "as a portable file: %s."),
- fh_get_filename (r->fh), strerror (errno));
- err_cond_fail ();
- goto error;
- }
-
- /* Read header, version, date info, product id, variables. */
- read_header (r);
- read_version_data (r, info);
- read_variables (r, *dict);
-
- /* Read value labels. */
- while (match (r, 'D'))
- read_value_label (r, *dict);
-
- /* Check that we've made it to the data. */
- if (!match (r, 'F'))
- error (r, _("Data record expected."));
-
- return r;
-
- error:
- pfm_close_reader (r);
- dict_destroy (*dict);
- *dict = NULL;
- return NULL;
-}
-\f
-/* Returns the value of base-30 digit C,
- or -1 if C is not a base-30 digit. */
-static int
-base_30_value (unsigned char c)
-{
- static const char base_30_digits[] = "0123456789ABCDEFGHIJKLMNOPQRST";
- const char *p = strchr (base_30_digits, c);
- return p != NULL ? p - base_30_digits : -1;
-}
-
-/* Read a floating point value and return its value. */
-static double
-read_float (struct pfm_reader *r)
-{
- double num = 0.;
- int exponent = 0;
- bool got_dot = false; /* Seen a decimal point? */
- bool got_digit = false; /* Seen any digits? */
- bool negative = false; /* Number is negative? */
-
- /* Skip leading spaces. */
- while (match (r, ' '))
- continue;
-
- /* `*' indicates system-missing. */
- if (match (r, '*'))
- {
- advance (r); /* Probably a dot (.) but doesn't appear to matter. */
- return SYSMIS;
- }
-
- negative = match (r, '-');
- for (;;)
- {
- int digit = base_30_value (r->cc);
- if (digit != -1)
- {
- got_digit = true;
-
- /* Make sure that multiplication by 30 will not overflow. */
- if (num > DBL_MAX * (1. / 30.))
- /* The value of the digit doesn't matter, since we have already
- gotten as many digits as can be represented in a `double'.
- This doesn't necessarily mean the result will overflow.
- The exponent may reduce it to within range.
-
- We just need to record that there was another
- digit so that we can multiply by 10 later. */
- ++exponent;
- else
- num = (num * 30.0) + digit;
-
- /* Keep track of the number of digits after the decimal point.
- If we just divided by 30 here, we would lose precision. */
- if (got_dot)
- --exponent;
- }
- else if (!got_dot && r->cc == '.')
- /* Record that we have found the decimal point. */
- got_dot = 1;
- else
- /* Any other character terminates the number. */
- break;
-
- advance (r);
- }
-
- /* Check that we had some digits. */
- if (!got_digit)
- error (r, "Number expected.");
-
- /* Get exponent if any. */
- if (r->cc == '+' || r->cc == '-')
- {
- long int exp = 0;
- bool negative_exponent = r->cc == '-';
- int digit;
-
- for (advance (r); (digit = base_30_value (r->cc)) != -1; advance (r))
- {
- if (exp > LONG_MAX / 30)
- {
- exp = LONG_MAX;
- break;
- }
- exp = exp * 30 + digit;
- }
-
- /* We don't check whether there were actually any digits, but we
- probably should. */
- if (negative_exponent)
- exp = -exp;
- exponent += exp;
- }
-
- /* Numbers must end with `/'. */
- if (!match (r, '/'))
- error (r, _("Missing numeric terminator."));
-
- /* Multiply `num' by 30 to the `exponent' power, checking for
- overflow. */
- if (exponent < 0)
- num *= pow (30.0, (double) exponent);
- else if (exponent > 0)
- {
- if (num > DBL_MAX * pow (30.0, (double) -exponent))
- num = DBL_MAX;
- else
- num *= pow (30.0, (double) exponent);
- }
-
- return negative ? -num : num;
-}
-
-/* Read an integer and return its value. */
-static int
-read_int (struct pfm_reader *r)
-{
- double f = read_float (r);
- if (floor (f) != f || f >= INT_MAX || f <= INT_MIN)
- error (r, _("Invalid integer."));
- return f;
-}
-
-/* Reads a string into BUF, which must have room for 256
- characters. */
-static void
-read_string (struct pfm_reader *r, char *buf)
-{
- int n = read_int (r);
- if (n < 0 || n > 255)
- error (r, _("Bad string length %d."), n);
-
- while (n-- > 0)
- {
- *buf++ = r->cc;
- advance (r);
- }
- *buf = '\0';
-}
-
-/* Reads a string and returns a copy of it allocated from R's
- pool. */
-static char *
-read_pool_string (struct pfm_reader *r)
-{
- char string[256];
- read_string (r, string);
- return pool_strdup (r->pool, string);
-}
-\f
-/* Reads the 464-byte file header. */
-static void
-read_header (struct pfm_reader *r)
-{
- char *trans;
- int i;
-
- /* Read and ignore vanity splash strings. */
- for (i = 0; i < 200; i++)
- advance (r);
-
- /* Skip the first 64 characters of the translation table.
- We don't care about these. They are probably all set to
- '0', marking them as untranslatable, and that would screw
- up our actual translation of the real '0'. */
- for (i = 0; i < 64; i++)
- advance (r);
-
- /* Read the rest of the translation table. */
- trans = pool_malloc (r->pool, 256);
- memset (trans, 0, 256);
- for (; i < 256; i++)
- {
- unsigned char c;
-
- advance (r);
-
- c = r->cc;
- if (trans[c] == 0)
- trans[c] = portable_to_local[i];
- }
-
- /* Set up the translation table, then read the first
- translated character. */
- r->trans = trans;
- advance (r);
-
- /* Skip and verify signature. */
- for (i = 0; i < 8; i++)
- if (!match (r, "SPSSPORT"[i]))
- {
- msg (SE, _("%s: Not a portable file."), fh_get_filename (r->fh));
- longjmp (r->bail_out, 1);
- }
-}
-
-/* Reads the version and date info record, as well as product and
- subproduct identification records if present. */
-static void
-read_version_data (struct pfm_reader *r, struct pfm_read_info *info)
-{
- static char empty_string[] = "";
- char *date, *time, *product, *author, *subproduct;
- int i;
-
- /* Read file. */
- if (!match (r, 'A'))
- error (r, "Unrecognized version code `%c'.", r->cc);
- date = read_pool_string (r);
- time = read_pool_string (r);
- product = match (r, '1') ? read_pool_string (r) : empty_string;
- author = match (r, '2') ? read_pool_string (r) : empty_string;
- subproduct = match (r, '3') ? read_pool_string (r) : empty_string;
-
- /* Validate file. */
- if (strlen (date) != 8)
- error (r, _("Bad date string length %d."), strlen (date));
- if (strlen (time) != 6)
- error (r, _("Bad time string length %d."), strlen (time));
-
- /* Save file info. */
- if (info != NULL)
- {
- /* Date. */
- for (i = 0; i < 8; i++)
- {
- static const int map[] = {6, 7, 8, 9, 3, 4, 0, 1};
- info->creation_date[map[i]] = date[i];
- }
- info->creation_date[2] = info->creation_date[5] = ' ';
- info->creation_date[10] = 0;
-
- /* Time. */
- for (i = 0; i < 6; i++)
- {
- static const int map[] = {0, 1, 3, 4, 6, 7};
- info->creation_time[map[i]] = time[i];
- }
- info->creation_time[2] = info->creation_time[5] = ' ';
- info->creation_time[8] = 0;
-
- /* Product. */
- str_copy_trunc (info->product, sizeof info->product, product);
- str_copy_trunc (info->subproduct, sizeof info->subproduct, subproduct);
- }
-}
-
-/* Translates a format specification read from portable file R as
- the three integers INTS into a normal format specifier FORMAT,
- checking that the format is appropriate for variable V. */
-static void
-convert_format (struct pfm_reader *r, const int portable_format[3],
- struct fmt_spec *format, struct variable *v)
-{
- format->type = translate_fmt (portable_format[0]);
- if (format->type == -1)
- error (r, _("%s: Bad format specifier byte (%d)."),
- v->name, portable_format[0]);
- format->w = portable_format[1];
- format->d = portable_format[2];
-
- if (!check_output_specifier (format, false)
- || !check_specifier_width (format, v->width, false))
- error (r, _("%s variable %s has invalid format specifier %s."),
- v->type == NUMERIC ? _("Numeric") : _("String"),
- v->name, fmt_to_string (format));
-}
-
-static union value parse_value (struct pfm_reader *, struct variable *);
-
-/* Read information on all the variables. */
-static void
-read_variables (struct pfm_reader *r, struct dictionary *dict)
-{
- char *weight_name = NULL;
- int i;
-
- if (!match (r, '4'))
- error (r, _("Expected variable count record."));
-
- r->var_cnt = read_int (r);
- if (r->var_cnt <= 0 || r->var_cnt == NOT_INT)
- error (r, _("Invalid number of variables %d."), r->var_cnt);
- r->widths = pool_nalloc (r->pool, r->var_cnt, sizeof *r->widths);
-
- /* Purpose of this value is unknown. It is typically 161. */
- read_int (r);
-
- if (match (r, '6'))
- {
- weight_name = read_pool_string (r);
- if (strlen (weight_name) > SHORT_NAME_LEN)
- error (r, _("Weight variable name (%s) truncated."), weight_name);
- }
-
- for (i = 0; i < r->var_cnt; i++)
- {
- int width;
- char name[256];
- int fmt[6];
- struct variable *v;
- int j;
-
- if (!match (r, '7'))
- error (r, _("Expected variable record."));
-
- width = read_int (r);
- if (width < 0)
- error (r, _("Invalid variable width %d."), width);
- r->widths[i] = width;
-
- read_string (r, name);
- for (j = 0; j < 6; j++)
- fmt[j] = read_int (r);
-
- if (!var_is_valid_name (name, false) || *name == '#' || *name == '$')
- error (r, _("position %d: Invalid variable name `%s'."), i, name);
- str_uppercase (name);
-
- if (width < 0 || width > 255)
- error (r, "Bad width %d for variable %s.", width, name);
-
- v = dict_create_var (dict, name, width);
- if (v == NULL)
- error (r, _("Duplicate variable name %s."), name);
-
- convert_format (r, &fmt[0], &v->print, v);
- convert_format (r, &fmt[3], &v->write, v);
-
- /* Range missing values. */
- if (match (r, 'B'))
- {
- double x = read_float (r);
- double y = read_float (r);
- mv_add_num_range (&v->miss, x, y);
- }
- else if (match (r, 'A'))
- mv_add_num_range (&v->miss, read_float (r), HIGHEST);
- else if (match (r, '9'))
- mv_add_num_range (&v->miss, LOWEST, read_float (r));
-
- /* Single missing values. */
- while (match (r, '8'))
- {
- union value value = parse_value (r, v);
- mv_add_value (&v->miss, &value);
- }
-
- if (match (r, 'C'))
- {
- char label[256];
- read_string (r, label);
- v->label = xstrdup (label);
- }
- }
-
- if (weight_name != NULL)
- {
- struct variable *weight_var = dict_lookup_var (dict, weight_name);
- if (weight_var == NULL)
- error (r, _("Weighting variable %s not present in dictionary."),
- weight_name);
-
- dict_set_weight (dict, weight_var);
- }
-}
-
-/* Parse a value for variable VV into value V. */
-static union value
-parse_value (struct pfm_reader *r, struct variable *vv)
-{
- union value v;
-
- if (vv->type == ALPHA)
- {
- char string[256];
- read_string (r, string);
- buf_copy_str_rpad (v.s, 8, string);
- }
- else
- v.f = read_float (r);
-
- return v;
-}
-
-/* Parse a value label record and return success. */
-static void
-read_value_label (struct pfm_reader *r, struct dictionary *dict)
-{
- /* Variables. */
- int nv;
- struct variable **v;
-
- /* Labels. */
- int n_labels;
-
- int i;
-
- nv = read_int (r);
- v = pool_nalloc (r->pool, nv, sizeof *v);
- for (i = 0; i < nv; i++)
- {
- char name[256];
- read_string (r, name);
-
- v[i] = dict_lookup_var (dict, name);
- if (v[i] == NULL)
- error (r, _("Unknown variable %s while parsing value labels."), name);
-
- if (v[0]->width != v[i]->width)
- error (r, _("Cannot assign value labels to %s and %s, which "
- "have different variable types or widths."),
- v[0]->name, v[i]->name);
- }
-
- n_labels = read_int (r);
- for (i = 0; i < n_labels; i++)
- {
- union value val;
- char label[256];
- int j;
-
- val = parse_value (r, v[0]);
- read_string (r, label);
-
- /* Assign the value_label's to each variable. */
- for (j = 0; j < nv; j++)
- {
- struct variable *var = v[j];
-
- if (!val_labs_replace (var->val_labs, val, label))
- continue;
-
- if (var->type == NUMERIC)
- error (r, _("Duplicate label for value %g for variable %s."),
- val.f, var->name);
- else
- error (r, _("Duplicate label for value `%.*s' for variable %s."),
- var->width, val.s, var->name);
- }
- }
-}
-
-/* Reads one case from portable file R into C. */
-bool
-pfm_read_case (struct pfm_reader *r, struct ccase *c)
-{
- size_t i;
- size_t idx;
-
- if (setjmp (r->bail_out))
- return false;
-
- /* Check for end of file. */
- if (r->cc == 'Z')
- return false;
-
- idx = 0;
- for (i = 0; i < r->var_cnt; i++)
- {
- int width = r->widths[i];
-
- if (width == 0)
- {
- case_data_rw (c, idx)->f = read_float (r);
- idx++;
- }
- else
- {
- char string[256];
- read_string (r, string);
- buf_copy_str_rpad (case_data_rw (c, idx)->s, width, string);
- idx += DIV_RND_UP (width, MAX_SHORT_STRING);
- }
- }
-
- return true;
-}
-
-/* Returns true if FILE is an SPSS portable file,
- false otherwise. */
-bool
-pfm_detect (FILE *file)
-{
- unsigned char header[464];
- char trans[256];
- int cooked_cnt, raw_cnt;
- int i;
-
- cooked_cnt = raw_cnt = 0;
- while (cooked_cnt < sizeof header)
- {
- int c = getc (file);
- if (c == EOF || raw_cnt++ > 512)
- return false;
- else if (c != '\n' && c != '\r')
- header[cooked_cnt++] = c;
- }
-
- memset (trans, 0, 256);
- for (i = 64; i < 256; i++)
- {
- unsigned char c = header[i + 200];
- if (trans[c] == 0)
- trans[c] = portable_to_local[i];
- }
-
- for (i = 0; i < 8; i++)
- if (trans[header[i + 456]] != "SPSSPORT"[i])
- return false;
-
- return true;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef PFM_READ_H
-#define PFM_READ_H
-
-/* Portable file reading. */
-
-#include <stdbool.h>
-#include <stdio.h>
-
-/* Information produced by pfm_read_dictionary() that doesn't fit into
- a dictionary struct. */
-struct pfm_read_info
- {
- char creation_date[11]; /* `dd mm yyyy' plus a null. */
- char creation_time[9]; /* `hh:mm:ss' plus a null. */
- char product[61]; /* Product name plus a null. */
- char subproduct[61]; /* Subproduct name plus a null. */
- };
-
-struct dictionary;
-struct file_handle;
-struct ccase;
-struct pfm_reader *pfm_open_reader (struct file_handle *,
- struct dictionary **,
- struct pfm_read_info *);
-bool pfm_read_case (struct pfm_reader *, struct ccase *);
-void pfm_close_reader (struct pfm_reader *);
-bool pfm_detect (FILE *);
-
-#endif /* pfm-read.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "pfm-write.h"
-#include "error.h"
-#include <ctype.h>
-#include <errno.h>
-#include <fcntl.h>
-#include <float.h>
-#include <math.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <sys/stat.h>
-#include <time.h>
-#include <unistd.h>
-#include "alloc.h"
-#include "case.h"
-#include "dictionary.h"
-#include "error.h"
-#include "file-handle.h"
-#include "hash.h"
-#include "magic.h"
-#include "misc.h"
-#include "stat-macros.h"
-#include "str.h"
-#include "value-labels.h"
-#include "var.h"
-#include "version.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-/* Portable file writer. */
-struct pfm_writer
- {
- struct file_handle *fh; /* File handle. */
- FILE *file; /* File stream. */
-
- int lc; /* Number of characters on this line so far. */
-
- size_t var_cnt; /* Number of variables. */
- struct pfm_var *vars; /* Variables. */
-
- int digits; /* Digits of precision. */
- };
-
-/* A variable to write to the portable file. */
-struct pfm_var
- {
- int width; /* 0=numeric, otherwise string var width. */
- int fv; /* Starting case index. */
- };
-
-static int buf_write (struct pfm_writer *, const void *, size_t);
-static int write_header (struct pfm_writer *);
-static int write_version_data (struct pfm_writer *);
-static int write_variables (struct pfm_writer *, struct dictionary *);
-static int write_value_labels (struct pfm_writer *, const struct dictionary *);
-
-static void format_trig_double (long double, int base_10_precision, char[]);
-static char *format_trig_int (int, bool force_sign, char[]);
-
-/* Returns default options for writing a portable file. */
-struct pfm_write_options
-pfm_writer_default_options (void)
-{
- struct pfm_write_options opts;
- opts.create_writeable = true;
- opts.type = PFM_COMM;
- opts.digits = DBL_DIG;
- return opts;
-}
-
-/* Writes the dictionary DICT to portable file HANDLE according
- to the given OPTS. Returns nonzero only if successful. DICT
- will not be modified, except to assign short names. */
-struct pfm_writer *
-pfm_open_writer (struct file_handle *fh, struct dictionary *dict,
- struct pfm_write_options opts)
-{
- struct pfm_writer *w = NULL;
- mode_t mode;
- int fd;
- size_t i;
-
- /* Create file. */
- mode = S_IRUSR | S_IRGRP | S_IROTH;
- if (opts.create_writeable)
- mode |= S_IWUSR | S_IWGRP | S_IWOTH;
- fd = open (fh_get_filename (fh), O_WRONLY | O_CREAT | O_TRUNC, mode);
- if (fd < 0)
- goto open_error;
-
- /* Open file handle. */
- if (!fh_open (fh, FH_REF_FILE, "portable file", "we"))
- goto error;
-
- /* Initialize data structures. */
- w = xmalloc (sizeof *w);
- w->fh = fh;
- w->file = fdopen (fd, "w");
- if (w->file == NULL)
- {
- close (fd);
- goto open_error;
- }
-
- w->lc = 0;
- w->var_cnt = 0;
- w->vars = NULL;
-
- w->var_cnt = dict_get_var_cnt (dict);
- w->vars = xnmalloc (w->var_cnt, sizeof *w->vars);
- for (i = 0; i < w->var_cnt; i++)
- {
- const struct variable *dv = dict_get_var (dict, i);
- struct pfm_var *pv = &w->vars[i];
- pv->width = dv->width;
- pv->fv = dv->fv;
- }
-
- w->digits = opts.digits;
- if (w->digits < 1)
- {
- msg (ME, _("Invalid decimal digits count %d. Treating as %d."),
- w->digits, DBL_DIG);
- w->digits = DBL_DIG;
- }
-
- /* Write file header. */
- if (!write_header (w)
- || !write_version_data (w)
- || !write_variables (w, dict)
- || !write_value_labels (w, dict)
- || !buf_write (w, "F", 1))
- goto error;
-
- return w;
-
- error:
- pfm_close_writer (w);
- return NULL;
-
- open_error:
- msg (ME, _("An error occurred while opening \"%s\" for writing "
- "as a portable file: %s."),
- fh_get_filename (fh), strerror (errno));
- err_cond_fail ();
- goto error;
-}
-\f
-/* Write NBYTES starting at BUF to the portable file represented by
- H. Break lines properly every 80 characters. */
-static int
-buf_write (struct pfm_writer *w, const void *buf_, size_t nbytes)
-{
- const char *buf = buf_;
-
- assert (buf != NULL);
- while (nbytes + w->lc >= 80)
- {
- size_t n = 80 - w->lc;
-
- if (n && fwrite (buf, n, 1, w->file) != 1)
- goto error;
-
- if (fwrite ("\r\n", 2, 1, w->file) != 1)
- goto error;
-
- nbytes -= n;
- buf += n;
- w->lc = 0;
- }
-
- if (nbytes && 1 != fwrite (buf, nbytes, 1, w->file))
- goto error;
- w->lc += nbytes;
-
- return 1;
-
- error:
- msg (ME, _("%s: Writing portable file: %s."),
- fh_get_filename (w->fh), strerror (errno));
- return 0;
-}
-
-/* Write D to the portable file as a floating-point field, and return
- success. */
-static int
-write_float (struct pfm_writer *w, double d)
-{
- char buffer[64];
- format_trig_double (d, floor (d) == d ? DBL_DIG : w->digits, buffer);
- return buf_write (w, buffer, strlen (buffer)) && buf_write (w, "/", 1);
-}
-
-/* Write N to the portable file as an integer field, and return success. */
-static int
-write_int (struct pfm_writer *w, int n)
-{
- char buffer[64];
- format_trig_int (n, false, buffer);
- return buf_write (w, buffer, strlen (buffer)) && buf_write (w, "/", 1);
-}
-
-/* Write S to the portable file as a string field. */
-static int
-write_string (struct pfm_writer *w, const char *s)
-{
- size_t n = strlen (s);
- return write_int (w, (int) n) && buf_write (w, s, n);
-}
-\f
-/* Write file header. */
-static int
-write_header (struct pfm_writer *w)
-{
- /* PORTME. */
- {
- int i;
-
- for (i = 0; i < 5; i++)
- if (!buf_write (w, "ASCII SPSS PORT FILE ", 40))
- return 0;
- }
-
- {
- /* PORTME: Translation table from SPSS character code to this
- computer's native character code (which is probably ASCII). */
- static const char spss2ascii[256] =
- {
- "0000000000000000000000000000000000000000000000000000000000000000"
- "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz ."
- "<(+|&[]!$*);^-/|,%_>?`:$@'=\"000000~-0000123456789000-()0{}\\00000"
- "0000000000000000000000000000000000000000000000000000000000000000"
- };
-
- if (!buf_write (w, spss2ascii, 256))
- return 0;
- }
-
- if (!buf_write (w, "SPSSPORT", 8))
- return 0;
-
- return 1;
-}
-
-/* Writes version, date, and identification records. */
-static int
-write_version_data (struct pfm_writer *w)
-{
- if (!buf_write (w, "A", 1))
- return 0;
-
- {
- char date_str[9];
- char time_str[7];
- time_t t;
- struct tm tm;
- struct tm *tmp;
-
- if ((time_t) -1 == time (&t))
- {
- tm.tm_sec = tm.tm_min = tm.tm_hour = tm.tm_mon = tm.tm_year = 0;
- tm.tm_mday = 1;
- tmp = &tm;
- }
- else
- tmp = localtime (&t);
-
- sprintf (date_str, "%04d%02d%02d",
- tmp->tm_year + 1900, tmp->tm_mon + 1, tmp->tm_mday);
- sprintf (time_str, "%02d%02d%02d", tmp->tm_hour, tmp->tm_min, tmp->tm_sec);
- if (!write_string (w, date_str) || !write_string (w, time_str))
- return 0;
- }
-
- /* Product identification. */
- if (!buf_write (w, "1", 1) || !write_string (w, version))
- return 0;
-
- /* Subproduct identification. */
- if (!buf_write (w, "3", 1) || !write_string (w, host_system))
- return 0;
-
- return 1;
-}
-
-/* Write format F to file H, and return success. */
-static int
-write_format (struct pfm_writer *w, struct fmt_spec *f)
-{
- return (write_int (w, formats[f->type].spss)
- && write_int (w, f->w)
- && write_int (w, f->d));
-}
-
-/* Write value V for variable VV to file H, and return success. */
-static int
-write_value (struct pfm_writer *w, union value *v, struct variable *vv)
-{
- if (vv->type == NUMERIC)
- return write_float (w, v->f);
- else
- return write_int (w, vv->width) && buf_write (w, v->s, vv->width);
-}
-
-/* Write variable records, and return success. */
-static int
-write_variables (struct pfm_writer *w, struct dictionary *dict)
-{
- int i;
-
- dict_assign_short_names (dict);
-
- if (!buf_write (w, "4", 1) || !write_int (w, dict_get_var_cnt (dict))
- || !write_int (w, 161))
- return 0;
-
- for (i = 0; i < dict_get_var_cnt (dict); i++)
- {
- struct variable *v = dict_get_var (dict, i);
- struct missing_values mv;
-
- if (!buf_write (w, "7", 1) || !write_int (w, v->width)
- || !write_string (w, v->short_name)
- || !write_format (w, &v->print) || !write_format (w, &v->write))
- return 0;
-
- /* Write missing values. */
- mv_copy (&mv, &v->miss);
- while (mv_has_range (&mv))
- {
- double x, y;
- mv_pop_range (&mv, &x, &y);
- if (x == LOWEST)
- {
- if (!buf_write (w, "9", 1) || !write_float (w, y))
- return 0;
- }
- else if (y == HIGHEST)
- {
- if (!buf_write (w, "A", 1) || !write_float (w, y))
- return 0;
- }
- else {
- if (!buf_write (w, "B", 1) || !write_float (w, x)
- || !write_float (w, y))
- return 0;
- }
- }
- while (mv_has_value (&mv))
- {
- union value value;
- mv_pop_value (&mv, &value);
- if (!buf_write (w, "8", 1) || !write_value (w, &value, v))
- return 0;
- }
-
- if (v->label && (!buf_write (w, "C", 1) || !write_string (w, v->label)))
- return 0;
- }
-
- return 1;
-}
-
-/* Write value labels to disk. FIXME: Inefficient. */
-static int
-write_value_labels (struct pfm_writer *w, const struct dictionary *dict)
-{
- int i;
-
- for (i = 0; i < dict_get_var_cnt (dict); i++)
- {
- struct val_labs_iterator *j;
- struct variable *v = dict_get_var (dict, i);
- struct val_lab *vl;
-
- if (!val_labs_count (v->val_labs))
- continue;
-
- if (!buf_write (w, "D", 1)
- || !write_int (w, 1)
- || !write_string (w, v->short_name)
- || !write_int (w, val_labs_count (v->val_labs)))
- return 0;
-
- for (vl = val_labs_first_sorted (v->val_labs, &j); vl != NULL;
- vl = val_labs_next (v->val_labs, &j))
- if (!write_value (w, &vl->value, v)
- || !write_string (w, vl->label))
- {
- val_labs_done (&j);
- return 0;
- }
- }
-
- return 1;
-}
-
-/* Writes case ELEM to the portable file represented by H. Returns
- success. */
-int
-pfm_write_case (struct pfm_writer *w, const struct ccase *c)
-{
- int i;
-
- for (i = 0; i < w->var_cnt; i++)
- {
- struct pfm_var *v = &w->vars[i];
-
- if (v->width == 0)
- {
- if (!write_float (w, case_num (c, v->fv)))
- return 0;
- }
- else
- {
- if (!write_int (w, v->width)
- || !buf_write (w, case_str (c, v->fv), v->width))
- return 0;
- }
- }
-
- return 1;
-}
-
-/* Closes a portable file after we're done with it. */
-void
-pfm_close_writer (struct pfm_writer *w)
-{
- if (w == NULL)
- return;
-
- if (w->file != NULL)
- {
- char buf[80];
-
- int n = 80 - w->lc;
- if (n == 0)
- n = 80;
-
- memset (buf, 'Z', n);
- buf_write (w, buf, n);
-
- if (fclose (w->file) == EOF)
- msg (ME, _("%s: Closing portable file: %s."),
- fh_get_filename (w->fh), strerror (errno));
- }
-
- fh_close (w->fh, "portable file", "we");
-
- free (w->vars);
- free (w);
-}
-\f
-/* Base-30 conversion.
-
- Portable files represent numbers in base-30 format, so we need
- to be able to convert real and integer number to that base.
- Older versions of PSPP used libgmp to do so, but this added a
- big library dependency to do just one thing. Now we do it
- ourselves internally.
-
- Important fact: base 30 is called "trigesimal". */
-
-/* Conversion base. */
-#define BASE 30 /* As an integer. */
-#define LDBASE ((long double) BASE) /* As a long double. */
-
-/* This is floor(log30(2**31)), the minimum number of trigesimal
- digits that a `long int' can hold. */
-#define CHUNK_SIZE 6
-
-/* pow_tab[i] = pow (30, pow (2, i)) */
-static long double pow_tab[16];
-
-/* Initializes pow_tab[]. */
-static void
-init_pow_tab (void)
-{
- static bool did_init = false;
- long double power;
- size_t i;
-
- /* Only initialize once. */
- if (did_init)
- return;
- did_init = true;
-
- /* Set each element of pow_tab[] until we run out of numerical
- range. */
- i = 0;
- for (power = 30.0L; power < DBL_MAX; power *= power)
- {
- assert (i < sizeof pow_tab / sizeof *pow_tab);
- pow_tab[i++] = power;
- }
-}
-
-/* Returns 30**EXPONENT, for 0 <= EXPONENT <= log30(DBL_MAX). */
-static long double
-pow30_nonnegative (int exponent)
-{
- long double power;
- int i;
-
- assert (exponent >= 0);
- assert (exponent < 1L << (sizeof pow_tab / sizeof *pow_tab));
-
- power = 1.L;
- for (i = 0; exponent > 0; exponent >>= 1, i++)
- if (exponent & 1)
- power *= pow_tab[i];
-
- return power;
-}
-
-/* Returns 30**EXPONENT, for log30(DBL_MIN) <= EXPONENT <=
- log30(DBL_MAX). */
-static long double
-pow30 (int exponent)
-{
- if (exponent >= 0)
- return pow30_nonnegative (exponent);
- else
- return 1.L / pow30_nonnegative (-exponent);
-}
-
-/* Returns the character corresponding to TRIG. */
-static int
-trig_to_char (int trig)
-{
- assert (trig >= 0 && trig < 30);
- return "0123456789ABCDEFGHIJKLMNOPQRST"[trig];
-}
-
-/* Formats the TRIG_CNT trigs in TRIGS[], writing them as
- null-terminated STRING. The trigesimal point is inserted
- after TRIG_PLACES characters have been printed, if necessary
- adding extra zeros at either end for correctness. Returns the
- character after the formatted number. */
-static char *
-format_trig_digits (char *string,
- const char trigs[], int trig_cnt, int trig_places)
-{
- if (trig_places < 0)
- {
- *string++ = '.';
- while (trig_places++ < 0)
- *string++ = '0';
- trig_places = -1;
- }
- while (trig_cnt-- > 0)
- {
- if (trig_places-- == 0)
- *string++ = '.';
- *string++ = trig_to_char (*trigs++);
- }
- while (trig_places-- > 0)
- *string++ = '0';
- *string = '\0';
- return string;
-}
-
-/* Helper function for format_trig_int() that formats VALUE as a
- trigesimal integer at CP. VALUE must be nonnegative.
- Returns the character following the formatted integer. */
-static char *
-recurse_format_trig_int (char *cp, int value)
-{
- int trig = value % BASE;
- value /= BASE;
- if (value > 0)
- cp = recurse_format_trig_int (cp, value);
- *cp++ = trig_to_char (trig);
- return cp;
-}
-
-/* Formats VALUE as a trigesimal integer in null-terminated
- STRING[]. VALUE must be in the range -DBL_MAX...DBL_MAX. If
- FORCE_SIGN is true, a sign is always inserted; otherwise, a
- sign is only inserted if VALUE is negative. */
-static char *
-format_trig_int (int value, bool force_sign, char string[])
-{
- /* Insert sign. */
- if (value < 0)
- {
- *string++ = '-';
- value = -value;
- }
- else if (force_sign)
- *string++ = '+';
-
- /* Format integer. */
- string = recurse_format_trig_int (string, value);
- *string = '\0';
- return string;
-}
-
-/* Determines whether the TRIG_CNT trigesimals in TRIGS[] warrant
- rounding up or down. Returns true if TRIGS[] represents a
- value greater than half, false if less than half. If TRIGS[]
- is exactly half, examines TRIGS[-1] and returns true if odd,
- false if even ("round to even"). */
-static bool
-should_round_up (const char trigs[], int trig_cnt)
-{
- assert (trig_cnt > 0);
-
- if (*trigs < BASE / 2)
- {
- /* Less than half: round down. */
- return false;
- }
- else if (*trigs > BASE / 2)
- {
- /* Greater than half: round up. */
- return true;
- }
- else
- {
- /* Approximately half: look more closely. */
- int i;
- for (i = 1; i < trig_cnt; i++)
- if (trigs[i] > 0)
- {
- /* Slightly greater than half: round up. */
- return true;
- }
-
- /* Exactly half: round to even. */
- return trigs[-1] % 2;
- }
-}
-
-/* Rounds up the rightmost trig in the TRIG_CNT trigs in TRIGS[],
- carrying to the left as necessary. Returns true if
- successful, false on failure (due to a carry out of the
- leftmost position). */
-static bool
-try_round_up (char *trigs, int trig_cnt)
-{
- while (trig_cnt > 0)
- {
- char *round_trig = trigs + --trig_cnt;
- if (*round_trig != BASE - 1)
- {
- /* Round this trig up to the next value. */
- ++*round_trig;
- return true;
- }
-
- /* Carry over to the next trig to the left. */
- *round_trig = 0;
- }
-
- /* Ran out of trigs to carry. */
- return false;
-}
-
-/* Converts VALUE to trigesimal format in string OUTPUT[] with the
- equivalent of at least BASE_10_PRECISION decimal digits of
- precision. The output format may use conventional or
- scientific notation. Missing, infinite, and extreme values
- are represented with "*.". */
-static void
-format_trig_double (long double value, int base_10_precision, char output[])
-{
- /* Original VALUE was negative? */
- bool negative;
-
- /* Number of significant trigesimals. */
- int base_30_precision;
-
- /* Base-2 significand and exponent for original VALUE. */
- double base_2_sig;
- int base_2_exp;
-
- /* VALUE as a set of trigesimals. */
- char buffer[DBL_DIG + 16];
- char *trigs;
- int trig_cnt;
-
- /* Number of trigesimal places for trigs.
- trigs[0] has coefficient 30**(trig_places - 1),
- trigs[1] has coefficient 30**(trig_places - 2),
- and so on.
- In other words, the trigesimal point is just before trigs[0].
- */
- int trig_places;
-
- /* Number of trigesimal places left to write into BUFFER. */
- int trigs_to_output;
-
- init_pow_tab ();
-
- /* Handle special cases. */
- if (value == SYSMIS)
- goto missing_value;
- if (value == 0.)
- goto zero;
-
- /* Make VALUE positive. */
- if (value < 0)
- {
- value = -value;
- negative = true;
- }
- else
- negative = false;
-
- /* Adjust VALUE to roughly 30**3, by shifting the trigesimal
- point left or right as necessary. We approximate the
- base-30 exponent by obtaining the base-2 exponent, then
- multiplying by log30(2). This approximation is sufficient
- to ensure that the adjusted VALUE is always in the range
- 0...30**6, an invariant of the loop below. */
- errno = 0;
- base_2_sig = frexp (value, &base_2_exp);
- if (errno != 0 || !finite (base_2_sig))
- goto missing_value;
- if (base_2_exp == 0 && base_2_sig == 0.)
- goto zero;
- if (base_2_exp <= INT_MIN / 20379L || base_2_exp >= INT_MAX / 20379L)
- goto missing_value;
- trig_places = (base_2_exp * 20379L / 100000L) + CHUNK_SIZE / 2;
- value *= pow30 (CHUNK_SIZE - trig_places);
-
- /* Dump all the trigs to buffer[], CHUNK_SIZE at a time. */
- trigs = buffer;
- trig_cnt = 0;
- for (trigs_to_output = DIV_RND_UP (DBL_DIG * 2, 3) + 1 + (CHUNK_SIZE / 2);
- trigs_to_output > 0;
- trigs_to_output -= CHUNK_SIZE)
- {
- long chunk;
- int trigs_left;
-
- /* The current chunk is just the integer part of VALUE,
- truncated to the nearest integer. The chunk fits in a
- long. */
- chunk = value;
- assert (pow30 (CHUNK_SIZE) <= LONG_MAX);
- assert (chunk >= 0 && chunk < pow30 (CHUNK_SIZE));
-
- value -= chunk;
-
- /* Append the chunk, in base 30, to trigs[]. */
- for (trigs_left = CHUNK_SIZE; chunk > 0 && trigs_left > 0; )
- {
- trigs[trig_cnt + --trigs_left] = chunk % 30;
- chunk /= 30;
- }
- while (trigs_left > 0)
- trigs[trig_cnt + --trigs_left] = 0;
- trig_cnt += CHUNK_SIZE;
-
- /* Proceed to the next chunk. */
- if (value == 0.)
- break;
- value *= pow (LDBASE, CHUNK_SIZE);
- }
-
- /* Strip leading zeros. */
- while (trig_cnt > 1 && *trigs == 0)
- {
- trigs++;
- trig_cnt--;
- trig_places--;
- }
-
- /* Round to requested precision, conservatively estimating the
- required base-30 precision as 2/3 of the base-10 precision
- (log30(10) = .68). */
- assert (base_10_precision > 0);
- if (base_10_precision > LDBL_DIG)
- base_10_precision = LDBL_DIG;
- base_30_precision = DIV_RND_UP (base_10_precision * 2, 3);
- if (trig_cnt > base_30_precision)
- {
- if (should_round_up (trigs + base_30_precision,
- trig_cnt - base_30_precision))
- {
- /* Try to round up. */
- if (try_round_up (trigs, base_30_precision))
- {
- /* Rounding up worked. */
- trig_cnt = base_30_precision;
- }
- else
- {
- /* Couldn't round up because we ran out of trigs to
- carry into. Do the carry here instead. */
- *trigs = 1;
- trig_cnt = 1;
- trig_places++;
- }
- }
- else
- {
- /* Round down. */
- trig_cnt = base_30_precision;
- }
- }
- else
- {
- /* No rounding required: fewer digits available than
- requested. */
- }
-
- /* Strip trailing zeros. */
- while (trig_cnt > 1 && trigs[trig_cnt - 1] == 0)
- trig_cnt--;
-
- /* Write output. */
- if (negative)
- *output++ = '-';
- if (trig_places >= -1 && trig_places < trig_cnt + 3)
- {
- /* Use conventional notation. */
- format_trig_digits (output, trigs, trig_cnt, trig_places);
- }
- else
- {
- /* Use scientific notation. */
- char *op;
- op = format_trig_digits (output, trigs, trig_cnt, trig_cnt);
- op = format_trig_int (trig_places - trig_cnt, true, op);
- }
- return;
-
- zero:
- strcpy (output, "0");
- return;
-
- missing_value:
- strcpy (output, "*.");
- return;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef PFM_WRITE_H
-#define PFM_WRITE_H
-
-#include <stdbool.h>
-
-/* Portable file writing. */
-
-/* Portable file types. */
-enum pfm_type
- {
- PFM_COMM, /* Formatted for communication. */
- PFM_TAPE /* Formatted for tape. */
- };
-
-/* Portable file writing options. */
-struct pfm_write_options
- {
- bool create_writeable; /* File perms: writeable or read/only? */
- enum pfm_type type; /* Type of portable file (TODO). */
- int digits; /* Digits of precision. */
- };
-
-struct file_handle;
-struct dictionary;
-struct ccase;
-struct pfm_writer *pfm_open_writer (struct file_handle *, struct dictionary *,
- struct pfm_write_options);
-struct pfm_write_options pfm_writer_default_options (void);
-
-int pfm_write_case (struct pfm_writer *, const struct ccase *);
-void pfm_close_writer (struct pfm_writer *);
-
-#endif /* pfm-write.h */
+++ /dev/null
-/* PSPP - draws pie charts of sample statistics
-
-Copyright (C) 2004 Free Software Foundation, Inc.
-Written by John Darrington <john@darrington.wattle.id.au>
-
-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 the Free Software Foundation; either version 2 of the
-License, or (at your option) any later version.
-
-This program is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA. */
-
-
-#include "config.h"
-#include "chart.h"
-#include <float.h>
-#include <assert.h>
-#include <math.h>
-#include <stdio.h>
-#include "str.h"
-#include "value-labels.h"
-#include "misc.h"
-
-
-/* Pie charts of course need to know Pi :) */
-#ifndef M_PI
-#define M_PI ( 22.0 / 7.0 )
-#endif
-
-
-
-/* Draw a single slice of the pie */
-static void
-draw_segment(struct chart *ch,
- double centre_x, double centre_y,
- double radius,
- double start_angle, double segment_angle,
- const char *colour) ;
-
-
-
-/* Draw a piechart */
-void
-piechart_plot(const char *title, const struct slice *slices, int n_slices)
-{
- int i;
- double total_magnetude=0;
-
- struct chart *ch = chart_create();
-
- const double left_label = ch->data_left +
- (ch->data_right - ch->data_left)/10.0;
-
- const double right_label = ch->data_right -
- (ch->data_right - ch->data_left)/10.0;
-
- const double centre_x = (ch->data_right + ch->data_left ) / 2.0 ;
- const double centre_y = (ch->data_top + ch->data_bottom ) / 2.0 ;
-
- const double radius = min(
- 5.0 / 12.0 * (ch->data_top - ch->data_bottom),
- 1.0 / 4.0 * (ch->data_right - ch->data_left)
- );
-
-
- chart_write_title(ch, title);
-
- for (i = 0 ; i < n_slices ; ++i )
- total_magnetude += slices[i].magnetude;
-
- for (i = 0 ; i < n_slices ; ++i )
- {
- static double angle=0.0;
-
- const double segment_angle =
- slices[i].magnetude / total_magnetude * 2 * M_PI ;
-
- const double label_x = centre_x -
- radius * sin(angle + segment_angle/2.0);
-
- const double label_y = centre_y +
- radius * cos(angle + segment_angle/2.0);
-
- /* Fill the segment */
- draw_segment(ch,
- centre_x, centre_y, radius,
- angle, segment_angle,
- data_colour[i]);
-
- /* Now add the labels */
- if ( label_x < centre_x )
- {
- pl_line_r(ch->lp, label_x, label_y,
- left_label, label_y );
- pl_moverel_r(ch->lp,0,5);
- pl_alabel_r(ch->lp,0,0,slices[i].label);
- }
- else
- {
- pl_line_r(ch->lp,
- label_x, label_y,
- right_label, label_y
- );
- pl_moverel_r(ch->lp,0,5);
- pl_alabel_r(ch->lp,'r',0,slices[i].label);
- }
-
- angle += segment_angle;
-
- }
-
- /* Draw an outline to the pie */
- pl_filltype_r(ch->lp,0);
- pl_fcircle_r (ch->lp, centre_x, centre_y, radius);
-
- chart_submit(ch);
-}
-
-static void
-fill_segment(struct chart *ch,
- double x0, double y0,
- double radius,
- double start_angle, double segment_angle) ;
-
-
-/* Fill a segment with the current fill colour */
-static void
-fill_segment(struct chart *ch,
- double x0, double y0,
- double radius,
- double start_angle, double segment_angle)
-{
-
- const double start_x = x0 - radius * sin(start_angle);
- const double start_y = y0 + radius * cos(start_angle);
-
- const double stop_x =
- x0 - radius * sin(start_angle + segment_angle);
-
- const double stop_y =
- y0 + radius * cos(start_angle + segment_angle);
-
- assert(segment_angle <= 2 * M_PI);
- assert(segment_angle >= 0);
-
- if ( segment_angle > M_PI )
- {
- /* Then we must draw it in two halves */
- fill_segment(ch, x0, y0, radius, start_angle, segment_angle / 2.0 );
- fill_segment(ch, x0, y0, radius, start_angle + segment_angle / 2.0,
- segment_angle / 2.0 );
- }
- else
- {
- pl_move_r(ch->lp, x0, y0);
-
- pl_cont_r(ch->lp, stop_x, stop_y);
- pl_cont_r(ch->lp, start_x, start_y);
-
- pl_arc_r(ch->lp,
- x0, y0,
- stop_x, stop_y,
- start_x, start_y
- );
-
- pl_endpath_r(ch->lp);
- }
-}
-
-
-
-/* Draw a single slice of the pie */
-static void
-draw_segment(struct chart *ch,
- double x0, double y0,
- double radius,
- double start_angle, double segment_angle,
- const char *colour)
-{
- const double start_x = x0 - radius * sin(start_angle);
- const double start_y = y0 + radius * cos(start_angle);
-
- pl_savestate_r(ch->lp);
-
- pl_savestate_r(ch->lp);
- pl_colorname_r(ch->lp, colour);
-
- pl_pentype_r(ch->lp,1);
- pl_filltype_r(ch->lp,1);
-
- fill_segment(ch, x0, y0, radius, start_angle, segment_angle);
- pl_restorestate_r(ch->lp);
-
- /* Draw line dividing segments */
- pl_pentype_r(ch->lp, 1);
- pl_fline_r(ch->lp, x0, y0, start_x, start_y);
-
-
- pl_restorestate_r(ch->lp);
-}
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <stdio.h>
-#include <plot.h>
-#include <stdarg.h>
-#include <string.h>
-#include <stdio.h>
-#include <float.h>
-#include <assert.h>
-#include <math.h>
-
-#include "chart.h"
-#include "str.h"
-#include "alloc.h"
-#include "som.h"
-#include "output.h"
-
-
-const char *data_colour[] = {
- "brown",
- "red",
- "orange",
- "yellow",
- "green",
- "blue",
- "violet",
- "grey",
- "pink"
-};
-
-
-
-struct chart *
-chart_create(void)
-{
- struct chart *chart;
- struct outp_driver *d;
-
- d = outp_drivers (NULL);
- if (d == NULL)
- return NULL;
-
- chart = xmalloc (sizeof *chart);
- d->class->initialise_chart(d, chart);
- if (!chart->lp)
- {
- free (chart);
- return NULL;
- }
-
- if (pl_openpl_r (chart->lp) < 0) /* open Plotter */
- return NULL;
-
- pl_fspace_r (chart->lp, 0.0, 0.0, 1000.0, 1000.0); /* set coordinate system */
- pl_flinewidth_r (chart->lp, 0.25); /* set line thickness */
- pl_pencolorname_r (chart->lp, "black");
-
- pl_erase_r (chart->lp); /* erase graphics display */
- pl_filltype_r(chart->lp,0);
-
- pl_savestate_r(chart->lp);
-
- /* Set default chartetry */
- chart->data_top = 900;
- chart->data_right = 800;
- chart->data_bottom = 120;
- chart->data_left = 150;
- chart->abscissa_top = 70;
- chart->ordinate_right = 120;
- chart->title_bottom = 920;
- chart->legend_left = 810;
- chart->legend_right = 1000;
- chart->font_size = 0;
- strcpy(chart->fill_colour,"red");
-
- /* Get default font size */
- if ( !chart->font_size)
- chart->font_size = pl_fontsize_r(chart->lp, -1);
-
- /* Draw the data area */
- pl_box_r(chart->lp,
- chart->data_left, chart->data_bottom,
- chart->data_right, chart->data_top);
-
- return chart;
-}
-
-/* Draw a tick mark at position
- If label is non zero, then print it at the tick mark
-*/
-void
-draw_tick(struct chart *chart,
- enum tick_orientation orientation,
- double position,
- const char *label, ...)
-{
- const int tickSize = 10;
-
- assert(chart);
-
- pl_savestate_r(chart->lp);
-
- pl_move_r(chart->lp, chart->data_left, chart->data_bottom);
-
- if ( orientation == TICK_ABSCISSA )
- pl_flinerel_r(chart->lp, position, 0, position, -tickSize);
- else if (orientation == TICK_ORDINATE )
- pl_flinerel_r(chart->lp, 0, position, -tickSize, position);
- else
- assert(0);
-
- if ( label ) {
- char buf[10];
- va_list ap;
- va_start(ap,label);
- vsnprintf(buf,10,label,ap);
-
- if ( orientation == TICK_ABSCISSA )
- pl_alabel_r(chart->lp, 'c','t', buf);
- else if (orientation == TICK_ORDINATE )
- {
- if ( fabs(position) < DBL_EPSILON )
- pl_moverel_r(chart->lp, 0, 10);
-
- pl_alabel_r(chart->lp, 'r','c', buf);
- }
-
- va_end(ap);
- }
-
- pl_restorestate_r(chart->lp);
-}
-
-
-
-
-/* Write the title on a chart*/
-void
-chart_write_title(struct chart *chart, const char *title, ...)
-{
- va_list ap;
- char buf[100];
-
- if ( ! chart )
- return ;
-
- pl_savestate_r(chart->lp);
- pl_ffontsize_r(chart->lp,chart->font_size * 1.5);
- pl_move_r(chart->lp,chart->data_left, chart->title_bottom);
-
- va_start(ap,title);
- vsnprintf(buf,100,title,ap);
- pl_alabel_r(chart->lp,0,0,buf);
- va_end(ap);
-
- pl_restorestate_r(chart->lp);
-}
-
-
-extern struct som_table_class tab_table_class;
-
-void
-chart_submit(struct chart *chart)
-{
- struct som_entity s;
- struct outp_driver *d;
-
- if ( ! chart )
- return ;
-
- pl_restorestate_r(chart->lp);
-
- s.class = &tab_table_class;
- s.ext = chart;
- s.type = SOM_CHART;
- som_submit (&s);
-
- if (pl_closepl_r (chart->lp) < 0) /* close Plotter */
- {
- fprintf (stderr, "Couldn't close Plotter\n");
- }
-
- pl_deletepl_r(chart->lp);
-
- pl_deleteplparams(chart->pl_params);
-
- d = outp_drivers (NULL);
- d->class->finalise_chart(d, chart);
- free(chart);
-}
-
-
-/* Set the scale for the abscissa */
-void
-chart_write_xscale(struct chart *ch, double min, double max, int ticks)
-{
- double x;
-
- const double tick_interval =
- chart_rounded_tick( (max - min) / (double) ticks);
-
- assert ( ch );
-
-
- ch->x_max = ceil( max / tick_interval ) * tick_interval ;
- ch->x_min = floor ( min / tick_interval ) * tick_interval ;
-
-
- ch->abscissa_scale = fabs(ch->data_right - ch->data_left) /
- fabs(ch->x_max - ch->x_min);
-
- for(x = ch->x_min ; x <= ch->x_max; x += tick_interval )
- {
- draw_tick (ch, TICK_ABSCISSA,
- (x - ch->x_min) * ch->abscissa_scale, "%g", x);
- }
-
-}
-
-
-/* Set the scale for the ordinate */
-void
-chart_write_yscale(struct chart *ch, double smin, double smax, int ticks)
-{
- double y;
-
- const double tick_interval =
- chart_rounded_tick( (smax - smin) / (double) ticks);
-
-
- if ( !ch )
- return;
-
- ch->y_max = ceil ( smax / tick_interval ) * tick_interval ;
- ch->y_min = floor ( smin / tick_interval ) * tick_interval ;
-
- ch->ordinate_scale =
- fabs(ch->data_top - ch->data_bottom) / fabs(ch->y_max - ch->y_min) ;
-
- for(y = ch->y_min ; y <= ch->y_max; y += tick_interval )
- {
- draw_tick (ch, TICK_ORDINATE,
- (y - ch->y_min) * ch->ordinate_scale, "%g", y);
- }
-
-}
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2004 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-/* If you add/modify any public symbols in this file, don't forget to
- change the stubs in dummy-chart.c */
-
-#include <config.h>
-
-#include <stdio.h>
-#include <plot.h>
-#include <math.h>
-#include <gsl/gsl_histogram.h>
-#include <gsl/gsl_randist.h>
-#include <assert.h>
-#include "hash.h"
-#include "var.h"
-#include "chart.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* Write the legend of the chart */
-void
-histogram_write_legend(struct chart *ch, const struct normal_curve *norm)
-{
- char buf[100];
- if ( !ch )
- return ;
-
- pl_savestate_r(ch->lp);
-
- sprintf(buf,"N = %.2f",norm->N);
- pl_move_r(ch->lp, ch->legend_left, ch->data_bottom);
- pl_alabel_r(ch->lp,0,'b',buf);
-
- sprintf(buf,"Mean = %.1f",norm->mean);
- pl_fmove_r(ch->lp,ch->legend_left,ch->data_bottom + ch->font_size * 1.5);
- pl_alabel_r(ch->lp,0,'b',buf);
-
- sprintf(buf,"Std. Dev = %.2f",norm->stddev);
- pl_fmove_r(ch->lp,ch->legend_left,ch->data_bottom + ch->font_size * 1.5 * 2);
- pl_alabel_r(ch->lp,0,'b',buf);
-
- pl_restorestate_r(ch->lp);
-}
-
-static void hist_draw_bar(struct chart *ch, const gsl_histogram *hist, int bar);
-
-
-static void
-hist_draw_bar(struct chart *ch, const gsl_histogram *hist, int bar)
-{
- if ( !ch )
- return ;
-
-
- {
- double upper;
- double lower;
- double height;
-
- const size_t bins = gsl_histogram_bins(hist);
- const double x_pos = (ch->data_right - ch->data_left) * bar / (double) bins ;
- const double width = (ch->data_right - ch->data_left) / (double) bins ;
-
-
- assert ( 0 == gsl_histogram_get_range(hist, bar, &lower, &upper));
-
- assert( upper >= lower);
-
- height = gsl_histogram_get(hist, bar) *
- (ch->data_top - ch->data_bottom) / gsl_histogram_max_val(hist);
-
- pl_savestate_r(ch->lp);
- pl_move_r(ch->lp,ch->data_left, ch->data_bottom);
- pl_fillcolorname_r(ch->lp, ch->fill_colour);
- pl_filltype_r(ch->lp,1);
-
-
- pl_fboxrel_r(ch->lp,
- x_pos, 0,
- x_pos + width, height);
-
- pl_restorestate_r(ch->lp);
-
- {
- char buf[5];
- snprintf(buf,5,"%g",(upper + lower) / 2.0);
- draw_tick(ch, TICK_ABSCISSA,
- x_pos + width / 2.0, buf);
- }
- }
-}
-
-
-
-
-void
-histogram_plot(const gsl_histogram *hist,
- const char *factorname,
- const struct normal_curve *norm, short show_normal)
-{
- int i;
- int bins;
-
- struct chart *ch;
-
- ch = chart_create();
- chart_write_title(ch, _("HISTOGRAM"));
-
- chart_write_ylabel(ch, _("Frequency"));
- chart_write_xlabel(ch, factorname);
-
- if ( ! hist ) /* If this happens, probably all values are SYSMIS */
- {
- chart_submit(ch);
- return ;
- }
- else
- {
- bins = gsl_histogram_bins(hist);
- }
-
- chart_write_yscale(ch, 0, gsl_histogram_max_val(hist), 5);
-
- for ( i = 0 ; i < bins ; ++i )
- hist_draw_bar(ch, hist, i);
-
- histogram_write_legend(ch, norm);
-
- if ( show_normal )
- {
- /* Draw the normal curve */
-
- double d ;
- double x_min, x_max, not_used ;
- double abscissa_scale ;
- double ordinate_scale ;
- double range ;
-
- gsl_histogram_get_range(hist, 0, &x_min, ¬_used);
- range = not_used - x_min;
- gsl_histogram_get_range(hist, bins - 1, ¬_used, &x_max);
- assert(range == x_max - not_used);
-
- abscissa_scale = (ch->data_right - ch->data_left) / (x_max - x_min);
- ordinate_scale = (ch->data_top - ch->data_bottom) /
- gsl_histogram_max_val(hist) ;
-
- pl_move_r(ch->lp, ch->data_left, ch->data_bottom);
- for( d = ch->data_left;
- d <= ch->data_right ;
- d += (ch->data_right - ch->data_left) / 100.0)
- {
- const double x = (d - ch->data_left) / abscissa_scale + x_min ;
- const double y = norm->N * range *
- gsl_ran_gaussian_pdf(x - norm->mean, norm->stddev);
-
- pl_fcont_r(ch->lp, d, ch->data_bottom + y * ordinate_scale);
-
- }
- pl_endpath_r(ch->lp);
-
- }
- chart_submit(ch);
-}
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "pool.h"
-#include <stdlib.h>
-#include "alloc.h"
-#include "command.h"
-#include "error.h"
-#include "size_max.h"
-#include "str.h"
-
-/* Fast, low-overhead memory block suballocator. */
-struct pool
- {
- struct pool *parent; /* Pool of which this pool is a subpool. */
- struct pool_block *blocks; /* Blocks owned by the pool. */
- struct pool_gizmo *gizmos; /* Other stuff owned by the pool. */
- };
-
-/* Pool block. */
-struct pool_block
- {
- struct pool_block *prev;
- struct pool_block *next;
- size_t ofs;
- };
-
-/* Gizmo types. */
-enum
- {
- POOL_GIZMO_MALLOC,
- POOL_GIZMO_FILE,
- POOL_GIZMO_SUBPOOL,
- POOL_GIZMO_REGISTERED,
- };
-
-/* Pool routines can maintain objects (`gizmos') as well as doing
- suballocation.
- This structure is used to keep track of them. */
-struct pool_gizmo
- {
- struct pool *pool;
- struct pool_gizmo *prev;
- struct pool_gizmo *next;
-
- long serial; /* Serial number. */
- int type; /* Type of this gizmo. */
-
- /* Type-dependent info. */
- union
- {
- FILE *file; /* POOL_GIZMO_FILE. */
- struct pool *subpool; /* POOL_GIZMO_SUBPOOL. */
-
- /* POOL_GIZMO_REGISTERED. */
- struct
- {
- void (*free) (void *p);
- void *p;
- }
- registered;
- }
- p;
- };
-
-/* Rounds X up to the next multiple of Y. */
-#ifndef ROUND_UP
-#define ROUND_UP(X, Y) \
- (((X) + ((Y) - 1)) / (Y) * (Y))
-#endif
-
-/* Types that provide typically useful alignment sizes. */
-union align
- {
- void *op;
- void (*fp) (void);
- long l;
- double d;
- };
-
-/* This should be the alignment size used by malloc(). The size of
- the union above is correct, if not optimal, in all known cases. */
-#define ALIGN_SIZE sizeof (union align)
-
-/* DISCRETE_BLOCKS may be declared as nonzero to prevent
- suballocation of blocks. This is useful under memory
- debuggers like Checker or valgrind because it allows the
- source location of bugs to be more accurately pinpointed.
-
- On the other hand, if we're testing the library, then we want to
- test the library's real functionality, not its crippled, slow,
- simplified functionality. */
-/*#define DISCRETE_BLOCKS 1*/
-
-/* Size of each block allocated in the pool, in bytes.
- Should be at least 1k. */
-#ifndef BLOCK_SIZE
-#define BLOCK_SIZE 1024
-#endif
-
-/* Maximum size of a suballocated block. Larger blocks are allocated
- directly with malloc() to avoid memory wastage at the end of a
- suballocation block. */
-#ifndef MAX_SUBALLOC
-#define MAX_SUBALLOC 64
-#endif
-
-/* Sizes of some structures with alignment padding included. */
-#define POOL_BLOCK_SIZE ROUND_UP (sizeof (struct pool_block), ALIGN_SIZE)
-#define POOL_GIZMO_SIZE ROUND_UP (sizeof (struct pool_gizmo), ALIGN_SIZE)
-#define POOL_SIZE ROUND_UP (sizeof (struct pool), ALIGN_SIZE)
-
-/* Serial number used to keep track of gizmos for mark/release. */
-static long serial = 0;
-
-/* Prototypes. */
-static void add_gizmo (struct pool *, struct pool_gizmo *);
-static void free_gizmo (struct pool_gizmo *);
-static void free_all_gizmos (struct pool *pool);
-static void delete_gizmo (struct pool *, struct pool_gizmo *);
-static void check_gizmo (struct pool *, struct pool_gizmo *);
-\f
-/* General routines. */
-
-/* Creates and returns a new memory pool, which allows malloc()'d
- blocks to be suballocated in a time- and space-efficient manner.
- The entire contents of the memory pool are freed at once.
-
- In addition, other objects can be associated with a memory pool.
- These are released when the pool is destroyed. */
-struct pool *
-pool_create (void)
-{
- struct pool_block *block;
- struct pool *pool;
-
- block = xmalloc (BLOCK_SIZE);
- block->prev = block->next = block;
- block->ofs = POOL_BLOCK_SIZE + POOL_SIZE;
-
- pool = (struct pool *) (((char *) block) + POOL_BLOCK_SIZE);
- pool->parent = NULL;
- pool->blocks = block;
- pool->gizmos = NULL;
-
- return pool;
-}
-
-/* Creates a pool, allocates a block STRUCT_SIZE bytes in
- length from it, stores the pool's address at offset
- POOL_MEMBER_OFFSET within the block, and returns the allocated
- block.
-
- Meant for use indirectly via pool_create_container(). */
-void *
-pool_create_at_offset (size_t struct_size, size_t pool_member_offset)
-{
- struct pool *pool;
- char *struct_;
-
- assert (struct_size >= sizeof pool);
- assert (pool_member_offset <= struct_size - sizeof pool);
-
- pool = pool_create ();
- struct_ = pool_alloc (pool, struct_size);
- *(struct pool **) (struct_ + pool_member_offset) = pool;
- return struct_;
-}
-
-/* Destroy the specified pool, including all subpools. */
-void
-pool_destroy (struct pool *pool)
-{
- if (pool == NULL)
- return;
-
- /* Remove this pool from its parent's list of gizmos. */
- if (pool->parent)
- delete_gizmo (pool->parent, (void *) (((char *) pool) + POOL_SIZE));
-
- free_all_gizmos (pool);
-
- /* Free all the memory. */
- {
- struct pool_block *cur, *next;
-
- pool->blocks->prev->next = NULL;
- for (cur = pool->blocks; cur; cur = next)
- {
- next = cur->next;
- free (cur);
- }
- }
-}
-
-/* Release all the memory and gizmos in POOL.
- Blocks are not given back with free() but kept for later
- allocations. To give back memory, use a subpool instead. */
-void
-pool_clear (struct pool *pool)
-{
- free_all_gizmos (pool);
-
- /* Zero out block sizes. */
- {
- struct pool_block *cur;
-
- cur = pool->blocks;
- do
- {
- cur->ofs = POOL_BLOCK_SIZE;
- if ((char *) cur + POOL_BLOCK_SIZE == (char *) pool)
- {
- cur->ofs += POOL_SIZE;
- if (pool->parent != NULL)
- cur->ofs += POOL_GIZMO_SIZE;
- }
- cur = cur->next;
- }
- while (cur != pool->blocks);
- }
-}
-\f
-/* Suballocation routines. */
-
-/* Allocates a memory region AMT bytes in size from POOL and returns a
- pointer to the region's start.
- The region is properly aligned for storing any object. */
-void *
-pool_alloc (struct pool *pool, size_t amt)
-{
- assert (pool != NULL);
-
- if (amt == 0)
- return NULL;
-
-#ifndef DISCRETE_BLOCKS
- if (amt <= MAX_SUBALLOC)
- {
- /* If there is space in this block, take it. */
- struct pool_block *b = pool->blocks;
- b->ofs = ROUND_UP (b->ofs, ALIGN_SIZE);
- if (b->ofs + amt <= BLOCK_SIZE)
- {
- void *const p = ((char *) b) + b->ofs;
- b->ofs += amt;
- return p;
- }
-
- /* No space in this block, so we must make other
- arrangements. */
- if (b->next->ofs == 0)
- {
- /* The next block is empty. Use it. */
- b = b->next;
- b->ofs = POOL_BLOCK_SIZE;
- if ((char *) b + POOL_BLOCK_SIZE == (char *) pool)
- b->ofs += POOL_SIZE;
- }
- else
- {
- /* Create a new block at the start of the list. */
- b = xmalloc (BLOCK_SIZE);
- b->next = pool->blocks;
- b->prev = pool->blocks->prev;
- b->ofs = POOL_BLOCK_SIZE;
- pool->blocks->prev->next = b;
- pool->blocks->prev = b;
- }
- pool->blocks = b;
-
- /* Allocate space from B. */
- b->ofs += amt;
- return ((char *) b) + b->ofs - amt;
- }
- else
-#endif
- return pool_malloc (pool, amt);
-}
-
-/* Allocates a memory region AMT bytes in size from POOL and
- returns a pointer to the region's start. The region is not
- necessarily aligned, so it is most suitable for storing
- strings. */
-void *
-pool_alloc_unaligned (struct pool *pool, size_t amt)
-{
- assert (pool != NULL);
-
-#ifndef DISCRETE_BLOCKS
- /* Strings need not be aligned on any boundary, but some
- operations may be more efficient when they are. However,
- that's only going to help with reasonably long strings. */
- if (amt < ALIGN_SIZE)
- {
- if (amt == 0)
- return NULL;
- else
- {
- struct pool_block *const b = pool->blocks;
-
- if (b->ofs + amt <= BLOCK_SIZE)
- {
- void *p = ((char *) b) + b->ofs;
- b->ofs += amt;
- return p;
- }
- }
- }
-#endif
-
- return pool_alloc (pool, amt);
-}
-
-/* Allocates a memory region N * S bytes in size from POOL and
- returns a pointer to the region's start.
- N must be nonnegative, S must be positive.
- Terminates the program if the memory cannot be obtained,
- including the case where N * S overflows the range of size_t. */
-void *
-pool_nalloc (struct pool *pool, size_t n, size_t s)
-{
- if (xalloc_oversized (n, s))
- xalloc_die ();
- return pool_alloc (pool, n * s);
-}
-
-/* Allocates SIZE bytes in POOL, copies BUFFER into it, and
- returns the new copy. */
-void *
-pool_clone (struct pool *pool, const void *buffer, size_t size)
-{
- void *block = pool_alloc (pool, size);
- memcpy (block, buffer, size);
- return block;
-}
-
-/* Allocates SIZE bytes of unaligned data in POOL, copies BUFFER
- into it, and returns the new copy. */
-void *
-pool_clone_unaligned (struct pool *pool, const void *buffer, size_t size)
-{
- void *block = pool_alloc_unaligned (pool, size);
- memcpy (block, buffer, size);
- return block;
-}
-
-/* Duplicates null-terminated STRING, within POOL, and returns a
- pointer to the duplicate. For use only with strings, because
- the returned pointere may not be aligned properly for other
- types. */
-char *
-pool_strdup (struct pool *pool, const char *string)
-{
- return pool_clone_unaligned (pool, string, strlen (string) + 1);
-}
-\f
-/* Standard allocation routines. */
-
-/* Allocates AMT bytes using malloc(), to be managed by POOL, and
- returns a pointer to the beginning of the block.
- If POOL is a null pointer, then allocates a normal memory block
- with xmalloc(). */
-void *
-pool_malloc (struct pool *pool, size_t amt)
-{
- if (pool != NULL)
- {
- if (amt != 0)
- {
- struct pool_gizmo *g = xmalloc (amt + POOL_GIZMO_SIZE);
- g->type = POOL_GIZMO_MALLOC;
- add_gizmo (pool, g);
-
- return ((char *) g) + POOL_GIZMO_SIZE;
- }
- else
- return NULL;
- }
- else
- return xmalloc (amt);
-}
-
-/* Allocates and returns N elements of S bytes each, to be
- managed by POOL.
- If POOL is a null pointer, then allocates a normal memory block
- with malloc().
- N must be nonnegative, S must be positive.
- Terminates the program if the memory cannot be obtained,
- including the case where N * S overflows the range of size_t. */
-void *
-pool_nmalloc (struct pool *pool, size_t n, size_t s)
-{
- if (xalloc_oversized (n, s))
- xalloc_die ();
- return pool_malloc (pool, n * s);
-}
-
-/* Changes the allocation size of the specified memory block P managed
- by POOL to AMT bytes and returns a pointer to the beginning of the
- block.
- If POOL is a null pointer, then the block is reallocated in the
- usual way with realloc(). */
-void *
-pool_realloc (struct pool *pool, void *p, size_t amt)
-{
- if (pool != NULL)
- {
- if (p != NULL)
- {
- if (amt != 0)
- {
- struct pool_gizmo *g = (void *) (((char *) p) - POOL_GIZMO_SIZE);
- check_gizmo (pool, g);
-
- g = xrealloc (g, amt + POOL_GIZMO_SIZE);
- if (g->next)
- g->next->prev = g;
- if (g->prev)
- g->prev->next = g;
- else
- pool->gizmos = g;
- check_gizmo (pool, g);
-
- return ((char *) g) + POOL_GIZMO_SIZE;
- }
- else
- {
- pool_free (pool, p);
- return NULL;
- }
- }
- else
- return pool_malloc (pool, amt);
- }
- else
- return xrealloc (p, amt);
-}
-
-/* Changes the allocation size of the specified memory block P
- managed by POOL to N * S bytes and returns a pointer to the
- beginning of the block.
- N must be nonnegative, S must be positive.
- If POOL is a null pointer, then the block is reallocated in
- the usual way with xrealloc().
- Terminates the program if the memory cannot be obtained,
- including the case where N * S overflows the range of size_t. */
-void *
-pool_nrealloc (struct pool *pool, void *p, size_t n, size_t s)
-{
- if (xalloc_oversized (n, s))
- xalloc_die ();
- return pool_realloc (pool, p, n * s);
-}
-
-/* If P is null, allocate a block of at least *PN such objects;
- otherwise, reallocate P so that it contains more than *PN
- objects each of S bytes. *PN must be nonzero unless P is
- null, and S must be nonzero. Set *PN to the new number of
- objects, and return the pointer to the new block. *PN is
- never set to zero, and the returned pointer is never null.
-
- The block returned is managed by POOL. If POOL is a null
- pointer, then the block is reallocated in the usual way with
- x2nrealloc().
-
- Terminates the program if the memory cannot be obtained,
- including the case where the memory required overflows the
- range of size_t.
-
- Repeated reallocations are guaranteed to make progress, either by
- allocating an initial block with a nonzero size, or by allocating a
- larger block.
-
- In the following implementation, nonzero sizes are doubled so that
- repeated reallocations have O(N log N) overall cost rather than
- O(N**2) cost, but the specification for this function does not
- guarantee that sizes are doubled.
-
- Here is an example of use:
-
- int *p = NULL;
- struct pool *pool;
- size_t used = 0;
- size_t allocated = 0;
-
- void
- append_int (int value)
- {
- if (used == allocated)
- p = pool_2nrealloc (pool, p, &allocated, sizeof *p);
- p[used++] = value;
- }
-
- This causes x2nrealloc to allocate a block of some nonzero size the
- first time it is called.
-
- To have finer-grained control over the initial size, set *PN to a
- nonzero value before calling this function with P == NULL. For
- example:
-
- int *p = NULL;
- struct pool *pool;
- size_t used = 0;
- size_t allocated = 0;
- size_t allocated1 = 1000;
-
- void
- append_int (int value)
- {
- if (used == allocated)
- {
- p = pool_2nrealloc (pool, p, &allocated1, sizeof *p);
- allocated = allocated1;
- }
- p[used++] = value;
- }
-
- This function implementation is from gnulib. */
-void *
-pool_2nrealloc (struct pool *pool, void *p, size_t *pn, size_t s)
-{
- size_t n = *pn;
-
- if (p == NULL)
- {
- if (n == 0)
- {
- /* The approximate size to use for initial small allocation
- requests, when the invoking code specifies an old size of
- zero. 64 bytes is the largest "small" request for the
- GNU C library malloc. */
- enum { DEFAULT_MXFAST = 64 };
-
- n = DEFAULT_MXFAST / s;
- n += !n;
- }
- }
- else
- {
- if (SIZE_MAX / 2 / s < n)
- xalloc_die ();
- n *= 2;
- }
-
- *pn = n;
- return pool_realloc (pool, p, n * s);
-}
-
-/* Frees block P managed by POOL.
- If POOL is a null pointer, then the block is freed as usual with
- free(). */
-void
-pool_free (struct pool *pool, void *p)
-{
- if (pool != NULL && p != NULL)
- {
- struct pool_gizmo *g = (void *) (((char *) p) - POOL_GIZMO_SIZE);
- check_gizmo (pool, g);
- delete_gizmo (pool, g);
- free (g);
- }
- else
- free (p);
-}
-\f
-/* Gizmo allocations. */
-
-/* Creates and returns a pool as a subpool of POOL.
- The subpool will be destroyed automatically when POOL is destroyed.
- It may also be destroyed explicitly in advance. */
-struct pool *
-pool_create_subpool (struct pool *pool)
-{
- struct pool *subpool;
- struct pool_gizmo *g;
-
- assert (pool != NULL);
- subpool = pool_create ();
- subpool->parent = pool;
-
- g = (void *) (((char *) subpool->blocks) + subpool->blocks->ofs);
- subpool->blocks->ofs += POOL_GIZMO_SIZE;
-
- g->type = POOL_GIZMO_SUBPOOL;
- g->p.subpool = subpool;
-
- add_gizmo (pool, g);
-
- return subpool;
-}
-
-/* Makes SUBPOOL a subpool of POOL.
- SUBPOOL must not already have a parent pool.
- The subpool will be destroyed automatically when POOL is destroyed.
- It may also be destroyed explicitly in advance. */
-void
-pool_add_subpool (struct pool *pool, struct pool *subpool)
-{
- struct pool_gizmo *g;
-
- assert (pool != NULL);
- assert (subpool != NULL);
- assert (subpool->parent == NULL);
-
- g = pool_alloc (subpool, sizeof *g);
- g->type = POOL_GIZMO_SUBPOOL;
- g->p.subpool = subpool;
- add_gizmo (pool, g);
-
- subpool->parent = pool;
-}
-
-/* Opens file FILENAME with mode MODE and returns a handle to it
- if successful or a null pointer if not.
- The file will be closed automatically when POOL is destroyed, or it
- may be closed explicitly in advance using pool_fclose. */
-FILE *
-pool_fopen (struct pool *pool, const char *filename, const char *mode)
-{
- FILE *f;
-
- assert (pool && filename && mode);
- f = fopen (filename, mode);
- if (f == NULL)
- return NULL;
-
- {
- struct pool_gizmo *g = pool_alloc (pool, sizeof *g);
- g->type = POOL_GIZMO_FILE;
- g->p.file = f;
- add_gizmo (pool, g);
- }
-
- return f;
-}
-
-/* Closes file FILE managed by POOL. */
-int
-pool_fclose (struct pool *pool, FILE *file)
-{
- assert (pool && file);
- if (fclose (file) == EOF)
- return EOF;
-
- {
- struct pool_gizmo *g;
-
- for (g = pool->gizmos; g; g = g->next)
- if (g->type == POOL_GIZMO_FILE && g->p.file == file)
- {
- delete_gizmo (pool, g);
- break;
- }
- }
-
- return 0;
-}
-\f
-/* Registers FREE to be called with argument P.
- P should be unique among those registered in POOL so that it can be
- uniquely identified by pool_unregister().
- If not unregistered, FREE will be called with argument P when POOL
- is destroyed. */
-void
-pool_register (struct pool *pool, void (*free) (void *), void *p)
-{
- assert (pool && free && p);
-
- {
- struct pool_gizmo *g = pool_alloc (pool, sizeof *g);
- g->type = POOL_GIZMO_REGISTERED;
- g->p.registered.free = free;
- g->p.registered.p = p;
- add_gizmo (pool, g);
- }
-}
-
-/* Unregisters previously registered P from POOL.
- Returns nonzero only if P was found to be registered in POOL. */
-int
-pool_unregister (struct pool *pool, void *p)
-{
- assert (pool && p);
-
- {
- struct pool_gizmo *g;
-
- for (g = pool->gizmos; g; g = g->next)
- if (g->type == POOL_GIZMO_REGISTERED && g->p.registered.p == p)
- {
- delete_gizmo (pool, g);
- return 1;
- }
- }
-
- return 0;
-}
-\f
-/* Partial freeing. */
-
-/* Notes the state of POOL into MARK so that it may be restored
- by a call to pool_release(). */
-void
-pool_mark (struct pool *pool, struct pool_mark *mark)
-{
- assert (pool && mark);
-
- mark->block = pool->blocks;
- mark->ofs = pool->blocks->ofs;
-
- mark->serial = serial;
-}
-
-/* Restores to POOL the state recorded in MARK.
- Emptied blocks are not given back with free() but kept for
- later allocations. To get that behavior, use a subpool
- instead. */
-void
-pool_release (struct pool *pool, const struct pool_mark *mark)
-{
- assert (pool && mark);
-
- {
- struct pool_gizmo *cur, *next;
-
- for (cur = pool->gizmos; cur && cur->serial >= mark->serial; cur = next)
- {
- next = cur->next;
- free_gizmo (cur);
- }
-
- if (cur != NULL)
- {
- cur->prev = NULL;
- pool->gizmos = cur;
- }
- else
- pool->gizmos = NULL;
- }
-
- {
- struct pool_block *cur;
-
- for (cur = pool->blocks; cur != mark->block; cur = cur->next)
- {
- cur->ofs = POOL_BLOCK_SIZE;
- if ((char *) cur + POOL_BLOCK_SIZE == (char *) pool)
- {
- cur->ofs += POOL_SIZE;
- if (pool->parent != NULL)
- cur->ofs += POOL_GIZMO_SIZE;
- }
- }
- pool->blocks = mark->block;
- pool->blocks->ofs = mark->ofs;
- }
-}
-\f
-/* Private functions. */
-
-/* Adds GIZMO at the beginning of POOL's gizmo list. */
-static void
-add_gizmo (struct pool *pool, struct pool_gizmo *gizmo)
-{
- assert (pool && gizmo);
-
- gizmo->pool = pool;
- gizmo->next = pool->gizmos;
- gizmo->prev = NULL;
- if (pool->gizmos)
- pool->gizmos->prev = gizmo;
- pool->gizmos = gizmo;
-
- gizmo->serial = serial++;
-
- check_gizmo (pool, gizmo);
-}
-
-/* Removes GIZMO from POOL's gizmo list. */
-static void
-delete_gizmo (struct pool *pool, struct pool_gizmo *gizmo)
-{
- assert (pool && gizmo);
-
- check_gizmo (pool, gizmo);
-
- if (gizmo->prev)
- gizmo->prev->next = gizmo->next;
- else
- pool->gizmos = gizmo->next;
- if (gizmo->next)
- gizmo->next->prev = gizmo->prev;
-}
-
-/* Frees any of GIZMO's internal state.
- GIZMO's data must not be referenced after calling this function. */
-static void
-free_gizmo (struct pool_gizmo *gizmo)
-{
- assert (gizmo != NULL);
-
- switch (gizmo->type)
- {
- case POOL_GIZMO_MALLOC:
- free (gizmo);
- break;
- case POOL_GIZMO_FILE:
- fclose (gizmo->p.file); /* Ignore errors. */
- break;
- case POOL_GIZMO_SUBPOOL:
- gizmo->p.subpool->parent = NULL;
- pool_destroy (gizmo->p.subpool);
- break;
- case POOL_GIZMO_REGISTERED:
- gizmo->p.registered.free (gizmo->p.registered.p);
- break;
- default:
- assert (0);
- }
-}
-
-/* Free all the gizmos in POOL. */
-static void
-free_all_gizmos (struct pool *pool)
-{
- struct pool_gizmo *cur, *next;
-
- for (cur = pool->gizmos; cur; cur = next)
- {
- next = cur->next;
- free_gizmo (cur);
- }
- pool->gizmos = NULL;
-}
-
-static void
-check_gizmo (struct pool *p, struct pool_gizmo *g)
-{
- assert (g->pool == p);
- assert (g->next == NULL || g->next->prev == g);
- assert ((g->prev != NULL && g->prev->next == g)
- || (g->prev == NULL && p->gizmos == g));
-
-}
-\f
-/* Self-test routine. */
-
-#include <errno.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <time.h>
-
-#define N_ITERATIONS 8192
-#define N_FILES 16
-
-/* Self-test routine.
- This is not exhaustive, but it can be useful. */
-int
-cmd_debug_pool (void)
-{
- int seed = time (0) * 257 % 32768;
-
- for (;;)
- {
- struct pool *pool;
- struct pool_mark m1, m2;
- FILE *files[N_FILES];
- int cur_file;
- long i;
-
- printf ("Random number seed: %d\n", seed);
- srand (seed++);
-
- printf ("Creating pool...\n");
- pool = pool_create ();
-
- printf ("Marking pool state...\n");
- pool_mark (pool, &m1);
-
- printf (" Populating pool with random-sized small objects...\n");
- for (i = 0; i < N_ITERATIONS; i++)
- {
- size_t size = rand () % MAX_SUBALLOC;
- void *p = pool_alloc (pool, size);
- memset (p, 0, size);
- }
-
- printf (" Marking pool state...\n");
- pool_mark (pool, &m2);
-
- printf (" Populating pool with random-sized small "
- "and large objects...\n");
- for (i = 0; i < N_ITERATIONS; i++)
- {
- size_t size = rand () % (2 * MAX_SUBALLOC);
- void *p = pool_alloc (pool, size);
- memset (p, 0, size);
- }
-
- printf (" Releasing pool state...\n");
- pool_release (pool, &m2);
-
- printf (" Populating pool with random objects and gizmos...\n");
- for (i = 0; i < N_FILES; i++)
- files[i] = NULL;
- cur_file = 0;
- for (i = 0; i < N_ITERATIONS; i++)
- {
- int type = rand () % 32;
-
- if (type == 0)
- {
- if (files[cur_file] != NULL
- && EOF == pool_fclose (pool, files[cur_file]))
- printf ("error on fclose: %s\n", strerror (errno));
-
- files[cur_file] = pool_fopen (pool, "/dev/null", "r");
-
- if (++cur_file >= N_FILES)
- cur_file = 0;
- }
- else if (type == 1)
- pool_create_subpool (pool);
- else
- {
- size_t size = rand () % (2 * MAX_SUBALLOC);
- void *p = pool_alloc (pool, size);
- memset (p, 0, size);
- }
- }
-
- printf ("Releasing pool state...\n");
- pool_release (pool, &m1);
-
- printf ("Destroying pool...\n");
- pool_destroy (pool);
-
- putchar ('\n');
- }
-
- return CMD_SUCCESS;
-}
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !pool_h
-#define pool_h 1
-
-#include <stdio.h>
-
-/* Records the state of a pool for later restoration. */
-struct pool_mark
- {
- /* Current block and offset into it. */
- struct pool_block *block;
- size_t ofs;
-
- /* Current serial number to allow freeing of gizmos. */
- long serial;
- };
-
-/* General routines. */
-struct pool *pool_create (void);
-void pool_destroy (struct pool *);
-void pool_clear (struct pool *);
-
-/* Creates a pool, allocates an instance of the given STRUCT
- within it, sets the struct's MEMBER to the pool's address, and
- returns the allocated structure. */
-#define pool_create_container(STRUCT, MEMBER) \
- ((STRUCT *) pool_create_at_offset (sizeof (STRUCT), \
- offsetof (STRUCT, MEMBER)))
-void *pool_create_at_offset (size_t struct_size, size_t pool_member_offset);
-
-/* Suballocation routines. */
-void *pool_alloc (struct pool *, size_t) MALLOC_LIKE;
-void *pool_nalloc (struct pool *, size_t n, size_t s) MALLOC_LIKE;
-void *pool_clone (struct pool *, const void *, size_t) MALLOC_LIKE;
-
-void *pool_alloc_unaligned (struct pool *, size_t) MALLOC_LIKE;
-void *pool_clone_unaligned (struct pool *, const void *, size_t) MALLOC_LIKE;
-char *pool_strdup (struct pool *, const char *) MALLOC_LIKE;
-char *pool_strcat (struct pool *, const char *, ...) MALLOC_LIKE;
-
-/* Standard allocation routines. */
-void *pool_malloc (struct pool *, size_t) MALLOC_LIKE;
-void *pool_nmalloc (struct pool *, size_t n, size_t s) MALLOC_LIKE;
-void *pool_realloc (struct pool *, void *, size_t);
-void *pool_nrealloc (struct pool *, void *, size_t n, size_t s);
-void *pool_2nrealloc (struct pool *, void *, size_t *pn, size_t s);
-void pool_free (struct pool *, void *);
-
-/* Gizmo allocations. */
-struct pool *pool_create_subpool (struct pool *);
-void pool_add_subpool (struct pool *, struct pool *subpool);
-FILE *pool_fopen (struct pool *, const char *, const char *);
-int pool_fclose (struct pool *, FILE *);
-
-/* Custom allocations. */
-void pool_register (struct pool *, void (*free) (void *), void *p);
-int pool_unregister (struct pool *, void *);
-
-/* Partial freeing. */
-void pool_mark (struct pool *, struct pool_mark *);
-void pool_release (struct pool *, const struct pool_mark *);
-
-#if GLOBAL_DEBUGGING
-void pool_dump (const struct pool *, const char *title);
-#endif
-
-#endif /* pool.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-
-/*this #if encloses the remainder of the file. */
-#if !NO_POSTSCRIPT
-
-#include <ctype.h>
-#include "error.h"
-#include <errno.h>
-#include <limits.h>
-#include <stdlib.h>
-#include <time.h>
-
-#if HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
-#include "alloc.h"
-#include "bitvector.h"
-#include "error.h"
-#include "filename.h"
-#include "font.h"
-#include "getl.h"
-#include "getline.h"
-#include "glob.h"
-#include "hash.h"
-#include "main.h"
-#include "misc.h"
-#include "output.h"
-#include "som.h"
-#include "version.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* FIXMEs:
-
- optimize-text-size not implemented.
-
- Line buffering is the only possibility; page buffering should also
- be possible.
-
- max-fonts-simult
-
- Should add a field to give a file that has a list of fonts
- typically used.
-
- Should add an option that tells the driver it can emit %%Include:'s.
-
- Should have auto-encode=true stream-edit or whatever to allow
- addition to list of encodings.
-
- Should align fonts of different sizes along their baselines (see
- text()). */
-
-/* PostScript driver options: (defaults listed first)
-
- output-file="pspp.ps"
- color=yes|no
- data=clean7bit|clean8bit|binary
- line-ends=lf|crlf
-
- paper-size=letter (see "papersize" file)
- orientation=portrait|landscape
- headers=on|off
-
- left-margin=0.5in
- right-margin=0.5in
- top-margin=0.5in
- bottom-margin=0.5in
-
- font-dir=devps
- prologue-file=ps-prologue
- device-file=DESC
- encoding-file=ps-encodings
- auto-encode=true|false
-
- prop-font-family=T
- fixed-font-family=C
- font-size=10000
-
- line-style=thick|double
- line-gutter=0.5pt
- line-spacing=0.5pt
- line-width=0.5pt
- line-width-thick=1pt
-
- optimize-text-size=1|0|2
- optimize-line-size=1|0
- max-fonts-simult=0 Max # of fonts in printer memory at once (0=infinite)
- */
-
-/* The number of `psus' (PostScript driver UnitS) per inch. Although
- this is a #define, the value is expected never to change. If it
- does, review all uses. */
-#define PSUS 72000
-
-/* Magic numbers for PostScript and EPSF drivers. */
-enum
- {
- MAGIC_PS,
- MAGIC_EPSF
- };
-
-/* Orientations. */
-enum
- {
- OTN_PORTRAIT, /* Portrait. */
- OTN_LANDSCAPE /* Landscape. */
- };
-
-/* Output options. */
-enum
- {
- OPO_MIRROR_HORZ = 001, /* 1=Mirror across a horizontal axis. */
- OPO_MIRROR_VERT = 002, /* 1=Mirror across a vertical axis. */
- OPO_ROTATE_180 = 004, /* 1=Rotate the page 180 degrees. */
- OPO_COLOR = 010, /* 1=Enable color. */
- OPO_HEADERS = 020, /* 1=Draw headers at top of page. */
- OPO_AUTO_ENCODE = 040, /* 1=Add encodings semi-intelligently. */
- OPO_DOUBLE_LINE = 0100 /* 1=Double lines instead of thick lines. */
- };
-
-/* Data allowed in output. */
-enum
- {
- ODA_CLEAN7BIT, /* 0x09, 0x0a, 0x0d, 0x1b...0x7e */
- ODA_CLEAN8BIT, /* 0x09, 0x0a, 0x0d, 0x1b...0xff */
- ODA_BINARY, /* 0x00...0xff */
- ODA_COUNT
- };
-
-/* Types of lines for purpose of caching. */
-enum
- {
- horz, /* Single horizontal. */
- dbl_horz, /* Double horizontal. */
- spl_horz, /* Special horizontal. */
- vert, /* Single vertical. */
- dbl_vert, /* Double vertical. */
- spl_vert, /* Special vertical. */
- n_line_types
- };
-
-/* Cached line. */
-struct line_form
- {
- int ind; /* Independent var. Don't reorder. */
- int mdep; /* Maximum number of dependent var pairs. */
- int ndep; /* Current number of dependent var pairs. */
- int dep[1][2]; /* Dependent var pairs. */
- };
-
-/* Contents of ps_driver_ext.loaded. */
-struct font_entry
- {
- char *dit; /* Font Groff name. */
- struct font_desc *font; /* Font descriptor. */
- };
-
-/* Combines a font with a font size for benefit of generated code. */
-struct ps_font_combo
- {
- struct font_entry *font; /* Font. */
- int size; /* Font size. */
- int index; /* PostScript index. */
- };
-
-/* A font encoding. */
-struct ps_encoding
- {
- char *filename; /* Normalized filename of this encoding. */
- int index; /* Index value. */
- };
-
-/* PostScript output driver extension record. */
-struct ps_driver_ext
- {
- /* User parameters. */
- int orientation; /* OTN_PORTRAIT or OTN_LANDSCAPE. */
- int output_options; /* OPO_*. */
- int data; /* ODA_*. */
-
- int left_margin; /* Left margin in psus. */
- int right_margin; /* Right margin in psus. */
- int top_margin; /* Top margin in psus. */
- int bottom_margin; /* Bottom margin in psus. */
-
- char eol[3]; /* End of line--CR, LF, or CRLF. */
-
- char *font_dir; /* Font directory relative to font path. */
- char *prologue_fn; /* Prologue's filename relative to font dir. */
- char *desc_fn; /* DESC filename relative to font dir. */
- char *encoding_fn; /* Encoding's filename relative to font dir. */
-
- char *prop_family; /* Default proportional font family. */
- char *fixed_family; /* Default fixed-pitch font family. */
- int font_size; /* Default font size (psus). */
-
- int line_gutter; /* Space around lines. */
- int line_space; /* Space between lines. */
- int line_width; /* Width of lines. */
- int line_width_thick; /* Width of thick lines. */
-
- int text_opt; /* Text optimization level. */
- int line_opt; /* Line optimization level. */
- int max_fonts; /* Max # of simultaneous fonts (0=infinite). */
-
- /* Internal state. */
- struct file_ext file; /* Output file. */
- int page_number; /* Current page number. */
- int file_page_number; /* Page number in this file. */
- int w, l; /* Paper size. */
- struct hsh_table *lines[n_line_types]; /* Line buffers. */
-
- struct font_entry *prop; /* Default Roman proportional font. */
- struct font_entry *fixed; /* Default Roman fixed-pitch font. */
- struct hsh_table *loaded; /* Fonts in memory. */
-
- struct hsh_table *combos; /* Combinations of fonts with font sizes. */
- struct ps_font_combo *last_font; /* PostScript selected font. */
- int next_combo; /* Next font combo position index. */
-
- struct hsh_table *encodings;/* Set of encodings. */
- int next_encoding; /* Next font encoding index. */
-
- /* Currently selected font. */
- struct font_entry *current; /* Current font. */
- char *family; /* Font family. */
- int size; /* Size in psus. */
- }
-ps_driver_ext;
-
-/* Transform logical y-ordinate Y into a page ordinate. */
-#define YT(Y) (this->length - (Y))
-
-/* Prototypes. */
-static int postopen (struct file_ext *);
-static int preclose (struct file_ext *);
-static void draw_headers (struct outp_driver *this);
-
-static int compare_font_entry (const void *, const void *, void *param);
-static unsigned hash_font_entry (const void *, void *param);
-static void free_font_entry (void *, void *foo);
-static struct font_entry *load_font (struct outp_driver *, const char *dit);
-static void init_fonts (void);
-static void done_fonts (void);
-
-static void dump_lines (struct outp_driver *this);
-
-static void read_ps_encodings (struct outp_driver *this);
-static int compare_ps_encoding (const void *pa, const void *pb, void *foo);
-static unsigned hash_ps_encoding (const void *pa, void *foo);
-static void free_ps_encoding (void *a, void *foo);
-static void add_encoding (struct outp_driver *this, char *filename);
-static struct ps_encoding *default_encoding (struct outp_driver *this);
-
-static int compare_ps_combo (const void *pa, const void *pb, void *foo);
-static unsigned hash_ps_combo (const void *pa, void *foo);
-static void free_ps_combo (void *a, void *foo);
-
-static char *quote_ps_name (char *dest, const char *string);
-static char *quote_ps_string (char *dest, const char *string);
-\f
-/* Driver initialization. */
-
-static int
-ps_open_global (struct outp_class *this UNUSED)
-{
- init_fonts ();
- groff_init ();
- return 1;
-}
-
-static int
-ps_close_global (struct outp_class *this UNUSED)
-{
- groff_done ();
- done_fonts ();
- return 1;
-}
-
-static int *
-ps_font_sizes (struct outp_class *this UNUSED, int *n_valid_sizes)
-{
- /* Allow fonts up to 1" in height. */
- static int valid_sizes[] =
- {1, PSUS, 0, 0};
-
- assert (n_valid_sizes != NULL);
- *n_valid_sizes = 1;
- return valid_sizes;
-}
-
-static int
-ps_preopen_driver (struct outp_driver *this)
-{
- struct ps_driver_ext *x;
-
- int i;
-
- assert (this->driver_open == 0);
- msg (VM (1), _("PostScript driver initializing as `%s'..."), this->name);
-
- this->ext = x = xmalloc (sizeof *x);
- this->res = PSUS;
- this->horiz = this->vert = 1;
- this->width = this->length = 0;
-
- x->orientation = OTN_PORTRAIT;
- x->output_options = OPO_COLOR | OPO_HEADERS | OPO_AUTO_ENCODE;
- x->data = ODA_CLEAN7BIT;
-
- x->left_margin = x->right_margin =
- x->top_margin = x->bottom_margin = PSUS / 2;
-
- strcpy (x->eol, "\n");
-
- x->font_dir = NULL;
- x->prologue_fn = NULL;
- x->desc_fn = NULL;
- x->encoding_fn = NULL;
-
- x->prop_family = NULL;
- x->fixed_family = NULL;
- x->font_size = PSUS * 10 / 72;
-
- x->line_gutter = PSUS / 144;
- x->line_space = PSUS / 144;
- x->line_width = PSUS / 144;
- x->line_width_thick = PSUS / 48;
-
- x->text_opt = -1;
- x->line_opt = -1;
- x->max_fonts = 0;
-
- x->file.filename = NULL;
- x->file.mode = "wb";
- x->file.file = NULL;
- x->file.sequence_no = &x->page_number;
- x->file.param = this;
- x->file.postopen = postopen;
- x->file.preclose = preclose;
- x->page_number = 0;
- x->w = x->l = 0;
-
- x->file_page_number = 0;
- for (i = 0; i < n_line_types; i++)
- x->lines[i] = NULL;
- x->last_font = NULL;
-
- x->prop = NULL;
- x->fixed = NULL;
- x->loaded = NULL;
-
- x->next_combo = 0;
- x->combos = NULL;
-
- x->encodings = hsh_create (31, compare_ps_encoding, hash_ps_encoding,
- free_ps_encoding, NULL);
- x->next_encoding = 0;
-
- x->current = NULL;
- x->family = NULL;
- x->size = 0;
-
- return 1;
-}
-
-static int
-ps_postopen_driver (struct outp_driver *this)
-{
- struct ps_driver_ext *x = this->ext;
-
- assert (this->driver_open == 0);
-
- if (this->width == 0)
- {
- this->width = PSUS * 17 / 2; /* Defaults to 8.5"x11". */
- this->length = PSUS * 11;
- }
-
- if (x->text_opt == -1)
- x->text_opt = (this->device & OUTP_DEV_SCREEN) ? 0 : 1;
- if (x->line_opt == -1)
- x->line_opt = (this->device & OUTP_DEV_SCREEN) ? 0 : 1;
-
- x->w = this->width;
- x->l = this->length;
- if (x->orientation == OTN_LANDSCAPE)
- {
- int temp = this->width;
- this->width = this->length;
- this->length = temp;
- }
- this->width -= x->left_margin + x->right_margin;
- this->length -= x->top_margin + x->bottom_margin;
- if (x->output_options & OPO_HEADERS)
- {
- this->length -= 3 * x->font_size;
- x->top_margin += 3 * x->font_size;
- }
- if (NULL == x->file.filename)
- x->file.filename = xstrdup ("pspp.ps");
-
- if (x->font_dir == NULL)
- x->font_dir = xstrdup ("devps");
- if (x->prologue_fn == NULL)
- x->prologue_fn = xstrdup ("ps-prologue");
- if (x->desc_fn == NULL)
- x->desc_fn = xstrdup ("DESC");
- if (x->encoding_fn == NULL)
- x->encoding_fn = xstrdup ("ps-encodings");
-
- if (x->prop_family == NULL)
- x->prop_family = xstrdup ("H");
- if (x->fixed_family == NULL)
- x->fixed_family = xstrdup ("C");
-
- read_ps_encodings (this);
-
- x->family = NULL;
- x->size = PSUS / 6;
-
- if (this->length / x->font_size < 15)
- {
- msg (SE, _("PostScript driver: The defined page is not long "
- "enough to hold margins and headers, plus least 15 "
- "lines of the default fonts. In fact, there's only "
- "room for %d lines of each font at the default size "
- "of %d.%03d points."),
- this->length / x->font_size,
- x->font_size / 1000, x->font_size % 1000);
- return 0;
- }
-
- this->driver_open = 1;
- msg (VM (2), _("%s: Initialization complete."), this->name);
-
- return 1;
-}
-
-static int
-ps_close_driver (struct outp_driver *this)
-{
- struct ps_driver_ext *x = this->ext;
-
- int i;
-
- assert (this->driver_open == 1);
- msg (VM (2), _("%s: Beginning closing..."), this->name);
-
- fn_close_ext (&x->file);
- free (x->file.filename);
- free (x->font_dir);
- free (x->prologue_fn);
- free (x->desc_fn);
- free (x->encoding_fn);
- free (x->prop_family);
- free (x->fixed_family);
- free (x->family);
- for (i = 0; i < n_line_types; i++)
- hsh_destroy (x->lines[i]);
- hsh_destroy (x->encodings);
- hsh_destroy (x->combos);
- hsh_destroy (x->loaded);
- free (x);
-
- this->driver_open = 0;
- msg (VM (3), _("%s: Finished closing."), this->name);
-
- return 1;
-}
-
-/* font_entry comparison function for hash tables. */
-static int
-compare_font_entry (const void *a, const void *b, void *foobar UNUSED)
-{
- return strcmp (((struct font_entry *) a)->dit, ((struct font_entry *) b)->dit);
-}
-
-/* font_entry hash function for hash tables. */
-static unsigned
-hash_font_entry (const void *fe_, void *foobar UNUSED)
-{
- const struct font_entry *fe = fe_;
- return hsh_hash_string (fe->dit);
-}
-
-/* font_entry destructor function for hash tables. */
-static void
-free_font_entry (void *pa, void *foo UNUSED)
-{
- struct font_entry *a = pa;
- free (a->dit);
- free (a);
-}
-
-/* Generic option types. */
-enum
-{
- boolean_arg = -10,
- pos_int_arg,
- dimension_arg,
- string_arg,
- nonneg_int_arg
-};
-
-/* All the options that the PostScript driver supports. */
-static struct outp_option option_tab[] =
-{
- /* *INDENT-OFF* */
- {"output-file", 1, 0},
- {"paper-size", 2, 0},
- {"orientation", 3, 0},
- {"color", boolean_arg, 0},
- {"data", 4, 0},
- {"auto-encode", boolean_arg, 5},
- {"headers", boolean_arg, 1},
- {"left-margin", pos_int_arg, 0},
- {"right-margin", pos_int_arg, 1},
- {"top-margin", pos_int_arg, 2},
- {"bottom-margin", pos_int_arg, 3},
- {"font-dir", string_arg, 0},
- {"prologue-file", string_arg, 1},
- {"device-file", string_arg, 2},
- {"encoding-file", string_arg, 3},
- {"prop-font-family", string_arg, 5},
- {"fixed-font-family", string_arg, 6},
- {"font-size", pos_int_arg, 4},
- {"optimize-text-size", nonneg_int_arg, 0},
- {"optimize-line-size", nonneg_int_arg, 1},
- {"max-fonts-simult", nonneg_int_arg, 2},
- {"line-ends", 6, 0},
- {"line-style", 7, 0},
- {"line-width", dimension_arg, 2},
- {"line-gutter", dimension_arg, 3},
- {"line-width", dimension_arg, 4},
- {"line-width-thick", dimension_arg, 5},
- {"", 0, 0},
- /* *INDENT-ON* */
-};
-static struct outp_option_info option_info;
-
-static void
-ps_option (struct outp_driver *this, const char *key, const struct string *val)
-{
- struct ps_driver_ext *x = this->ext;
- int cat, subcat;
- char *value = ds_c_str (val);
-
- cat = outp_match_keyword (key, option_tab, &option_info, &subcat);
-
- switch (cat)
- {
- case 0:
- msg (SE, _("Unknown configuration parameter `%s' for PostScript device "
- "driver."), key);
- break;
- case 1:
- free (x->file.filename);
- x->file.filename = xstrdup (value);
- break;
- case 2:
- outp_get_paper_size (value, &this->width, &this->length);
- break;
- case 3:
- if (!strcmp (value, "portrait"))
- x->orientation = OTN_PORTRAIT;
- else if (!strcmp (value, "landscape"))
- x->orientation = OTN_LANDSCAPE;
- else
- msg (SE, _("Unknown orientation `%s'. Valid orientations are "
- "`portrait' and `landscape'."), value);
- break;
- case 4:
- if (!strcmp (value, "clean7bit") || !strcmp (value, "Clean7Bit"))
- x->data = ODA_CLEAN7BIT;
- else if (!strcmp (value, "clean8bit")
- || !strcmp (value, "Clean8Bit"))
- x->data = ODA_CLEAN8BIT;
- else if (!strcmp (value, "binary") || !strcmp (value, "Binary"))
- x->data = ODA_BINARY;
- else
- msg (SE, _("Unknown value for `data'. Valid values are `clean7bit', "
- "`clean8bit', and `binary'."));
- break;
- case 6:
- if (!strcmp (value, "lf"))
- strcpy (x->eol, "\n");
- else if (!strcmp (value, "crlf"))
- strcpy (x->eol, "\r\n");
- else
- msg (SE, _("Unknown value for `line-ends'. Valid values are `lf' and "
- "`crlf'."));
- break;
- case 7:
- if (!strcmp (value, "thick"))
- x->output_options &= ~OPO_DOUBLE_LINE;
- else if (!strcmp (value, "double"))
- x->output_options |= OPO_DOUBLE_LINE;
- else
- msg (SE, _("Unknown value for `line-style'. Valid values are `thick' "
- "and `double'."));
- break;
- case boolean_arg:
- {
- int setting;
- int mask;
-
- if (!strcmp (value, "on") || !strcmp (value, "true")
- || !strcmp (value, "yes") || atoi (value))
- setting = 1;
- else if (!strcmp (value, "off") || !strcmp (value, "false")
- || !strcmp (value, "no") || !strcmp (value, "0"))
- setting = 0;
- else
- {
- msg (SE, _("Boolean value expected for %s."), key);
- return;
- }
- switch (subcat)
- {
- case 0:
- mask = OPO_COLOR;
- break;
- case 1:
- mask = OPO_HEADERS;
- break;
- case 2:
- mask = OPO_MIRROR_HORZ;
- break;
- case 3:
- mask = OPO_MIRROR_VERT;
- break;
- case 4:
- mask = OPO_ROTATE_180;
- break;
- case 5:
- mask = OPO_AUTO_ENCODE;
- break;
- default:
- assert (0);
- abort ();
- }
- if (setting)
- x->output_options |= mask;
- else
- x->output_options &= ~mask;
- }
- break;
- case pos_int_arg:
- {
- char *tail;
- int arg;
-
- errno = 0;
- arg = strtol (value, &tail, 0);
- if (arg < 1 || errno == ERANGE || *tail)
- {
- msg (SE, _("Positive integer required as value for `%s'."), key);
- break;
- }
- if ((subcat == 4 || subcat == 5) && arg < 1000)
- {
- msg (SE, _("Default font size must be at least 1 point (value "
- "of 1000 for key `%s')."), key);
- break;
- }
- switch (subcat)
- {
- case 0:
- x->left_margin = arg;
- break;
- case 1:
- x->right_margin = arg;
- break;
- case 2:
- x->top_margin = arg;
- break;
- case 3:
- x->bottom_margin = arg;
- break;
- case 4:
- x->font_size = arg;
- break;
- default:
- assert (0);
- }
- }
- break;
- case dimension_arg:
- {
- int dimension = outp_evaluate_dimension (value, NULL);
-
- if (dimension <= 0)
- {
- msg (SE, _("Value for `%s' must be a dimension of positive "
- "length (i.e., `1in')."), key);
- break;
- }
- switch (subcat)
- {
- case 2:
- x->line_width = dimension;
- break;
- case 3:
- x->line_gutter = dimension;
- break;
- case 4:
- x->line_width = dimension;
- break;
- case 5:
- x->line_width_thick = dimension;
- break;
- default:
- assert (0);
- }
- }
- break;
- case string_arg:
- {
- char **dest;
- switch (subcat)
- {
- case 0:
- dest = &x->font_dir;
- break;
- case 1:
- dest = &x->prologue_fn;
- break;
- case 2:
- dest = &x->desc_fn;
- break;
- case 3:
- dest = &x->encoding_fn;
- break;
- case 5:
- dest = &x->prop_family;
- break;
- case 6:
- dest = &x->fixed_family;
- break;
- default:
- assert (0);
- abort ();
- }
- if (*dest)
- free (*dest);
- *dest = xstrdup (value);
- }
- break;
- case nonneg_int_arg:
- {
- char *tail;
- int arg;
-
- errno = 0;
- arg = strtol (value, &tail, 0);
- if (arg < 0 || errno == ERANGE || *tail)
- {
- msg (SE, _("Nonnegative integer required as value for `%s'."), key);
- break;
- }
- switch (subcat)
- {
- case 0:
- x->text_opt = arg;
- break;
- case 1:
- x->line_opt = arg;
- break;
- case 2:
- x->max_fonts = arg;
- break;
- default:
- assert (0);
- }
- }
- break;
- default:
- assert (0);
- }
-}
-
-/* Looks for a PostScript font file or config file in all the
- appropriate places. Returns the filename on success, NULL on
- failure. */
-/* PORTME: Filename operations. */
-static char *
-find_ps_file (struct outp_driver *this, const char *name)
-{
- struct ps_driver_ext *x = this->ext;
- char *cp;
-
- /* x->font_dir + name: "devps/ps-encodings". */
- char *basename;
-
- /* Usually equal to groff_font_path. */
- char *pathname;
-
- /* Final filename. */
- char *fn;
-
- /* Make basename. */
- basename = local_alloc (strlen (x->font_dir) + 1 + strlen (name) + 1);
- cp = stpcpy (basename, x->font_dir);
- *cp++ = DIR_SEPARATOR;
- strcpy (cp, name);
-
- /* Decide on search path. */
- {
- const char *pre_pathname;
-
- pre_pathname = getenv ("STAT_GROFF_FONT_PATH");
- if (pre_pathname == NULL)
- pre_pathname = getenv ("GROFF_FONT_PATH");
- if (pre_pathname == NULL)
- pre_pathname = groff_font_path;
- pathname = fn_tilde_expand (pre_pathname);
- }
-
- /* Search all possible places for the file. */
- fn = fn_search_path (basename, pathname, NULL);
- if (fn == NULL)
- fn = fn_search_path (basename, config_path, NULL);
- if (fn == NULL)
- fn = fn_search_path (name, pathname, NULL);
- if (fn == NULL)
- fn = fn_search_path (name, config_path, NULL);
- free (pathname);
- local_free (basename);
-
- return fn;
-}
-\f
-/* Encodings. */
-
-/* Hash table comparison function for ps_encoding's. */
-static int
-compare_ps_encoding (const void *pa, const void *pb, void *foo UNUSED)
-{
- const struct ps_encoding *a = pa;
- const struct ps_encoding *b = pb;
-
- return strcmp (a->filename, b->filename);
-}
-
-/* Hash table hash function for ps_encoding's. */
-static unsigned
-hash_ps_encoding (const void *pa, void *foo UNUSED)
-{
- const struct ps_encoding *a = pa;
-
- return hsh_hash_string (a->filename);
-}
-
-/* Hash table free function for ps_encoding's. */
-static void
-free_ps_encoding (void *pa, void *foo UNUSED)
-{
- struct ps_encoding *a = pa;
-
- free (a->filename);
- free (a);
-}
-
-/* Iterates through the list of encodings used for this driver
- instance, reads each of them from disk, and writes them as
- PostScript code to the output file. */
-static void
-output_encodings (struct outp_driver *this)
-{
- struct ps_driver_ext *x = this->ext;
-
- struct hsh_iterator iter;
- struct ps_encoding *pe;
-
- struct string line, buf;
-
- ds_init (&line, 128);
- ds_init (&buf, 128);
- for (pe = hsh_first (x->encodings, &iter); pe != NULL;
- pe = hsh_next (x->encodings, &iter))
- {
- FILE *f;
-
- msg (VM (1), _("%s: %s: Opening PostScript font encoding..."),
- this->name, pe->filename);
-
- f = fopen (pe->filename, "r");
- if (!f)
- {
- msg (IE, _("PostScript driver: Cannot open encoding file `%s': %s. "
- "Substituting ISOLatin1Encoding for missing encoding."),
- pe->filename, strerror (errno));
- fprintf (x->file.file, "/E%x ISOLatin1Encoding def%s",
- pe->index, x->eol);
- }
- else
- {
- struct file_locator where;
-
- const char *tab[256];
-
- char *pschar;
- char *code;
- int code_val;
- char *fubar;
-
- const char *notdef = ".notdef";
-
- int i;
-
- for (i = 0; i < 256; i++)
- tab[i] = notdef;
-
- where.filename = pe->filename;
- where.line_number = 0;
- err_push_file_locator (&where);
-
- while (ds_get_config_line (f, &buf, &where))
- {
- char *sp;
-
- if (buf.length == 0)
- continue;
-
- pschar = strtok_r (ds_c_str (&buf), " \t\r\n", &sp);
- code = strtok_r (NULL, " \t\r\n", &sp);
- if (*pschar == 0 || *code == 0)
- continue;
- code_val = strtol (code, &fubar, 0);
- if (*fubar)
- {
- msg (IS, _("PostScript driver: Invalid numeric format."));
- continue;
- }
- if (code_val < 0 || code_val > 255)
- {
- msg (IS, _("PostScript driver: Codes must be between 0 "
- "and 255. (%d is not allowed.)"), code_val);
- break;
- }
- tab[code_val] = local_alloc (strlen (pschar) + 1);
- strcpy ((char *) (tab[code_val]), pschar);
- }
- err_pop_file_locator (&where);
-
- ds_clear (&line);
- ds_printf (&line, "/E%x[", pe->index);
- for (i = 0; i < 257; i++)
- {
- char temp[288];
-
- if (i < 256)
- {
- quote_ps_name (temp, tab[i]);
- if (tab[i] != notdef)
- local_free (tab[i]);
- }
- else
- strcpy (temp, "]def");
-
- if (ds_length (&line) + strlen (temp) > 70)
- {
- ds_puts (&line, x->eol);
- fputs (ds_c_str (&line), x->file.file);
- ds_clear (&line);
- }
- ds_puts (&line, temp);
- }
- ds_puts (&line, x->eol);
- fputs (ds_c_str (&line), x->file.file);
-
- if (fclose (f) == EOF)
- msg (MW, _("PostScript driver: Error closing encoding file `%s'."),
- pe->filename);
-
- msg (VM (2), _("%s: PostScript font encoding read successfully."),
- this->name);
- }
- }
- ds_destroy (&line);
- ds_destroy (&buf);
-}
-
-/* Finds the ps_encoding in THIS that corresponds to the file with
- name NORM_FILENAME, which must have previously been normalized with
- normalize_filename(). */
-static struct ps_encoding *
-get_encoding (struct outp_driver *this, const char *norm_filename)
-{
- struct ps_driver_ext *x = this->ext;
- struct ps_encoding *pe;
-
- pe = (struct ps_encoding *) hsh_find (x->encodings, (void *) &norm_filename);
- return pe;
-}
-
-/* Searches the filesystem for an encoding file with name FILENAME;
- returns its malloc'd, normalized name if found, otherwise NULL. */
-static char *
-find_encoding_file (struct outp_driver *this, char *filename)
-{
- char *cp, *temp;
-
- if (filename == NULL)
- return NULL;
- while (isspace ((unsigned char) *filename))
- filename++;
- for (cp = filename; *cp && !isspace ((unsigned char) *cp); cp++)
- ;
- if (cp == filename)
- return NULL;
- *cp = 0;
-
- temp = find_ps_file (this, filename);
- if (temp == NULL)
- return NULL;
-
- filename = fn_normalize (temp);
- assert (filename != NULL);
- free (temp);
-
- return filename;
-}
-
-/* Adds the encoding represented by the not-necessarily-normalized
- file FILENAME to the list of encodings, if it exists and is not
- already in the list. */
-static void
-add_encoding (struct outp_driver *this, char *filename)
-{
- struct ps_driver_ext *x = this->ext;
- struct ps_encoding **pe;
-
- filename = find_encoding_file (this, filename);
- if (!filename)
- return;
-
- pe = (struct ps_encoding **) hsh_probe (x->encodings, &filename);
- if (*pe)
- {
- free (filename);
- return;
- }
- *pe = xmalloc (sizeof **pe);
- (*pe)->filename = filename;
- (*pe)->index = x->next_encoding++;
-}
-
-/* Finds the file on disk that contains the list of encodings to
- include in the output file, then adds those encodings to the list
- of encodings. */
-static void
-read_ps_encodings (struct outp_driver *this)
-{
- struct ps_driver_ext *x = this->ext;
-
- /* Encodings file. */
- char *encoding_fn; /* `ps-encodings' filename. */
- FILE *f;
-
- struct string line;
- struct file_locator where;
-
- /* It's okay if there's no list of encodings; not everyone cares. */
- encoding_fn = find_ps_file (this, x->encoding_fn);
- if (encoding_fn == NULL)
- return;
- free (encoding_fn);
-
- msg (VM (1), _("%s: %s: Opening PostScript encoding list file."),
- this->name, encoding_fn);
- f = fopen (encoding_fn, "r");
- if (!f)
- {
- msg (IE, _("Opening %s: %s."), encoding_fn, strerror (errno));
- return;
- }
-
- where.filename = encoding_fn;
- where.line_number = 0;
- err_push_file_locator (&where);
-
- ds_init (&line, 128);
-
- for (;;)
- {
- if (!ds_get_config_line (f, &line, &where))
- {
- if (ferror (f))
- msg (ME, _("Reading %s: %s."), encoding_fn, strerror (errno));
- break;
- }
-
- add_encoding (this, line.string);
- }
-
- ds_destroy (&line);
- err_pop_file_locator (&where);
-
- if (-1 == fclose (f))
- msg (MW, _("Closing %s: %s."), encoding_fn, strerror (errno));
-
- msg (VM (2), _("%s: PostScript encoding list file read successfully."), this->name);
-}
-
-/* Creates a default encoding for driver D that can be substituted for
- an unavailable encoding. */
-struct ps_encoding *
-default_encoding (struct outp_driver *d)
-{
- struct ps_driver_ext *x = d->ext;
- static struct ps_encoding *enc;
-
- if (!enc)
- {
- enc = xmalloc (sizeof *enc);
- enc->filename = xstrdup (_("<<default encoding>>"));
- enc->index = x->next_encoding++;
- }
- return enc;
-}
-\f
-/* Basic file operations. */
-
-/* Variables for the prologue. */
-struct ps_variable
- {
- const char *key;
- const char *value;
- };
-
-static struct ps_variable *ps_var_tab;
-
-/* Searches ps_var_tab for a ps_variable with key KEY, and returns the
- associated value. */
-static const char *
-ps_get_var (const char *key)
-{
- struct ps_variable *v;
-
- for (v = ps_var_tab; v->key; v++)
- if (!strcmp (key, v->key))
- return v->value;
- return NULL;
-}
-
-/* Writes the PostScript prologue to file F. */
-static int
-postopen (struct file_ext *f)
-{
- static struct ps_variable dict[] =
- {
- {"bounding-box", 0},
- {"creator", 0},
- {"date", 0},
- {"data", 0},
- {"orientation", 0},
- {"user", 0},
- {"host", 0},
- {"prop-font", 0},
- {"fixed-font", 0},
- {"scale-factor", 0},
- {"paper-width", 0},
- {"paper-length", 0},
- {"left-margin", 0},
- {"top-margin", 0},
- {"line-width", 0},
- {"line-width-thick", 0},
- {"title", 0},
- {"source-file", 0},
- {0, 0},
- };
- char boundbox[INT_DIGITS * 4 + 4];
-#if HAVE_UNISTD_H
- char host[128];
-#endif
- char scaling[INT_DIGITS + 5];
- time_t curtime;
- struct tm *loctime;
- char *p, *cp;
- char paper_width[INT_DIGITS + 1];
- char paper_length[INT_DIGITS + 1];
- char left_margin[INT_DIGITS + 1];
- char top_margin[INT_DIGITS + 1];
- char line_width[INT_DIGITS + 1];
- char line_width_thick[INT_DIGITS + 1];
-
- struct outp_driver *this = f->param;
- struct ps_driver_ext *x = this->ext;
-
- char *prologue_fn = find_ps_file (this, x->prologue_fn);
- FILE *prologue_file;
-
- char *buf = NULL;
- size_t buf_size = 0;
-
- x->loaded = hsh_create (31, compare_font_entry, hash_font_entry,
- free_font_entry, NULL);
-
- {
- char *font_name = local_alloc (2 + max (strlen (x->prop_family),
- strlen (x->fixed_family)));
-
- strcpy (stpcpy (font_name, x->prop_family), "R");
- x->prop = load_font (this, font_name);
-
- strcpy (stpcpy (font_name, x->fixed_family), "R");
- x->fixed = load_font (this, font_name);
-
- local_free(font_name);
- }
-
- x->current = x->prop;
- x->family = xstrdup (x->prop_family);
- x->size = x->font_size;
-
- {
- int *h = this->horiz_line_width, *v = this->vert_line_width;
-
- this->cp_x = this->cp_y = 0;
- this->font_height = x->font_size;
- {
- struct char_metrics *metric;
-
- metric = font_get_char_metrics (x->prop->font, '0');
- this->prop_em_width = ((metric
- ? metric->width : x->prop->font->space_width)
- * x->font_size / 1000);
-
- metric = font_get_char_metrics (x->fixed->font, '0');
- this->fixed_width = ((metric
- ? metric->width : x->fixed->font->space_width)
- * x->font_size / 1000);
- }
-
- h[0] = v[0] = 0;
- h[1] = v[1] = 2 * x->line_gutter + x->line_width;
- if (x->output_options & OPO_DOUBLE_LINE)
- h[2] = v[2] = 2 * x->line_gutter + 2 * x->line_width + x->line_space;
- else
- h[2] = v[2] = 2 * x->line_gutter + x->line_width_thick;
- h[3] = v[3] = 2 * x->line_gutter + x->line_width;
-
- {
- int i;
-
- for (i = 0; i < (1 << OUTP_L_COUNT); i++)
- {
- int bit;
-
- /* Maximum width of any line type so far. */
- int max = 0;
-
- for (bit = 0; bit < OUTP_L_COUNT; bit++)
- if ((i & (1 << bit)) && h[bit] > max)
- max = h[bit];
- this->horiz_line_spacing[i] = this->vert_line_spacing[i] = max;
- }
- }
- }
-
- if (x->output_options & OPO_AUTO_ENCODE)
- {
- /* It's okay if this is done more than once since add_encoding()
- is idempotent over identical encodings. */
- add_encoding (this, x->prop->font->encoding);
- add_encoding (this, x->fixed->font->encoding);
- }
-
- x->file_page_number = 0;
-
- errno = 0;
- if (prologue_fn == NULL)
- {
- msg (IE, _("Cannot find PostScript prologue. The use of `-vv' "
- "on the command line is suggested as a debugging aid."));
- return 0;
- }
-
- msg (VM (1), _("%s: %s: Opening PostScript prologue..."),
- this->name, prologue_fn);
- prologue_file = fopen (prologue_fn, "rb");
- if (prologue_file == NULL)
- {
- fclose (prologue_file);
- free (prologue_fn);
- msg (IE, "%s: %s", prologue_fn, strerror (errno));
- goto error;
- }
-
- sprintf (boundbox, "0 0 %d %d",
- x->w / (PSUS / 72) + (x->w % (PSUS / 72) > 0),
- x->l / (PSUS / 72) + (x->l % (PSUS / 72) > 0));
- dict[0].value = boundbox;
-
- dict[1].value = (char *) version;
-
- curtime = time (NULL);
- loctime = localtime (&curtime);
- dict[2].value = asctime (loctime);
- cp = strchr (dict[2].value, '\n');
- if (cp)
- *cp = 0;
-
- switch (x->data)
- {
- case ODA_CLEAN7BIT:
- dict[3].value = "Clean7Bit";
- break;
- case ODA_CLEAN8BIT:
- dict[3].value = "Clean8Bit";
- break;
- case ODA_BINARY:
- dict[3].value = "Binary";
- break;
- default:
- assert (0);
- }
-
- if (x->orientation == OTN_PORTRAIT)
- dict[4].value = "Portrait";
- else
- dict[4].value = "Landscape";
-
- /* PORTME: Determine username, net address. */
-#if HAVE_UNISTD_H
- dict[5].value = getenv ("LOGNAME");
- if (!dict[5].value)
- dict[5].value = getlogin ();
- if (!dict[5].value)
- dict[5].value = _("nobody");
-
- if (gethostname (host, 128) == -1)
- {
- if (errno == ENAMETOOLONG)
- host[127] = 0;
- else
- strcpy (host, _("nowhere"));
- }
- dict[6].value = host;
-#else /* !HAVE_UNISTD_H */
- dict[5].value = _("nobody");
- dict[6].value = _("nowhere");
-#endif /* !HAVE_UNISTD_H */
-
- cp = stpcpy (p = local_alloc (288), "font ");
- quote_ps_string (cp, x->prop->font->internal_name);
- dict[7].value = p;
-
- cp = stpcpy (p = local_alloc (288), "font ");
- quote_ps_string (cp, x->fixed->font->internal_name);
- dict[8].value = p;
-
- sprintf (scaling, "%.3f", PSUS / 72.0);
- dict[9].value = scaling;
-
- sprintf (paper_width, "%g", x->w / (PSUS / 72.0));
- dict[10].value = paper_width;
-
- sprintf (paper_length, "%g", x->l / (PSUS / 72.0));
- dict[11].value = paper_length;
-
- sprintf (left_margin, "%d", x->left_margin);
- dict[12].value = left_margin;
-
- sprintf (top_margin, "%d", x->top_margin);
- dict[13].value = top_margin;
-
- sprintf (line_width, "%d", x->line_width);
- dict[14].value = line_width;
-
- sprintf (line_width, "%d", x->line_width_thick);
- dict[15].value = line_width_thick;
-
- getl_location (&dict[17].value, NULL);
- if (dict[17].value == NULL)
- dict[17].value = "<stdin>";
-
- if (!outp_title)
- {
- dict[16].value = cp = local_alloc (strlen (dict[17].value) + 30);
- sprintf (cp, "PSPP (%s)", dict[17].value);
- }
- else
- {
- dict[16].value = local_alloc (strlen (outp_title) + 1);
- strcpy ((char *) (dict[16].value), outp_title);
- }
-
- ps_var_tab = dict;
- while (-1 != getline (&buf, &buf_size, prologue_file))
- {
- char *cp;
- char *buf2;
- int len;
-
- cp = strstr (buf, "!eps");
- if (cp)
- {
- if (this->class->magic == MAGIC_PS)
- continue;
- else
- *cp = '\0';
- }
- else
- {
- cp = strstr (buf, "!ps");
- if (cp)
- {
- if (this->class->magic == MAGIC_EPSF)
- continue;
- else
- *cp = '\0';
- } else {
- if (strstr (buf, "!!!"))
- continue;
- }
- }
-
- if (!strncmp (buf, "!encodings", 10))
- output_encodings (this);
- else
- {
- char *beg;
- beg = buf2 = fn_interp_vars (buf, ps_get_var);
- len = strlen (buf2);
- while (isspace ((unsigned char) *beg))
- beg++, len--;
- if (beg[len - 1] == '\n')
- len--;
- if (beg[len - 1] == '\r')
- len--;
- fwrite (beg, len, 1, f->file);
- fputs (x->eol, f->file);
- free (buf2);
- }
- }
- if (ferror (f->file))
- msg (IE, _("Reading `%s': %s."), prologue_fn, strerror (errno));
- fclose (prologue_file);
-
- free (prologue_fn);
- free (buf);
-
- local_free (dict[7].value);
- local_free (dict[8].value);
- local_free (dict[16].value);
-
- if (ferror (f->file))
- goto error;
-
- msg (VM (2), _("%s: PostScript prologue read successfully."), this->name);
- return 1;
-
-error:
- msg (VM (1), _("%s: Error reading PostScript prologue."), this->name);
- return 0;
-}
-
-/* Writes the string STRING to buffer DEST (of at least 288
- characters) as a PostScript name object. Returns a pointer
- to the null terminator of the resultant string. */
-static char *
-quote_ps_name (char *dest, const char *string)
-{
- const char *sp;
-
- for (sp = string; *sp; sp++)
- switch (*sp)
- {
- case 'a':
- case 'f':
- case 'k':
- case 'p':
- case 'u':
- case 'b':
- case 'g':
- case 'l':
- case 'q':
- case 'v':
- case 'c':
- case 'h':
- case 'm':
- case 'r':
- case 'w':
- case 'd':
- case 'i':
- case 'n':
- case 's':
- case 'x':
- case 'e':
- case 'j':
- case 'o':
- case 't':
- case 'y':
- case 'z':
- case 'A':
- case 'F':
- case 'K':
- case 'P':
- case 'U':
- case 'B':
- case 'G':
- case 'L':
- case 'Q':
- case 'V':
- case 'C':
- case 'H':
- case 'M':
- case 'R':
- case 'W':
- case 'D':
- case 'I':
- case 'N':
- case 'S':
- case 'X':
- case 'E':
- case 'J':
- case 'O':
- case 'T':
- case 'Y':
- case 'Z':
- case '@':
- case '^':
- case '_':
- case '|':
- case '!':
- case '$':
- case '&':
- case ':':
- case ';':
- case '.':
- case ',':
- case '-':
- case '+':
- break;
- default:
- {
- char *dp = dest;
-
- *dp++ = '<';
- for (sp = string; *sp && dp < &dest[256]; sp++)
- {
- sprintf (dp, "%02x", (unsigned char) *sp);
- dp += 2;
- }
- return stpcpy (dp, ">cvn");
- }
- }
- dest[0] = '/';
- return stpcpy (&dest[1], string);
-}
-
-/* Adds the string STRING to buffer DEST as a PostScript quoted
- string; returns a pointer to the null terminator added. Will not
- add more than 235 characters. */
-static char *
-quote_ps_string (char *dest, const char *string)
-{
- const char *sp = string;
- char *dp = dest;
-
- *dp++ = '(';
- for (; *sp && dp < &dest[235]; sp++)
- if (*sp == '(')
- dp = stpcpy (dp, "\\(");
- else if (*sp == ')')
- dp = stpcpy (dp, "\\)");
- else if (*sp < 32 || (unsigned char) *sp > 127)
- dp = spprintf (dp, "\\%3o", *sp);
- else
- *dp++ = *sp;
- return stpcpy (dp, ")");
-}
-
-/* Writes the PostScript epilogue to file F. */
-static int
-preclose (struct file_ext *f)
-{
- struct outp_driver *this = f->param;
- struct ps_driver_ext *x = this->ext;
- struct hsh_iterator iter;
- struct font_entry *fe;
-
- fprintf (f->file,
- ("%%%%Trailer%s"
- "%%%%Pages: %d%s"
- "%%%%DocumentNeededResources:%s"),
- x->eol, x->file_page_number, x->eol, x->eol);
-
- for (fe = hsh_first (x->loaded, &iter); fe != NULL;
- fe = hsh_next (x->loaded, &iter))
- {
- char buf[256], *cp;
-
- cp = stpcpy (buf, "%%+ font ");
- cp = quote_ps_string (cp, fe->font->internal_name);
- strcpy (cp, x->eol);
- fputs (buf, f->file);
- }
-
- hsh_destroy (x->loaded);
- x->loaded = NULL;
- hsh_destroy (x->combos);
- x->combos = NULL;
- x->last_font = NULL;
- x->next_combo = 0;
-
- fprintf (f->file, "%%EOF%s", x->eol);
- if (ferror (f->file))
- return 0;
- return 1;
-}
-
-static int
-ps_open_page (struct outp_driver *this)
-{
- struct ps_driver_ext *x = this->ext;
-
- assert (this->driver_open && !this->page_open);
-
- x->page_number++;
- if (!fn_open_ext (&x->file))
- {
- if (errno)
- msg (ME, _("PostScript output driver: %s: %s"), x->file.filename,
- strerror (errno));
- return 0;
- }
- x->file_page_number++;
-
- hsh_destroy (x->combos);
- x->combos = hsh_create (31, compare_ps_combo, hash_ps_combo,
- free_ps_combo, NULL);
- x->last_font = NULL;
- x->next_combo = 0;
-
- fprintf (x->file.file,
- "%%%%Page: %d %d%s"
- "%%%%BeginPageSetup%s"
- "/pg save def 0.001 dup scale%s",
- x->page_number, x->file_page_number, x->eol,
- x->eol,
- x->eol);
-
- if (x->orientation == OTN_LANDSCAPE)
- fprintf (x->file.file,
- "%d 0 translate 90 rotate%s",
- x->w, x->eol);
-
- if (x->bottom_margin != 0 || x->left_margin != 0)
- fprintf (x->file.file,
- "%d %d translate%s",
- x->left_margin, x->bottom_margin, x->eol);
-
- fprintf (x->file.file,
- "/LW %d def/TW %d def %d setlinewidth%s"
- "%%%%EndPageSetup%s",
- x->line_width, x->line_width_thick, x->line_width, x->eol,
- x->eol);
-
- if (!ferror (x->file.file))
- {
- this->page_open = 1;
- if (x->output_options & OPO_HEADERS)
- draw_headers (this);
- }
-
- this->cp_y = 0;
-
- return !ferror (x->file.file);
-}
-
-static int
-ps_close_page (struct outp_driver *this)
-{
- struct ps_driver_ext *x = this->ext;
-
- assert (this->driver_open && this->page_open);
-
- if (x->line_opt)
- dump_lines (this);
-
- fprintf (x->file.file,
- "%%PageTrailer%s"
- "EP%s",
- x->eol, x->eol);
-
- this->page_open = 0;
- return !ferror (x->file.file);
-}
-
-static void
-ps_submit (struct outp_driver *this UNUSED, struct som_entity *s)
-{
- switch (s->type)
- {
- case SOM_CHART:
- break;
- default:
- assert(0);
- break;
- }
-}
-\f
-/* Lines. */
-
-/* qsort() comparison function for int tuples. */
-static int
-int_2_compare (const void *a_, const void *b_)
-{
- const int *a = a_;
- const int *b = b_;
-
- return *a < *b ? -1 : *a > *b;
-}
-
-/* Hash table comparison function for cached lines. */
-static int
-compare_line (const void *a_, const void *b_, void *foo UNUSED)
-{
- const struct line_form *a = a_;
- const struct line_form *b = b_;
-
- return a->ind < b->ind ? -1 : a->ind > b->ind;
-}
-
-/* Hash table hash function for cached lines. */
-static unsigned
-hash_line (const void *pa, void *foo UNUSED)
-{
- const struct line_form *a = pa;
-
- return a->ind;
-}
-
-/* Hash table free function for cached lines. */
-static void
-free_line (void *pa, void *foo UNUSED)
-{
- free (pa);
-}
-
-/* Writes PostScript code to draw a line from (x1,y1) to (x2,y2) to
- the output file. */
-#define dump_line(x1, y1, x2, y2) \
- fprintf (ext->file.file, "%d %d %d %d L%s", \
- x1, YT (y1), x2, YT (y2), ext->eol)
-
-/* Write PostScript code to draw a thick line from (x1,y1) to (x2,y2)
- to the output file. */
-#define dump_thick_line(x1, y1, x2, y2) \
- fprintf (ext->file.file, "%d %d %d %d TL%s", \
- x1, YT (y1), x2, YT (y2), ext->eol)
-
-/* Writes a line of type TYPE to THIS driver's output file. The line
- (or its center, in the case of double lines) has its independent
- axis coordinate at IND; it extends from DEP1 to DEP2 on the
- dependent axis. */
-static void
-dump_fancy_line (struct outp_driver *this, int type, int ind, int dep1, int dep2)
-{
- struct ps_driver_ext *ext = this->ext;
- int ofs = ext->line_space / 2 + ext->line_width / 2;
-
- switch (type)
- {
- case horz:
- dump_line (dep1, ind, dep2, ind);
- break;
- case dbl_horz:
- if (ext->output_options & OPO_DOUBLE_LINE)
- {
- dump_line (dep1, ind - ofs, dep2, ind - ofs);
- dump_line (dep1, ind + ofs, dep2, ind + ofs);
- }
- else
- dump_thick_line (dep1, ind, dep2, ind);
- break;
- case spl_horz:
- assert (0);
- case vert:
- dump_line (ind, dep1, ind, dep2);
- break;
- case dbl_vert:
- if (ext->output_options & OPO_DOUBLE_LINE)
- {
- dump_line (ind - ofs, dep1, ind - ofs, dep2);
- dump_line (ind + ofs, dep1, ind + ofs, dep2);
- }
- else
- dump_thick_line (ind, dep1, ind, dep2);
- break;
- case spl_vert:
- assert (0);
- default:
- assert (0);
- }
-}
-
-#undef dump_line
-
-/* Writes all the cached lines to the output file, then clears the
- cache. */
-static void
-dump_lines (struct outp_driver *this)
-{
- struct ps_driver_ext *x = this->ext;
-
- struct hsh_iterator iter;
- int type;
-
- for (type = 0; type < n_line_types; type++)
- {
- struct line_form *line;
-
- if (x->lines[type] == NULL)
- continue;
-
- for (line = hsh_first (x->lines[type], &iter); line != NULL;
- line = hsh_next (x->lines[type], &iter))
- {
- int i;
- int lo = INT_MIN, hi;
-
- qsort (line->dep, line->ndep, sizeof *line->dep, int_2_compare);
- lo = line->dep[0][0];
- hi = line->dep[0][1];
- for (i = 1; i < line->ndep; i++)
- if (line->dep[i][0] <= hi + 1)
- {
- int min_hi = line->dep[i][1];
- if (min_hi > hi)
- hi = min_hi;
- }
- else
- {
- dump_fancy_line (this, type, line->ind, lo, hi);
- lo = line->dep[i][0];
- hi = line->dep[i][1];
- }
- dump_fancy_line (this, type, line->ind, lo, hi);
- }
-
- hsh_destroy (x->lines[type]);
- x->lines[type] = NULL;
- }
-}
-
-/* (Same args as dump_fancy_line()). Either dumps the line directly
- to the output file, or adds it to the cache, depending on the
- user-selected line optimization mode. */
-static void
-line (struct outp_driver *this, int type, int ind, int dep1, int dep2)
-{
- struct ps_driver_ext *ext = this->ext;
- struct line_form **f;
-
- assert (dep2 >= dep1);
- if (ext->line_opt == 0)
- {
- dump_fancy_line (this, type, ind, dep1, dep2);
- return;
- }
-
- if (ext->lines[type] == NULL)
- ext->lines[type] = hsh_create (31, compare_line, hash_line,
- free_line, NULL);
- f = (struct line_form **) hsh_probe (ext->lines[type], &ind);
- if (*f == NULL)
- {
- *f = xmalloc (sizeof **f + sizeof (int[15][2]));
- (*f)->ind = ind;
- (*f)->mdep = 16;
- (*f)->ndep = 1;
- (*f)->dep[0][0] = dep1;
- (*f)->dep[0][1] = dep2;
- return;
- }
- if ((*f)->ndep >= (*f)->mdep)
- {
- (*f)->mdep += 16;
- *f = xrealloc (*f, sizeof **f + sizeof (int[2]) * ((*f)->mdep - 1));
- }
- (*f)->dep[(*f)->ndep][0] = dep1;
- (*f)->dep[(*f)->ndep][1] = dep2;
- (*f)->ndep++;
-}
-
-static void
-ps_line_horz (struct outp_driver *this, const struct rect *r,
- const struct color *c UNUSED, int style)
-{
- /* Must match output.h:OUTP_L_*. */
- static const int types[OUTP_L_COUNT] =
- {-1, horz, dbl_horz, spl_horz};
-
- int y = (r->y1 + r->y2) / 2;
-
- assert (this->driver_open && this->page_open);
- assert (style >= 0 && style < OUTP_L_COUNT);
- style = types[style];
- if (style != -1)
- line (this, style, y, r->x1, r->x2);
-}
-
-static void
-ps_line_vert (struct outp_driver *this, const struct rect *r,
- const struct color *c UNUSED, int style)
-{
- /* Must match output.h:OUTP_L_*. */
- static const int types[OUTP_L_COUNT] =
- {-1, vert, dbl_vert, spl_vert};
-
- int x = (r->x1 + r->x2) / 2;
-
- assert (this->driver_open && this->page_open);
- assert (style >= 0 && style < OUTP_L_COUNT);
- style = types[style];
- if (style != -1)
- line (this, style, x, r->y1, r->y2);
-}
-
-#define L (style->l != OUTP_L_NONE)
-#define R (style->r != OUTP_L_NONE)
-#define T (style->t != OUTP_L_NONE)
-#define B (style->b != OUTP_L_NONE)
-
-static void
-ps_line_intersection (struct outp_driver *this, const struct rect *r,
- const struct color *c UNUSED,
- const struct outp_styles *style)
-{
- struct ps_driver_ext *ext = this->ext;
-
- int x = (r->x1 + r->x2) / 2;
- int y = (r->y1 + r->y2) / 2;
- int ofs = (ext->line_space + ext->line_width) / 2;
- int x1 = x - ofs, x2 = x + ofs;
- int y1 = y - ofs, y2 = y + ofs;
-
- assert (this->driver_open && this->page_open);
- assert (!((style->l != style->r && style->l != OUTP_L_NONE
- && style->r != OUTP_L_NONE)
- || (style->t != style->b && style->t != OUTP_L_NONE
- && style->b != OUTP_L_NONE)));
-
- switch ((style->l | style->r) | ((style->t | style->b) << 8))
- {
- case (OUTP_L_SINGLE) | (OUTP_L_SINGLE << 8):
- case (OUTP_L_SINGLE) | (OUTP_L_NONE << 8):
- case (OUTP_L_NONE) | (OUTP_L_SINGLE << 8):
- if (L)
- line (this, horz, y, r->x1, x);
- if (R)
- line (this, horz, y, x, r->x2);
- if (T)
- line (this, vert, x, r->y1, y);
- if (B)
- line (this, vert, x, y, r->y2);
- break;
- case (OUTP_L_SINGLE) | (OUTP_L_DOUBLE << 8):
- case (OUTP_L_NONE) | (OUTP_L_DOUBLE << 8):
- if (L)
- line (this, horz, y, r->x1, x1);
- if (R)
- line (this, horz, y, x2, r->x2);
- if (T)
- line (this, dbl_vert, x, r->y1, y);
- if (B)
- line (this, dbl_vert, x, y, r->y2);
- if ((L && R) && !(T && B))
- line (this, horz, y, x1, x2);
- break;
- case (OUTP_L_DOUBLE) | (OUTP_L_SINGLE << 8):
- case (OUTP_L_DOUBLE) | (OUTP_L_NONE << 8):
- if (L)
- line (this, dbl_horz, y, r->x1, x);
- if (R)
- line (this, dbl_horz, y, x, r->x2);
- if (T)
- line (this, vert, x, r->y1, y);
- if (B)
- line (this, vert, x, y, r->y2);
- if ((T && B) && !(L && R))
- line (this, vert, x, y1, y2);
- break;
- case (OUTP_L_DOUBLE) | (OUTP_L_DOUBLE << 8):
- if (L)
- line (this, dbl_horz, y, r->x1, x);
- if (R)
- line (this, dbl_horz, y, x, r->x2);
- if (T)
- line (this, dbl_vert, x, r->y1, y);
- if (B)
- line (this, dbl_vert, x, y, r->y2);
- if (T && B && !L)
- line (this, vert, x1, y1, y2);
- if (T && B && !R)
- line (this, vert, x2, y1, y2);
- if (L && R && !T)
- line (this, horz, y1, x1, x2);
- if (L && R && !B)
- line (this, horz, y2, x1, x2);
- break;
- default:
- assert (0);
- }
-}
-
-static void
-ps_box (struct outp_driver *this UNUSED, const struct rect *r UNUSED,
- const struct color *bord UNUSED, const struct color *fill UNUSED)
-{
- assert (this->driver_open && this->page_open);
-}
-
-static void
-ps_polyline_begin (struct outp_driver *this UNUSED,
- const struct color *c UNUSED)
-{
- assert (this->driver_open && this->page_open);
-}
-static void
-ps_polyline_point (struct outp_driver *this UNUSED, int x UNUSED, int y UNUSED)
-{
- assert (this->driver_open && this->page_open);
-}
-static void
-ps_polyline_end (struct outp_driver *this UNUSED)
-{
- assert (this->driver_open && this->page_open);
-}
-
-/* Returns the width of string S for THIS driver. */
-static int
-text_width (struct outp_driver *this, char *s)
-{
- struct outp_text text;
-
- text.options = OUTP_T_JUST_LEFT;
- ls_init (&text.s, s, strlen (s));
- this->class->text_metrics (this, &text);
- return text.h;
-}
-
-/* Write string S at location (X,Y) with width W for THIS driver. */
-static void
-out_text_plain (struct outp_driver *this, char *s, int x, int y, int w)
-{
- struct outp_text text;
-
- text.options = OUTP_T_JUST_LEFT | OUTP_T_HORZ | OUTP_T_VERT;
- ls_init (&text.s, s, strlen (s));
- text.h = w;
- text.v = this->font_height;
- text.x = x;
- text.y = y;
- this->class->text_draw (this, &text);
-}
-
-/* Draw top of page headers for THIS driver. */
-static void
-draw_headers (struct outp_driver *this)
-{
- struct ps_driver_ext *ext = this->ext;
-
- struct font_entry *old_current = ext->current;
- char *old_family = xstrdup (ext->family); /* FIXME */
- int old_size = ext->size;
-
- int fh = this->font_height;
- int y = -3 * fh;
-
- fprintf (ext->file.file, "%d %d %d %d GB%s",
- 0, YT (y), this->width, YT (y + 2 * fh + ext->line_gutter),
- ext->eol);
- this->class->text_set_font_family (this, "T");
-
- y += ext->line_width + ext->line_gutter;
-
- {
- int rh_width;
- char buf[128];
-
- sprintf (buf, _("%s - Page %d"), get_start_date (), ext->page_number);
- rh_width = text_width (this, buf);
-
- out_text_plain (this, buf, this->width - this->prop_em_width - rh_width,
- y, rh_width);
-
- if (outp_title && outp_subtitle)
- out_text_plain (this, outp_title, this->prop_em_width, y,
- this->width - 3 * this->prop_em_width - rh_width);
-
- y += fh;
- }
-
- {
- int rh_width;
- char buf[128];
- char *string = outp_subtitle ? outp_subtitle : outp_title;
-
- sprintf (buf, "%s - %s", version, host_system);
- rh_width = text_width (this, buf);
-
- out_text_plain (this, buf, this->width - this->prop_em_width - rh_width,
- y, rh_width);
-
- if (string)
- out_text_plain (this, string, this->prop_em_width, y,
- this->width - 3 * this->prop_em_width - rh_width);
-
- y += fh;
- }
-
- ext->current = old_current;
- free (ext->family);
- ext->family = old_family;
- ext->size = old_size;
-}
-
-\f
-/* Text. */
-
-static void
-ps_text_set_font_by_name (struct outp_driver *this, const char *dit)
-{
- struct ps_driver_ext *x = this->ext;
- struct font_entry *fe;
-
- assert (this->driver_open && this->page_open);
-
- /* Short-circuit common fonts. */
- if (!strcmp (dit, "PROP"))
- {
- x->current = x->prop;
- x->size = x->font_size;
- return;
- }
- else if (!strcmp (dit, "FIXED"))
- {
- x->current = x->fixed;
- x->size = x->font_size;
- return;
- }
-
- /* Find font_desc corresponding to Groff name dit. */
- fe = hsh_find (x->loaded, &dit);
- if (fe == NULL)
- fe = load_font (this, dit);
- x->current = fe;
-}
-
-static void
-ps_text_set_font_by_position (struct outp_driver *this, int pos)
-{
- struct ps_driver_ext *x = this->ext;
- char *dit;
-
- assert (this->driver_open && this->page_open);
-
- /* Determine font name by suffixing position string to font family
- name. */
- {
- char *cp;
-
- dit = local_alloc (strlen (x->family) + 3);
- cp = stpcpy (dit, x->family);
- switch (pos)
- {
- case OUTP_F_R:
- *cp++ = 'R';
- break;
- case OUTP_F_I:
- *cp++ = 'I';
- break;
- case OUTP_F_B:
- *cp++ = 'B';
- break;
- case OUTP_F_BI:
- *cp++ = 'B';
- *cp++ = 'I';
- break;
- default:
- assert(0);
- }
- *cp++ = 0;
- }
-
- /* Find font_desc corresponding to Groff name dit. */
- {
- struct font_entry *fe = hsh_find (x->loaded, &dit);
- if (fe == NULL)
- fe = load_font (this, dit);
- x->current = fe;
- }
-
- local_free (dit);
-}
-
-static void
-ps_text_set_font_family (struct outp_driver *this, const char *s)
-{
- struct ps_driver_ext *x = this->ext;
-
- assert (this->driver_open && this->page_open);
-
- free(x->family);
- x->family = xstrdup (s);
-}
-
-static const char *
-ps_text_get_font_name (struct outp_driver *this)
-{
- struct ps_driver_ext *x = this->ext;
-
- assert (this->driver_open && this->page_open);
- return x->current->font->name;
-}
-
-static const char *
-ps_text_get_font_family (struct outp_driver *this)
-{
- struct ps_driver_ext *x = this->ext;
-
- assert (this->driver_open && this->page_open);
- return x->family;
-}
-
-static int
-ps_text_set_size (struct outp_driver *this, int size)
-{
- struct ps_driver_ext *x = this->ext;
-
- assert (this->driver_open && this->page_open);
- x->size = PSUS / 72000 * size;
- return 1;
-}
-
-static int
-ps_text_get_size (struct outp_driver *this, int *em_width)
-{
- struct ps_driver_ext *x = this->ext;
-
- assert (this->driver_open && this->page_open);
- if (em_width)
- *em_width = (x->current->font->space_width * x->size) / 1000;
- return x->size / (PSUS / 72000);
-}
-
-/* An output character. */
-struct output_char
- {
- struct font_entry *font; /* Font of character. */
- int size; /* Size of character. */
- int x, y; /* Location of character. */
- unsigned char ch; /* Character. */
- char separate; /* Must be separate from previous char. */
- };
-
-/* Hash table comparison function for ps_combo structs. */
-static int
-compare_ps_combo (const void *pa, const void *pb, void *foo UNUSED)
-{
- const struct ps_font_combo *a = pa;
- const struct ps_font_combo *b = pb;
-
- return !((a->font == b->font) && (a->size == b->size));
-}
-
-/* Hash table hash function for ps_combo structs. */
-static unsigned
-hash_ps_combo (const void *pa, void *foo UNUSED)
-{
- const struct ps_font_combo *a = pa;
- unsigned name_hash = hsh_hash_string (a->font->font->internal_name);
- return name_hash ^ hsh_hash_int (a->size);
-}
-
-/* Hash table free function for ps_combo structs. */
-static void
-free_ps_combo (void *a, void *foo UNUSED)
-{
- free (a);
-}
-
-/* Causes PostScript code to be output that switches to the font
- CP->FONT and font size CP->SIZE. The first time a particular
- font/size combination is used on a particular page, this involves
- outputting PostScript code to load the font. */
-static void
-switch_font (struct outp_driver *this, const struct output_char *cp)
-{
- struct ps_driver_ext *ext = this->ext;
- struct ps_font_combo srch, **fc;
-
- srch.font = cp->font;
- srch.size = cp->size;
-
- fc = (struct ps_font_combo **) hsh_probe (ext->combos, &srch);
- if (*fc)
- {
- fprintf (ext->file.file, "F%x%s", (*fc)->index, ext->eol);
- }
- else
- {
- char *filename;
- struct ps_encoding *encoding;
- char buf[512], *bp;
-
- *fc = xmalloc (sizeof **fc);
- (*fc)->font = cp->font;
- (*fc)->size = cp->size;
- (*fc)->index = ext->next_combo++;
-
- filename = find_encoding_file (this, cp->font->font->encoding);
- if (filename)
- {
- encoding = get_encoding (this, filename);
- free (filename);
- }
- else
- {
- msg (IE, _("PostScript driver: Cannot find encoding `%s' for "
- "PostScript font `%s'."), cp->font->font->encoding,
- cp->font->font->internal_name);
- encoding = default_encoding (this);
- }
-
- if (cp->font != ext->fixed && cp->font != ext->prop)
- {
- bp = stpcpy (buf, "%%IncludeResource: font ");
- bp = quote_ps_string (bp, cp->font->font->internal_name);
- bp = stpcpy (bp, ext->eol);
- }
- else
- bp = buf;
-
- bp = spprintf (bp, "/F%x E%x %d", (*fc)->index, encoding->index,
- cp->size);
- bp = quote_ps_name (bp, cp->font->font->internal_name);
- sprintf (bp, " SF%s", ext->eol);
- fputs (buf, ext->file.file);
- }
- ext->last_font = *fc;
-}
-
-/* (write_text) Writes the accumulated line buffer to the output
- file. */
-#define output_line() \
- do \
- { \
- lp = stpcpy (lp, ext->eol); \
- *lp = 0; \
- fputs (line, ext->file.file); \
- lp = line; \
- } \
- while (0)
-
-/* (write_text) Adds the string representing number X to the line
- buffer, flushing the buffer to disk beforehand if necessary. */
-#define put_number(X) \
- do \
- { \
- int n = nsprintf (number, "%d", X); \
- if (n + lp > &line[75]) \
- output_line (); \
- lp = stpcpy (lp, number); \
- } \
- while (0)
-
-/* Outputs PostScript code to THIS driver's output file to display the
- characters represented by the output_char's between CP and END,
- using the associated outp_text T to determine formatting. WIDTH is
- the width of the output region; WIDTH_LEFT is the amount of the
- WIDTH that is not taken up by text (so it can be used to determine
- justification). */
-static void
-write_text (struct outp_driver *this,
- const struct output_char *cp, const struct output_char *end,
- struct outp_text *t, int width UNUSED, int width_left)
-{
- struct ps_driver_ext *ext = this->ext;
- int ofs;
-
- int last_y;
-
- char number[INT_DIGITS + 1];
- char line[80];
- char *lp;
-
- switch (t->options & OUTP_T_JUST_MASK)
- {
- case OUTP_T_JUST_LEFT:
- ofs = 0;
- break;
- case OUTP_T_JUST_RIGHT:
- ofs = width_left;
- break;
- case OUTP_T_JUST_CENTER:
- ofs = width_left / 2;
- break;
- default:
- assert (0);
- abort ();
- }
-
- lp = line;
- last_y = INT_MIN;
- while (cp < end)
- {
- int x = cp->x + ofs;
- int y = cp->y + (cp->font->font->ascent * cp->size / 1000);
-
- if (ext->last_font == NULL
- || cp->font != ext->last_font->font
- || cp->size != ext->last_font->size)
- switch_font (this, cp);
-
- *lp++ = '(';
- do
- {
- /* PORTME! */
- static unsigned char literal_chars[ODA_COUNT][32] =
- {
- {0x00, 0x00, 0x00, 0xf8, 0xff, 0xfc, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- },
- {0x00, 0x00, 0x00, 0xf8, 0xff, 0xfc, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
- },
- {0x7e, 0xd6, 0xff, 0xfb, 0xff, 0xfc, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
- 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
- }
- };
-
- if (TEST_BIT (literal_chars[ext->data], cp->ch))
- *lp++ = cp->ch;
- else
- switch ((char) cp->ch)
- {
- case '(':
- lp = stpcpy (lp, "\\(");
- break;
- case ')':
- lp = stpcpy (lp, "\\)");
- break;
- default:
- lp = spprintf (lp, "\\%03o", cp->ch);
- break;
- }
- cp++;
- }
- while (cp < end && lp < &line[70] && cp->separate == 0);
- *lp++ = ')';
-
- put_number (x);
-
- if (y != last_y)
- {
- *lp++ = ' ';
- put_number (YT (y));
- *lp++ = ' ';
- *lp++ = 'S';
- last_y = y;
- }
- else
- {
- *lp++ = ' ';
- *lp++ = 'T';
- }
-
- if (lp >= &line[70])
- output_line ();
- }
- if (lp != line)
- output_line ();
-}
-
-#undef output_line
-#undef put_number
-
-/* Displays the text in outp_text T, if DRAW is nonzero; or, merely
- determine the text metrics, if DRAW is zero. */
-static void
-text (struct outp_driver *this, struct outp_text *t, int draw)
-{
- struct ps_driver_ext *ext = this->ext;
-
- /* Output. */
- struct output_char *buf; /* Output buffer. */
- struct output_char *buf_end; /* End of output buffer. */
- struct output_char *buf_loc; /* Current location in output buffer. */
-
- /* Saved state. */
- struct font_entry *old_current = ext->current;
- char *old_family = xstrdup (ext->family); /* FIXME */
- int old_size = ext->size;
-
- /* Input string. */
- char *cp, *end;
-
- /* Current location. */
- int x, y;
-
- /* Keeping track of what's left over. */
- int width; /* Width available for characters. */
- int width_left, height_left; /* Width, height left over. */
- int max_height; /* Tallest character on this line so far. */
-
- /* Previous character. */
- int prev_char;
-
- /* Information about location of previous space. */
- char *space_char; /* Character after space. */
- struct output_char *space_buf_loc; /* Buffer location after space. */
- int space_width_left; /* Width of characters before space. */
-
- /* Name of the current character. */
- const char *char_name;
- char local_char_name[2] = {0, 0};
-
- local_char_name[0] = local_char_name[1] = 0;
-
- buf = local_alloc (sizeof *buf * 128);
- buf_end = &buf[128];
- buf_loc = buf;
-
- assert (!ls_null_p (&t->s));
- cp = ls_c_str (&t->s);
- end = ls_end (&t->s);
- if (draw)
- {
- x = t->x;
- y = t->y;
- }
- else
- x = y = 0;
- width = width_left = (t->options & OUTP_T_HORZ) ? t->h : INT_MAX;
- height_left = (t->options & OUTP_T_VERT) ? t->v : INT_MAX;
- max_height = 0;
- prev_char = -1;
- space_char = NULL;
- space_buf_loc = NULL;
- space_width_left = 0;
-
-
- if (!width || !height_left)
- goto exit;
-
- while (cp < end)
- {
- struct char_metrics *metric;
- int cur_char;
- int kern_amt;
- int char_width;
- int separate = 0;
-
- /* Set char_name to the name of the character or ligature at
- *cp. */
- local_char_name[0] = *cp;
- char_name = local_char_name;
- if (ext->current->font->ligatures && *cp == 'f')
- {
- int lig = 0;
- char_name = NULL;
-
- if (cp < end - 1)
- switch (cp[1])
- {
- case 'i':
- lig = LIG_fi, char_name = "fi";
- break;
- case 'l':
- lig = LIG_fl, char_name = "fl";
- break;
- case 'f':
- if (cp < end - 2)
- switch (cp[2])
- {
- case 'i':
- lig = LIG_ffi, char_name = "ffi";
- goto got_ligature;
- case 'l':
- lig = LIG_ffl, char_name = "ffl";
- goto got_ligature;
- }
- lig = LIG_ff, char_name = "ff";
- got_ligature:
- break;
- }
- if ((lig & ext->current->font->ligatures) == 0)
- {
- local_char_name[0] = *cp; /* 'f' */
- char_name = local_char_name;
- }
- }
- else if (*cp == '\n')
- {
- if (draw)
- {
- write_text (this, buf, buf_loc, t, width, width_left);
- buf_loc = buf;
- x = t->x;
- y += max_height;
- }
-
- width_left = width;
- height_left -= max_height;
- max_height = 0;
- kern_amt = 0;
- separate = 1;
- cp++;
-
- /* FIXME: when we're page buffering it will be necessary to
- set separate to 1. */
- continue;
- }
- cp += strlen (char_name);
-
- /* Figure out what size this character is, and what kern
- adjustment we need. */
- cur_char = font_char_name_to_index (char_name);
- metric = font_get_char_metrics (ext->current->font, cur_char);
- if (!metric)
- {
- static struct char_metrics m;
- metric = &m;
- m.width = ext->current->font->space_width;
- m.code = *char_name;
- }
- kern_amt = font_get_kern_adjust (ext->current->font, prev_char,
- cur_char);
- if (kern_amt)
- {
- kern_amt = (kern_amt * ext->size / 1000);
- separate = 1;
- }
- char_width = metric->width * ext->size / 1000;
-
- /* Record the current status if this is a space character. */
- if (cur_char == space_index && buf_loc > buf)
- {
- space_char = cp;
- space_buf_loc = buf_loc;
- space_width_left = width_left;
- }
-
- /* Drop down to a new line if there's no room left on this
- line. */
- if (char_width + kern_amt > width_left)
- {
- /* Regress to previous space, if any. */
- if (space_char)
- {
- cp = space_char;
- width_left = space_width_left;
- buf_loc = space_buf_loc;
- }
-
- if (draw)
- {
- write_text (this, buf, buf_loc, t, width, width_left);
- buf_loc = buf;
- x = t->x;
- y += max_height;
- }
-
- width_left = width;
- height_left -= max_height;
- max_height = 0;
- kern_amt = 0;
-
- if (space_char)
- {
- space_char = NULL;
- prev_char = -1;
- /* FIXME: when we're page buffering it will be
- necessary to set separate to 1. */
- continue;
- }
- separate = 1;
- }
- if (ext->size > max_height)
- max_height = ext->size;
- if (max_height > height_left)
- goto exit;
-
- /* Actually draw the character. */
- if (draw)
- {
- if (buf_loc >= buf_end)
- {
- int buf_len = buf_end - buf;
-
- if (buf_len == 128)
- {
- struct output_char *new_buf;
-
- new_buf = xmalloc (sizeof *new_buf * 256);
- memcpy (new_buf, buf, sizeof *new_buf * 128);
- buf_loc = new_buf + 128;
- buf_end = new_buf + 256;
- local_free (buf);
- buf = new_buf;
- }
- else
- {
- buf = xnrealloc (buf, buf_len * 2, sizeof *buf);
- buf_loc = buf + buf_len;
- buf_end = buf + buf_len * 2;
- }
- }
-
- x += kern_amt;
- buf_loc->font = ext->current;
- buf_loc->size = ext->size;
- buf_loc->x = x;
- buf_loc->y = y;
- buf_loc->ch = metric->code;
- buf_loc->separate = separate;
- buf_loc++;
- x += char_width;
- }
-
- /* Prepare for next iteration. */
- width_left -= char_width + kern_amt;
- prev_char = cur_char;
- }
- height_left -= max_height;
- if (buf_loc > buf && draw)
- write_text (this, buf, buf_loc, t, width, width_left);
-
-exit:
- if (!(t->options & OUTP_T_HORZ))
- t->h = INT_MAX - width_left;
- if (!(t->options & OUTP_T_VERT))
- t->v = INT_MAX - height_left;
- else
- t->v -= height_left;
- if (buf_end - buf == 128)
- local_free (buf);
- else
- free (buf);
- ext->current = old_current;
- free (ext->family);
- ext->family = old_family;
- ext->size = old_size;
-}
-
-static void
-ps_text_metrics (struct outp_driver *this, struct outp_text *t)
-{
- assert (this->driver_open && this->page_open);
- text (this, t, 0);
-}
-
-static void
-ps_text_draw (struct outp_driver *this, struct outp_text *t)
-{
- assert (this->driver_open && this->page_open);
- text (this, t, 1);
-}
-\f
-/* Font loader. */
-
-/* Translate a filename to a font. */
-struct filename2font
- {
- char *filename; /* Normalized filename. */
- struct font_desc *font;
- };
-
-/* Table of `filename2font's. */
-static struct hsh_table *ps_fonts;
-
-/* Hash table comparison function for filename2font structs. */
-static int
-compare_filename2font (const void *a, const void *b, void *param UNUSED)
-{
- return strcmp (((struct filename2font *) a)->filename,
- ((struct filename2font *) b)->filename);
-}
-
-/* Hash table hash function for filename2font structs. */
-static unsigned
-hash_filename2font (const void *f2f_, void *param UNUSED)
-{
- const struct filename2font *f2f = f2f_;
- return hsh_hash_string (f2f->filename);
-}
-
-/* Initializes the global font list by creating the hash table for
- translation of filenames to font_desc structs. */
-static void
-init_fonts (void)
-{
- ps_fonts = hsh_create (31, compare_filename2font, hash_filename2font,
- NULL, NULL);
-}
-
-static void
-done_fonts (void)
-{
- hsh_destroy (ps_fonts);
-}
-
-/* Loads the font having Groff name DIT into THIS driver instance.
- Specifically, adds it into the THIS driver's `loaded' hash
- table. */
-static struct font_entry *
-load_font (struct outp_driver *this, const char *dit)
-{
- struct ps_driver_ext *x = this->ext;
- char *filename1, *filename2;
- void **entry;
- struct font_entry *fe;
-
- filename1 = find_ps_file (this, dit);
- if (!filename1)
- filename1 = xstrdup (dit);
- filename2 = fn_normalize (filename1);
- free (filename1);
-
- entry = hsh_probe (ps_fonts, &filename2);
- if (*entry == NULL)
- {
- struct filename2font *f2f;
- struct font_desc *f = groff_read_font (filename2);
-
- if (f == NULL)
- {
- if (x->fixed)
- f = x->fixed->font;
- else
- f = default_font ();
- }
-
- f2f = xmalloc (sizeof *f2f);
- f2f->filename = filename2;
- f2f->font = f;
- *entry = f2f;
- }
- else
- free (filename2);
-
- fe = xmalloc (sizeof *fe);
- fe->dit = xstrdup (dit);
- fe->font = ((struct filename2font *) * entry)->font;
- *hsh_probe (x->loaded, &dit) = fe;
-
- return fe;
-}
-
-static void
-ps_chart_initialise (struct outp_driver *this UNUSED, struct chart *ch)
-{
-#ifdef NO_CHARTS
- ch->lp = NULL;
-#else
- struct ps_driver_ext *x = this->ext;
- char page_size[128];
- int size;
- int x_origin, y_origin;
-
- ch->file = tmpfile ();
- if (ch->file == NULL)
- {
- ch->lp = NULL;
- return;
- }
-
- size = this->width < this->length ? this->width : this->length;
- x_origin = x->left_margin + (size - this->width) / 2;
- y_origin = x->bottom_margin + (size - this->length) / 2;
-
- snprintf (page_size, sizeof page_size,
- "a,xsize=%.3f,ysize=%.3f,xorigin=%.3f,yorigin=%.3f",
- (double) size / PSUS, (double) size / PSUS,
- (double) x_origin / PSUS, (double) y_origin / PSUS);
-
- ch->pl_params = pl_newplparams ();
- pl_setplparam (ch->pl_params, "PAGESIZE", page_size);
- ch->lp = pl_newpl_r ("ps", NULL, ch->file, stderr, ch->pl_params);
-#endif
-}
-
-static void
-ps_chart_finalise (struct outp_driver *this UNUSED, struct chart *ch UNUSED)
-{
-#ifndef NO_CHARTS
- struct ps_driver_ext *x = this->ext;
- char buf[BUFSIZ];
- static int doc_num = 0;
-
- if (this->page_open)
- {
- this->class->close_page (this);
- this->page_open = 0;
- }
- this->class->open_page (this);
- fprintf (x->file.file,
- "/sp save def%s"
- "%d %d translate 1000 dup scale%s"
- "userdict begin%s"
- "/showpage { } def%s"
- "0 setgray 0 setlinecap 1 setlinewidth%s"
- "0 setlinejoin 10 setmiterlimit [ ] 0 setdash newpath clear%s"
- "%%%%BeginDocument: %d%s",
- x->eol,
- -x->left_margin, -x->bottom_margin, x->eol,
- x->eol,
- x->eol,
- x->eol,
- x->eol,
- doc_num++, x->eol);
-
- rewind (ch->file);
- while (fwrite (buf, 1, fread (buf, 1, sizeof buf, ch->file), x->file.file))
- continue;
- fclose (ch->file);
-
- fprintf (x->file.file,
- "%%%%EndDocument%s"
- "end%s"
- "sp restore%s",
- x->eol,
- x->eol,
- x->eol);
- this->class->close_page (this);
- this->page_open = 0;
-#endif
-}
-
-/* PostScript driver class. */
-struct outp_class postscript_class =
-{
- "postscript",
- MAGIC_PS,
- 0,
-
- ps_open_global,
- ps_close_global,
- ps_font_sizes,
-
- ps_preopen_driver,
- ps_option,
- ps_postopen_driver,
- ps_close_driver,
-
- ps_open_page,
- ps_close_page,
-
- ps_submit,
-
- ps_line_horz,
- ps_line_vert,
- ps_line_intersection,
-
- ps_box,
- ps_polyline_begin,
- ps_polyline_point,
- ps_polyline_end,
-
- ps_text_set_font_by_name,
- ps_text_set_font_by_position,
- ps_text_set_font_family,
- ps_text_get_font_name,
- ps_text_get_font_family,
- ps_text_set_size,
- ps_text_get_size,
- ps_text_metrics,
- ps_text_draw,
-
- ps_chart_initialise,
- ps_chart_finalise
-};
-
-/* EPSF driver class. FIXME: Probably doesn't work right. */
-struct outp_class epsf_class =
-{
- "epsf",
- MAGIC_EPSF,
- 0,
-
- ps_open_global,
- ps_close_global,
- ps_font_sizes,
-
- ps_preopen_driver,
- ps_option,
- ps_postopen_driver,
- ps_close_driver,
-
- ps_open_page,
- ps_close_page,
-
- ps_submit,
-
- ps_line_horz,
- ps_line_vert,
- ps_line_intersection,
-
- ps_box,
- ps_polyline_begin,
- ps_polyline_point,
- ps_polyline_end,
-
- ps_text_set_font_by_name,
- ps_text_set_font_by_position,
- ps_text_set_font_family,
- ps_text_get_font_name,
- ps_text_get_font_family,
- ps_text_set_size,
- ps_text_get_size,
- ps_text_metrics,
- ps_text_draw,
-
- ps_chart_initialise,
- ps_chart_finalise
-
-};
-
-#endif /* NO_POSTSCRIPT */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-/* FIXME: seems like a lot of code duplication with data-list.c. */
-
-#include <config.h>
-#include "error.h"
-#include <stdlib.h>
-#include "alloc.h"
-#include "case.h"
-#include "command.h"
-#include "dfm-write.h"
-#include "error.h"
-#include "expressions/public.h"
-#include "file-handle.h"
-#include "lexer.h"
-#include "misc.h"
-#include "som.h"
-#include "tab.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* Describes what to do when an output field is encountered. */
-enum
- {
- PRT_ERROR, /* Invalid value. */
- PRT_NEWLINE, /* Newline. */
- PRT_CONST, /* Constant string. */
- PRT_VAR, /* Variable. */
- PRT_SPACE /* A single space. */
- };
-
-/* Describes how to output one field. */
-struct prt_out_spec
- {
- struct prt_out_spec *next;
- int type; /* PRT_* constant. */
- int fc; /* 0-based first column. */
- union
- {
- char *c; /* PRT_CONST: Associated string. */
- struct
- {
- struct variable *v; /* PRT_VAR: Associated variable. */
- struct fmt_spec f; /* PRT_VAR: Output spec. */
- }
- v;
- }
- u;
- };
-
-/* Enums for use with print_trns's `options' field. */
-enum
- {
- PRT_CMD_MASK = 1, /* Command type mask. */
- PRT_PRINT = 0, /* PRINT transformation identifier. */
- PRT_WRITE = 1, /* WRITE transformation identifier. */
- PRT_EJECT = 002, /* Can be combined with CMD_PRINT only. */
- PRT_BINARY = 004 /* File is binary, omit newlines. */
- };
-
-/* PRINT, PRINT EJECT, WRITE private data structure. */
-struct print_trns
- {
- struct dfm_writer *writer; /* Output file, NULL=listing file. */
- int options; /* PRT_* bitmapped field. */
- struct prt_out_spec *spec; /* Output specifications. */
- int max_width; /* Maximum line width including null. */
- char *line; /* Buffer for sticking lines in. */
- };
-
-/* PRT_PRINT or PRT_WRITE. */
-int which_cmd;
-
-/* Holds information on parsing the data file. */
-static struct print_trns prt;
-
-/* Last prt_out_spec in the chain. Used for building the linked-list. */
-static struct prt_out_spec *next;
-
-/* Number of records. */
-static int nrec;
-
-static int internal_cmd_print (int flags);
-static trns_proc_func print_trns_proc;
-static trns_free_func print_trns_free;
-static int parse_specs (void);
-static void dump_table (const struct file_handle *);
-static void append_var_spec (struct prt_out_spec *);
-static void alloc_line (void);
-\f
-/* Basic parsing. */
-
-/* Parses PRINT command. */
-int
-cmd_print (void)
-{
- return internal_cmd_print (PRT_PRINT);
-}
-
-/* Parses PRINT EJECT command. */
-int
-cmd_print_eject (void)
-{
- return internal_cmd_print (PRT_PRINT | PRT_EJECT);
-}
-
-/* Parses WRITE command. */
-int
-cmd_write (void)
-{
- return internal_cmd_print (PRT_WRITE);
-}
-
-/* Parses the output commands. F is PRT_PRINT, PRT_WRITE, or
- PRT_PRINT|PRT_EJECT. */
-static int
-internal_cmd_print (int f)
-{
- int table = 0; /* Print table? */
- struct print_trns *trns; /* malloc()'d transformation. */
- struct file_handle *fh = NULL;
-
- /* Fill in prt to facilitate error-handling. */
- prt.writer = NULL;
- prt.options = f;
- prt.spec = NULL;
- prt.line = NULL;
- next = NULL;
- nrec = 0;
-
- which_cmd = f & PRT_CMD_MASK;
-
- /* Parse the command options. */
- while (!lex_match ('/'))
- {
- if (lex_match_id ("OUTFILE"))
- {
- lex_match ('=');
-
- fh = fh_parse (FH_REF_FILE);
- if (fh == NULL)
- goto error;
- }
- else if (lex_match_id ("RECORDS"))
- {
- lex_match ('=');
- lex_match ('(');
- if (!lex_force_int ())
- goto error;
- nrec = lex_integer ();
- lex_get ();
- lex_match (')');
- }
- else if (lex_match_id ("TABLE"))
- table = 1;
- else if (lex_match_id ("NOTABLE"))
- table = 0;
- else
- {
- lex_error (_("expecting a valid subcommand"));
- goto error;
- }
- }
-
- /* Parse variables and strings. */
- if (!parse_specs ())
- goto error;
-
- if (fh != NULL)
- {
- prt.writer = dfm_open_writer (fh);
- if (prt.writer == NULL)
- goto error;
-
- if (fh_get_mode (fh) == FH_MODE_BINARY)
- prt.options |= PRT_BINARY;
- }
-
- /* Output the variable table if requested. */
- if (table)
- dump_table (fh);
-
- /* Count the maximum line width. Allocate linebuffer if
- applicable. */
- alloc_line ();
-
- /* Put the transformation in the queue. */
- trns = xmalloc (sizeof *trns);
- memcpy (trns, &prt, sizeof *trns);
- add_transformation (print_trns_proc, print_trns_free, trns);
-
- return CMD_SUCCESS;
-
- error:
- print_trns_free (&prt);
- return CMD_FAILURE;
-}
-
-/* Appends the field output specification SPEC to the list maintained
- in prt. */
-static void
-append_var_spec (struct prt_out_spec *spec)
-{
- if (next == 0)
- prt.spec = next = xmalloc (sizeof *spec);
- else
- next = next->next = xmalloc (sizeof *spec);
-
- memcpy (next, spec, sizeof *spec);
- next->next = NULL;
-}
-\f
-/* Field parsing. Mostly stolen from data-list.c. */
-
-/* Used for chaining together fortran-like format specifiers. */
-struct fmt_list
-{
- struct fmt_list *next;
- int count;
- struct fmt_spec f;
- struct fmt_list *down;
-};
-
-/* Used as "local" variables among the fixed-format parsing funcs. If
- it were guaranteed that PSPP were going to be compiled by gcc,
- I'd make all these functions a single set of nested functions. */
-static struct
- {
- struct variable **v; /* variable list */
- size_t nv; /* number of variables in list */
- size_t cv; /* number of variables from list used up so far
- by the FORTRAN-like format specifiers */
-
- int recno; /* current 1-based record number */
- int sc; /* 1-based starting column for next variable */
-
- struct prt_out_spec spec; /* next format spec to append to list */
- int fc, lc; /* first, last 1-based column number of current
- var */
-
- int level; /* recursion level for FORTRAN-like format
- specifiers */
- }
-fx;
-
-static int fixed_parse_compatible (void);
-static struct fmt_list *fixed_parse_fortran (void);
-
-static int parse_string_argument (void);
-static int parse_variable_argument (void);
-
-/* Parses all the variable and string specifications on a single
- PRINT, PRINT EJECT, or WRITE command into the prt structure.
- Returns success. */
-static int
-parse_specs (void)
-{
- /* Return code from called function. */
- int code;
-
- fx.recno = 1;
- fx.sc = 1;
-
- while (token != '.')
- {
- while (lex_match ('/'))
- {
- int prev_recno = fx.recno;
-
- fx.recno++;
- if (lex_is_number ())
- {
- if (!lex_force_int ())
- return 0;
- if (lex_integer () < fx.recno)
- {
- msg (SE, _("The record number specified, %ld, is "
- "before the previous record, %d. Data "
- "fields must be listed in order of "
- "increasing record number."),
- lex_integer (), fx.recno - 1);
- return 0;
- }
- fx.recno = lex_integer ();
- lex_get ();
- }
-
- fx.spec.type = PRT_NEWLINE;
- while (prev_recno++ < fx.recno)
- append_var_spec (&fx.spec);
-
- fx.sc = 1;
- }
-
- if (token == T_STRING)
- code = parse_string_argument ();
- else
- code = parse_variable_argument ();
- if (!code)
- return 0;
- }
- fx.spec.type = PRT_NEWLINE;
- append_var_spec (&fx.spec);
-
- if (!nrec)
- nrec = fx.recno;
- else if (fx.recno > nrec)
- {
- msg (SE, _("Variables are specified on records that "
- "should not exist according to RECORDS subcommand."));
- return 0;
- }
-
- if (token != '.')
- {
- lex_error (_("expecting end of command"));
- return 0;
- }
-
- return 1;
-}
-
-/* Parses a string argument to the PRINT commands. Returns success. */
-static int
-parse_string_argument (void)
-{
- fx.spec.type = PRT_CONST;
- fx.spec.fc = fx.sc - 1;
- fx.spec.u.c = xstrdup (ds_c_str (&tokstr));
- lex_get ();
-
- /* Parse the included column range. */
- if (lex_is_number ())
- {
- /* Width of column range in characters. */
- int c_len;
-
- /* Width of constant string in characters. */
- int s_len;
-
- /* 1-based index of last column in range. */
- int lc;
-
- if (!lex_is_integer () || lex_integer () <= 0)
- {
- msg (SE, _("%g is not a valid column location."), tokval);
- goto fail;
- }
- fx.spec.fc = lex_integer () - 1;
-
- lex_get ();
- lex_negative_to_dash ();
- if (lex_match ('-'))
- {
- if (!lex_is_integer ())
- {
- msg (SE, _("Column location expected following `%d-'."),
- fx.spec.fc + 1);
- goto fail;
- }
- if (lex_integer () <= 0)
- {
- msg (SE, _("%g is not a valid column location."), tokval);
- goto fail;
- }
- if (lex_integer () < fx.spec.fc + 1)
- {
- msg (SE, _("%d-%ld is not a valid column range. The second "
- "column must be greater than or equal to the first."),
- fx.spec.fc + 1, lex_integer ());
- goto fail;
- }
- lc = lex_integer () - 1;
-
- lex_get ();
- }
- else
- /* If only a starting location is specified then the field is
- the width of the provided string. */
- lc = fx.spec.fc + strlen (fx.spec.u.c) - 1;
-
- /* Apply the range. */
- c_len = lc - fx.spec.fc + 1;
- s_len = strlen (fx.spec.u.c);
- if (s_len > c_len)
- fx.spec.u.c[c_len] = 0;
- else if (s_len < c_len)
- {
- fx.spec.u.c = xrealloc (fx.spec.u.c, c_len + 1);
- memset (&fx.spec.u.c[s_len], ' ', c_len - s_len);
- fx.spec.u.c[c_len] = 0;
- }
-
- fx.sc = lc + 1;
- }
- else
- /* If nothing is provided then the field is the width of the
- provided string. */
- fx.sc += strlen (fx.spec.u.c);
-
- append_var_spec (&fx.spec);
- return 1;
-
-fail:
- free (fx.spec.u.c);
- return 0;
-}
-
-/* Parses a variable argument to the PRINT commands by passing it off
- to fixed_parse_compatible() or fixed_parse_fortran() as appropriate.
- Returns success. */
-static int
-parse_variable_argument (void)
-{
- if (!parse_variables (default_dict, &fx.v, &fx.nv, PV_DUPLICATE))
- return 0;
-
- if (lex_is_number ())
- {
- if (!fixed_parse_compatible ())
- goto fail;
- }
- else if (token == '(')
- {
- fx.level = 0;
- fx.cv = 0;
- if (!fixed_parse_fortran ())
- goto fail;
- }
- else
- {
- /* User wants dictionary format specifiers. */
- size_t i;
-
- lex_match ('*');
- for (i = 0; i < fx.nv; i++)
- {
- /* Variable. */
- fx.spec.type = PRT_VAR;
- fx.spec.fc = fx.sc - 1;
- fx.spec.u.v.v = fx.v[i];
- fx.spec.u.v.f = fx.v[i]->print;
- append_var_spec (&fx.spec);
- fx.sc += fx.v[i]->print.w;
-
- /* Space. */
- fx.spec.type = PRT_SPACE;
- fx.spec.fc = fx.sc - 1;
- append_var_spec (&fx.spec);
- fx.sc++;
- }
- }
-
- free (fx.v);
- return 1;
-
-fail:
- free (fx.v);
- return 0;
-}
-
-/* Verifies that FORMAT doesn't need a variable wider than WIDTH.
- Returns true iff that is the case. */
-static bool
-check_string_width (const struct fmt_spec *format, const struct variable *v)
-{
- if (get_format_var_width (format) > v->width)
- {
- msg (SE, _("Variable %s has width %d so it cannot be output "
- "as format %s."),
- v->name, v->width, fmt_to_string (format));
- return false;
- }
- return true;
-}
-
-/* Parses a column specification for parse_specs(). */
-static int
-fixed_parse_compatible (void)
-{
- int individual_var_width;
- int type;
- size_t i;
-
- type = fx.v[0]->type;
- for (i = 1; i < fx.nv; i++)
- if (type != fx.v[i]->type)
- {
- msg (SE, _("%s is not of the same type as %s. To specify "
- "variables of different types in the same variable "
- "list, use a FORTRAN-like format specifier."),
- fx.v[i]->name, fx.v[0]->name);
- return 0;
- }
-
- if (!lex_force_int ())
- return 0;
- fx.fc = lex_integer () - 1;
- if (fx.fc < 0)
- {
- msg (SE, _("Column positions for fields must be positive."));
- return 0;
- }
- lex_get ();
-
- lex_negative_to_dash ();
- if (lex_match ('-'))
- {
- if (!lex_force_int ())
- return 0;
- fx.lc = lex_integer () - 1;
- if (fx.lc < 0)
- {
- msg (SE, _("Column positions for fields must be positive."));
- return 0;
- }
- else if (fx.lc < fx.fc)
- {
- msg (SE, _("The ending column for a field must not "
- "be less than the starting column."));
- return 0;
- }
- lex_get ();
- }
- else
- fx.lc = fx.fc;
-
- fx.spec.u.v.f.w = fx.lc - fx.fc + 1;
- if (lex_match ('('))
- {
- struct fmt_desc *fdp;
-
- if (token == T_ID)
- {
- const char *cp;
-
- fx.spec.u.v.f.type = parse_format_specifier_name (&cp, 0);
- if (fx.spec.u.v.f.type == -1)
- return 0;
- if (*cp)
- {
- msg (SE, _("A format specifier on this line "
- "has extra characters on the end."));
- return 0;
- }
- lex_get ();
- lex_match (',');
- }
- else
- fx.spec.u.v.f.type = FMT_F;
-
- if (lex_is_number ())
- {
- if (!lex_force_int ())
- return 0;
- if (lex_integer () < 1)
- {
- msg (SE, _("The value for number of decimal places "
- "must be at least 1."));
- return 0;
- }
- fx.spec.u.v.f.d = lex_integer ();
- lex_get ();
- }
- else
- fx.spec.u.v.f.d = 0;
-
- fdp = &formats[fx.spec.u.v.f.type];
- if (fdp->n_args < 2 && fx.spec.u.v.f.d)
- {
- msg (SE, _("Input format %s doesn't accept decimal places."),
- fdp->name);
- return 0;
- }
- if (fx.spec.u.v.f.d > 16)
- fx.spec.u.v.f.d = 16;
-
- if (!lex_force_match (')'))
- return 0;
- }
- else
- {
- fx.spec.u.v.f.type = FMT_F;
- fx.spec.u.v.f.d = 0;
- }
-
- fx.sc = fx.lc + 1;
-
- if ((fx.lc - fx.fc + 1) % fx.nv)
- {
- msg (SE, _("The %d columns %d-%d can't be evenly divided into %u "
- "fields."),
- fx.lc - fx.fc + 1, fx.fc + 1, fx.lc + 1, (unsigned) fx.nv);
- return 0;
- }
-
- individual_var_width = (fx.lc - fx.fc + 1) / fx.nv;
- fx.spec.u.v.f.w = individual_var_width;
- if (!check_output_specifier (&fx.spec.u.v.f, true)
- || !check_specifier_type (&fx.spec.u.v.f, type, true))
- return 0;
- if (type == ALPHA)
- {
- for (i = 0; i < fx.nv; i++)
- if (!check_string_width (&fx.spec.u.v.f, fx.v[i]))
- return false;
- }
-
- fx.spec.type = PRT_VAR;
- for (i = 0; i < fx.nv; i++)
- {
- fx.spec.fc = fx.fc + individual_var_width * i;
- fx.spec.u.v.v = fx.v[i];
- append_var_spec (&fx.spec);
- }
- return 1;
-}
-
-/* Destroy a format list and, optionally, all its sublists. */
-static void
-destroy_fmt_list (struct fmt_list *f, int recurse)
-{
- struct fmt_list *next;
-
- for (; f; f = next)
- {
- next = f->next;
- if (recurse && f->f.type == FMT_DESCEND)
- destroy_fmt_list (f->down, 1);
- free (f);
- }
-}
-
-/* Recursively puts the format list F (which represents a set of
- FORTRAN-like format specifications, like 4(F10,2X)) into the
- structure prt. */
-static int
-dump_fmt_list (struct fmt_list *f)
-{
- int i;
-
- for (; f; f = f->next)
- if (f->f.type == FMT_X)
- fx.sc += f->count;
- else if (f->f.type == FMT_T)
- fx.sc = f->f.w;
- else if (f->f.type == FMT_NEWREC)
- {
- fx.recno += f->count;
- fx.sc = 1;
- fx.spec.type = PRT_NEWLINE;
- for (i = 0; i < f->count; i++)
- append_var_spec (&fx.spec);
- }
- else
- for (i = 0; i < f->count; i++)
- if (f->f.type == FMT_DESCEND)
- {
- if (!dump_fmt_list (f->down))
- return 0;
- }
- else
- {
- struct variable *v;
-
- if (fx.cv >= fx.nv)
- {
- msg (SE, _("The number of format "
- "specifications exceeds the number of variable "
- "names given."));
- return 0;
- }
-
- v = fx.v[fx.cv++];
- if (!check_output_specifier (&f->f, true)
- || !check_specifier_type (&f->f, v->type, true)
- || !check_string_width (&f->f, v))
- return false;
-
- fx.spec.type = PRT_VAR;
- fx.spec.u.v.v = v;
- fx.spec.u.v.f = f->f;
- fx.spec.fc = fx.sc - 1;
- append_var_spec (&fx.spec);
-
- fx.sc += f->f.w;
- }
- return 1;
-}
-
-/* Recursively parses a list of FORTRAN-like format specifiers. Calls
- itself to parse nested levels of parentheses. Returns to its
- original caller NULL, to indicate error, non-NULL, but nothing
- useful, to indicate success (it returns a free()'d block). */
-static struct fmt_list *
-fixed_parse_fortran (void)
-{
- struct fmt_list *head = NULL;
- struct fmt_list *fl = NULL;
-
- lex_get (); /* skip opening parenthesis */
- while (token != ')')
- {
- if (fl)
- fl = fl->next = xmalloc (sizeof *fl);
- else
- head = fl = xmalloc (sizeof *fl);
-
- if (lex_is_number ())
- {
- if (!lex_is_integer ())
- goto fail;
- fl->count = lex_integer ();
- lex_get ();
- }
- else
- fl->count = 1;
-
- if (token == '(')
- {
- fl->f.type = FMT_DESCEND;
- fx.level++;
- fl->down = fixed_parse_fortran ();
- fx.level--;
- if (!fl->down)
- goto fail;
- }
- else if (lex_match ('/'))
- fl->f.type = FMT_NEWREC;
- else if (!parse_format_specifier (&fl->f, FMTP_ALLOW_XT)
- || !check_output_specifier (&fl->f, 1))
- goto fail;
-
- lex_match (',');
- }
- fl->next = NULL;
- lex_get ();
-
- if (fx.level)
- return head;
-
- fl->next = NULL;
- dump_fmt_list (head);
- destroy_fmt_list (head, 1);
- if (fx.cv < fx.nv)
- {
- msg (SE, _("There aren't enough format specifications "
- "to match the number of variable names given."));
- goto fail;
- }
- return head;
-
-fail:
- fl->next = NULL;
- destroy_fmt_list (head, 0);
-
- return NULL;
-}
-
-/* Prints the table produced by the TABLE subcommand to the listing
- file. */
-static void
-dump_table (const struct file_handle *fh)
-{
- struct prt_out_spec *spec;
- struct tab_table *t;
- int recno;
- int nspec;
-
- for (nspec = 0, spec = prt.spec; spec; spec = spec->next)
- if (spec->type == PRT_CONST || spec->type == PRT_VAR)
- nspec++;
- t = tab_create (4, nspec + 1, 0);
- tab_columns (t, TAB_COL_DOWN, 1);
- tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, nspec);
- tab_hline (t, TAL_2, 0, 3, 1);
- tab_headers (t, 0, 0, 1, 0);
- tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
- tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
- tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
- tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
- tab_dim (t, tab_natural_dimensions);
- for (nspec = recno = 0, spec = prt.spec; spec; spec = spec->next)
- switch (spec->type)
- {
- case PRT_NEWLINE:
- recno++;
- break;
- case PRT_CONST:
- {
- int len = strlen (spec->u.c);
- nspec++;
- tab_text (t, 0, nspec, TAB_LEFT | TAT_FIX | TAT_PRINTF,
- "\"%s\"", spec->u.c);
- tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
- tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
- spec->fc + 1, spec->fc + len);
- tab_text (t, 3, nspec, TAB_LEFT | TAT_FIX | TAT_PRINTF,
- "A%d", len);
- break;
- }
- case PRT_VAR:
- {
- nspec++;
- tab_text (t, 0, nspec, TAB_LEFT, spec->u.v.v->name);
- tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
- tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
- spec->fc + 1, spec->fc + spec->u.v.f.w);
- tab_text (t, 3, nspec, TAB_LEFT | TAT_FIX,
- fmt_to_string (&spec->u.v.f));
- break;
- }
- case PRT_SPACE:
- break;
- case PRT_ERROR:
- assert (0);
- }
-
- if (fh != NULL)
- tab_title (t, 1, ngettext ("Writing %d record to %s.",
- "Writing %d records to %s.", recno),
- recno, fh_get_name (fh));
- else
- tab_title (t, 1, ngettext ("Writing %d record.",
- "Writing %d records.", recno), recno);
- tab_submit (t);
-}
-
-/* PORTME: The number of characters in a line terminator. */
-#ifdef __MSDOS__
-#define LINE_END_WIDTH 2 /* \r\n */
-#else
-#define LINE_END_WIDTH 1 /* \n */
-#endif
-
-/* Calculates the maximum possible line width and allocates a buffer
- big enough to contain it */
-static void
-alloc_line (void)
-{
- /* Cumulative maximum line width (excluding null terminator) so far. */
- int w = 0;
-
- /* Width required by current this prt_out_spec. */
- int pot_w; /* Potential w. */
-
- /* Iterator. */
- struct prt_out_spec *i;
-
- for (i = prt.spec; i; i = i->next)
- {
- switch (i->type)
- {
- case PRT_NEWLINE:
- pot_w = 0;
- break;
- case PRT_CONST:
- pot_w = i->fc + strlen (i->u.c);
- break;
- case PRT_VAR:
- pot_w = i->fc + i->u.v.f.w;
- break;
- case PRT_SPACE:
- pot_w = i->fc + 1;
- break;
- case PRT_ERROR:
- default:
- assert (0);
- abort ();
- }
- if (pot_w > w)
- w = pot_w;
- }
- prt.max_width = w + LINE_END_WIDTH + 1;
- prt.line = xmalloc (prt.max_width);
-}
-\f
-/* Transformation. */
-
-/* Performs the transformation inside print_trns T on case C. */
-static int
-print_trns_proc (void *trns_, struct ccase *c, int case_num UNUSED)
-{
- /* Transformation. */
- struct print_trns *t = trns_;
-
- /* Iterator. */
- struct prt_out_spec *i;
-
- /* Line buffer. */
- char *buf = t->line;
-
- /* Length of the line in buf. */
- int len = 0;
- memset (buf, ' ', t->max_width);
-
- if (t->options & PRT_EJECT)
- som_eject_page ();
-
- /* Note that a field written to a place where a field has
- already been written truncates the record. `PRINT /A B
- (T10,F8,T1,F8).' only outputs B. */
- for (i = t->spec; i; i = i->next)
- switch (i->type)
- {
- case PRT_NEWLINE:
- if (t->writer == NULL)
- {
- buf[len] = 0;
- tab_output_text (TAT_FIX | TAT_NOWRAP, buf);
- }
- else
- {
- if ((t->options & PRT_CMD_MASK) == PRT_PRINT
- || !(t->options & PRT_BINARY))
- {
- /* PORTME: Line ends. */
-#ifdef __MSDOS__
- buf[len++] = '\r';
-#endif
- buf[len++] = '\n';
- }
-
- dfm_put_record (t->writer, buf, len);
- }
-
- memset (buf, ' ', t->max_width);
- len = 0;
- break;
-
- case PRT_CONST:
- /* FIXME: Should be revised to keep track of the string's
- length outside the loop, probably in i->u.c[0]. */
- memcpy (&buf[i->fc], i->u.c, strlen (i->u.c));
- len = i->fc + strlen (i->u.c);
- break;
-
- case PRT_VAR:
- data_out (&buf[i->fc], &i->u.v.f, case_data (c, i->u.v.v->fv));
- len = i->fc + i->u.v.f.w;
- break;
-
- case PRT_SPACE:
- /* PRT_SPACE always immediately follows PRT_VAR. */
- buf[len++] = ' ';
- break;
-
- case PRT_ERROR:
- assert (0);
- break;
- }
-
- return -1;
-}
-
-/* Frees all the data inside print_trns T. Does not free T. */
-static void
-print_trns_free (void *prt_)
-{
- struct print_trns *prt = prt_;
- struct prt_out_spec *i, *n;
-
- for (i = prt->spec; i; i = n)
- {
- switch (i->type)
- {
- case PRT_CONST:
- free (i->u.c);
- /* fall through */
- case PRT_NEWLINE:
- case PRT_VAR:
- case PRT_SPACE:
- /* nothing to do */
- break;
- case PRT_ERROR:
- assert (0);
- break;
- }
- n = i->next;
- free (i);
- }
- if (prt->writer != NULL)
- dfm_close_writer (prt->writer);
- free (prt->line);
- free (prt);
-}
-\f
-/* PRINT SPACE. */
-
-/* PRINT SPACE transformation. */
-struct print_space_trns
-{
- struct dfm_writer *writer; /* Output data file. */
- struct expression *e; /* Number of lines; NULL=1. */
-}
-print_space_trns;
-
-static trns_proc_func print_space_trns_proc;
-static trns_free_func print_space_trns_free;
-
-int
-cmd_print_space (void)
-{
- struct print_space_trns *t;
- struct file_handle *fh;
- struct expression *e;
- struct dfm_writer *writer;
-
- if (lex_match_id ("OUTFILE"))
- {
- lex_match ('=');
-
- fh = fh_parse (FH_REF_FILE);
- if (fh == NULL)
- return CMD_FAILURE;
- lex_get ();
- }
- else
- fh = NULL;
-
- if (token != '.')
- {
- e = expr_parse (default_dict, EXPR_NUMBER);
- if (token != '.')
- {
- expr_free (e);
- lex_error (_("expecting end of command"));
- return CMD_FAILURE;
- }
- }
- else
- e = NULL;
-
- if (fh != NULL)
- {
- writer = dfm_open_writer (fh);
- if (writer == NULL)
- {
- expr_free (e);
- return CMD_FAILURE;
- }
- }
- else
- writer = NULL;
-
- t = xmalloc (sizeof *t);
- t->writer = writer;
- t->e = e;
-
- add_transformation (print_space_trns_proc, print_space_trns_free, t);
- return CMD_SUCCESS;
-}
-
-static int
-print_space_trns_proc (void *t_, struct ccase *c,
- int case_num UNUSED)
-{
- struct print_space_trns *t = t_;
- double n = 1.;
-
- if (t->e)
- {
- n = expr_evaluate_num (t->e, c, case_num);
- if (n == SYSMIS)
- msg (SW, _("The expression on PRINT SPACE evaluated to the "
- "system-missing value."));
- else if (n < 0)
- msg (SW, _("The expression on PRINT SPACE evaluated to %g."), n);
- n = 1.;
- }
-
- if (t->writer == NULL)
- while (n--)
- som_blank_line ();
- else
- {
- char buf[LINE_END_WIDTH];
-
- /* PORTME: Line ends. */
-#ifdef __MSDOS__
- buf[0] = '\r';
- buf[1] = '\n';
-#else
- buf[0] = '\n';
-#endif
- while (n--)
- dfm_put_record (t->writer, buf, LINE_END_WIDTH);
- }
-
- return -1;
-}
-
-static void
-print_space_trns_free (void *trns_)
-{
- struct print_space_trns *trns = trns_;
- expr_free (trns->e);
- free (trns);
-}
+++ /dev/null
-/* q2c - parser generator for PSPP procedures.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <assert.h>
-#include <ctype.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <stdarg.h>
-#include <time.h>
-#include <errno.h>
-#if HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-#include "str.h"
-
-
-/* Brokenness. */
-#ifndef EXIT_SUCCESS
-#define EXIT_SUCCESS 0
-#endif
-
-#ifndef EXIT_FAILURE
-#define EXIT_FAILURE 1
-#endif
-
-#if !HAVE_STRERROR
-#include "misc/strerror.c"
-#endif
-
-#include "debug-print.h"
-
-/* Max length of an input line. */
-#define MAX_LINE_LEN 1024
-
-/* Max token length. */
-#define MAX_TOK_LEN 1024
-
-/* argv[0]. */
-char *program_name;
-
-/* Have the input and output files been opened yet? */
-int is_open;
-
-/* Input, output files. */
-FILE *in, *out;
-
-/* Input, output file names. */
-char *ifn, *ofn;
-
-/* Input, output file line number. */
-int ln, oln = 1;
-
-/* Input line buffer, current position. */
-char *buf, *cp;
-
-/* Token types. */
-enum
- {
- T_STRING = 256, /* String literal. */
- T_ID = 257 /* Identifier. */
- };
-
-/* Current token: either one of the above, or a single character. */
-int token;
-
-/* Token string value. */
-char *tokstr;
-\f
-/* Utility functions. */
-
-char nullstr[] = "";
-
-/* Close all open files and delete the output file, on failure. */
-static void
-finish_up (void)
-{
- if (!is_open)
- return;
- is_open = 0;
- fclose (in);
- fclose (out);
- if (remove (ofn) == -1)
- fprintf (stderr, "%s: %s: remove: %s\n", program_name, ofn, strerror (errno));
-}
-
-void hcf (void) NO_RETURN;
-
-/* Terminate unsuccessfully. */
-void
-hcf (void)
-{
- finish_up ();
- exit (EXIT_FAILURE);
-}
-
-int fail (const char *, ...) PRINTF_FORMAT (1, 2);
-int error (const char *, ...) PRINTF_FORMAT (1, 2);
-
-/* Output an error message and terminate unsuccessfully. */
-int
-fail (const char *format, ...)
-{
- va_list args;
-
- va_start (args, format);
- fprintf (stderr, "%s: ", program_name);
- vfprintf (stderr, format, args);
- fprintf (stderr, "\n");
- va_end (args);
-
- hcf ();
-}
-
-/* Output a context-dependent error message and terminate
- unsuccessfully. */
-int
-error (const char *format,...)
-{
- va_list args;
-
- va_start (args, format);
- fprintf (stderr, "%s:%d: (column %d) ", ifn, ln, (int) (cp - buf));
- vfprintf (stderr, format, args);
- fprintf (stderr, "\n");
- va_end (args);
-
- hcf ();
-}
-
-#define VME "virtual memory exhausted"
-
-/* Allocate a block of SIZE bytes and return a pointer to its
- beginning. */
-static void *
-xmalloc (size_t size)
-{
- void *vp;
-
- if (size == 0)
- return NULL;
-
- vp = malloc (size);
- if (!vp)
- fail ("xmalloc(%lu): %s", (unsigned long) size, VME);
-
- return vp;
-}
-
-/* Make a dynamically allocated copy of string S and return a pointer
- to the first character. */
-static char *
-xstrdup (const char *s)
-{
- size_t size;
- char *t;
-
- assert (s != NULL);
- size = strlen (s) + 1;
-
- t = malloc (size);
- if (!t)
- fail ("xstrdup(%lu): %s", (unsigned long) strlen (s), VME);
-
- memcpy (t, s, size);
- return t;
-}
-
-/* Returns a pointer to one of 8 static buffers. The buffers are used
- in rotation. */
-static char *
-get_buffer (void)
-{
- static char b[8][256];
- static int cb;
-
- if (++cb >= 8)
- cb = 0;
-
- return b[cb];
-}
-
-/* Copies a string to a static buffer, converting it to lowercase in
- the process, and returns a pointer to the static buffer. */
-static char *
-st_lower (const char *s)
-{
- char *p, *cp;
-
- p = cp = get_buffer ();
- while (*s)
- *cp++ = tolower ((unsigned char) (*s++));
- *cp++ = '\0';
-
- return p;
-}
-
-/* Copies a string to a static buffer, converting it to uppercase in
- the process, and returns a pointer to the static buffer. */
-static char *
-st_upper (const char *s)
-{
- char *p, *cp;
-
- p = cp = get_buffer ();
- while (*s)
- *cp++ = toupper ((unsigned char) (*s++));
- *cp++ = '\0';
-
- return p;
-}
-
-/* Returns the address of the first non-whitespace character in S, or
- the address of the null terminator if none. */
-static char *
-skip_ws (const char *s)
-{
- while (isspace ((unsigned char) *s))
- s++;
- return (char *) s;
-}
-
-/* Read one line from the input file into buf. Lines having special
- formats are handled specially. */
-static int
-get_line (void)
-{
- ln++;
- if (0 == fgets (buf, MAX_LINE_LEN, in))
- {
- if (ferror (in))
- fail ("%s: fgets: %s", ifn, strerror (errno));
- return 0;
- }
-
- cp = strchr (buf, '\n');
- if (cp != NULL)
- *cp = '\0';
-
- cp = buf;
- return 1;
-}
-\f
-/* Symbol table manager. */
-
-/* Symbol table entry. */
-typedef struct symbol symbol;
-struct symbol
- {
- symbol *next; /* Next symbol in symbol table. */
- char *name; /* Symbol name. */
- int unique; /* 1=Name must be unique in this file. */
- int ln; /* Line number of definition. */
- int value; /* Symbol value. */
- };
-
-/* Symbol table. */
-symbol *symtab;
-
-/* Add a symbol to the symbol table having name NAME, uniqueness
- UNIQUE, and value VALUE. If a symbol having the same name is found
- in the symbol table, its sequence number is returned and the symbol
- table is not modified. Otherwise, the symbol is added and the next
- available sequence number is returned. */
-static int
-add_symbol (const char *name, int unique, int value)
-{
- symbol *iter, *sym;
- int x;
-
- sym = xmalloc (sizeof *sym);
- sym->name = xstrdup (name);
- sym->unique = unique;
- sym->value = value;
- sym->next = NULL;
- sym->ln = ln;
- if (!symtab)
- {
- symtab = sym;
- return 1;
- }
- iter = symtab;
- x = 1;
- for (;;)
- {
- if (!strcmp (iter->name, name))
- {
- if (iter->unique)
- {
- fprintf (stderr, "%s:%d: `%s' is already defined above\n", ifn,
- ln, name);
- fprintf (stderr, "%s:%d: location of previous definition\n", ifn,
- iter->ln);
- hcf ();
- }
- free (sym->name);
- free (sym);
- return x;
- }
- if (!iter->next)
- break;
- iter = iter->next;
- x++;
- }
- iter->next = sym;
- return ++x;
-}
-
-/* Finds the symbol having given sequence number X within the symbol
- table, and returns the associated symbol structure. */
-static symbol *
-find_symbol (int x)
-{
- symbol *iter;
-
- iter = symtab;
- while (x > 1 && iter)
- {
- iter = iter->next;
- x--;
- }
- assert (iter);
- return iter;
-}
-
-#if DEBUGGING
-/* Writes a printable representation of the current token to
- stdout. */
-static void
-dump_token (void)
-{
- switch (token)
- {
- case T_STRING:
- printf ("STRING\t\"%s\"\n", tokstr);
- break;
- case T_ID:
- printf ("ID\t%s\n", tokstr);
- break;
- default:
- printf ("PUNCT\t%c\n", token);
- }
-}
-#endif /* DEBUGGING */
-
-/* Reads a token from the input file. */
-static int
-lex_get (void)
-{
- /* Skip whitespace and check for end of file. */
- for (;;)
- {
- cp = skip_ws (cp);
- if (*cp != '\0')
- break;
-
- if (!get_line ())
- fail ("%s: Unexpected end of file.", ifn);
- }
-
- if (*cp == '"')
- {
- char *dest = tokstr;
- token = T_STRING;
- cp++;
- while (*cp != '"' && *cp)
- {
- if (*cp == '\\')
- {
- cp++;
- if (!*cp)
- error ("Unterminated string literal.");
- *dest++ = *cp++;
- }
- else
- *dest++ = *cp++;
- }
- *dest++ = 0;
- if (!*cp)
- error ("Unterminated string literal.");
- cp++;
- }
- else if (*cp == '_' || isalnum ((unsigned char) *cp))
- {
- char *dest = tokstr;
- token = T_ID;
- while (*cp == '_' || isalnum ((unsigned char) *cp))
- *dest++ = toupper ((unsigned char) (*cp++));
- *dest++ = '\0';
- }
- else
- token = *cp++;
-
-#if DEBUGGING
- dump_token ();
-#endif
-
- return token;
-}
-
-/* Force the current token to be an identifier token. */
-static void
-force_id (void)
-{
- if (token != T_ID)
- error ("Identifier expected.");
-}
-
-/* Force the current token to be a string token. */
-static void
-force_string (void)
-{
- if (token != T_STRING)
- error ("String expected.");
-}
-
-/* Checks whether the current token is the identifier S; if so, skips
- the token and returns 1; otherwise, returns 0. */
-static int
-match_id (const char *s)
-{
- if (token == T_ID && !strcmp (tokstr, s))
- {
- lex_get ();
- return 1;
- }
- return 0;
-}
-
-/* Checks whether the current token is T. If so, skips the token and
- returns 1; otherwise, returns 0. */
-static int
-match_token (int t)
-{
- if (token == t)
- {
- lex_get ();
- return 1;
- }
- return 0;
-}
-
-/* Force the current token to be T, and skip it. */
-static void
-skip_token (int t)
-{
- if (token != t)
- error ("`%c' expected.", t);
- lex_get ();
-}
-\f
-/* Structures. */
-
-/* Some specifiers have associated values. */
-enum
- {
- VAL_NONE, /* No value. */
- VAL_INT, /* Integer value. */
- VAL_DBL /* Floating point value. */
- };
-
-/* For those specifiers with values, the syntax of those values. */
-enum
- {
- VT_PLAIN, /* Unadorned value. */
- VT_PAREN /* Value must be enclosed in parentheses. */
- };
-
-/* Forward definition. */
-typedef struct specifier specifier;
-
-/* A single setting. */
-typedef struct setting setting;
-struct setting
- {
- specifier *parent; /* Owning specifier. */
- setting *next; /* Next in the chain. */
- char *specname; /* Name of the setting. */
- int con; /* Sequence number. */
-
- /* Values. */
- int valtype; /* One of VT_*. */
- int value; /* One of VAL_*. */
- int optvalue; /* 1=value is optional, 0=value is required. */
- char *valname; /* Variable name for the value. */
- char *restriction; /* !=NULL: expression specifying valid values. */
- };
-
-/* A single specifier. */
-struct specifier
- {
- specifier *next; /* Next in the chain. */
- char *varname; /* Variable name. */
- setting *s; /* Associated settings. */
-
- setting *def; /* Default setting. */
- setting *omit_kw; /* Setting for which the keyword can be omitted. */
-
- int index; /* Next array index. */
- };
-
-/* Subcommand types. */
-typedef enum
- {
- SBC_PLAIN, /* The usual case. */
- SBC_VARLIST, /* Variable list. */
- SBC_INT, /* Integer value. */
- SBC_PINT, /* Integer inside parentheses. */
- SBC_DBL, /* Floating point value. */
- SBC_INT_LIST, /* List of integers (?). */
- SBC_DBL_LIST, /* List of floating points (?). */
- SBC_CUSTOM, /* Custom. */
- SBC_ARRAY, /* Array of boolean values. */
- SBC_STRING, /* String value. */
- SBC_VAR /* Single variable name. */
- }
-subcommand_type;
-
-typedef enum
- {
- ARITY_ONCE_EXACTLY, /* must occur exactly once */
- ARITY_ONCE_ONLY, /* zero or once */
- ARITY_MANY /* 0, 1, ... , inf */
- }subcommand_arity;
-
-/* A single subcommand. */
-typedef struct subcommand subcommand;
-struct subcommand
- {
- subcommand *next; /* Next in the chain. */
- char *name; /* Subcommand name. */
- subcommand_type type; /* One of SBC_*. */
- subcommand_arity arity; /* How many times should the subcommand occur*/
- int narray; /* Index of next array element. */
- const char *prefix; /* Prefix for variable and constant names. */
- specifier *spec; /* Array of specifiers. */
-
- /* SBC_STRING and SBC_INT only. */
- char *restriction; /* Expression restricting string length. */
- char *message; /* Error message. */
- int translatable; /* Error message is translatable */
- };
-
-/* Name of the command; i.e., DESCRIPTIVES. */
-char *cmdname;
-
-/* Short prefix for the command; i.e., `dsc_'. */
-char *prefix;
-
-/* List of subcommands. */
-subcommand *subcommands;
-
-/* Default subcommand if any, or NULL. */
-subcommand *def;
-\f
-/* Parsing. */
-
-void parse_subcommands (void);
-
-/* Parse an entire specification. */
-static void
-parse (void)
-{
- /* Get the command name and prefix. */
- if (token != T_STRING && token != T_ID)
- error ("Command name expected.");
- cmdname = xstrdup (tokstr);
- lex_get ();
- skip_token ('(');
- force_id ();
- prefix = xstrdup (tokstr);
- lex_get ();
- skip_token (')');
- skip_token (':');
-
- /* Read all the subcommands. */
- subcommands = NULL;
- def = NULL;
- parse_subcommands ();
-}
-
-/* Parses a single setting into S, given subcommand information SBC
- and specifier information SPEC. */
-static void
-parse_setting (setting *s, specifier *spec)
-{
- s->parent = spec;
-
- if (match_token ('*'))
- {
- if (spec->omit_kw)
- error ("Cannot have two settings with omittable keywords.");
- else
- spec->omit_kw = s;
- }
-
- if (match_token ('!'))
- {
- if (spec->def)
- error ("Cannot have two default settings.");
- else
- spec->def = s;
- }
-
- force_id ();
- s->specname = xstrdup (tokstr);
- s->con = add_symbol (s->specname, 0, 0);
- s->value = VAL_NONE;
-
- lex_get ();
-
- /* Parse setting value info if necessary. */
- if (token != '/' && token != ';' && token != '.' && token != ',')
- {
- if (token == '(')
- {
- s->valtype = VT_PAREN;
- lex_get ();
- }
- else
- s->valtype = VT_PLAIN;
-
- s->optvalue = match_token ('*');
-
- if (match_id ("N"))
- s->value = VAL_INT;
- else if (match_id ("D"))
- s->value = VAL_DBL;
- else
- error ("`n' or `d' expected.");
-
- skip_token (':');
-
- force_id ();
- s->valname = xstrdup (tokstr);
- lex_get ();
-
- if (token == ',')
- {
- lex_get ();
- force_string ();
- s->restriction = xstrdup (tokstr);
- lex_get ();
- }
- else
- s->restriction = NULL;
-
- if (s->valtype == VT_PAREN)
- skip_token (')');
- }
-}
-
-/* Parse a single specifier into SPEC, given subcommand information
- SBC. */
-static void
-parse_specifier (specifier *spec, subcommand *sbc)
-{
- spec->index = 0;
- spec->s = NULL;
- spec->def = NULL;
- spec->omit_kw = NULL;
- spec->varname = NULL;
-
- if (token == T_ID)
- {
- spec->varname = xstrdup (st_lower (tokstr));
- lex_get ();
- }
-
- /* Handle array elements. */
- if (token != ':')
- {
- spec->index = sbc->narray;
- if (sbc->type == SBC_ARRAY)
- {
- if (token == '|')
- token = ',';
- else
- sbc->narray++;
- }
- spec->s = NULL;
- return;
- }
- skip_token (':');
-
- if ( sbc->type == SBC_ARRAY && token == T_ID )
- {
- spec->varname = xstrdup (st_lower (tokstr));
- spec->index = sbc->narray;
- sbc->narray++;
- }
-
-
-
- /* Parse all the settings. */
- {
- setting **s = &spec->s;
-
- for (;;)
- {
- *s = xmalloc (sizeof **s);
- parse_setting (*s, spec);
- if (token == ',' || token == ';' || token == '.')
- break;
- skip_token ('/');
- s = &(*s)->next;
- }
- (*s)->next = NULL;
- }
-}
-
-/* Parse a list of specifiers for subcommand SBC. */
-static void
-parse_specifiers (subcommand *sbc)
-{
- specifier **spec = &sbc->spec;
-
- if (token == ';' || token == '.')
- {
- *spec = NULL;
- return;
- }
-
- for (;;)
- {
- *spec = xmalloc (sizeof **spec);
- parse_specifier (*spec, sbc);
- if (token == ';' || token == '.')
- break;
- skip_token (',');
- spec = &(*spec)->next;
- }
- (*spec)->next = NULL;
-}
-
-/* Parse a subcommand into SBC. */
-static void
-parse_subcommand (subcommand *sbc)
-{
- sbc->arity = ARITY_MANY;
-
- if (match_token ('*'))
- {
- if (def)
- error ("Multiple default subcommands.");
- def = sbc;
- }
-
- if ( match_token('+'))
- sbc->arity = ARITY_ONCE_ONLY ;
- else if (match_token('^'))
- sbc->arity = ARITY_ONCE_EXACTLY ;
-
-
- force_id ();
- sbc->name = xstrdup (tokstr);
- lex_get ();
-
- sbc->narray = 0;
- sbc->type = SBC_PLAIN;
- sbc->spec = NULL;
- sbc->translatable = 0;
-
- if (match_token ('['))
- {
- force_id ();
- sbc->prefix = xstrdup (st_lower (tokstr));
- lex_get ();
-
- skip_token (']');
- skip_token ('=');
-
- sbc->type = SBC_ARRAY;
- parse_specifiers (sbc);
-
- }
- else
- {
- if (match_token ('('))
- {
- force_id ();
- sbc->prefix = xstrdup (st_lower (tokstr));
- lex_get ();
-
- skip_token (')');
- }
- else
- sbc->prefix = "";
-
- skip_token ('=');
-
- if (match_id ("VAR"))
- sbc->type = SBC_VAR;
- if (match_id ("VARLIST"))
- {
- if (match_token ('('))
- {
- force_string ();
- sbc->message = xstrdup (tokstr);
- lex_get();
-
- skip_token (')');
- }
- else sbc->message = NULL;
-
- sbc->type = SBC_VARLIST;
- }
- else if (match_id ("INTEGER"))
- {
- sbc->type = match_id ("LIST") ? SBC_INT_LIST : SBC_INT;
- if ( token == T_STRING)
- {
- sbc->restriction = xstrdup (tokstr);
- lex_get ();
- if ( match_id("N_") )
- {
- skip_token('(');
- force_string ();
- lex_get();
- skip_token(')');
- sbc->translatable = 1;
- }
- else {
- force_string ();
- lex_get ();
- }
- sbc->message = xstrdup (tokstr);
- }
- else
- sbc->restriction = NULL;
- }
- else if (match_id ("PINT"))
- sbc->type = SBC_PINT;
- else if (match_id ("DOUBLE"))
- {
- if ( match_id ("LIST") )
- sbc->type = SBC_DBL_LIST;
- else
- sbc->type = SBC_DBL;
- }
- else if (match_id ("STRING"))
- {
- sbc->type = SBC_STRING;
- if (token == T_STRING)
- {
- sbc->restriction = xstrdup (tokstr);
- lex_get ();
- force_string ();
- sbc->message = xstrdup (tokstr);
- lex_get ();
- }
- else
- sbc->restriction = NULL;
- }
- else if (match_id ("CUSTOM"))
- sbc->type = SBC_CUSTOM;
- else
- parse_specifiers (sbc);
- }
-}
-
-/* Parse all the subcommands. */
-void
-parse_subcommands (void)
-{
- subcommand **sbc = &subcommands;
-
- for (;;)
- {
- *sbc = xmalloc (sizeof **sbc);
- (*sbc)->next = NULL;
-
- parse_subcommand (*sbc);
-
- if (token == '.')
- return;
-
- skip_token (';');
- sbc = &(*sbc)->next;
- }
-}
-\f
-/* Output. */
-
-#define BASE_INDENT 2 /* Starting indent. */
-#define INC_INDENT 2 /* Indent increment. */
-
-/* Increment the indent. */
-#define indent() indent += INC_INDENT
-#define outdent() indent -= INC_INDENT
-
-/* Size of the indent from the left margin. */
-int indent;
-
-void dump (int, const char *, ...) PRINTF_FORMAT (2, 3);
-
-/* Write line FORMAT to the output file, formatted as with printf,
- indented `indent' characters from the left margin. If INDENTION is
- greater than 0, indents BASE_INDENT * INDENTION characters after
- writing the line; if INDENTION is less than 0, dedents BASE_INDENT
- * INDENTION characters _before_ writing the line. */
-void
-dump (int indention, const char *format, ...)
-{
- va_list args;
- int i;
-
- if (indention < 0)
- indent += BASE_INDENT * indention;
-
- oln++;
- va_start (args, format);
- for (i = 0; i < indent; i++)
- putc (' ', out);
- vfprintf (out, format, args);
- putc ('\n', out);
- va_end (args);
-
- if (indention > 0)
- indent += BASE_INDENT * indention;
-}
-
-/* Write the structure members for specifier SPEC to the output file.
- SBC is the including subcommand. */
-static void
-dump_specifier_vars (const specifier *spec, const subcommand *sbc)
-{
- if (spec->varname)
- dump (0, "long %s%s;", sbc->prefix, spec->varname);
-
- {
- setting *s;
-
- for (s = spec->s; s; s = s->next)
- {
- if (s->value != VAL_NONE)
- {
- const char *typename;
-
- assert (s->value == VAL_INT || s->value == VAL_DBL);
- typename = s->value == VAL_INT ? "long" : "double";
-
- dump (0, "%s %s%s;", typename, sbc->prefix, st_lower (s->valname));
- }
- }
- }
-}
-
-/* Returns 1 if string T is a PSPP keyword, 0 otherwise. */
-static int
-is_keyword (const char *t)
-{
- static const char *kw[] =
- {
- "AND", "OR", "NOT", "EQ", "GE", "GT", "LE", "LT",
- "NE", "ALL", "BY", "TO", "WITH", 0,
- };
- const char **cp;
-
- for (cp = kw; *cp; cp++)
- if (!strcmp (t, *cp))
- return 1;
- return 0;
-}
-
-/* Transforms a string NAME into a valid C identifier: makes
- everything lowercase and maps nonalphabetic characters to
- underscores. Returns a pointer to a static buffer. */
-static char *
-make_identifier (const char *name)
-{
- char *p = get_buffer ();
- char *cp;
-
- for (cp = p; *name; name++)
- if (isalpha ((unsigned char) *name))
- *cp++ = tolower ((unsigned char) (*name));
- else
- *cp++ = '_';
- *cp = '\0';
-
- return p;
-}
-
-/* Writes the struct and enum declarations for the parser. */
-static void
-dump_declarations (void)
-{
- indent = 0;
-
- /* Write out enums for all the identifiers in the symbol table. */
- {
- int f, k;
- symbol *sym;
- char *buf = NULL;
-
- /* Note the squirmings necessary to make sure that the last enum
- is not followed by a comma, as mandated by ANSI C89. */
- for (sym = symtab, f = k = 0; sym; sym = sym->next)
- if (!sym->unique && !is_keyword (sym->name))
- {
- if (!f)
- {
- dump (0, "/* Settings for subcommand specifiers. */");
- dump (1, "enum");
- dump (1, "{");
- f = 1;
- }
-
- if (buf == NULL)
- buf = xmalloc (1024);
- else
- dump (0, buf);
-
- if (k)
- sprintf (buf, "%s%s,", st_upper (prefix), sym->name);
- else
- {
- k = 1;
- sprintf (buf, "%s%s = 1000,", st_upper (prefix), sym->name);
- }
- }
- if (buf)
- {
- buf[strlen (buf) - 1] = 0;
- dump (0, buf);
- free (buf);
- }
- if (f)
- {
- dump (-1, "};");
- dump (-1, nullstr);
- }
- }
-
- /* Write out some type definitions */
- {
- dump (0, "#define MAXLISTS 10");
- }
-
-
- /* For every array subcommand, write out the associated enumerated
- values. */
- {
- subcommand *sbc;
-
- for (sbc = subcommands; sbc; sbc = sbc->next)
- if (sbc->type == SBC_ARRAY && sbc->narray)
- {
- dump (0, "/* Array indices for %s subcommand. */", sbc->name);
-
- dump (1, "enum");
- dump (1, "{");
-
- {
- specifier *spec;
-
- for (spec = sbc->spec; spec; spec = spec->next)
- dump (0, "%s%s%s = %d,",
- st_upper (prefix), st_upper (sbc->prefix),
- st_upper (spec->varname), spec->index);
-
- dump (0, "%s%scount", st_upper (prefix), st_upper (sbc->prefix));
-
- dump (-1, "};");
- dump (-1, nullstr);
- }
- }
- }
-
- /* Write out structure declaration. */
- {
- subcommand *sbc;
-
- dump (0, "/* %s structure. */", cmdname);
- dump (1, "struct cmd_%s", make_identifier (cmdname));
- dump (1, "{");
- for (sbc = subcommands; sbc; sbc = sbc->next)
- {
- int f = 0;
-
- if (sbc != subcommands)
- dump (0, nullstr);
-
- dump (0, "/* %s subcommand. */", sbc->name);
- dump (0, "int sbc_%s;", st_lower (sbc->name));
-
- switch (sbc->type)
- {
- case SBC_ARRAY:
- case SBC_PLAIN:
- {
- specifier *spec;
-
- for (spec = sbc->spec; spec; spec = spec->next)
- {
- if (spec->s == 0)
- {
- if (sbc->type == SBC_PLAIN)
- dump (0, "long int %s%s;", st_lower (sbc->prefix),
- spec->varname);
- else if (f == 0)
- {
- dump (0, "int a_%s[%s%scount];",
- st_lower (sbc->name),
- st_upper (prefix),
- st_upper (sbc->prefix)
- );
-
- f = 1;
- }
- }
- else
- dump_specifier_vars (spec, sbc);
- }
- }
- break;
-
- case SBC_VARLIST:
- dump (0, "size_t %sn_%s;", st_lower (sbc->prefix),
- st_lower (sbc->name));
- dump (0, "struct variable **%sv_%s;", st_lower (sbc->prefix),
- st_lower (sbc->name));
- break;
-
- case SBC_VAR:
- dump (0, "struct variable *%sv_%s;", st_lower (sbc->prefix),
- st_lower (sbc->name));
- break;
-
- case SBC_STRING:
- dump (0, "char *s_%s;", st_lower (sbc->name));
- break;
-
- case SBC_INT:
- case SBC_PINT:
- dump (0, "long n_%s[MAXLISTS];", st_lower (sbc->name));
- break;
-
- case SBC_DBL:
- dump (0, "double n_%s[MAXLISTS];", st_lower (sbc->name));
- break;
-
- case SBC_DBL_LIST:
- dump (0, "subc_list_double dl_%s[MAXLISTS];",
- st_lower(sbc->name));
- break;
-
- case SBC_INT_LIST:
- dump (0, "subc_list_int il_%s[MAXLISTS];",
- st_lower(sbc->name));
- break;
-
-
- default:;
- /* nothing */
- }
- }
-
- dump (-1, "};");
- dump (-1, nullstr);
- }
-
- /* Write out prototypes for custom_*() functions as necessary. */
- {
- int seen = 0;
- subcommand *sbc;
-
- for (sbc = subcommands; sbc; sbc = sbc->next)
- if (sbc->type == SBC_CUSTOM)
- {
- if (!seen)
- {
- seen = 1;
- dump (0, "/* Prototype for custom subcommands of %s. */",
- cmdname);
- }
- dump (0, "static int %scustom_%s (struct cmd_%s *);",
- st_lower (prefix), st_lower (sbc->name),
- make_identifier (cmdname));
- }
-
- if (seen)
- dump (0, nullstr);
- }
-
- /* Prototypes for parsing and freeing functions. */
- {
- dump (0, "/* Command parsing functions. */");
- dump (0, "static int parse_%s (struct cmd_%s *);",
- make_identifier (cmdname), make_identifier (cmdname));
- dump (0, "static void free_%s (struct cmd_%s *);",
- make_identifier (cmdname), make_identifier (cmdname));
- dump (0, nullstr);
- }
-}
-
-/* Writes out code to initialize all the variables that need
- initialization for particular specifier SPEC inside subcommand SBC. */
-static void
-dump_specifier_init (const specifier *spec, const subcommand *sbc)
-{
- if (spec->varname)
- {
- char s[256];
-
- if (spec->def)
- sprintf (s, "%s%s",
- st_upper (prefix), find_symbol (spec->def->con)->name);
- else
- strcpy (s, "-1");
- dump (0, "p->%s%s = %s;", sbc->prefix, spec->varname, s);
- }
-
- {
- setting *s;
-
- for (s = spec->s; s; s = s->next)
- {
- if (s->value != VAL_NONE)
- {
- const char *init;
-
- assert (s->value == VAL_INT || s->value == VAL_DBL);
- init = s->value == VAL_INT ? "NOT_LONG" : "SYSMIS";
-
- dump (0, "p->%s%s = %s;", sbc->prefix, st_lower (s->valname), init);
- }
- }
- }
-}
-
-/* Write code to initialize all variables. */
-static void
-dump_vars_init (int persistent)
-{
- /* Loop through all the subcommands. */
- {
- subcommand *sbc;
-
- for (sbc = subcommands; sbc; sbc = sbc->next)
- {
- int f = 0;
-
- dump (0, "p->sbc_%s = 0;", st_lower (sbc->name));
- if ( ! persistent )
- {
- switch (sbc->type)
- {
- case SBC_INT_LIST:
- break;
-
- case SBC_DBL_LIST:
- dump (1, "{");
- dump (0, "int i;");
- dump (1, "for (i = 0; i < MAXLISTS; ++i)");
- dump (0, "subc_list_double_create(&p->dl_%s[i]) ;",
- st_lower (sbc->name)
- );
- dump (-2, "}");
- break;
-
- case SBC_DBL:
- dump (1, "{");
- dump (0, "int i;");
- dump (1, "for (i = 0; i < MAXLISTS; ++i)");
- dump (0, "p->n_%s[i] = SYSMIS;", st_lower (sbc->name));
- dump (-2, "}");
- break;
-
- case SBC_CUSTOM:
- /* nothing */
- break;
-
- case SBC_PLAIN:
- case SBC_ARRAY:
- {
- specifier *spec;
-
- for (spec = sbc->spec; spec; spec = spec->next)
- if (spec->s == NULL)
- {
- if (sbc->type == SBC_PLAIN)
- dump (0, "p->%s%s = 0;", sbc->prefix, spec->varname);
- else if (f == 0)
- {
- dump (0, "memset (p->a_%s, 0, sizeof p->a_%s);",
- st_lower (sbc->name), st_lower (sbc->name));
- f = 1;
- }
- }
- else
- dump_specifier_init (spec, sbc);
- }
- break;
-
- case SBC_VARLIST:
- dump (0, "p->%sn_%s = 0;",
- st_lower (sbc->prefix), st_lower (sbc->name));
- dump (0, "p->%sv_%s = NULL;",
- st_lower (sbc->prefix), st_lower (sbc->name));
- break;
-
- case SBC_VAR:
- dump (0, "p->%sv_%s = NULL;",
- st_lower (sbc->prefix), st_lower (sbc->name));
- break;
-
- case SBC_STRING:
- dump (0, "p->s_%s = NULL;", st_lower (sbc->name));
- break;
-
- case SBC_INT:
- case SBC_PINT:
- dump (1, "{");
- dump (0, "int i;");
- dump (1, "for (i = 0; i < MAXLISTS; ++i)");
- dump (0, "p->n_%s[i] = NOT_LONG;", st_lower (sbc->name));
- dump (-2, "}");
- break;
-
- default:
- assert (0);
- }
- }
- }
- }
-}
-
-/* Return a pointer to a static buffer containing an expression that
- will match token T. */
-static char *
-make_match (const char *t)
-{
- char *s;
-
- s = get_buffer ();
-
- while (*t == '_')
- t++;
-
- if (is_keyword (t))
- sprintf (s, "lex_match (T_%s)", t);
- else if (!strcmp (t, "ON") || !strcmp (t, "YES"))
- strcpy (s, "(lex_match_id (\"ON\") || lex_match_id (\"YES\") "
- "|| lex_match_id (\"TRUE\"))");
- else if (!strcmp (t, "OFF") || !strcmp (t, "NO"))
- strcpy (s, "(lex_match_id (\"OFF\") || lex_match_id (\"NO\") "
- "|| lex_match_id (\"FALSE\"))");
- else if (isdigit ((unsigned char) t[0]))
- sprintf (s, "lex_match_int (%s)", t);
- else
- sprintf (s, "lex_match_id (\"%s\")", t);
-
- return s;
-}
-
-/* Write out the parsing code for specifier SPEC within subcommand
- SBC. */
-static void
-dump_specifier_parse (const specifier *spec, const subcommand *sbc)
-{
- setting *s;
-
- if (spec->omit_kw && spec->omit_kw->next)
- error ("Omittable setting is not last setting in `%s' specifier.",
- spec->varname);
- if (spec->omit_kw && spec->omit_kw->parent->next)
- error ("Default specifier is not in last specifier in `%s' "
- "subcommand.", sbc->name);
-
- for (s = spec->s; s; s = s->next)
- {
- int first = spec == sbc->spec && s == spec->s;
-
- /* Match the setting's keyword. */
- if (spec->omit_kw == s)
- {
- if (!first)
- {
- dump (1, "else");
- dump (1, "{");
- }
- dump (1, "%s;", make_match (s->specname));
- }
- else
- dump (1, "%sif (%s)", first ? "" : "else ",
- make_match (s->specname));
-
-
- /* Handle values. */
- if (s->value == VAL_NONE)
- dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
- st_upper (prefix), find_symbol (s->con)->name);
- else
- {
- if (spec->omit_kw != s)
- dump (1, "{");
-
- if (spec->varname)
- {
- dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
- st_upper (prefix), find_symbol (s->con)->name);
-
- if ( sbc->type == SBC_ARRAY )
- dump (0, "p->a_%s[%s%s%s] = 1;",
- st_lower (sbc->name),
- st_upper (prefix), st_upper (sbc->prefix),
- st_upper (spec->varname));
- }
-
-
- if (s->valtype == VT_PAREN)
- {
- if (s->optvalue)
- {
- dump (1, "if (lex_match ('('))");
- dump (1, "{");
- }
- else
- {
- dump (1, "if (!lex_match ('('))");
- dump (1, "{");
- dump (0, "msg (SE, _(\"`(' expected after %s "
- "specifier of %s subcommand.\"));",
- s->specname, sbc->name);
- dump (0, "goto lossage;");
- dump (-1, "}");
- outdent ();
- }
- }
-
- if (s->value == VAL_INT)
- {
- dump (1, "if (!lex_is_integer ())");
- dump (1, "{");
- dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
- "requires an integer argument.\"));",
- s->specname, sbc->name);
- dump (0, "goto lossage;");
- dump (-1, "}");
- dump (-1, "p->%s%s = lex_integer ();",
- sbc->prefix, st_lower (s->valname));
- }
- else
- {
- dump (1, "if (!lex_is_number ())");
- dump (1, "{");
- dump (0, "msg (SE, _(\"Number expected after %s "
- "specifier of %s subcommand.\"));",
- s->specname, sbc->name);
- dump (0, "goto lossage;");
- dump (-1, "}");
- dump (-1, "p->%s%s = tokval;", sbc->prefix,
- st_lower (s->valname));
- }
-
- if (s->restriction)
- {
- {
- char *str, *str2;
- str = xmalloc (MAX_TOK_LEN);
- str2 = xmalloc (MAX_TOK_LEN);
- sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
- sprintf (str, s->restriction, str2, str2, str2, str2,
- str2, str2, str2, str2);
- dump (1, "if (!(%s))", str);
- free (str);
- free (str2);
- }
-
- dump (1, "{");
- dump (0, "msg (SE, _(\"Bad argument for %s "
- "specifier of %s subcommand.\"));",
- s->specname, sbc->name);
- dump (0, "goto lossage;");
- dump (-1, "}");
- outdent ();
- }
-
- dump (0, "lex_get ();");
-
- if (s->valtype == VT_PAREN)
- {
- dump (1, "if (!lex_match (')'))");
- dump (1, "{");
- dump (0, "msg (SE, _(\"`)' expected after argument for "
- "%s specifier of %s.\"));",
- s->specname, sbc->name);
- dump (0, "goto lossage;");
- dump (-1, "}");
- outdent ();
- if (s->optvalue)
- {
- dump (-1, "}");
- outdent ();
- }
- }
-
- if (s != spec->omit_kw)
- dump (-1, "}");
- }
-
- if (s == spec->omit_kw)
- {
- dump (-1, "}");
- outdent ();
- }
- outdent ();
- }
-}
-
-/* Write out the code to parse subcommand SBC. */
-static void
-dump_subcommand (const subcommand *sbc)
-{
- if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
- {
- int count;
-
- dump (1, "while (token != '/' && token != '.')");
- dump (1, "{");
-
- {
- specifier *spec;
-
- for (count = 0, spec = sbc->spec; spec; spec = spec->next)
- {
- if (spec->s)
- dump_specifier_parse (spec, sbc);
- else
- {
- count++;
- dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
- make_match (st_upper (spec->varname)));
- if (sbc->type == SBC_PLAIN)
- dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
- spec->varname);
- else
- dump (0, "p->a_%s[%s%s%s] = 1;",
- st_lower (sbc->name),
- st_upper (prefix), st_upper (sbc->prefix),
- st_upper (spec->varname));
- outdent ();
- }
- }
- }
-
- {
- specifier *spec;
- setting *s;
-
- /* This code first finds the last specifier in sbc. Then it
- finds the last setting within that last specifier. Either
- or both might be NULL. */
- spec = sbc->spec;
- s = NULL;
- if (spec)
- {
- while (spec->next)
- spec = spec->next;
- s = spec->s;
- if (s)
- while (s->next)
- s = s->next;
- }
-
- if (spec && (!spec->s || !spec->omit_kw))
- {
- dump (1, "else");
- dump (1, "{");
- dump (0, "lex_error (NULL);");
- dump (0, "goto lossage;");
- dump (-1, "}");
- outdent ();
- }
- }
-
- dump (0, "lex_match (',');");
- dump (-1, "}");
- outdent ();
- }
- else if (sbc->type == SBC_VARLIST)
- {
- dump (1, "if (!parse_variables (default_dict, &p->%sv_%s, &p->%sn_%s, "
- "PV_APPEND%s%s))",
- st_lower (sbc->prefix), st_lower (sbc->name),
- st_lower (sbc->prefix), st_lower (sbc->name),
- sbc->message ? " |" : "",
- sbc->message ? sbc->message : "");
- dump (0, "goto lossage;");
- outdent ();
- }
- else if (sbc->type == SBC_VAR)
- {
- dump (0, "p->%sv_%s = parse_variable ();",
- st_lower (sbc->prefix), st_lower (sbc->name));
- dump (1, "if (!p->%sv_%s)",
- st_lower (sbc->prefix), st_lower (sbc->name));
- dump (0, "goto lossage;");
- outdent ();
- }
- else if (sbc->type == SBC_STRING)
- {
- if (sbc->restriction)
- {
- dump (1, "{");
- dump (0, "int x;");
- }
- dump (1, "if (!lex_force_string ())");
- dump (0, "return 0;");
- outdent ();
- if (sbc->restriction)
- {
- dump (0, "x = ds_length (&tokstr);");
- dump (1, "if (!(%s))", sbc->restriction);
- dump (1, "{");
- dump (0, "msg (SE, _(\"String for %s must be %s.\"));",
- sbc->name, sbc->message);
- dump (0, "goto lossage;");
- dump (-1, "}");
- outdent ();
- }
- dump (0, "free(p->s_%s);", st_lower(sbc->name) );
- dump (0, "p->s_%s = xstrdup (ds_c_str (&tokstr));",
- st_lower (sbc->name));
- dump (0, "lex_get ();");
- if (sbc->restriction)
- dump (-1, "}");
- }
- else if (sbc->type == SBC_DBL)
- {
- dump (1, "if (!lex_force_num ())");
- dump (0, "goto lossage;");
- dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number ();",
- st_lower (sbc->name), st_lower (sbc->name) );
- dump (0, "lex_get();");
- }
- else if (sbc->type == SBC_INT)
- {
- dump(1, "{");
- dump(0, "int x;");
- dump (1, "if (!lex_force_int ())");
- dump (0, "goto lossage;");
- dump (-1, "x = lex_integer ();");
- dump (0, "lex_get();");
- if (sbc->restriction)
- {
- char buf[1024];
- dump (1, "if (!(%s))", sbc->restriction);
- dump (1, "{");
- sprintf(buf,sbc->message,sbc->name);
- if ( sbc->translatable )
- dump (0, "msg (SE, gettext(\"%s\"));",buf);
- else
- dump (0, "msg (SE, \"%s\");",buf);
- dump (0, "goto lossage;");
- dump (-1, "}");
- }
- dump (0, "p->n_%s[p->sbc_%s - 1] = x;", st_lower (sbc->name), st_lower(sbc->name) );
- dump (-1,"}");
- }
- else if (sbc->type == SBC_PINT)
- {
- dump (0, "lex_match ('(');");
- dump (1, "if (!lex_force_int ())");
- dump (0, "goto lossage;");
- dump (-1, "p->n_%s = lex_integer ();", st_lower (sbc->name));
- dump (0, "lex_match (')');");
- }
- else if (sbc->type == SBC_DBL_LIST)
- {
- dump (0, "if ( p->sbc_%s > MAXLISTS)",st_lower(sbc->name));
- dump (1, "{");
- dump (0, "msg (SE, \"No more than %%d %s subcommands allowed\",MAXLISTS);",st_lower(sbc->name));
- dump (0, "goto lossage;");
- dump (-1,"}");
-
- dump (1, "while (token != '/' && token != '.')");
- dump (1, "{");
- dump (0, "lex_match(',');");
- dump (0, "if (!lex_force_num ())");
- dump (1, "{");
- dump (0, "goto lossage;");
- dump (-1,"}");
-
- dump (0, "subc_list_double_push(&p->dl_%s[p->sbc_%s-1],lex_number ());",
- st_lower (sbc->name),st_lower (sbc->name)
- );
-
- dump (0, "lex_get();");
- dump (-1,"}");
-
- }
- else if (sbc->type == SBC_CUSTOM)
- {
- dump (1, "switch (%scustom_%s (p))",
- st_lower (prefix), st_lower (sbc->name));
- dump (0, "{");
- dump (1, "case 0:");
- dump (0, "goto lossage;");
- dump (-1, "case 1:");
- indent ();
- dump (0, "break;");
- dump (-1, "case 2:");
- indent ();
- dump (0, "lex_error (NULL);");
- dump (0, "goto lossage;");
- dump (-1, "default:");
- indent ();
- dump (0, "assert (0);");
- dump (-1, "}");
- outdent ();
- }
-}
-
-/* Write out entire parser. */
-static void
-dump_parser (int persistent)
-{
- int f;
-
- indent = 0;
-
- dump (0, "static int");
- dump (0, "parse_%s (struct cmd_%s *p)", make_identifier (cmdname),
- make_identifier (cmdname));
- dump (1, "{");
-
- dump_vars_init (persistent);
-
- dump (1, "for (;;)");
- dump (1, "{");
-
- f = 0;
- if (def && (def->type == SBC_VARLIST))
- {
- if (def->type == SBC_VARLIST)
- dump (1, "if (token == T_ID "
- "&& dict_lookup_var (default_dict, tokid) != NULL "
- "&& lex_look_ahead () != '=')");
- else
- {
- dump (0, "if ((token == T_ID "
- "&& dict_lookup_var (default_dict, tokid) "
- "&& lex_look_ahead () != '=')");
- dump (1, " || token == T_ALL)");
- }
- dump (1, "{");
- dump (0, "p->sbc_%s++;", st_lower (def->name));
- dump (1, "if (!parse_variables (default_dict, &p->%sv_%s, &p->%sn_%s, "
- "PV_APPEND))",
- st_lower (def->prefix), st_lower (def->name),
- st_lower (def->prefix), st_lower (def->name));
- dump (0, "goto lossage;");
- dump (-2, "}");
- outdent ();
- f = 1;
- }
- else if (def && def->type == SBC_CUSTOM)
- {
- dump (1, "switch (%scustom_%s (p))",
- st_lower (prefix), st_lower (def->name));
- dump (0, "{");
- dump (1, "case 0:");
- dump (0, "goto lossage;");
- dump (-1, "case 1:");
- indent ();
- dump (0, "p->sbc_%s++;", st_lower (def->name));
- dump (0, "continue;");
- dump (-1, "case 2:");
- indent ();
- dump (0, "break;");
- dump (-1, "default:");
- indent ();
- dump (0, "assert (0);");
- dump (-1, "}");
- outdent ();
- }
-
- {
- subcommand *sbc;
-
- for (sbc = subcommands; sbc; sbc = sbc->next)
- {
- dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
- f = 1;
- dump (1, "{");
-
- dump (0, "lex_match ('=');");
- dump (0, "p->sbc_%s++;", st_lower (sbc->name));
- if (sbc->arity != ARITY_MANY)
- {
- dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
- dump (1, "{");
- dump (0, "msg (SE, _(\"%s subcommand may be given only once.\"));",
- sbc->name);
- dump (0, "goto lossage;");
- dump (-1, "}");
- outdent ();
- }
- dump_subcommand (sbc);
- dump (-1, "}");
- outdent ();
- }
- }
-
-
- /* Now deal with the /ALGORITHM subcommand implicit to all commands */
- dump(1,"else if ( get_syntax() != COMPATIBLE && lex_match_id(\"ALGORITHM\"))");
- dump(1,"{");
-
- dump (0, "lex_match ('=');");
-
- dump(1,"if (lex_match_id(\"COMPATIBLE\"))");
- dump(0,"set_cmd_algorithm(COMPATIBLE);");
- outdent();
- dump(1,"else if (lex_match_id(\"ENHANCED\"))");
- dump(0,"set_cmd_algorithm(ENHANCED);");
-
- dump (-1, "}");
- outdent ();
-
-
-
- dump (1, "if (!lex_match ('/'))");
- dump (0, "break;");
- dump (-2, "}");
- outdent ();
- dump (0, nullstr);
- dump (1, "if (token != '.')");
- dump (1, "{");
- dump (0, "lex_error (_(\"expecting end of command\"));");
- dump (0, "goto lossage;");
- dump (-1, "}");
- dump (0, nullstr);
-
- outdent ();
-
- {
- /* Check that mandatory subcommands have been specified */
- subcommand *sbc;
-
- for (sbc = subcommands; sbc; sbc = sbc->next)
- {
-
- if ( sbc->arity == ARITY_ONCE_EXACTLY )
- {
- dump (0, "if ( 0 == p->sbc_%s)", st_lower (sbc->name));
- dump (1, "{");
- dump (0, "msg (SE, _(\"%s subcommand must be given.\"));",
- sbc->name);
- dump (0, "goto lossage;");
- dump (-1, "}");
- dump (0, nullstr);
- }
- }
- }
-
- dump (-1, "return 1;");
- dump (0, nullstr);
- dump (-1, "lossage:");
- indent ();
- dump (0, "free_%s (p);", make_identifier (cmdname));
- dump (0, "return 0;");
- dump (-1, "}");
- dump (0, nullstr);
-}
-
-
-/* Write the output file header. */
-static void
-dump_header (void)
-{
- time_t curtime;
- struct tm *loctime;
- char *timep;
-
- indent = 0;
- curtime = time (NULL);
- loctime = localtime (&curtime);
- timep = asctime (loctime);
- timep[strlen (timep) - 1] = 0;
- dump (0, "/* %s\t\t-*- mode: c; buffer-read-only: t -*-", ofn);
- dump (0, nullstr);
- dump (0, " Generated by q2c from %s on %s.", ifn, timep);
- dump (0, " Do not modify!");
- dump (0, " */");
-}
-
-/* Write out commands to free variable state. */
-static void
-dump_free (int persistent)
-{
- subcommand *sbc;
- int used;
-
- indent = 0;
-
- used = 0;
- if ( ! persistent )
- {
- for (sbc = subcommands; sbc; sbc = sbc->next)
- {
- if (sbc->type == SBC_STRING)
- used = 1;
- if (sbc->type == SBC_DBL_LIST)
- used = 1;
- }
-
- }
-
- dump (0, "static void");
- dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
- make_identifier (cmdname), used ? "" : " UNUSED");
- dump (1, "{");
-
- if ( ! persistent )
- {
-
- for (sbc = subcommands; sbc; sbc = sbc->next)
- {
- switch (sbc->type)
- {
- case SBC_VARLIST:
- dump (0, "free (p->v_variables);");
- break;
- case SBC_STRING:
- dump (0, "free (p->s_%s);", st_lower (sbc->name));
- break;
- case SBC_DBL_LIST:
- dump (0, "int i;");
- dump (1, "for(i = 0; i < MAXLISTS ; ++i)");
- dump (0, "subc_list_double_destroy(&p->dl_%s[i]);", st_lower (sbc->name));
- outdent();
- break;
- default:
- break;
- }
- }
- }
-
- dump (-1, "}");
-
-}
-
-
-
-/* Returns the name of a directive found on the current input line, if
- any, or a null pointer if none found. */
-static const char *
-recognize_directive (void)
-{
- static char directive[16];
- char *sp, *ep;
-
- sp = skip_ws (buf);
- if (strncmp (sp, "/*", 2))
- return NULL;
- sp = skip_ws (sp + 2);
- if (*sp != '(')
- return NULL;
- sp++;
-
- ep = strchr (sp, ')');
- if (ep == NULL)
- return NULL;
-
- if (ep - sp > 15)
- ep = sp + 15;
- memcpy (directive, sp, ep - sp);
- directive[ep - sp] = '\0';
- return directive;
-}
-
-int
-main (int argc, char *argv[])
-{
- program_name = argv[0];
- if (argc != 3)
- fail ("Syntax: q2c input.q output.c");
-
- ifn = argv[1];
- in = fopen (ifn, "r");
- if (!in)
- fail ("%s: open: %s.", ifn, strerror (errno));
-
- ofn = argv[2];
- out = fopen (ofn, "w");
- if (!out)
- fail ("%s: open: %s.", ofn, strerror (errno));
-
- is_open = 1;
- buf = xmalloc (MAX_LINE_LEN);
- tokstr = xmalloc (MAX_TOK_LEN);
-
- dump_header ();
-
-
- indent = 0;
- dump (0, "#line %d \"%s\"", ln + 1, ifn);
- while (get_line ())
- {
- const char *directive = recognize_directive ();
- if (directive == NULL)
- {
- dump (0, "%s", buf);
- continue;
- }
-
- dump (0, "#line %d \"%s\"", oln + 1, ofn);
- if (!strcmp (directive, "specification"))
- {
- /* Skip leading slash-star line. */
- get_line ();
- lex_get ();
-
- parse ();
-
- /* Skip trailing star-slash line. */
- get_line ();
- }
- else if (!strcmp (directive, "headers"))
- {
- indent = 0;
-
- dump (0, "#include <stdlib.h>");
- dump (0, "#include \"alloc.h\"");
- dump (0, "#include \"error.h\"");
- dump (0, "#include \"lexer.h\"");
- dump (0, "#include \"settings.h\"");
- dump (0, "#include \"str.h\"");
- dump (0, "#include \"subclist.h\"");
- dump (0, "#include \"var.h\"");
- dump (0, nullstr);
-
- dump (0, "#include \"gettext.h\"");
- dump (0, "#define _(msgid) gettext (msgid)");
- dump (0, nullstr);
- }
- else if (!strcmp (directive, "declarations"))
- dump_declarations ();
- else if (!strcmp (directive, "functions"))
- {
- dump_parser (0);
- dump_free (0);
- }
- else if (!strcmp (directive, "_functions"))
- {
- dump_parser (1);
- dump_free (1);
- }
- else
- error ("unknown directive `%s'", directive);
- indent = 0;
- dump (0, "#line %d \"%s\"", ln + 1, ifn);
- }
-
-
-
- return EXIT_SUCCESS;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000, 2005 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "random.h"
-#include <time.h>
-#include "xalloc.h"
-
-static gsl_rng *rng;
-
-void
-random_init (void)
-{
-}
-
-void
-random_done (void)
-{
- if (rng != NULL)
- gsl_rng_free (rng);
-}
-
-/* Returns the current random number generator. */
-gsl_rng *
-get_rng (void)
-{
- if (rng == NULL)
- set_rng (time (0));
- return rng;
-}
-
-/* Initializes or reinitializes the random number generator with
- the given SEED. */
-void
-set_rng (unsigned long seed)
-{
- rng = gsl_rng_alloc (gsl_rng_mt19937);
- if (rng == NULL)
- xalloc_die ();
- gsl_rng_set (rng, seed);
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000, 2005 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef RANDOM_H
-#define RANDOM_H 1
-
-#include <gsl/gsl_rng.h>
-
-void random_init (void);
-void random_done (void);
-
-gsl_rng *get_rng (void);
-void set_rng (unsigned long seed);
-
-#endif /* random.h */
+++ /dev/null
-#include <config.h>
-#include "range-prs.h"
-#include <stdbool.h>
-#include "data-in.h"
-#include "error.h"
-#include "lexer.h"
-#include "magic.h"
-#include "str.h"
-#include "val.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-#define N_(msgid) msgid
-
-static bool parse_number (double *, const struct fmt_spec *);
-
-/* Parses and stores a numeric value, or a range of the form "x
- THRU y". Open-ended ranges may be specified as "LO(WEST) THRU
- y" or "x THRU HI(GHEST)". Sets *X and *Y to the range or the
- value and returns success.
-
- Numeric values are always accepted. If F is nonnull, then
- string values are also accepted, and converted to numeric
- values using the specified format. */
-bool
-parse_num_range (double *x, double *y, const struct fmt_spec *f)
-{
- if (lex_match_id ("LO") || lex_match_id ("LOWEST"))
- *x = LOWEST;
- else if (!parse_number (x, f))
- return false;
-
- if (lex_match_id ("THRU"))
- {
- if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
- *y = HIGHEST;
- else if (!parse_number (y, f))
- return false;
-
- if (*y < *x)
- {
- double t;
- msg (SW, _("Low end of range (%g) is below high end (%g). "
- "The range will be treated as reversed."),
- *x, *y);
- t = *x;
- *x = *y;
- *y = t;
- }
- else if (*x == *y)
- msg (SW, _("Ends of range are equal (%g)."), *x);
-
- return true;
- }
- else
- {
- if (*x == LOWEST)
- {
- msg (SE, _("LO or LOWEST must be part of a range."));
- return false;
- }
- *y = *x;
- }
-
- return true;
-}
-
-/* Parses a number and stores it in *X. Returns success.
-
- Numeric values are always accepted. If F is nonnull, then
- string values are also accepted, and converted to numeric
- values using the specified format. */
-static bool
-parse_number (double *x, const struct fmt_spec *f)
-{
- if (lex_is_number ())
- {
- *x = lex_number ();
- lex_get ();
- return true;
- }
- else if (token == T_STRING && f != NULL)
- {
- struct data_in di;
- union value v;
- di.s = ds_data (&tokstr);
- di.e = ds_end (&tokstr);
- di.v = &v;
- di.flags = 0;
- di.f1 = 1;
- di.f2 = ds_length (&tokstr);
- di.format = *f;
- data_in (&di);
- lex_get ();
- *x = v.f;
- if (*x == SYSMIS)
- {
- lex_error (_("System-missing value is not valid here."));
- return false;
- }
- return true;
- }
- else
- {
- if (f != NULL)
- lex_error (_("expecting number or data string"));
- else
- lex_force_num ();
- return false;
- }
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef RANGE_PRS_H
-#define RANGE_PRS_H 1
-
-#include <stdbool.h>
-
-struct fmt_spec;
-bool parse_num_range (double *x, double *y, const struct fmt_spec *fmt);
-
-#endif /* range-prs.h */
+++ /dev/null
-/* PSPP - RANK. -*-c-*-
-
-Copyright (C) 2005 Free Software Foundation, Inc.
-Author: John Darrington 2005
-
-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 the Free Software Foundation; either version 2 of the
-License, or (at your option) any later version.
-
-This program is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA. */
-
-#include <config.h>
-#include "command.h"
-#include "dictionary.h"
-#include "sort.h"
-#include "sort-prs.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* (headers) */
-
-/* (specification)
- "RANK" (rank_):
- *^variables=custom;
- +rank=custom;
- +normal=custom;
- +percent=custom;
- +ntiles=custom;
- +rfraction=custom;
- +proportion=custom;
- +n=custom;
- +savage=custom;
- +print=print:!yes/no;
- +missing=miss:!exclude/include.
-*/
-/* (declarations) */
-/* (functions) */
-
-
-
-enum RANK_FUNC
- {
- RANK,
- NORMAL,
- PERCENT,
- RFRACTION,
- PROPORTION,
- N,
- NTILES,
- SAVAGE,
- };
-
-
-struct rank_spec
-{
- enum RANK_FUNC rfunc;
- struct variable **destvars;
- struct variable *srcvar;
-};
-
-
-static struct rank_spec *rank_specs;
-static size_t n_rank_specs;
-
-static struct sort_criteria *sc;
-
-static struct variable **group_vars;
-static size_t n_group_vars;
-
-static struct cmd_rank cmd;
-
-
-
-int cmd_rank(void);
-
-int
-cmd_rank(void)
-{
- size_t i;
- n_rank_specs = 0;
-
- if ( !parse_rank(&cmd) )
- return CMD_FAILURE;
-
-#if 1
- for (i = 0 ; i < sc->crit_cnt ; ++i )
- {
- struct sort_criterion *crit = &sc->crits[i];
-
- printf("Dir: %d; Index: %d\n", crit->dir, crit->fv);
- }
-
- for (i = 0 ; i < n_group_vars ; ++i )
- printf("Group var: %s\n",group_vars[0]->name);
-
- for (i = 0 ; i < n_rank_specs ; ++i )
- {
- int j;
- printf("Ranks spec %d; Func: %d\n",i, rank_specs[i].rfunc);
-
- for (j=0; j < sc->crit_cnt ; ++j )
- printf("Dest var is \"%s\"\n", rank_specs[i].destvars[j]->name);
- }
-#endif
-
-
- free(group_vars);
-
- for (i = 0 ; i < n_rank_specs ; ++i )
- {
- free(rank_specs[i].destvars);
- }
-
- free(rank_specs);
-
- sort_destroy_criteria(sc);
-
- return CMD_SUCCESS;
-}
-
-
-
-/* Parser for the variables sub command
- Returns 1 on success */
-static int
-rank_custom_variables(struct cmd_rank *cmd UNUSED)
-{
- static const int terminators[2] = {T_BY, 0};
-
- lex_match('=');
-
- if ((token != T_ID || dict_lookup_var (default_dict, tokid) == NULL)
- && token != T_ALL)
- return 2;
-
- sc = sort_parse_criteria (default_dict, 0, 0, 0, terminators);
-
- if ( lex_match(T_BY) )
- {
- if ((token != T_ID || dict_lookup_var (default_dict, tokid) == NULL))
- {
- return 2;
- }
-
- if (!parse_variables (default_dict, &group_vars, &n_group_vars,
- PV_NO_DUPLICATE | PV_NUMERIC | PV_NO_SCRATCH) )
- {
- free (group_vars);
- return 0;
- }
- }
-
- return 1;
-}
-
-
-/* Return a name for a new variable which ranks the variable VAR_NAME,
- according to the ranking function F.
- If IDX is non zero, then IDX is used as a disambiguating number.
- FIXME: This is not very robust.
-*/
-static char *
-new_variable_name(const char *ranked_var_name, enum RANK_FUNC f, int idx)
-{
- static char new_name[SHORT_NAME_LEN + 1];
- char temp[SHORT_NAME_LEN + 1];
-
- if ( idx == 0 )
- {
- switch (f)
- {
- case RANK:
- case RFRACTION:
- strcpy(new_name,"R");
- break;
-
- case NORMAL:
- case N:
- case NTILES:
- strcpy(new_name,"N");
- break;
-
- case PERCENT:
- case PROPORTION:
- strcpy(new_name,"P");
- break;
-
- case SAVAGE:
- strcpy(new_name,"S");
- break;
-
- default:
- assert(false);
- break;
- }
-
- strncat(new_name, ranked_var_name, 7);
- }
- else
- {
- strncpy(temp, ranked_var_name, 3);
- snprintf(new_name, SHORT_NAME_LEN, "%s%03d", temp, idx);
- }
-
- return new_name;
-}
-
-/* Parse the [/rank INTO var1 var2 ... varN ] clause */
-static int
-parse_rank_function(struct cmd_rank *cmd UNUSED, enum RANK_FUNC f)
-{
- static const struct fmt_spec f8_2 = {FMT_F, 8, 2};
- int var_count = 0;
-
- n_rank_specs++;
- rank_specs = xnrealloc(rank_specs, n_rank_specs, sizeof *rank_specs);
- rank_specs[n_rank_specs - 1].rfunc = f;
-
- rank_specs[n_rank_specs - 1].destvars =
- xcalloc (sc->crit_cnt, sizeof (struct variable *));
-
- if (lex_match_id("INTO"))
- {
- struct variable *destvar;
-
- while( token == T_ID )
- {
- ++var_count;
- if ( dict_lookup_var (default_dict, tokid) != NULL )
- {
- msg(ME, _("Variable %s already exists."), tokid);
- return 0;
- }
- if ( var_count > sc->crit_cnt )
- {
- msg(ME, _("Too many variables in INTO clause."));
- return 0;
- }
-
- destvar = dict_create_var (default_dict, tokid, 0);
- if ( destvar )
- {
- destvar->print = destvar->write = f8_2;
- }
-
- rank_specs[n_rank_specs - 1].destvars[var_count - 1] = destvar ;
-
- lex_get();
-
- }
- }
-
- /* Allocate rank variable names to all those which haven't had INTO
- variables assigned */
- while (var_count < sc->crit_cnt)
- {
- static int idx=0;
- struct variable *destvar ;
- const struct variable *v = dict_get_var(default_dict,
- sc->crits[var_count].fv);
-
- char *new_name;
-
- do {
- new_name = new_variable_name(v->name, f, idx);
-
- destvar = dict_create_var (default_dict, new_name, 0);
- if (!destvar )
- ++idx;
-
- } while( !destvar ) ;
-
- destvar->print = destvar->write = f8_2;
-
- rank_specs[n_rank_specs - 1].destvars[var_count] = destvar ;
-
- ++var_count;
- }
-
- return 1;
-}
-
-
-static int
-rank_custom_rank(struct cmd_rank *cmd )
-{
- return parse_rank_function(cmd, RANK);
-}
-
-static int
-rank_custom_normal(struct cmd_rank *cmd )
-{
- return parse_rank_function(cmd, NORMAL);
-}
-
-static int
-rank_custom_percent(struct cmd_rank *cmd )
-{
- return parse_rank_function(cmd, NORMAL);
-}
-
-static int
-rank_custom_rfraction(struct cmd_rank *cmd )
-{
- return parse_rank_function(cmd, RFRACTION);
-}
-
-static int
-rank_custom_proportion(struct cmd_rank *cmd )
-{
- return parse_rank_function(cmd, PROPORTION);
-}
-
-static int
-rank_custom_n(struct cmd_rank *cmd )
-{
- return parse_rank_function(cmd, N);
-}
-
-static int
-rank_custom_savage(struct cmd_rank *cmd )
-{
- return parse_rank_function(cmd, SAVAGE);
-}
-
-
-static int
-rank_custom_ntiles(struct cmd_rank *cmd )
-{
- if ( lex_force_match('(') )
- {
- if ( lex_force_int() )
- {
- lex_get();
- lex_force_match(')');
- }
- else
- return 0;
- }
- else
- return 0;
-
- return parse_rank_function(cmd, NTILES);
-}
-
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-
-#include <stdlib.h>
-#include <stdbool.h>
-#include <assert.h>
-#include <errno.h>
-
-#include "readln.h"
-#include "command.h"
-#include "version.h"
-#include "getl.h"
-#include "str.h"
-#include "tab.h"
-#include "error.h"
-#include "filename.h"
-#include "settings.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-
-#if HAVE_LIBREADLINE
-#include <readline/readline.h>
-#endif
-
-#if HAVE_LIBHISTORY
-static char *history_file;
-
-#if HAVE_READLINE_HISTORY_H
-#include <readline/history.h>
-#else /* no readline/history.h */
-extern void add_history (char *);
-extern void using_history (void);
-extern int read_history (char *);
-extern void stifle_history (int);
-extern int write_history (char *);
-#endif /* no readline/history.h */
-#endif /* -lhistory */
-
-
-static int read_console (void);
-
-static bool initialised = false;
-
-/* Initialize getl. */
-void
-readln_initialize (void)
-{
- initialised = true;
-#if HAVE_LIBREADLINE
- rl_completion_entry_function = pspp_completion_function;
-#endif
-}
-
-/* Close getl. */
-void
-readln_uninitialize (void)
-{
- initialised = false;
-#if HAVE_LIBHISTORY && defined (unix)
- if (history_file)
- write_history (history_file);
-#endif
-}
-
-static bool welcomed = false;
-
-/* Display a welcoming message. */
-static void
-welcome (void)
-{
- welcomed = true;
- fputs ("PSPP is free software and you are welcome to distribute copies of "
- "it\nunder certain conditions; type \"show copying.\" to see the "
- "conditions.\nThere is ABSOLUTELY NO WARRANTY for PSPP; type \"show "
- "warranty.\" for details.\n", stdout);
- puts (stat_version);
-}
-
-/* From repeat.c. */
-extern void perform_DO_REPEAT_substitutions (void);
-
- /* Global variables. */
-int getl_mode;
-int getl_interactive;
-int getl_prompt;
-
-/*
-extern struct cmd_set cmd;
-*/
-
-
-/* Reads a single line into getl_buf from the list of files. Will not
- read from the eof of one file to the beginning of another unless
- the options field on the new file's getl_script is nonzero. Return
- zero on eof. */
-int
-getl_read_line (void)
-{
- assert (initialised);
- getl_mode = GETL_MODE_BATCH;
-
- while (getl_head)
- {
- struct getl_script *s = getl_head;
-
- ds_clear (&getl_buf);
- if (s->separate)
- return 0;
-
- if (s->first_line)
- {
- if (!getl_handle_line_buffer ())
- {
- getl_close_file ();
- continue;
- }
- perform_DO_REPEAT_substitutions ();
- if (getl_head->print)
- tab_output_text (TAB_LEFT | TAT_FIX | TAT_PRINTF, "+%s",
- ds_c_str (&getl_buf));
- return 1;
- }
-
- if (s->f == NULL)
- {
- msg (VM (1), _("%s: Opening as syntax file."), s->fn);
- s->f = fn_open (s->fn, "r");
-
- if (s->f == NULL)
- {
- msg (ME, _("Opening `%s': %s."), s->fn, strerror (errno));
- getl_close_file ();
- continue;
- }
- }
-
- if (!ds_gets (&getl_buf, s->f))
- {
- if (ferror (s->f))
- msg (ME, _("Reading `%s': %s."), s->fn, strerror (errno));
- getl_close_file ();
- continue;
- }
- if (ds_length (&getl_buf) > 0 && ds_end (&getl_buf)[-1] == '\n')
- ds_truncate (&getl_buf, ds_length (&getl_buf) - 1);
-
- if (get_echo())
- tab_output_text (TAB_LEFT | TAT_FIX, ds_c_str (&getl_buf));
-
- getl_head->ln++;
-
- /* Allows shebang invocation: `#! /usr/local/bin/pspp'. */
- if (ds_c_str (&getl_buf)[0] == '#'
- && ds_c_str (&getl_buf)[1] == '!')
- continue;
-
- return 1;
- }
-
- if (getl_interactive == 0)
- return 0;
-
- getl_mode = GETL_MODE_INTERACTIVE;
-
- if (!welcomed)
- welcome ();
-
- return read_console ();
-}
-
-
-/* PORTME: Adapt to your local system's idea of the terminal. */
-#if HAVE_LIBREADLINE
-
-#if HAVE_READLINE_READLINE_H
-#include <readline/readline.h>
-#else /* no readline/readline.h */
-extern char *readline (char *);
-#endif /* no readline/readline.h */
-
-static int
-read_console (void)
-{
- char *line;
- const char *prompt;
-
- assert(initialised);
-
- err_error_count = err_warning_count = 0;
- err_already_flagged = 0;
-
-#if HAVE_LIBHISTORY
- if (!history_file)
- {
-#ifdef unix
- history_file = tilde_expand (HISTORY_FILE);
-#endif
- using_history ();
- read_history (history_file);
- stifle_history (MAX_HISTORY);
- }
-#endif /* -lhistory */
-
- switch (getl_prompt)
- {
- case GETL_PRPT_STANDARD:
- prompt = get_prompt ();
- break;
-
- case GETL_PRPT_CONTINUATION:
- prompt = get_cprompt ();
- break;
-
- case GETL_PRPT_DATA:
- prompt = get_dprompt ();
- break;
-
- default:
- assert (0);
- abort ();
- }
-
- line = readline (prompt);
- if (!line)
- return 0;
-
-#if HAVE_LIBHISTORY
- if (*line)
- add_history (line);
-#endif
-
- ds_clear (&getl_buf);
- ds_puts (&getl_buf, line);
-
- free (line);
-
- return 1;
-}
-#else /* no -lreadline */
-static int
-read_console (void)
-{
- assert(initialised);
-
- err_error_count = err_warning_count = 0;
- err_already_flagged = 0;
-
- fputs (getl_prompt ? get_cprompt() : get_prompt(), stdout);
- ds_clear (&getl_buf);
- if (ds_gets (&getl_buf, stdin))
- return 1;
-
- if (ferror (stdin))
- msg (FE, "stdin: fgets(): %s.", strerror (errno));
-
- return 0;
-}
-#endif /* no -lreadline */
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef READLN_H
-#define READLN_H
-
-#include <config.h>
-
-/* Initialize getl. */
-void readln_initialize (void);
-
-/* Close getl. */
-void readln_uninitialize (void);
-
-#endif /* READLN_H */
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <ctype.h>
-#include <math.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "case.h"
-#include "command.h"
-#include "data-in.h"
-#include "dictionary.h"
-#include "error.h"
-#include "lexer.h"
-#include "magic.h"
-#include "pool.h"
-#include "range-prs.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-\f
-/* Definitions. */
-
-/* Type of source value for RECODE. */
-enum map_in_type
- {
- MAP_SINGLE, /* Specific value. */
- MAP_RANGE, /* Range of values. */
- MAP_SYSMIS, /* System missing value. */
- MAP_MISSING, /* Any missing value. */
- MAP_ELSE, /* Any value. */
- MAP_CONVERT /* "123" => 123. */
- };
-
-/* Describes input values to be mapped. */
-struct map_in
- {
- enum map_in_type type; /* One of MAP_*. */
- union value x, y; /* Source values. */
- };
-
-/* Describes the value used as output from a mapping. */
-struct map_out
- {
- bool copy_input; /* If true, copy input to output. */
- union value value; /* If copy_input false, recoded value. */
- int width; /* If copy_input false, output value width. */
- };
-
-/* Describes how to recode a single value or range of values into a
- single value. */
-struct mapping
- {
- struct map_in in; /* Input values. */
- struct map_out out; /* Output value. */
- };
-
-/* RECODE transformation. */
-struct recode_trns
- {
- struct pool *pool;
-
- /* Variable types, for convenience. */
- enum var_type src_type; /* src_vars[*]->type. */
- enum var_type dst_type; /* dst_vars[*]->type. */
-
- /* Variables. */
- struct variable **src_vars; /* Source variables. */
- struct variable **dst_vars; /* Destination variables. */
- char **dst_names; /* Name of dest variables, if they're new. */
- size_t var_cnt; /* Number of variables. */
-
- /* Mappings. */
- struct mapping *mappings; /* Value mappings. */
- size_t map_cnt; /* Number of mappings. */
- };
-
-static bool parse_src_vars (struct recode_trns *);
-static bool parse_mappings (struct recode_trns *);
-static bool parse_dst_vars (struct recode_trns *);
-
-static void add_mapping (struct recode_trns *,
- size_t *map_allocated, const struct map_in *);
-
-static bool parse_map_in (struct map_in *, struct pool *,
- enum var_type src_type, size_t max_src_width);
-static void set_map_in_generic (struct map_in *, enum map_in_type);
-static void set_map_in_num (struct map_in *, enum map_in_type, double, double);
-static void set_map_in_str (struct map_in *, struct pool *,
- const struct string *, size_t width);
-
-static bool parse_map_out (struct pool *, struct map_out *);
-static void set_map_out_num (struct map_out *, double);
-static void set_map_out_str (struct map_out *, struct pool *,
- const struct string *);
-
-static void enlarge_dst_widths (struct recode_trns *);
-static void create_dst_vars (struct recode_trns *);
-
-static trns_proc_func recode_trns_proc;
-static trns_free_func recode_trns_free;
-\f
-/* Parser. */
-
-/* Parses the RECODE transformation. */
-int
-cmd_recode (void)
-{
- do
- {
- struct recode_trns *trns
- = pool_create_container (struct recode_trns, pool);
-
- /* Parse source variable names,
- then input to output mappings,
- then destintation variable names. */
- if (!parse_src_vars (trns)
- || !parse_mappings (trns)
- || !parse_dst_vars (trns))
- {
- recode_trns_free (trns);
- return CMD_PART_SUCCESS;
- }
-
- /* Ensure that all the output strings are at least as wide
- as the widest destination variable. */
- if (trns->dst_type == ALPHA)
- enlarge_dst_widths (trns);
-
- /* Create destination variables, if needed.
- This must be the final step; otherwise we'd have to
- delete destination variables on failure. */
- if (trns->src_vars != trns->dst_vars)
- create_dst_vars (trns);
-
- /* Done. */
- add_transformation (recode_trns_proc, recode_trns_free, trns);
- }
- while (lex_match ('/'));
-
- return lex_end_of_command ();
-}
-
-/* Parses a set of variables to recode into TRNS->src_vars and
- TRNS->var_cnt. Sets TRNS->src_type. Returns true if
- successful, false on parse error. */
-static bool
-parse_src_vars (struct recode_trns *trns)
-{
- if (!parse_variables (default_dict, &trns->src_vars, &trns->var_cnt,
- PV_SAME_TYPE))
- return false;
- pool_register (trns->pool, free, trns->src_vars);
- trns->src_type = trns->src_vars[0]->type;
- return true;
-}
-
-/* Parses a set of mappings, which take the form (input=output),
- into TRNS->mappings and TRNS->map_cnt. Sets TRNS->dst_type.
- Returns true if successful, false on parse error. */
-static bool
-parse_mappings (struct recode_trns *trns)
-{
- size_t max_src_width;
- size_t map_allocated;
- bool have_dst_type;
- size_t i;
-
- /* Find length of longest source variable. */
- max_src_width = trns->src_vars[0]->width;
- for (i = 1; i < trns->var_cnt; i++)
- {
- size_t var_width = trns->src_vars[i]->width;
- if (var_width > max_src_width)
- max_src_width = var_width;
- }
-
- /* Parse the mappings in parentheses. */
- trns->mappings = NULL;
- trns->map_cnt = 0;
- map_allocated = 0;
- have_dst_type = false;
- if (!lex_force_match ('('))
- return false;
- do
- {
- enum var_type dst_type;
-
- if (!lex_match_id ("CONVERT"))
- {
- struct map_out out;
- size_t first_map_idx;
- size_t i;
-
- first_map_idx = trns->map_cnt;
-
- /* Parse source specifications. */
- do
- {
- struct map_in in;
- if (!parse_map_in (&in, trns->pool,
- trns->src_type, max_src_width))
- return false;
- add_mapping (trns, &map_allocated, &in);
- lex_match (',');
- }
- while (!lex_match ('='));
-
- if (!parse_map_out (trns->pool, &out))
- return false;
- dst_type = out.width == 0 ? NUMERIC : ALPHA;
- if (have_dst_type && dst_type != trns->dst_type)
- {
- msg (SE, _("Inconsistent target variable types. "
- "Target variables "
- "must be all numeric or all string."));
- return false;
- }
-
- for (i = first_map_idx; i < trns->map_cnt; i++)
- trns->mappings[i].out = out;
- }
- else
- {
- /* Parse CONVERT as a special case. */
- struct map_in in;
- set_map_in_generic (&in, MAP_CONVERT);
- add_mapping (trns, &map_allocated, &in);
-
- dst_type = NUMERIC;
- if (trns->src_type != ALPHA
- || (have_dst_type && trns->dst_type != NUMERIC))
- {
- msg (SE, _("CONVERT requires string input values and "
- "numeric output values."));
- return false;
- }
- }
- trns->dst_type = dst_type;
- have_dst_type = true;
-
- if (!lex_force_match (')'))
- return false;
- }
- while (lex_match ('('));
-
- return true;
-}
-
-/* Parses a mapping input value into IN, allocating memory from
- POOL. The source value type must be provided as SRC_TYPE and,
- if string, the maximum width of a string source variable must
- be provided in MAX_SRC_WIDTH. Returns true if successful,
- false on parse error. */
-static bool
-parse_map_in (struct map_in *in, struct pool *pool,
- enum var_type src_type, size_t max_src_width)
-{
- if (lex_match_id ("ELSE"))
- set_map_in_generic (in, MAP_ELSE);
- else if (src_type == NUMERIC)
- {
- if (lex_match_id ("MISSING"))
- set_map_in_generic (in, MAP_MISSING);
- else if (lex_match_id ("SYSMIS"))
- set_map_in_generic (in, MAP_SYSMIS);
- else
- {
- double x, y;
- if (!parse_num_range (&x, &y, NULL))
- return false;
- set_map_in_num (in, x == y ? MAP_SINGLE : MAP_RANGE, x, y);
- }
- }
- else
- {
- if (!lex_force_string ())
- return false;
- set_map_in_str (in, pool, &tokstr, max_src_width);
- lex_get ();
- }
-
- return true;
-}
-
-/* Adds IN to the list of mappings in TRNS.
- MAP_ALLOCATED is the current number of allocated mappings,
- which is updated as needed. */
-static void
-add_mapping (struct recode_trns *trns,
- size_t *map_allocated, const struct map_in *in)
-{
- struct mapping *m;
- if (trns->map_cnt >= *map_allocated)
- trns->mappings = pool_2nrealloc (trns->pool, trns->mappings,
- map_allocated,
- sizeof *trns->mappings);
- m = &trns->mappings[trns->map_cnt++];
- m->in = *in;
-}
-
-/* Sets IN as a mapping of the given TYPE. */
-static void
-set_map_in_generic (struct map_in *in, enum map_in_type type)
-{
- in->type = type;
-}
-
-/* Sets IN as a numeric mapping of the given TYPE,
- with X and Y as the two numeric values. */
-static void
-set_map_in_num (struct map_in *in, enum map_in_type type, double x, double y)
-{
- in->type = type;
- in->x.f = x;
- in->y.f = y;
-}
-
-/* Sets IN as a string mapping, with STRING as the string,
- allocated from POOL. The string is padded with spaces on the
- right to WIDTH characters long. */
-static void
-set_map_in_str (struct map_in *in, struct pool *pool,
- const struct string *string, size_t width)
-{
- in->type = MAP_SINGLE;
- in->x.c = pool_alloc_unaligned (pool, width);
- buf_copy_rpad (in->x.c, width, ds_data (string), ds_length (string));
-}
-
-/* Parses a mapping output value into OUT, allocating memory from
- POOL. Returns true if successful, false on parse error. */
-static bool
-parse_map_out (struct pool *pool, struct map_out *out)
-{
- if (lex_is_number ())
- {
- set_map_out_num (out, lex_number ());
- lex_get ();
- }
- else if (lex_match_id ("SYSMIS"))
- set_map_out_num (out, SYSMIS);
- else if (token == T_STRING)
- {
- set_map_out_str (out, pool, &tokstr);
- lex_get ();
- }
- else if (lex_match_id ("COPY"))
- out->copy_input = true;
- else
- {
- lex_error (_("expecting output value"));
- return false;
- }
- return true;
-}
-
-/* Sets OUT as a numeric mapping output with the given VALUE. */
-static void
-set_map_out_num (struct map_out *out, double value)
-{
- out->copy_input = false;
- out->value.f = value;
- out->width = 0;
-}
-
-/* Sets OUT as a string mapping output with the given VALUE. */
-static void
-set_map_out_str (struct map_out *out, struct pool *pool,
- const struct string *value)
-{
- const char *string = ds_data (value);
- size_t length = ds_length (value);
-
- out->copy_input = false;
- out->value.c = pool_alloc_unaligned (pool, length);
- memcpy (out->value.c, string, length);
- out->width = length;
-}
-
-/* Parses a set of target variables into TRNS->dst_vars and
- TRNS->dst_names. */
-static bool
-parse_dst_vars (struct recode_trns *trns)
-{
- size_t i;
-
- if (lex_match_id ("INTO"))
- {
- size_t name_cnt;
- size_t i;
-
- if (!parse_mixed_vars_pool (trns->pool, &trns->dst_names, &name_cnt,
- PV_NONE))
- return false;
-
- if (name_cnt != trns->var_cnt)
- {
- msg (SE, _("%u variable(s) cannot be recoded into "
- "%u variable(s). Specify the same number "
- "of variables as source and target variables."),
- (unsigned) trns->var_cnt, (unsigned) name_cnt);
- return false;
- }
-
- trns->dst_vars = pool_nalloc (trns->pool,
- trns->var_cnt, sizeof *trns->dst_vars);
- for (i = 0; i < trns->var_cnt; i++)
- {
- struct variable *v;
- v = trns->dst_vars[i] = dict_lookup_var (default_dict,
- trns->dst_names[i]);
- if (v == NULL && trns->dst_type == ALPHA)
- {
- msg (SE, _("There is no variable named "
- "%s. (All string variables specified "
- "on INTO must already exist. Use the "
- "STRING command to create a string "
- "variable.)"),
- trns->dst_names[i]);
- return false;
- }
- }
- }
- else
- {
- trns->dst_vars = trns->src_vars;
- if (trns->src_type != trns->dst_type)
- {
- msg (SE, _("INTO is required with %s input values "
- "and %s output values."),
- var_type_adj (trns->src_type),
- var_type_adj (trns->dst_type));
- return false;
- }
- }
-
- for (i = 0; i < trns->var_cnt; i++)
- {
- struct variable *v = trns->dst_vars[i];
- if (v != NULL && v->type != trns->dst_type)
- {
- msg (SE, _("Type mismatch. Cannot store %s data in "
- "%s variable %s."),
- trns->dst_type == ALPHA ? _("string") : _("numeric"),
- v->type == ALPHA ? _("string") : _("numeric"),
- v->name);
- return false;
- }
- }
-
- return true;
-}
-
-/* Ensures that all the output values in TRNS are as wide as the
- widest destination variable. */
-static void
-enlarge_dst_widths (struct recode_trns *trns)
-{
- size_t max_dst_width;
- size_t i;
-
- max_dst_width = 0;
- for (i = 0; i < trns->var_cnt; i++)
- {
- struct variable *v = trns->dst_vars[i];
- if (v->width > max_dst_width)
- max_dst_width = v->width;
- }
-
- for (i = 0; i < trns->map_cnt; i++)
- {
- struct map_out *out = &trns->mappings[i].out;
- if (!out->copy_input && out->width < max_dst_width)
- {
- char *s = pool_alloc_unaligned (trns->pool, max_dst_width + 1);
- str_copy_rpad (s, max_dst_width + 1, out->value.c);
- out->value.c = s;
- }
- }
-}
-
-/* Creates destination variables that don't already exist. */
-static void
-create_dst_vars (struct recode_trns *trns)
-{
- size_t i;
-
- for (i = 0; i < trns->var_cnt; i++)
- {
- struct variable **var = &trns->dst_vars[i];
- const char *name = trns->dst_names[i];
-
- *var = dict_lookup_var (default_dict, name);
- if (*var == NULL)
- *var = dict_create_var_assert (default_dict, name, 0);
- assert ((*var)->type == trns->dst_type);
- }
-}
-\f
-/* Data transformation. */
-
-/* Returns the output mapping in TRNS for an input of VALUE on
- variable V, or a null pointer if there is no mapping. */
-static const struct map_out *
-find_src_numeric (struct recode_trns *trns, double value, struct variable *v)
-{
- struct mapping *m;
-
- for (m = trns->mappings; m < trns->mappings + trns->map_cnt; m++)
- {
- const struct map_in *in = &m->in;
- const struct map_out *out = &m->out;
- bool match;
-
- switch (in->type)
- {
- case MAP_SINGLE:
- match = value == in->x.f;
- break;
- case MAP_MISSING:
- match = mv_is_num_user_missing (&v->miss, value);
- break;
- case MAP_RANGE:
- match = value >= in->x.f && value <= in->y.f;
- break;
- case MAP_ELSE:
- match = true;
- break;
- default:
- abort ();
- }
-
- if (match)
- return out;
- }
-
- return NULL;
-}
-
-/* Returns the output mapping in TRNS for an input of VALUE with
- the given WIDTH, or a null pointer if there is no mapping. */
-static const struct map_out *
-find_src_string (struct recode_trns *trns, const char *value, int width)
-{
- struct mapping *m;
-
- for (m = trns->mappings; m < trns->mappings + trns->map_cnt; m++)
- {
- const struct map_in *in = &m->in;
- struct map_out *out = &m->out;
- bool match;
-
- switch (in->type)
- {
- case MAP_SINGLE:
- match = !memcmp (value, in->x.c, width);
- break;
- case MAP_ELSE:
- match = true;
- break;
- case MAP_CONVERT:
- {
- struct data_in di;
-
- di.s = value;
- di.e = value + width;
- di.v = &out->value;
- di.flags = DI_IGNORE_ERROR;
- di.f1 = di.f2 = 0;
- di.format.type = FMT_F;
- di.format.w = width;
- di.format.d = 0;
- match = data_in (&di);
- break;
- }
- default:
- abort ();
- }
-
- if (match)
- return out;
- }
-
- return NULL;
-}
-
-/* Performs RECODE transformation. */
-static int
-recode_trns_proc (void *trns_, struct ccase *c, int case_idx UNUSED)
-{
- struct recode_trns *trns = trns_;
- size_t i;
-
- for (i = 0; i < trns->var_cnt; i++)
- {
- struct variable *src_var = trns->src_vars[i];
- struct variable *dst_var = trns->dst_vars[i];
-
- const union value *src_data = case_data (c, src_var->fv);
- union value *dst_data = case_data_rw (c, dst_var->fv);
-
- const struct map_out *out;
-
- if (trns->src_type == NUMERIC)
- out = find_src_numeric (trns, src_data->f, src_var);
- else
- out = find_src_string (trns, src_data->s, src_var->width);
-
- if (trns->dst_type == NUMERIC)
- {
- if (out != NULL)
- dst_data->f = !out->copy_input ? out->value.f : src_data->f;
- else if (trns->src_vars != trns->dst_vars)
- dst_data->f = SYSMIS;
- }
- else
- {
- if (out != NULL)
- {
- if (!out->copy_input)
- memcpy (dst_data->s, out->value.c, dst_var->width);
- else if (trns->src_vars != trns->dst_vars)
- buf_copy_rpad (dst_data->s, dst_var->width,
- src_data->s, src_var->width);
- }
- else if (trns->src_vars != trns->dst_vars)
- memset (dst_data->s, ' ', dst_var->width);
- }
- }
-
- return -1;
-}
-
-/* Frees a RECODE transformation. */
-static void
-recode_trns_free (void *trns_)
-{
- struct recode_trns *trns = trns_;
- pool_destroy (trns->pool);
-}
+++ /dev/null
-/* PSPP - linear regression.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Written by Jason H Stover <jason@sakla.net>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <stdlib.h>
-#include <gsl/gsl_cdf.h>
-#include <gsl/gsl_vector.h>
-#include <gsl/gsl_matrix.h>
-#include "alloc.h"
-#include "case.h"
-#include "casefile.h"
-#include "cat.h"
-#include "cat-routines.h"
-#include "command.h"
-#include "design-matrix.h"
-#include "dictionary.h"
-#include "error.h"
-#include "file-handle.h"
-#include "gettext.h"
-#include "lexer.h"
-#include <linreg/pspp_linreg.h>
-#include "missing-values.h"
-#include "regression_export.h"
-#include "tab.h"
-#include "value-labels.h"
-#include "var.h"
-#include "vfm.h"
-
-#define REG_LARGE_DATA 1000
-
-/* (headers) */
-
-/* (specification)
- "REGRESSION" (regression_):
- *variables=varlist;
- statistics[st_]=r,
- coeff,
- anova,
- outs,
- zpp,
- label,
- sha,
- ci,
- bcov,
- ses,
- xtx,
- collin,
- tol,
- selection,
- f,
- defaults,
- all;
- export=custom;
- ^dependent=varlist;
- method=enter.
-*/
-/* (declarations) */
-/* (functions) */
-static struct cmd_regression cmd;
-
-/*
- Array holding the subscripts of the independent variables.
- */
-size_t *indep_vars;
-
-/*
- File where the model will be saved if the EXPORT subcommand
- is given.
- */
-struct file_handle *model_file;
-
-/*
- Return value for the procedure.
- */
-int pspp_reg_rc = CMD_SUCCESS;
-
-static void run_regression (const struct casefile *, void *);
-
-/*
- STATISTICS subcommand output functions.
- */
-static void reg_stats_r (pspp_linreg_cache *);
-static void reg_stats_coeff (pspp_linreg_cache *);
-static void reg_stats_anova (pspp_linreg_cache *);
-static void reg_stats_outs (pspp_linreg_cache *);
-static void reg_stats_zpp (pspp_linreg_cache *);
-static void reg_stats_label (pspp_linreg_cache *);
-static void reg_stats_sha (pspp_linreg_cache *);
-static void reg_stats_ci (pspp_linreg_cache *);
-static void reg_stats_f (pspp_linreg_cache *);
-static void reg_stats_bcov (pspp_linreg_cache *);
-static void reg_stats_ses (pspp_linreg_cache *);
-static void reg_stats_xtx (pspp_linreg_cache *);
-static void reg_stats_collin (pspp_linreg_cache *);
-static void reg_stats_tol (pspp_linreg_cache *);
-static void reg_stats_selection (pspp_linreg_cache *);
-static void statistics_keyword_output (void (*)(pspp_linreg_cache *),
- int, pspp_linreg_cache *);
-
-static void
-reg_stats_r (pspp_linreg_cache * c)
-{
- struct tab_table *t;
- int n_rows = 2;
- int n_cols = 5;
- double rsq;
- double adjrsq;
- double std_error;
-
- assert (c != NULL);
- rsq = c->ssm / c->sst;
- adjrsq = 1.0 - (1.0 - rsq) * (c->n_obs - 1.0) / (c->n_obs - c->n_indeps);
- std_error = sqrt ((c->n_indeps - 1.0) / (c->n_obs - 1.0));
- t = tab_create (n_cols, n_rows, 0);
- tab_dim (t, tab_natural_dimensions);
- tab_box (t, TAL_2, TAL_2, -1, TAL_1, 0, 0, n_cols - 1, n_rows - 1);
- tab_hline (t, TAL_2, 0, n_cols - 1, 1);
- tab_vline (t, TAL_2, 2, 0, n_rows - 1);
- tab_vline (t, TAL_0, 1, 0, 0);
-
- tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("R"));
- tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("R Square"));
- tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Adjusted R Square"));
- tab_text (t, 4, 0, TAB_CENTER | TAT_TITLE, _("Std. Error of the Estimate"));
- tab_float (t, 1, 1, TAB_RIGHT, sqrt (rsq), 10, 2);
- tab_float (t, 2, 1, TAB_RIGHT, rsq, 10, 2);
- tab_float (t, 3, 1, TAB_RIGHT, adjrsq, 10, 2);
- tab_float (t, 4, 1, TAB_RIGHT, std_error, 10, 2);
- tab_title (t, 0, _("Model Summary"));
- tab_submit (t);
-}
-
-/*
- Table showing estimated regression coefficients.
- */
-static void
-reg_stats_coeff (pspp_linreg_cache * c)
-{
- size_t i;
- size_t j;
- int n_cols = 7;
- int n_rows;
- double t_stat;
- double pval;
- double coeff;
- double std_err;
- double beta;
- const char *label;
- char *tmp;
- const struct variable *v;
- const union value *val;
- const char *val_s;
- struct tab_table *t;
-
- assert (c != NULL);
- tmp = xnmalloc (MAX_STRING, sizeof (*tmp));
- n_rows = c->n_coeffs + 2;
-
- t = tab_create (n_cols, n_rows, 0);
- tab_headers (t, 2, 0, 1, 0);
- tab_dim (t, tab_natural_dimensions);
- tab_box (t, TAL_2, TAL_2, -1, TAL_1, 0, 0, n_cols - 1, n_rows - 1);
- tab_hline (t, TAL_2, 0, n_cols - 1, 1);
- tab_vline (t, TAL_2, 2, 0, n_rows - 1);
- tab_vline (t, TAL_0, 1, 0, 0);
-
- tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("B"));
- tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Std. Error"));
- tab_text (t, 4, 0, TAB_CENTER | TAT_TITLE, _("Beta"));
- tab_text (t, 5, 0, TAB_CENTER | TAT_TITLE, _("t"));
- tab_text (t, 6, 0, TAB_CENTER | TAT_TITLE, _("Significance"));
- tab_text (t, 1, 1, TAB_LEFT | TAT_TITLE, _("(Constant)"));
- coeff = c->coeff[0].estimate;
- tab_float (t, 2, 1, 0, coeff, 10, 2);
- std_err = sqrt (gsl_matrix_get (c->cov, 0, 0));
- tab_float (t, 3, 1, 0, std_err, 10, 2);
- beta = coeff / c->depvar_std;
- tab_float (t, 4, 1, 0, beta, 10, 2);
- t_stat = coeff / std_err;
- tab_float (t, 5, 1, 0, t_stat, 10, 2);
- pval = 2 * gsl_cdf_tdist_Q (fabs (t_stat), 1.0);
- tab_float (t, 6, 1, 0, pval, 10, 2);
- for (j = 1; j <= c->n_indeps; j++)
- {
- i = indep_vars[j];
- v = pspp_linreg_coeff_get_var (c->coeff + j, 0);
- label = var_to_string (v);
- /* Do not overwrite the variable's name. */
- strncpy (tmp, label, MAX_STRING);
- if (v->type == ALPHA)
- {
- /*
- Append the value associated with this coefficient.
- This makes sense only if we us the usual binary encoding
- for that value.
- */
-
- val = pspp_linreg_coeff_get_value (c->coeff + j, v);
- val_s = value_to_string (val, v);
- strncat (tmp, val_s, MAX_STRING);
- }
-
- tab_text (t, 1, j + 1, TAB_CENTER, tmp);
- /*
- Regression coefficients.
- */
- coeff = c->coeff[j].estimate;
- tab_float (t, 2, j + 1, 0, coeff, 10, 2);
- /*
- Standard error of the coefficients.
- */
- std_err = sqrt (gsl_matrix_get (c->cov, j, j));
- tab_float (t, 3, j + 1, 0, std_err, 10, 2);
- /*
- 'Standardized' coefficient, i.e., regression coefficient
- if all variables had unit variance.
- */
- beta = gsl_vector_get (c->indep_std, j);
- beta *= coeff / c->depvar_std;
- tab_float (t, 4, j + 1, 0, beta, 10, 2);
-
- /*
- Test statistic for H0: coefficient is 0.
- */
- t_stat = coeff / std_err;
- tab_float (t, 5, j + 1, 0, t_stat, 10, 2);
- /*
- P values for the test statistic above.
- */
- pval = 2 * gsl_cdf_tdist_Q (fabs (t_stat), 1.0);
- tab_float (t, 6, j + 1, 0, pval, 10, 2);
- }
- tab_title (t, 0, _("Coefficients"));
- tab_submit (t);
- free (tmp);
-}
-
-/*
- Display the ANOVA table.
- */
-static void
-reg_stats_anova (pspp_linreg_cache * c)
-{
- int n_cols = 7;
- int n_rows = 4;
- const double msm = c->ssm / c->dfm;
- const double mse = c->sse / c->dfe;
- const double F = msm / mse;
- const double pval = gsl_cdf_fdist_Q (F, c->dfm, c->dfe);
-
- struct tab_table *t;
-
- assert (c != NULL);
- t = tab_create (n_cols, n_rows, 0);
- tab_headers (t, 2, 0, 1, 0);
- tab_dim (t, tab_natural_dimensions);
-
- tab_box (t, TAL_2, TAL_2, -1, TAL_1, 0, 0, n_cols - 1, n_rows - 1);
-
- tab_hline (t, TAL_2, 0, n_cols - 1, 1);
- tab_vline (t, TAL_2, 2, 0, n_rows - 1);
- tab_vline (t, TAL_0, 1, 0, 0);
-
- tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Sum of Squares"));
- 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, 1, 1, TAB_LEFT | TAT_TITLE, _("Regression"));
- tab_text (t, 1, 2, TAB_LEFT | TAT_TITLE, _("Residual"));
- tab_text (t, 1, 3, TAB_LEFT | TAT_TITLE, _("Total"));
-
- /* Sums of Squares */
- tab_float (t, 2, 1, 0, c->ssm, 10, 2);
- tab_float (t, 2, 3, 0, c->sst, 10, 2);
- tab_float (t, 2, 2, 0, c->sse, 10, 2);
-
-
- /* Degrees of freedom */
- tab_float (t, 3, 1, 0, c->dfm, 4, 0);
- tab_float (t, 3, 2, 0, c->dfe, 4, 0);
- tab_float (t, 3, 3, 0, c->dft, 4, 0);
-
- /* Mean Squares */
-
- tab_float (t, 4, 1, TAB_RIGHT, msm, 8, 3);
- tab_float (t, 4, 2, TAB_RIGHT, mse, 8, 3);
-
- tab_float (t, 5, 1, 0, F, 8, 3);
-
- tab_float (t, 6, 1, 0, pval, 8, 3);
-
- tab_title (t, 0, _("ANOVA"));
- tab_submit (t);
-}
-static void
-reg_stats_outs (pspp_linreg_cache * c)
-{
- assert (c != NULL);
-}
-static void
-reg_stats_zpp (pspp_linreg_cache * c)
-{
- assert (c != NULL);
-}
-static void
-reg_stats_label (pspp_linreg_cache * c)
-{
- assert (c != NULL);
-}
-static void
-reg_stats_sha (pspp_linreg_cache * c)
-{
- assert (c != NULL);
-}
-static void
-reg_stats_ci (pspp_linreg_cache * c)
-{
- assert (c != NULL);
-}
-static void
-reg_stats_f (pspp_linreg_cache * c)
-{
- assert (c != NULL);
-}
-static void
-reg_stats_bcov (pspp_linreg_cache * c)
-{
- int n_cols;
- int n_rows;
- int i;
- int j;
- int k;
- int row;
- int col;
- const char *label;
- struct tab_table *t;
-
- assert (c != NULL);
- n_cols = c->n_indeps + 1 + 2;
- n_rows = 2 * (c->n_indeps + 1);
- t = tab_create (n_cols, n_rows, 0);
- tab_headers (t, 2, 0, 1, 0);
- tab_dim (t, tab_natural_dimensions);
- tab_box (t, TAL_2, TAL_2, -1, TAL_1, 0, 0, n_cols - 1, n_rows - 1);
- tab_hline (t, TAL_2, 0, n_cols - 1, 1);
- tab_vline (t, TAL_2, 2, 0, n_rows - 1);
- tab_vline (t, TAL_0, 1, 0, 0);
- tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Model"));
- tab_text (t, 1, 1, TAB_CENTER | TAT_TITLE, _("Covariances"));
- for (i = 1; i < c->n_indeps + 1; i++)
- {
- j = indep_vars[(i - 1)];
- struct variable *v = cmd.v_variables[j];
- label = var_to_string (v);
- tab_text (t, 2, i, TAB_CENTER, label);
- tab_text (t, i + 2, 0, TAB_CENTER, label);
- for (k = 1; k < c->n_indeps + 1; k++)
- {
- col = (i <= k) ? k : i;
- row = (i <= k) ? i : k;
- tab_float (t, k + 2, i, TAB_CENTER,
- gsl_matrix_get (c->cov, row, col), 8, 3);
- }
- }
- tab_title (t, 0, _("Coefficient Correlations"));
- tab_submit (t);
-}
-static void
-reg_stats_ses (pspp_linreg_cache * c)
-{
- assert (c != NULL);
-}
-static void
-reg_stats_xtx (pspp_linreg_cache * c)
-{
- assert (c != NULL);
-}
-static void
-reg_stats_collin (pspp_linreg_cache * c)
-{
- assert (c != NULL);
-}
-static void
-reg_stats_tol (pspp_linreg_cache * c)
-{
- assert (c != NULL);
-}
-static void
-reg_stats_selection (pspp_linreg_cache * c)
-{
- assert (c != NULL);
-}
-
-static void
-statistics_keyword_output (void (*function) (pspp_linreg_cache *),
- int keyword, pspp_linreg_cache * c)
-{
- if (keyword)
- {
- (*function) (c);
- }
-}
-
-static void
-subcommand_statistics (int *keywords, pspp_linreg_cache * c)
-{
- /*
- The order here must match the order in which the STATISTICS
- keywords appear in the specification section above.
- */
- enum
- { r,
- coeff,
- anova,
- outs,
- zpp,
- label,
- sha,
- ci,
- bcov,
- ses,
- xtx,
- collin,
- tol,
- selection,
- f,
- defaults,
- all
- };
- int i;
- int d = 1;
-
- if (keywords[all])
- {
- /*
- Set everything but F.
- */
- for (i = 0; i < f; i++)
- {
- keywords[i] = 1;
- }
- }
- else
- {
- for (i = 0; i < all; i++)
- {
- if (keywords[i])
- {
- d = 0;
- }
- }
- /*
- Default output: ANOVA table, parameter estimates,
- and statistics for variables not entered into model,
- if appropriate.
- */
- if (keywords[defaults] | d)
- {
- keywords[anova] = 1;
- keywords[outs] = 1;
- keywords[coeff] = 1;
- keywords[r] = 1;
- }
- }
- statistics_keyword_output (reg_stats_r, keywords[r], c);
- statistics_keyword_output (reg_stats_anova, keywords[anova], c);
- statistics_keyword_output (reg_stats_coeff, keywords[coeff], c);
- statistics_keyword_output (reg_stats_outs, keywords[outs], c);
- statistics_keyword_output (reg_stats_zpp, keywords[zpp], c);
- statistics_keyword_output (reg_stats_label, keywords[label], c);
- statistics_keyword_output (reg_stats_sha, keywords[sha], c);
- statistics_keyword_output (reg_stats_ci, keywords[ci], c);
- statistics_keyword_output (reg_stats_f, keywords[f], c);
- statistics_keyword_output (reg_stats_bcov, keywords[bcov], c);
- statistics_keyword_output (reg_stats_ses, keywords[ses], c);
- statistics_keyword_output (reg_stats_xtx, keywords[xtx], c);
- statistics_keyword_output (reg_stats_collin, keywords[collin], c);
- statistics_keyword_output (reg_stats_tol, keywords[tol], c);
- statistics_keyword_output (reg_stats_selection, keywords[selection], c);
-}
-static int
-reg_inserted (const struct variable *v, struct variable **varlist, int n_vars)
-{
- int i;
-
- for (i = 0; i < n_vars; i++)
- {
- if (v->index == varlist[i]->index)
- {
- return 1;
- }
- }
- return 0;
-}
-static void
-reg_print_categorical_encoding (FILE * fp, pspp_linreg_cache * c)
-{
- int i;
- size_t j;
- int n_vars = 0;
- struct variable **varlist;
- struct pspp_linreg_coeff *coeff;
- const struct variable *v;
- union value *val;
-
- fprintf (fp, "%s", reg_export_categorical_encode_1);
-
- varlist = xnmalloc (c->n_indeps, sizeof (*varlist));
- for (i = 1; i < c->n_indeps; i++) /* c->coeff[0] is the intercept. */
- {
- coeff = c->coeff + i;
- v = pspp_linreg_coeff_get_var (coeff, 0);
- if (v->type == ALPHA)
- {
- if (!reg_inserted (v, varlist, n_vars))
- {
- fprintf (fp, "struct pspp_reg_categorical_variable %s;\n\t",
- v->name);
- varlist[n_vars] = (struct variable *) v;
- n_vars++;
- }
- }
- }
- fprintf (fp, "int n_vars = %d;\n\t", n_vars);
- fprintf (fp, "struct pspp_reg_categorical_variable *varlist[%d] = {",
- n_vars);
- for (i = 0; i < n_vars - 1; i++)
- {
- fprintf (fp, "&%s,\n\t\t", varlist[i]->name);
- }
- fprintf (fp, "&%s};\n\t", varlist[i]->name);
-
- for (i = 0; i < n_vars; i++)
- {
- coeff = c->coeff + i;
- fprintf (fp, "%s.name = \"%s\";\n\t", varlist[i]->name,
- varlist[i]->name);
- fprintf (fp, "%s.n_vals = %d;\n\t", varlist[i]->name,
- varlist[i]->obs_vals->n_categories);
-
- for (j = 0; j < varlist[i]->obs_vals->n_categories; j++)
- {
- val = cat_subscript_to_value ((const size_t) j, varlist[i]);
- fprintf (fp, "%s.values[%d] = \"%s\";\n\t", varlist[i]->name, j,
- value_to_string (val, varlist[i]));
- }
- }
- fprintf (fp, "%s", reg_export_categorical_encode_2);
-}
-
-static void
-reg_print_depvars (FILE * fp, pspp_linreg_cache * c)
-{
- int i;
- struct pspp_linreg_coeff *coeff;
- const struct variable *v;
-
- fprintf (fp, "char *model_depvars[%d] = {", c->n_indeps);
- for (i = 1; i < c->n_indeps; i++)
- {
- coeff = c->coeff + i;
- v = pspp_linreg_coeff_get_var (coeff, 0);
- fprintf (fp, "\"%s\",\n\t\t", v->name);
- }
- coeff = c->coeff + i;
- v = pspp_linreg_coeff_get_var (coeff, 0);
- fprintf (fp, "\"%s\"};\n\t", v->name);
-}
-static void
-reg_print_getvar (FILE * fp, pspp_linreg_cache * c)
-{
- fprintf (fp, "static int\npspp_reg_getvar (char *v_name)\n{\n\t");
- fprintf (fp, "int i;\n\tint n_vars = %d;\n\t", c->n_indeps);
- reg_print_depvars (fp, c);
- fprintf (fp, "for (i = 0; i < n_vars; i++)\n\t{\n\t\t");
- fprintf (fp,
- "if (strncmp (v_name, model_depvars[i], PSPP_REG_MAXLEN) == 0)\n\t\t{\n\t\t\t");
- fprintf (fp, "return i;\n\t\t}\n\t}\n}\n");
-}
-static void
-subcommand_export (int export, pspp_linreg_cache * c)
-{
- size_t i;
- size_t j;
- int n_quantiles = 100;
- double increment;
- double tmp;
- struct pspp_linreg_coeff coeff;
-
- if (export)
- {
- FILE *fp;
- assert (c != NULL);
- assert (model_file != NULL);
- assert (fp != NULL);
- fp = fopen (fh_get_filename (model_file), "w");
- fprintf (fp, "%s", reg_preamble);
- reg_print_getvar (fp, c);
- reg_print_categorical_encoding (fp, c);
- fprintf (fp, "%s", reg_export_t_quantiles_1);
- increment = 0.5 / (double) increment;
- for (i = 0; i < n_quantiles - 1; i++)
- {
- tmp = 0.5 + 0.005 * (double) i;
- fprintf (fp, "%.15e,\n\t\t",
- gsl_cdf_tdist_Pinv (tmp, c->n_obs - c->n_indeps));
- }
- fprintf (fp, "%.15e};\n\t",
- gsl_cdf_tdist_Pinv (.9995, c->n_obs - c->n_indeps));
- fprintf (fp, "%s", reg_export_t_quantiles_2);
- fprintf (fp, "%s", reg_mean_cmt);
- fprintf (fp, "double\npspp_reg_estimate (const double *var_vals,");
- fprintf (fp, "const char *var_names[])\n{\n\t");
- fprintf (fp, "double model_coeffs[%d] = {", c->n_indeps);
- for (i = 1; i < c->n_indeps; i++)
- {
- coeff = c->coeff[i];
- fprintf (fp, "%.15e,\n\t\t", coeff.estimate);
- }
- coeff = c->coeff[i];
- fprintf (fp, "%.15e};\n\t", coeff.estimate);
- coeff = c->coeff[0];
- fprintf (fp, "double estimate = %.15e;\n\t", coeff.estimate);
- fprintf (fp, "int i;\n\tint j;\n\n\t");
- fprintf (fp, "for (i = 0; i < %d; i++)\n\t", c->n_indeps);
- fprintf (fp, "%s", reg_getvar);
- fprintf (fp, "const double cov[%d][%d] = {\n\t", c->n_coeffs,
- c->n_coeffs);
- for (i = 0; i < c->cov->size1 - 1; i++)
- {
- fprintf (fp, "{");
- for (j = 0; j < c->cov->size2 - 1; j++)
- {
- fprintf (fp, "%.15e, ", gsl_matrix_get (c->cov, i, j));
- }
- fprintf (fp, "%.15e},\n\t", gsl_matrix_get (c->cov, i, j));
- }
- fprintf (fp, "{");
- for (j = 0; j < c->cov->size2 - 1; j++)
- {
- fprintf (fp, "%.15e, ",
- gsl_matrix_get (c->cov, c->cov->size1 - 1, j));
- }
- fprintf (fp, "%.15e}\n\t",
- gsl_matrix_get (c->cov, c->cov->size1 - 1, c->cov->size2 - 1));
- fprintf (fp, "};\n\tint n_vars = %d;\n\tint i;\n\tint j;\n\t",
- c->n_indeps);
- fprintf (fp, "double unshuffled_vals[%d];\n\t", c->n_indeps);
- fprintf (fp, "%s", reg_variance);
- fprintf (fp, "%s", reg_export_confidence_interval);
- tmp = c->mse * c->mse;
- fprintf (fp, "%s %.15e", reg_export_prediction_interval_1, tmp);
- fprintf (fp, "%s %.15e", reg_export_prediction_interval_2, tmp);
- fprintf (fp, "%s", reg_export_prediction_interval_3);
- fclose (fp);
- fp = fopen ("pspp_model_reg.h", "w");
- fprintf (fp, "%s", reg_header);
- fclose (fp);
- }
-}
-static int
-regression_custom_export (struct cmd_regression *cmd)
-{
- /* 0 on failure, 1 on success, 2 on failure that should result in syntax error */
- if (!lex_force_match ('('))
- return 0;
-
- if (lex_match ('*'))
- model_file = NULL;
- else
- {
- model_file = fh_parse (FH_REF_FILE);
- if (model_file == NULL)
- return 0;
- }
-
- if (!lex_force_match (')'))
- return 0;
-
- return 1;
-}
-
-int
-cmd_regression (void)
-{
- if (!parse_regression (&cmd))
- {
- return CMD_FAILURE;
- }
- multipass_procedure_with_splits (run_regression, &cmd);
-
- return pspp_reg_rc;
-}
-
-/*
- Is variable k one of the dependent variables?
- */
-static int
-is_depvar (size_t k)
-{
- size_t j = 0;
- for (j = 0; j < cmd.n_dependent; j++)
- {
- /*
- compare_var_names returns 0 if the variable
- names match.
- */
- if (!compare_var_names (cmd.v_dependent[j], cmd.v_variables[k], NULL))
- return 1;
- }
- return 0;
-}
-
-/*
- Mark missing cases. Return the number of non-missing cases.
- */
-static size_t
-mark_missing_cases (const struct casefile *cf, struct variable *v,
- int *is_missing_case, double n_data)
-{
- struct casereader *r;
- struct ccase c;
- size_t row;
- const union value *val;
-
- for (r = casefile_get_reader (cf);
- casereader_read (r, &c); case_destroy (&c))
- {
- row = casereader_cnum (r) - 1;
-
- val = case_data (&c, v->fv);
- cat_value_update (v, val);
- if (mv_is_value_missing (&v->miss, val))
- {
- if (!is_missing_case[row])
- {
- /* Now it is missing. */
- n_data--;
- is_missing_case[row] = 1;
- }
- }
- }
- casereader_destroy (r);
-
- return n_data;
-}
-
-static void
-run_regression (const struct casefile *cf, void *cmd_ UNUSED)
-{
- size_t i;
- size_t n_data = 0;
- size_t row;
- size_t case_num;
- int n_indep;
- int j = 0;
- int k;
- /*
- Keep track of the missing cases.
- */
- int *is_missing_case;
- const union value *val;
- struct casereader *r;
- struct ccase c;
- struct variable *v;
- struct variable *depvar;
- struct variable **indep_vars;
- struct design_matrix *X;
- gsl_vector *Y;
- pspp_linreg_cache *lcache;
- pspp_linreg_opts lopts;
-
- n_data = casefile_get_case_cnt (cf);
-
- for (i = 0; i < cmd.n_dependent; i++)
- {
- if (cmd.v_dependent[i]->type != NUMERIC)
- {
- msg (SE, gettext ("Dependent variable must be numeric."));
- pspp_reg_rc = CMD_FAILURE;
- return;
- }
- }
-
- is_missing_case = xnmalloc (n_data, sizeof (*is_missing_case));
- for (i = 0; i < n_data; i++)
- is_missing_case[i] = 0;
-
- n_indep = cmd.n_variables - cmd.n_dependent;
- indep_vars = xnmalloc (n_indep, sizeof *indep_vars);
-
- lopts.get_depvar_mean_std = 1;
- lopts.get_indep_mean_std = xnmalloc (n_indep, sizeof (int));
-
- /*
- Read from the active file. The first pass encodes categorical
- variables and drops cases with missing values.
- */
- j = 0;
- for (i = 0; i < cmd.n_variables; i++)
- {
- if (!is_depvar (i))
- {
- v = cmd.v_variables[i];
- indep_vars[j] = v;
- j++;
- if (v->type == ALPHA)
- {
- /* Make a place to hold the binary vectors
- corresponding to this variable's values. */
- cat_stored_values_create (v);
- }
- n_data = mark_missing_cases (cf, v, is_missing_case, n_data);
- }
- }
-
- /*
- Drop cases with missing values for any dependent variable.
- */
- j = 0;
- for (i = 0; i < cmd.n_dependent; i++)
- {
- v = cmd.v_dependent[i];
- j++;
- n_data = mark_missing_cases (cf, v, is_missing_case, n_data);
- }
-
- for (k = 0; k < cmd.n_dependent; k++)
- {
- depvar = cmd.v_dependent[k];
- Y = gsl_vector_alloc (n_data);
-
- X =
- design_matrix_create (n_indep, (const struct variable **) indep_vars,
- n_data);
- for (i = 0; i < X->m->size2; i++)
- {
- lopts.get_indep_mean_std[i] = 1;
- }
- lcache = pspp_linreg_cache_alloc (X->m->size1, X->m->size2);
- lcache->indep_means = gsl_vector_alloc (X->m->size2);
- lcache->indep_std = gsl_vector_alloc (X->m->size2);
- lcache->depvar = (const struct variable *) depvar;
- /*
- For large data sets, use QR decomposition.
- */
- if (n_data > sqrt (n_indep) && n_data > REG_LARGE_DATA)
- {
- lcache->method = PSPP_LINREG_SVD;
- }
-
- /*
- The second pass creates the design matrix.
- */
- row = 0;
- for (r = casefile_get_reader (cf); casereader_read (r, &c);
- case_destroy (&c))
- /* Iterate over the cases. */
- {
- case_num = casereader_cnum (r) - 1;
- if (!is_missing_case[case_num])
- {
- for (i = 0; i < cmd.n_variables; ++i) /* Iterate over the variables
- for the current case.
- */
- {
- v = cmd.v_variables[i];
- val = case_data (&c, v->fv);
- /*
- Independent/dependent variable separation. The
- 'variables' subcommand specifies a varlist which contains
- both dependent and independent variables. The dependent
- variables are specified with the 'dependent'
- subcommand, and maybe also in the 'variables' subcommand.
- We need to separate the two.
- */
- if (!is_depvar (i))
- {
- if (v->type == ALPHA)
- {
- design_matrix_set_categorical (X, row, v, val);
- }
- else if (v->type == NUMERIC)
- {
- design_matrix_set_numeric (X, row, v, val);
- }
- }
- }
- val = case_data (&c, depvar->fv);
- gsl_vector_set (Y, row, val->f);
- row++;
- }
- }
- /*
- Now that we know the number of coefficients, allocate space
- and store pointers to the variables that correspond to the
- coefficients.
- */
- pspp_linreg_coeff_init (lcache, X);
-
- /*
- Find the least-squares estimates and other statistics.
- */
- pspp_linreg ((const gsl_vector *) Y, X->m, &lopts, lcache);
- subcommand_statistics (cmd.a_statistics, lcache);
- subcommand_export (cmd.sbc_export, lcache);
- gsl_vector_free (Y);
- design_matrix_destroy (X);
- pspp_linreg_cache_free (lcache);
- free (lopts.get_indep_mean_std);
- casereader_destroy (r);
- }
- free (indep_vars);
- free (is_missing_case);
-
- return;
-}
-
-/*
- Local Variables:
- mode: c
- End:
-*/
+++ /dev/null
-/* PSPP - Comments for C files generated by REGRESSION's EXPORT subcommand.
- Copyright (C) 2005 Free Software Foundation, Inc.
- Written by Jason H Stover <jason@sakla.net>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-/*
- Exported C code for a regression model. The EXPORT subcommand causes PSPP
- to save a model as a small C program. This file contains some of the code
- of that saved program.
- */
-#ifndef REG_EXPORT_COMMENTS_H
-#define REG_EXPORT_COMMENTS_H
-const char reg_header[] = "#ifndef REG_EXPORT_COMMENTS_H\n#define REG_EXPORT_COMMENTS_H\n"
-"double pspp_reg_estimate (const double *, const char *[]);\n\n"
-"double pspp_reg_variance (const double *var_vals, const char *[]);\n\n"
-"double pspp_reg_confidence_interval_U "
-"(const double *var_vals, const char *var_names[], double p);\n\n"
-"double pspp_reg_confidence_interval_L "
-"(const double *var_vals, const char *var_names[], double p);\n\n"
-"double pspp_reg_prediction_interval_U "
-"(const double *var_vals, const char *var_names[], double p);\n\n"
-"double pspp_reg_prediction_interval_L "
-"(const double *var_vals, const char *var_names[], double p);\n"
-"#endif\n";
-
-const char reg_preamble[] = "/*\n This program contains functions which return estimates\n"
-" and confidence intervals for a linear model. The EXPORT subcommand\n"
-" of the REGRESSION procedure of GNU PSPP generated this program.\n*/\n\n"
-"#include <string.h>\n#include <math.h>\n#define PSPP_REG_MAXLEN 1024\n\n";
-
-const char reg_mean_cmt[] = "/*\n Estimate the mean of Y, the dependent variable for\n"
-" the linear model of the form \n\n"
-" Y = b0 + b1 * X1 + b2 * X2 + ... + bk * Xk + error\n\n"
-" where X1, ..., Xk are the independent variables\n"
-" whose values are stored in var_vals and whose names, \n"
-" as known by PSPP, are stored in var_names. The estimated \n"
-" regression coefficients (i.e., the estimates of b0,...,bk) \n"
-" are stored in model_coeffs.\n*/\n";
-
-const char reg_getvar[] = "{\n\t\tj = pspp_reg_getvar (var_names[i]);\n"
-"\t\testimate += var_vals[j] * model_coeffs[j];\n"
-"\t}\n\t\n\treturn estimate;\n}\n\n"
-"/*\n Variance of an estimated mean of this form:\n\t"
-"Y = b0 + b1 * X1 + ... + bk * Xk\n where X1,...Xk are the dependent variables,"
-" stored in\n var_vals and b0,...,bk are the estimated regression coefficients.\n*/\n"
-"double\npspp_reg_variance (const double *var_vals, "
-"const char *var_names[])\n{\n\t";
-
-const char reg_export_t_quantiles_1[] = "/*\n Quantiles for the T distribution.\n*/\n"
-"static int\npspp_reg_t_quantile "
-"(double prob)\n{\n\n\tint i;\n\tdouble quantiles[] = {\n\t\t";
-
-const char reg_export_t_quantiles_2[] = "i = (int) 100.0 * prob;\n\treturn quantiles[i];\n}\n";
-
-const char reg_variance[] = "double result = 0.0;\n\n\tfor(i = 0; i < n_vars; i++)\n\t"
-"{\n\t\tj = pspp_reg_getvar (var_names[i]);\n\t\t"
-"unshuffled_vals[j] = var_vals[i];\n\t}\n\t"
-"for (i = 0; i < n_vars; i++)\n\t"
-"{\n\t\tresult += cov[i][i] * unshuffled_vals[i] * unshuffled_vals[i];\n\t\t"
-"for (j = i + 1; j < n_vars; j++)\n\t\t{\n\t\t\t"
-"result += 2.0 * cov[i][j] * unshuffled_vals[i] * unshuffled_vals[j];"
-"\n\t\t}\n\t}\n\treturn result;\n}\n";
-
-const char reg_export_confidence_interval[] = "/*\n Upper confidence limit for an "
-"estimated mean b0 + b1 * X1 + ... + bk * Xk.\n The confidence interval is a "
-"100 * p percent confidence interval.\n*/\n"
-"double pspp_reg_confidence_interval_U "
-"(const double *var_vals, const char *var_names[], double p)\n{\n\t"
-"double result;\n\t"
-"result = sqrt (pspp_reg_variance (var_vals, var_names));\n\t"
-"result *= pspp_reg_t_quantile ((1.0 + p) / 2.0);\n\t"
-"result += pspp_reg_estimate (var_vals, var_names);\n\treturn result;\n}\n"
-"/*\n Lower confidence limit for an "
-"estimated mean b0 + b1 * X1 + ... + bk * Xk.\n The confidence interval is a "
-"100 * p percent confidence interval.\n*/\n"
-"double pspp_reg_confidence_interval_L "
-"(const double *var_vals, const char *var_names[], double p)\n{\n\t"
-"double result;\n\t"
-"result = -sqrt (pspp_reg_variance (var_vals, var_names));\n\t"
-"result *= pspp_reg_t_quantile ((1.0 + p) / 2.0);\n\t"
-"result += pspp_reg_estimate (var_vals, var_names);\n\treturn result;\n}\n";
-
-const char reg_export_prediction_interval_1[] = "/*\n Upper prediction limit for a "
-"predicted value b0 + b1 * X1 + ... + bk * Xk.\n The prediction interval is a "
-"100 * p percent prediction interval.\n*/\n"
-"double pspp_reg_prediction_interval_U "
-"(const double *var_vals, const char *var_names[], double p)\n{\n\t"
-"double result;\n\tresult = sqrt (";
-
-const char reg_export_prediction_interval_2[] = " + pspp_reg_variance (var_vals, var_names));\n"
-"\tresult *= pspp_reg_t_quantile ((1.0 + p) / 2.0);\n\t"
-"result += pspp_reg_estimate (var_vals, var_names);\n\treturn result;\n}\n"
-"/*\n Lower prediction limit for a "
-"predicted value b0 + b1 * X1 + ... + bk * Xk.\n The prediction interval is a "
-"100 * p percent prediction interval.\n*/\n"
-"double pspp_reg_prediction_interval_L "
-"(const double *var_vals, const char *var_names[], double p)\n{\n\t"
-"double result;\n\t"
-"result = -sqrt (";
-
-const char reg_export_prediction_interval_3[] = " + pspp_reg_variance (var_vals, var_names));"
-"\n\tresult *= pspp_reg_t_quantile ((1.0 + p) / 2.0);\n\t"
-"result += pspp_reg_estimate (var_vals, var_names);\n\treturn result;\n}\n";
-
-/*
- Change categorical values to binary vectors. The routine will use
- an encoding in which a categorical variable with n values is mapped
- to a vector with n-1 entries. Value 0 is mapped to the zero vector,
- value 1 is mapped to a vector whose first entry is 1 and all others are
- 0, etc. For example, if a variable can have 'a', 'b' or 'c' as values,
- then the value 'a' will be encoded as (0,0), 'b' as (1,0) and 'c' as
- (0,1). If the design matrix used to create the model used a different
- encoding, then the function pspp_reg_categorical_encode () will return
- a vector which does not match its categorical value in the model.
- */
-const char reg_export_categorical_encode_1[] = "struct pspp_reg_categorical_variable\n"
-"{\n\tchar * name;\n\tsize_t n_vals;\n\tchar *values[1024];\n};\n\n"
-"/*\n This function returns the binary vector which corresponds to the value\n"
-" of the categorical variable stored in 'value'. The name of the variable is\n"
-" stored in the 'var' argument. Notice the values stored in the\n"
-" pspp_categorical_variable structures all end with a space character.\n"
-" That means the values of the categorical variables you pass to any function\n"
-" in this program should also end with a space character.\n*/\n"
-"static\ndouble * pspp_reg_get_value_vector (char *var, char *value)\n{\n\tdouble *result;\n\t"
-"int i;\n\t";
-
-const char reg_export_categorical_encode_2[] = "int v_index = 0;\n\t"
-"while (v_index < n_vars && strncmp (var, varlist[i]->name, PSPP_REG_MAXLEN) != 0)\n\t{\n\t\t"
-"v_index++;\n\t}\n\tresult = (double *) malloc (varlist[v_index]->n_vals * sizeof (*result));\n\t"
-"for (i = 0; i < varlist[v_index]->n_vals; i++)\n\t{\n\t\t"
-"if (strncmp ( (varlist[v_index]->values)[i], value, PSPP_REG_MAXLEN) == 0)\n\t\t{\n\t\t\t"
-"result[i] = 1.0;\n\t\t}\n\t\telse result[i] = 0.0;\n\t}\n\n\t"
-"return result;\n}\n\n";
-#endif
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <stdlib.h>
-#include "error.h"
-#include "alloc.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "hash.h"
-#include "lexer.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* The code for this function is very similar to the code for the
- RENAME subcommand of MODIFY VARS. */
-int
-cmd_rename_variables (void)
-{
- struct variable **rename_vars = NULL;
- char **rename_new_names = NULL;
- size_t rename_cnt = 0;
- char *err_name;
-
- int status = CMD_FAILURE;
-
- if (temporary != 0)
- {
- msg (SE, _("RENAME VARS may not be used after TEMPORARY. "
- "Temporary transformations will be made permanent."));
- cancel_temporary ();
- }
-
- do
- {
- size_t prev_nv_1 = rename_cnt;
- size_t prev_nv_2 = rename_cnt;
-
- if (!lex_match ('('))
- {
- msg (SE, _("`(' expected."));
- goto lossage;
- }
- if (!parse_variables (default_dict, &rename_vars, &rename_cnt,
- PV_APPEND | PV_NO_DUPLICATE))
- goto lossage;
- if (!lex_match ('='))
- {
- msg (SE, _("`=' expected between lists of new and old variable names."));
- goto lossage;
- }
- if (!parse_DATA_LIST_vars (&rename_new_names, &prev_nv_1, PV_APPEND))
- goto lossage;
- if (prev_nv_1 != rename_cnt)
- {
- size_t i;
-
- msg (SE, _("Differing number of variables in old name list "
- "(%u) and in new name list (%u)."),
- (unsigned) rename_cnt - prev_nv_2,
- (unsigned) prev_nv_1 - prev_nv_2);
- for (i = 0; i < prev_nv_1; i++)
- free (rename_new_names[i]);
- free (rename_new_names);
- rename_new_names = NULL;
- goto lossage;
- }
- if (!lex_match (')'))
- {
- msg (SE, _("`)' expected after variable names."));
- goto lossage;
- }
- }
- while (token != '.');
-
- if (!dict_rename_vars (default_dict,
- rename_vars, rename_new_names, rename_cnt,
- &err_name))
- {
- msg (SE, _("Renaming would duplicate variable name %s."), err_name);
- goto lossage;
- }
-
- status = CMD_SUCCESS;
-
- lossage:
- free (rename_vars);
- if (rename_new_names != NULL)
- {
- size_t i;
- for (i = 0; i < rename_cnt; i++)
- free (rename_new_names[i]);
- free (rename_new_names);
- }
- return status;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "repeat.h"
-#include "error.h"
-#include <ctype.h>
-#include <math.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "getl.h"
-#include "lexer.h"
-#include "misc.h"
-#include "settings.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-/* Describes one DO REPEAT macro. */
-struct repeat_entry
- {
- int type; /* 1=variable names, 0=any other. */
- char id[LONG_NAME_LEN + 1]; /* Macro identifier. */
- char **replacement; /* Macro replacement. */
- struct repeat_entry *next;
- };
-
-/* List of macro identifiers. */
-static struct repeat_entry *repeat_tab;
-
-/* Number of substitutions for each macro. */
-static int count;
-
-/* List of lines before it's actually assigned to a file. */
-static struct getl_line_list *line_buf_head;
-static struct getl_line_list *line_buf_tail;
-
-static int parse_ids (struct repeat_entry *);
-static int parse_numbers (struct repeat_entry *);
-static int parse_strings (struct repeat_entry *);
-static void clean_up (void);
-static int internal_cmd_do_repeat (void);
-
-int
-cmd_do_repeat (void)
-{
- if (internal_cmd_do_repeat ())
- return CMD_SUCCESS;
-
- clean_up ();
- return CMD_FAILURE;
-}
-
-/* Garbage collects all the allocated memory that's no longer
- needed. */
-static void
-clean_up (void)
-{
- struct repeat_entry *iter, *next;
- int i;
-
- iter = repeat_tab;
- repeat_tab = NULL;
-
- while (iter)
- {
- if (iter->replacement)
- {
- for (i = 0; i < count; i++)
- free (iter->replacement[i]);
- free (iter->replacement);
- }
- next = iter->next;
- free (iter);
- iter = next;
- }
-}
-
-/* Allocates & appends another record at the end of the line_buf_tail
- chain. */
-static inline void
-append_record (void)
-{
- struct getl_line_list *new = xmalloc (sizeof *new);
-
- if (line_buf_head == NULL)
- line_buf_head = line_buf_tail = new;
- else
- line_buf_tail = line_buf_tail->next = new;
-}
-
-/* Returns nonzero if KEYWORD appears beginning at CONTEXT. */
-static int
-recognize_keyword (const char *context, const char *keyword)
-{
- const char *end = context;
- while (isalpha ((unsigned char) *end))
- end++;
- return lex_id_match_len (keyword, strlen (keyword), context, end - context);
-}
-
-/* Does the real work of parsing the DO REPEAT command and its nested
- commands. */
-static int
-internal_cmd_do_repeat (void)
-{
- /* Name of first DO REPEAT macro. */
- char first_name[LONG_NAME_LEN + 1];
-
- /* Current filename. */
- const char *current_filename = NULL;
-
- /* 1=Print lines after preprocessing. */
- int print;
-
- /* The first step is parsing the DO REPEAT command itself. */
- count = 0;
- line_buf_head = NULL;
- do
- {
- struct repeat_entry *e;
- struct repeat_entry *iter;
- int result;
-
- /* Get a stand-in variable name and make sure it's unique. */
- if (!lex_force_id ())
- return 0;
- for (iter = repeat_tab; iter; iter = iter->next)
- if (!strcasecmp (iter->id, tokid))
- {
- msg (SE, _("Identifier %s is given twice."), tokid);
- return 0;
- }
-
- /* Make a new stand-in variable entry and link it into the
- list. */
- e = xmalloc (sizeof *e);
- e->type = 0;
- e->next = repeat_tab;
- strcpy (e->id, tokid);
- repeat_tab = e;
-
- /* Skip equals sign. */
- lex_get ();
- if (!lex_force_match ('='))
- return 0;
-
- /* Get the details of the variable's possible values. */
-
- if (token == T_ID)
- result = parse_ids (e);
- else if (lex_is_number ())
- result = parse_numbers (e);
- else if (token == T_STRING)
- result = parse_strings (e);
- else
- {
- lex_error (NULL);
- return 0;
- }
- if (!result)
- return 0;
-
- /* If this is the first variable then it defines how many
- replacements there must be; otherwise enforce this number of
- replacements. */
- if (!count)
- {
- count = result;
- strcpy (first_name, e->id);
- }
- else if (count != result)
- {
- msg (SE, _("There must be the same number of substitutions "
- "for each dummy variable specified. Since there "
- "were %d substitutions for %s, there must be %d "
- "for %s as well, but %d were specified."),
- count, first_name, count, e->id, result);
- return 0;
- }
-
- /* Next! */
- lex_match ('/');
- }
- while (token != '.');
-
- /* Read all the lines inside the DO REPEAT ... END REPEAT. */
- {
- int nest = 1;
-
- for (;;)
- {
- if (!getl_read_line ())
- msg (FE, _("Unexpected end of file."));
-
- /* If the current file has changed then record the fact. */
- {
- const char *curfn;
- int curln;
-
- getl_location (&curfn, &curln);
- if (current_filename != curfn)
- {
- assert (curln > 0 && curfn != NULL);
-
- append_record ();
- line_buf_tail->len = -curln;
- line_buf_tail->line = xstrdup (curfn);
- current_filename = curfn;
- }
- }
-
- /* FIXME? This code is not strictly correct, however if you
- have begun a line with DO REPEAT or END REPEAT and it's
- *not* a command name, then you are obviously *trying* to
- break this mechanism. And you will. Also, the entire
- command names must appear on a single line--they can't be
- spread out. */
- {
- char *cp = ds_c_str (&getl_buf);
-
- /* Skip leading indentors and any whitespace. */
- if (*cp == '+' || *cp == '-' || *cp == '.')
- cp++;
- while (isspace ((unsigned char) *cp))
- cp++;
-
- /* Find END REPEAT. */
- if (recognize_keyword (cp, "end"))
- {
- while (isalpha ((unsigned char) *cp))
- cp++;
- while (isspace ((unsigned char) *cp))
- cp++;
- if (recognize_keyword (cp, "repeat"))
- {
- nest--;
-
- if (!nest)
- {
- while (isalpha ((unsigned char) *cp))
- cp++;
- while (isspace ((unsigned char) *cp))
- cp++;
-
- print = recognize_keyword (cp, "print");
- break;
- }
- }
- }
- else /* Find DO REPEAT. */
- if (!strncasecmp (cp, "do", 2))
- {
- cp += 2;
- while (isspace ((unsigned char) *cp))
- cp++;
- if (!strncasecmp (cp, "rep", 3))
- nest++;
- }
- }
-
- append_record ();
- line_buf_tail->len = ds_length (&getl_buf);
- line_buf_tail->line = xmalloc (ds_length (&getl_buf) + 1);
- memcpy (line_buf_tail->line,
- ds_c_str (&getl_buf), ds_length (&getl_buf) + 1);
- }
- }
-
- /* FIXME: For the moment we simply discard the contents of the END
- REPEAT line. We should actually check for the PRINT specifier.
- This can be done easier when we buffer entire commands instead of
- doing it token by token; see TODO. */
- lex_discard_line ();
-
- /* Tie up the loose end of the chain. */
- if (line_buf_head == NULL)
- {
- msg (SW, _("No commands in scope."));
- return 1;
- }
- line_buf_tail->next = NULL;
-
- /* Make new variables. */
- {
- struct repeat_entry *iter;
- for (iter = repeat_tab; iter; iter = iter->next)
- if (iter->type == 1)
- {
- int i;
- for (i = 0; i < count; i++)
- {
- /* Note that if the variable already exists there is no
- harm done. */
- dict_create_var (default_dict, iter->replacement[i], 0);
- }
- }
- }
-
- /* Create the DO REPEAT virtual input file. */
- {
- struct getl_script *script = xmalloc (sizeof *script);
-
- script->first_line = line_buf_head;
- script->cur_line = NULL;
- script->remaining_loops = count;
- script->loop_index = -1;
- script->macros = repeat_tab;
- script->print = print;
-
- getl_add_DO_REPEAT_file (script);
- }
-
- return 1;
-}
-
-/* Parses a set of ids for DO REPEAT. */
-static int
-parse_ids (struct repeat_entry * e)
-{
- size_t i;
- size_t n = 0;
-
- e->type = 1;
- e->replacement = NULL;
-
- do
- {
- char **names;
- size_t nnames;
-
- if (!parse_mixed_vars (&names, &nnames, PV_NONE))
- return 0;
-
- e->replacement = xnrealloc (e->replacement,
- nnames + n, sizeof *e->replacement);
- for (i = 0; i < nnames; i++)
- {
- e->replacement[n + i] = xstrdup (names[i]);
- free (names[i]);
- }
- free (names);
- n += nnames;
- }
- while (token != '/' && token != '.');
-
- return n;
-}
-
-/* Stores VALUE into *REPL. */
-static inline void
-store_numeric (char **repl, long value)
-{
- *repl = xmalloc (INT_DIGITS + 1);
- sprintf (*repl, "%ld", value);
-}
-
-/* Parses a list of numbers for DO REPEAT. */
-static int
-parse_numbers (struct repeat_entry *e)
-{
- /* First and last numbers for TO, plus the step factor. */
- long a, b;
-
- /* Alias to e->replacement. */
- char **array;
-
- /* Number of entries in array; maximum number for this allocation
- size. */
- int n, m;
-
- n = m = 0;
- e->type = 0;
- e->replacement = array = NULL;
-
- do
- {
- /* Parse A TO B into a, b. */
- if (!lex_force_int ())
- return 0;
- a = lex_integer ();
-
- lex_get ();
- if (token == T_TO)
- {
- lex_get ();
- if (!lex_force_int ())
- return 0;
- b = lex_integer ();
-
- lex_get ();
- }
- else b = a;
-
- if (n + (abs (b - a) + 1) > m)
- {
- m = n + (abs (b - a) + 1) + 16;
- e->replacement = array = xnrealloc (array,
- m, sizeof *e->replacement);
- }
-
- if (a == b)
- store_numeric (&array[n++], a);
- else
- {
- long iter;
-
- if (a < b)
- for (iter = a; iter <= b; iter++)
- store_numeric (&array[n++], iter);
- else
- for (iter = a; iter >= b; iter--)
- store_numeric (&array[n++], iter);
- }
-
- lex_match (',');
- }
- while (token != '/' && token != '.');
- e->replacement = xrealloc (array, n * sizeof *e->replacement);
-
- return n;
-}
-
-/* Parses a list of strings for DO REPEAT. */
-int
-parse_strings (struct repeat_entry * e)
-{
- char **string;
- int n, m;
-
- e->type = 0;
- string = e->replacement = NULL;
- n = m = 0;
-
- do
- {
- if (token != T_STRING)
- {
- int i;
- msg (SE, _("String expected."));
- for (i = 0; i < n; i++)
- free (string[i]);
- free (string);
- return 0;
- }
-
- if (n + 1 > m)
- {
- m += 16;
- e->replacement = string = xnrealloc (string,
- m, sizeof *e->replacement);
- }
- string[n++] = lex_token_representation ();
- lex_get ();
-
- lex_match (',');
- }
- while (token != '/' && token != '.');
- e->replacement = xnrealloc (string, n, sizeof *e->replacement);
-
- return n;
-}
-\f
-int
-cmd_end_repeat (void)
-{
- msg (SE, _("No matching DO REPEAT."));
- return CMD_FAILURE;
-}
-\f
-/* Finds a DO REPEAT macro with name MACRO_NAME and returns the
- appropriate subsitution if found, or NULL if not. */
-static char *
-find_DO_REPEAT_substitution (char *macro_name)
-{
- struct getl_script *s;
-
- for (s = getl_head; s; s = s->included_from)
- {
- struct repeat_entry *e;
-
- if (s->first_line == NULL)
- continue;
-
- for (e = s->macros; e; e = e->next)
- if (!strcasecmp (e->id, macro_name))
- return e->replacement[s->loop_index];
- }
-
- return NULL;
-}
-
-/* Makes appropriate DO REPEAT macro substitutions within getl_buf. */
-void
-perform_DO_REPEAT_substitutions (void)
-{
- /* Are we in an apostrophized string or a quoted string? */
- int in_apos = 0, in_quote = 0;
-
- /* Source pointer. */
- char *cp;
-
- /* Output buffer, size, pointer. */
- struct string output;
-
- /* Terminal dot. */
- int dot = 0;
-
- ds_init (&output, ds_capacity (&getl_buf));
-
- /* Strip trailing whitespace, check for & remove terminal dot. */
- while (ds_length (&getl_buf) > 0
- && isspace ((unsigned char) ds_end (&getl_buf)[-1]))
- ds_truncate (&getl_buf, ds_length (&getl_buf) - 1);
- if (ds_length (&getl_buf) > 0 && ds_end (&getl_buf)[-1] == get_endcmd() )
- {
- dot = 1;
- ds_truncate (&getl_buf, ds_length (&getl_buf) - 1);
- }
-
- for (cp = ds_c_str (&getl_buf); cp < ds_end (&getl_buf); )
- {
- if (*cp == '\'' && !in_quote)
- in_apos ^= 1;
- else if (*cp == '"' && !in_apos)
- in_quote ^= 1;
-
- if (in_quote || in_apos || !CHAR_IS_ID1 (*cp))
- {
- ds_putc (&output, *cp++);
- continue;
- }
-
- /* Collect an identifier. */
- {
- char name[LONG_NAME_LEN + 1];
- char *start = cp;
- char *np = name;
- char *substitution;
-
- while (CHAR_IS_IDN (*cp) && np < &name[LONG_NAME_LEN])
- *np++ = *cp++;
- while (CHAR_IS_IDN (*cp))
- cp++;
- *np = 0;
-
- substitution = find_DO_REPEAT_substitution (name);
- if (!substitution)
- {
- ds_concat (&output, start, cp - start);
- continue;
- }
-
- /* Force output buffer size, copy substitution. */
- ds_puts (&output, substitution);
- }
- }
- if (dot)
- ds_putc (&output, get_endcmd ());
-
- ds_destroy (&getl_buf);
- getl_buf = output;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !INCLUDED_REPEAT_H
-#define INCLUDED_REPEAT_H 1
-
-void perform_DO_REPEAT_substitutions (void);
-
-#endif /* repeat.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <gsl/gsl_rng.h>
-#include <limits.h>
-#include <stdio.h>
-#include <math.h>
-#include "alloc.h"
-#include "command.h"
-#include "error.h"
-#include "lexer.h"
-#include "random.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-/* The two different types of samples. */
-enum
- {
- TYPE_A_FROM_B, /* 5 FROM 10 */
- TYPE_FRACTION /* 0.5 */
- };
-
-/* SAMPLE transformation. */
-struct sample_trns
- {
- int type; /* One of TYPE_*. */
- int n, N; /* TYPE_A_FROM_B: n from N. */
- int m, t; /* TYPE_A_FROM_B: # picked so far; # so far. */
- unsigned frac; /* TYPE_FRACTION: a fraction of UINT_MAX. */
- };
-
-static trns_proc_func sample_trns_proc;
-static trns_free_func sample_trns_free;
-
-int
-cmd_sample (void)
-{
- struct sample_trns *trns;
-
- int type;
- int a, b;
- unsigned frac;
-
- if (!lex_force_num ())
- return CMD_FAILURE;
- if (!lex_is_integer ())
- {
- unsigned long min = gsl_rng_min (get_rng ());
- unsigned long max = gsl_rng_max (get_rng ());
-
- type = TYPE_FRACTION;
- if (tokval <= 0 || tokval >= 1)
- {
- msg (SE, _("The sampling factor must be between 0 and 1 "
- "exclusive."));
- return CMD_FAILURE;
- }
-
- frac = tokval * (max - min) + min;
- a = b = 0;
- }
- else
- {
- type = TYPE_A_FROM_B;
- a = lex_integer ();
- lex_get ();
- if (!lex_force_match_id ("FROM"))
- return CMD_FAILURE;
- if (!lex_force_int ())
- return CMD_FAILURE;
- b = lex_integer ();
- if (a >= b)
- {
- msg (SE, _("Cannot sample %d observations from a population of "
- "%d."),
- a, b);
- return CMD_FAILURE;
- }
-
- frac = 0;
- }
- lex_get ();
-
- trns = xmalloc (sizeof *trns);
- trns->type = type;
- trns->n = a;
- trns->N = b;
- trns->m = trns->t = 0;
- trns->frac = frac;
- add_transformation (sample_trns_proc, sample_trns_free, trns);
-
- return lex_end_of_command ();
-}
-
-/* Executes a SAMPLE transformation. */
-static int
-sample_trns_proc (void *t_, struct ccase *c UNUSED,
- int case_num UNUSED)
-{
- struct sample_trns *t = t_;
- double U;
-
- if (t->type == TYPE_FRACTION)
- {
- if (gsl_rng_get (get_rng ()) <= t->frac)
- return -1;
- else
- return -2;
- }
-
- if (t->m >= t->n)
- return -2;
-
- U = gsl_rng_uniform (get_rng ());
- if ((t->N - t->t) * U >= t->n - t->m)
- {
- t->t++;
- return -2;
- }
- else
- {
- t->m++;
- t->t++;
- return -1;
- }
-}
-
-static void
-sample_trns_free (void *t_)
-{
- struct sample_trns *t = t_;
- free (t);
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <stdlib.h>
-#include "scratch-handle.h"
-#include "casefile.h"
-#include "dictionary.h"
-
-/* Destroys HANDLE. */
-void
-scratch_handle_destroy (struct scratch_handle *handle)
-{
- if (handle != NULL)
- {
- dict_destroy (handle->dictionary);
- casefile_destroy (handle->casefile);
- free (handle);
- }
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef SCRATCH_HANDLE_H
-#define SCRATCH_HANDLE_H 1
-
-#include <stdbool.h>
-
-/* A scratch file. */
-struct scratch_handle
- {
- struct dictionary *dictionary; /* Dictionary. */
- struct casefile *casefile; /* Cases. */
- };
-
-void scratch_handle_destroy (struct scratch_handle *);
-
-#endif /* scratch-handle.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "scratch-reader.h"
-#include <stdlib.h>
-#include "casefile.h"
-#include "dictionary.h"
-#include "error.h"
-#include "file-handle-def.h"
-#include "scratch-handle.h"
-#include "xalloc.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* A reader for a scratch file. */
-struct scratch_reader
- {
- struct file_handle *fh; /* Underlying file handle. */
- struct casereader *casereader; /* Case reader. */
- };
-
-/* Opens FH, which must have referent type FH_REF_SCRATCH, and
- returns a scratch_reader for it, or a null pointer on
- failure. Stores the dictionary for the scratch file into
- *DICT.
-
- If you use an any_reader instead, then your code can be more
- flexible without being any harder to write. */
-struct scratch_reader *
-scratch_reader_open (struct file_handle *fh, struct dictionary **dict)
-{
- struct scratch_handle *sh;
- struct scratch_reader *reader;
-
- if (!fh_open (fh, FH_REF_SCRATCH, "scratch file", "rs"))
- return NULL;
-
- sh = fh_get_scratch_handle (fh);
- if (sh == NULL)
- {
- msg (SE, _("Scratch file handle %s has not yet been written, "
- "using SAVE or another procedure, so it cannot yet "
- "be used for reading."),
- fh_get_name (fh));
- return NULL;
- }
-
- *dict = dict_clone (sh->dictionary);
- reader = xmalloc (sizeof *reader);
- reader->fh = fh;
- reader->casereader = casefile_get_reader (sh->casefile);
- return reader;
-}
-
-/* Reads a case from READER into C.
- Returns true if successful, false on error or at end of file. */
-bool
-scratch_reader_read_case (struct scratch_reader *reader, struct ccase *c)
-{
- return casereader_read (reader->casereader, c);
-}
-
-/* Closes READER. */
-void
-scratch_reader_close (struct scratch_reader *reader)
-{
- fh_close (reader->fh, "scratch file", "rs");
- casereader_destroy (reader->casereader);
- free (reader);
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef SCRATCH_READER_H
-#define SCRATCH_READER_H 1
-
-#include <stdbool.h>
-
-struct dictionary;
-struct file_handle;
-struct ccase;
-struct scratch_reader *scratch_reader_open (struct file_handle *,
- struct dictionary **);
-bool scratch_reader_read_case (struct scratch_reader *, struct ccase *);
-void scratch_reader_close (struct scratch_reader *);
-
-#endif /* scratch-reader.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "scratch-writer.h"
-#include <stdlib.h>
-#include "case.h"
-#include "casefile.h"
-#include "dictionary.h"
-#include "file-handle-def.h"
-#include "scratch-handle.h"
-#include "xalloc.h"
-
-/* A scratch file writer. */
-struct scratch_writer
- {
- struct scratch_handle *handle; /* Underlying scratch handle. */
- struct file_handle *fh; /* Underlying file handle. */
- struct dict_compactor *compactor; /* Compacts into handle->dictionary. */
- };
-
-/* Opens FH, which must have referent type FH_REF_SCRATCH, and
- returns a scratch_writer for it, or a null pointer on
- failure. Cases stored in the scratch_writer will be expected
- to be drawn from DICTIONARY.
-
- If you use an any_writer instead, then your code can be more
- flexible without being any harder to write. */
-struct scratch_writer *
-scratch_writer_open (struct file_handle *fh,
- const struct dictionary *dictionary)
-{
- struct scratch_handle *sh;
- struct scratch_writer *writer;
- struct dictionary *scratch_dict;
- struct dict_compactor *compactor;
-
- if (!fh_open (fh, FH_REF_SCRATCH, "scratch file", "we"))
- return NULL;
-
- /* Destroy previous contents of handle. */
- sh = fh_get_scratch_handle (fh);
- if (sh != NULL)
- scratch_handle_destroy (sh);
-
- /* Copy the dictionary and compact if needed. */
- scratch_dict = dict_clone (dictionary);
- if (dict_needs_compaction (scratch_dict))
- {
- compactor = dict_make_compactor (scratch_dict);
- dict_compact_values (scratch_dict);
- }
- else
- compactor = NULL;
-
- /* Create new contents. */
- sh = xmalloc (sizeof *sh);
- sh->dictionary = scratch_dict;
- sh->casefile = casefile_create (dict_get_next_value_idx (sh->dictionary));
-
- /* Create writer. */
- writer = xmalloc (sizeof *writer);
- writer->handle = sh;
- writer->fh = fh;
- writer->compactor = compactor;
-
- fh_set_scratch_handle (fh, sh);
- return writer;
-}
-
-/* Writes case C to WRITER. */
-void
-scratch_writer_write_case (struct scratch_writer *writer,
- const struct ccase *c)
-{
- struct scratch_handle *handle = writer->handle;
- if (writer->compactor)
- {
- struct ccase tmp_case;
- case_create (&tmp_case, dict_get_next_value_idx (handle->dictionary));
- dict_compactor_compact (writer->compactor, &tmp_case, c);
- casefile_append_xfer (handle->casefile, &tmp_case);
- }
- else
- casefile_append (handle->casefile, c);
-}
-
-/* Closes WRITER. */
-void
-scratch_writer_close (struct scratch_writer *writer)
-{
- struct scratch_handle *handle = writer->handle;
- casefile_mode_reader (handle->casefile);
- fh_close (writer->fh, "scratch file", "we");
- free (writer);
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef SCRATCH_WRITER_H
-#define SCRATCH_WRITER_H 1
-
-#include <stdbool.h>
-
-struct dictionary;
-struct file_handle;
-struct ccase;
-struct scratch_writer *scratch_writer_open (struct file_handle *,
- const struct dictionary *);
-void scratch_writer_write_case (struct scratch_writer *, const struct ccase *);
-void scratch_writer_close (struct scratch_writer *);
-
-#endif /* scratch-writer.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "expressions/public.h"
-#include "lexer.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* SELECT IF transformation. */
-struct select_if_trns
- {
- struct expression *e; /* Test expression. */
- };
-
-static trns_proc_func select_if_proc;
-static trns_free_func select_if_free;
-
-/* Parses the SELECT IF transformation. */
-int
-cmd_select_if (void)
-{
- struct expression *e;
- struct select_if_trns *t;
-
- e = expr_parse (default_dict, EXPR_BOOLEAN);
- if (!e)
- return CMD_FAILURE;
-
- if (token != '.')
- {
- expr_free (e);
- lex_error (_("expecting end of command"));
- return CMD_FAILURE;
- }
-
- t = xmalloc (sizeof *t);
- t->e = e;
- add_transformation (select_if_proc, select_if_free, t);
-
- return CMD_SUCCESS;
-}
-
-/* Performs the SELECT IF transformation T on case C. */
-static int
-select_if_proc (void *t_, struct ccase *c,
- int case_num)
-{
- struct select_if_trns *t = t_;
- return expr_evaluate_num (t->e, c, case_num) == 1.0 ? -1 : -2;
-}
-
-/* Frees SELECT IF transformation T. */
-static void
-select_if_free (void *t_)
-{
- struct select_if_trns *t = t_;
- expr_free (t->e);
- free (t);
-}
-
-/* Parses the FILTER command. */
-int
-cmd_filter (void)
-{
- if (lex_match_id ("OFF"))
- dict_set_filter (default_dict, NULL);
- else
- {
- struct variable *v;
-
- lex_match (T_BY);
- v = parse_variable ();
- if (!v)
- return CMD_FAILURE;
-
- if (v->type == ALPHA)
- {
- msg (SE, _("The filter variable must be numeric."));
- return CMD_FAILURE;
- }
-
- if (dict_class_from_id (v->name) == DC_SCRATCH)
- {
- msg (SE, _("The filter variable may not be scratch."));
- return CMD_FAILURE;
- }
-
- dict_set_filter (default_dict, v);
-
- FILTER_before_TEMPORARY = !temporary;
- }
-
- return CMD_SUCCESS;
-}
-
-/* Parses the PROCESS IF command. */
-int
-cmd_process_if (void)
-{
- struct expression *e;
-
- e = expr_parse (default_dict, EXPR_BOOLEAN);
- if (!e)
- return CMD_FAILURE;
-
- if (token != '.')
- {
- expr_free (e);
- lex_error (_("expecting end of command"));
- return CMD_FAILURE;
- }
-
- if (process_if_expr)
- {
- msg (MW, _("Only last instance of this command is in effect."));
- expr_free (process_if_expr);
- }
- process_if_expr = e;
-
- return CMD_SUCCESS;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "settings.h"
-#include "error.h"
-#include <stdio.h>
-#include <errno.h>
-#include <stdlib.h>
-#include <time.h>
-#include "alloc.h"
-#include "command.h"
-#include "dictionary.h"
-#include "lexer.h"
-#include "error.h"
-#include "magic.h"
-#include "output.h"
-#include "random.h"
-#include "var.h"
-#include "format.h"
-#include "copyleft.h"
-#include "var.h"
-
-
-#if HAVE_LIBTERMCAP
-#if HAVE_TERMCAP_H
-#include <termcap.h>
-#else /* !HAVE_TERMCAP_H */
-int tgetent (char *, const char *);
-int tgetnum (const char *);
-#endif /* !HAVE_TERMCAP_H */
-#endif /* !HAVE_LIBTERMCAP */
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* (specification)
- "SET" (stc_):
- blanks=custom;
- block=string "x==1" "one character long";
- boxstring=string "x==3 || x==11" "3 or 11 characters long";
- case=size:upper/uplow;
- cca=string;
- ccb=string;
- ccc=string;
- ccd=string;
- cce=string;
- compression=compress:on/off;
- cpi=integer "x>0" "%s must be greater than 0";
- cprompt=string;
- decimal=dec:dot/comma;
- disk=custom;
- dprompt=string;
- echo=echo:on/off;
- endcmd=string "x==1" "one character long";
- epoch=custom;
- errorbreak=errbrk:on/off;
- errors=errors:on/off/terminal/listing/both/none;
- format=custom;
- headers=headers:no/yes/blank;
- highres=hires:on/off;
- histogram=string "x==1" "one character long";
- include=inc:on/off;
- journal=custom;
- length=custom;
- listing=custom;
- lowres=lores:auto/on/off;
- lpi=integer "x>0" "%s must be greater than 0";
- menus=menus:standard/extended;
- messages=messages:on/off/terminal/listing/both/none;
- mexpand=mexp:on/off;
- miterate=integer "x>0" "%s must be greater than 0";
- mnest=integer "x>0" "%s must be greater than 0";
- mprint=mprint:on/off;
- mxerrs=integer "x >= 1" "%s must be at least 1";
- mxloops=integer "x >=1" "%s must be at least 1";
- mxmemory=integer;
- mxwarns=integer;
- nulline=null:on/off;
- printback=prtbck:on/off;
- prompt=string;
- results=res:on/off/terminal/listing/both/none;
- safer=safe:on;
- scompression=scompress:on/off;
- scripttab=string "x==1" "one character long";
- seed=custom;
- tb1=string "x==3 || x==11" "3 or 11 characters long";
- tbfonts=string;
- undefined=undef:warn/nowarn;
- width=custom;
- workspace=integer "x>=1024" "%s must be at least 1 MB";
- xsort=xsort:yes/no.
-*/
-
-/* (declarations) */
-
-/* (_functions) */
-
-static bool do_cc (const char *cc_string, int idx);
-
-int
-cmd_set (void)
-{
- struct cmd_set cmd;
- bool ok = true;
-
- if (!parse_set (&cmd))
- return CMD_FAILURE;
-
- if (cmd.sbc_cca)
- ok = ok && do_cc (cmd.s_cca, 0);
- if (cmd.sbc_ccb)
- ok = ok && do_cc (cmd.s_ccb, 1);
- if (cmd.sbc_ccc)
- ok = ok && do_cc (cmd.s_ccc, 2);
- if (cmd.sbc_ccd)
- ok = ok && do_cc (cmd.s_ccd, 3);
- if (cmd.sbc_cce)
- ok = ok && do_cc (cmd.s_cce, 4);
-
- if (cmd.sbc_prompt)
- set_prompt (cmd.s_prompt);
- if (cmd.sbc_cprompt)
- set_prompt (cmd.s_cprompt);
- if (cmd.sbc_dprompt)
- set_prompt (cmd.s_dprompt);
-
- if (cmd.sbc_decimal)
- set_decimal (cmd.dec == STC_DOT ? '.' : ',');
- if (cmd.sbc_echo)
- set_echo (cmd.echo == STC_ON);
- if (cmd.sbc_endcmd)
- set_endcmd (cmd.s_endcmd[0]);
- if (cmd.sbc_errorbreak)
- set_errorbreak (cmd.errbrk == STC_ON);
- if (cmd.sbc_include)
- set_include (cmd.inc == STC_ON);
- if (cmd.sbc_mxerrs)
- set_mxerrs (cmd.n_mxerrs[0]);
- if (cmd.sbc_mxwarns)
- set_mxwarns (cmd.n_mxwarns[0]);
- if (cmd.sbc_nulline)
- set_nulline (cmd.null == STC_ON);
- if (cmd.sbc_safer)
- set_safer_mode ();
- if (cmd.sbc_scompression)
- set_scompression (cmd.scompress == STC_ON);
- if (cmd.sbc_undefined)
- set_undefined (cmd.undef == STC_WARN);
- if (cmd.sbc_workspace)
- set_workspace (cmd.n_workspace[0] * 1024L);
-
- if (cmd.sbc_block)
- msg (SW, _("%s is obsolete."),"BLOCK");
- if (cmd.sbc_boxstring)
- msg (SW, _("%s is obsolete."),"BOXSTRING");
- if (cmd.sbc_histogram)
- msg (MW, _("%s is obsolete."),"HISTOGRAM");
- if (cmd.sbc_menus )
- msg (MW, _("%s is obsolete."),"MENUS");
- if (cmd.sbc_xsort )
- msg (SW, _("%s is obsolete."),"XSORT");
- if (cmd.sbc_mxmemory )
- msg (SE, _("%s is obsolete."),"MXMEMORY");
- if (cmd.sbc_scripttab)
- msg (SE, _("%s is obsolete."),"SCRIPTTAB");
- if (cmd.sbc_tbfonts)
- msg (SW, _("%s is obsolete."),"TBFONTS");
- if (cmd.sbc_tb1 && cmd.s_tb1)
- msg (SW, _("%s is obsolete."),"TB1");
-
- if (cmd.sbc_case)
- msg (SW, _("%s is not implemented."), "CASE");
-
- if (cmd.sbc_compression)
- msg (MW, _("Active file compression is not implemented."));
-
- return CMD_SUCCESS;
-}
-
-/* Find the grouping characters in CC_STRING and set CC's
- grouping and decimal members appropriately. Returns true if
- successful, false otherwise. */
-static bool
-find_cc_separators (const char *cc_string, struct custom_currency *cc)
-{
- const char *sp;
- int comma_cnt, dot_cnt;
-
- /* Count commas and periods. There must be exactly three of
- one or the other, except that an apostrophe acts escapes a
- following comma or period. */
- comma_cnt = dot_cnt = 0;
- for (sp = cc_string; *sp; sp++)
- if (*sp == ',')
- comma_cnt++;
- else if (*sp == '.')
- dot_cnt++;
- else if (*sp == '\'' && (sp[1] == '.' || sp[1] == ',' || sp[1] == '\''))
- sp++;
-
- if ((comma_cnt == 3) == (dot_cnt == 3))
- return false;
-
- if (comma_cnt == 3)
- {
- cc->decimal = '.';
- cc->grouping = ',';
- }
- else
- {
- cc->decimal = ',';
- cc->grouping = '.';
- }
- return true;
-}
-
-/* Extracts a token from IN into TOKEn. Tokens are delimited by
- GROUPING. The token is truncated to at most CC_WIDTH
- characters (including null terminator). Returns the first
- character following the token. */
-static const char *
-extract_cc_token (const char *in, int grouping, char token[CC_WIDTH])
-{
- char *out = token;
-
- for (; *in != '\0' && *in != grouping; in++)
- {
- if (*in == '\'' && in[1] == grouping)
- in++;
- if (out < &token[CC_WIDTH - 1])
- *out++ = *in;
- }
- *out = '\0';
-
- if (*in == grouping)
- in++;
- return in;
-}
-
-/* Sets custom currency specifier CC having name CC_NAME ('A' through
- 'E') to correspond to the settings in CC_STRING. */
-static bool
-do_cc (const char *cc_string, int idx)
-{
- struct custom_currency cc;
-
- /* Determine separators. */
- if (!find_cc_separators (cc_string, &cc))
- {
- msg (SE, _("CC%c: Custom currency string `%s' does not contain "
- "exactly three periods or commas (not both)."),
- "ABCDE"[idx], cc_string);
- return false;
- }
-
- cc_string = extract_cc_token (cc_string, cc.grouping, cc.neg_prefix);
- cc_string = extract_cc_token (cc_string, cc.grouping, cc.prefix);
- cc_string = extract_cc_token (cc_string, cc.grouping, cc.suffix);
- cc_string = extract_cc_token (cc_string, cc.grouping, cc.neg_suffix);
-
- set_cc (idx, &cc);
-
- return true;
-}
-
-/* Parses the BLANKS subcommand, which controls the value that
- completely blank fields in numeric data imply. X, Wnd: Syntax is
- SYSMIS or a numeric value. */
-static int
-stc_custom_blanks (struct cmd_set *cmd UNUSED)
-{
- lex_match ('=');
- if ((token == T_ID && lex_id_match ("SYSMIS", tokid)))
- {
- lex_get ();
- set_blanks (SYSMIS);
- }
- else
- {
- if (!lex_force_num ())
- return 0;
- set_blanks (lex_number ());
- lex_get ();
- }
- return 1;
-}
-
-/* Parses the EPOCH subcommand, which controls the epoch used for
- parsing 2-digit years. */
-static int
-stc_custom_epoch (struct cmd_set *cmd UNUSED)
-{
- lex_match ('=');
- if (lex_match_id ("AUTOMATIC"))
- set_epoch (-1);
- else if (lex_is_integer ())
- {
- int new_epoch = lex_integer ();
- lex_get ();
- if (new_epoch < 1500)
- {
- msg (SE, _("EPOCH must be 1500 or later."));
- return 0;
- }
- set_epoch (new_epoch);
- }
- else
- {
- lex_error (_("expecting AUTOMATIC or year"));
- return 0;
- }
-
- return 1;
-}
-
-static int
-stc_custom_length (struct cmd_set *cmd UNUSED)
-{
- int page_length;
-
- lex_match ('=');
- if (lex_match_id ("NONE"))
- page_length = -1;
- else
- {
- if (!lex_force_int ())
- return 0;
- if (lex_integer () < 1)
- {
- msg (SE, _("LENGTH must be at least 1."));
- return 0;
- }
- page_length = lex_integer ();
- lex_get ();
- }
-
- if (page_length != -1)
- set_viewlength (page_length);
-
- return 1;
-}
-
-static int
-stc_custom_seed (struct cmd_set *cmd UNUSED)
-{
- lex_match ('=');
- if (lex_match_id ("RANDOM"))
- set_rng (time (0));
- else
- {
- if (!lex_force_num ())
- return 0;
- set_rng (lex_number ());
- lex_get ();
- }
-
- return 1;
-}
-
-static int
-stc_custom_width (struct cmd_set *cmd UNUSED)
-{
- lex_match ('=');
- if (lex_match_id ("NARROW"))
- set_viewwidth (79);
- else if (lex_match_id ("WIDE"))
- set_viewwidth (131);
- else
- {
- if (!lex_force_int ())
- return 0;
- if (lex_integer () < 40)
- {
- msg (SE, _("WIDTH must be at least 40."));
- return 0;
- }
- set_viewwidth (lex_integer ());
- lex_get ();
- }
-
- return 1;
-}
-
-/* Parses FORMAT subcommand, which consists of a numeric format
- specifier. */
-static int
-stc_custom_format (struct cmd_set *cmd UNUSED)
-{
- struct fmt_spec fmt;
-
- lex_match ('=');
- if (!parse_format_specifier (&fmt, 0))
- return 0;
- if ((formats[fmt.type].cat & FCAT_STRING) != 0)
- {
- msg (SE, _("FORMAT requires numeric output format as an argument. "
- "Specified format %s is of type string."),
- fmt_to_string (&fmt));
- return 0;
- }
-
- set_format (&fmt);
- return 1;
-}
-
-static int
-stc_custom_journal (struct cmd_set *cmd UNUSED)
-{
- lex_match ('=');
- if (!lex_match_id ("ON") && !lex_match_id ("OFF"))
- {
- if (token == T_STRING)
- lex_get ();
- else
- {
- lex_error (NULL);
- return 0;
- }
- }
- return 1;
-}
-
-static int
-stc_custom_listing (struct cmd_set *cmd UNUSED)
-{
- bool listing;
-
- lex_match ('=');
- if (lex_match_id ("ON") || lex_match_id ("YES"))
- listing = true;
- else if (lex_match_id ("OFF") || lex_match_id ("NO"))
- listing = false;
- else
- {
- /* FIXME */
- return 0;
- }
- outp_enable_device (listing, OUTP_DEV_LISTING);
-
- return 1;
-}
-
-static int
-stc_custom_disk (struct cmd_set *cmd UNUSED)
-{
- return stc_custom_listing (cmd);
-}
-\f
-static void
-show_blanks (void)
-{
- if (get_blanks () == SYSMIS)
- msg (MM, _("BLANKS is SYSMIS."));
- else
- msg (MM, _("BLANKS is %g."), get_blanks ());
-
-}
-
-static char *
-format_cc (const char *in, char grouping, char *out)
-{
- while (*in != '\0')
- {
- if (*in == grouping || *in == '\'')
- *out++ = '\'';
- *out++ = *in++;
- }
- return out;
-}
-
-static void
-show_cc (int idx)
-{
- const struct custom_currency *cc = get_cc (idx);
- char cc_string[CC_WIDTH * 4 * 2 + 3 + 1];
- char *out;
-
- out = format_cc (cc->neg_prefix, cc->grouping, cc_string);
- *out++ = cc->grouping;
- out = format_cc (cc->prefix, cc->grouping, out);
- *out++ = cc->grouping;
- out = format_cc (cc->suffix, cc->grouping, out);
- *out++ = cc->grouping;
- out = format_cc (cc->neg_suffix, cc->grouping, out);
- *out = '\0';
-
- msg (MM, _("CC%c is \"%s\"."), "ABCDE"[idx], cc_string);
-}
-
-
-static void
-show_cca (void)
-{
- show_cc (0);
-}
-
-static void
-show_ccb (void)
-{
- show_cc (1);
-}
-
-static void
-show_ccc (void)
-{
- show_cc (2);
-}
-
-static void
-show_ccd (void)
-{
- show_cc (3);
-}
-
-static void
-show_cce (void)
-{
- show_cc (4);
-}
-
-static void
-show_decimals (void)
-{
- msg (MM, _("DECIMAL is \"%c\"."), get_decimal ());
-}
-
-static void
-show_endcmd (void)
-{
- msg (MM, _("ENDCMD is \"%c\"."), get_endcmd ());
-}
-
-static void
-show_format (void)
-{
- msg (MM, _("FORMAT is %s."), fmt_to_string (get_format ()));
-}
-
-static void
-show_length (void)
-{
- msg (MM, _("LENGTH is %d."), get_viewlength ());
-}
-
-static void
-show_mxerrs (void)
-{
- msg (MM, _("MXERRS is %d."), get_mxerrs ());
-}
-
-static void
-show_mxloops (void)
-{
- msg (MM, _("MXLOOPS is %d."), get_mxloops ());
-}
-
-static void
-show_mxwarns (void)
-{
- msg (MM, _("MXWARNS is %d."), get_mxwarns ());
-}
-
-static void
-show_scompression (void)
-{
- if (get_scompression ())
- msg (MM, _("SCOMPRESSION is ON."));
- else
- msg (MM, _("SCOMPRESSION is OFF."));
-}
-
-static void
-show_undefined (void)
-{
- if (get_undefined ())
- msg (MM, _("UNDEFINED is WARN."));
- else
- msg (MM, _("UNDEFINED is NOWARN."));
-}
-
-static void
-show_weight (void)
-{
- struct variable *var = dict_get_weight (default_dict);
- if (var == NULL)
- msg (MM, _("WEIGHT is off."));
- else
- msg (MM, _("WEIGHT is variable %s."), var->name);
-}
-
-static void
-show_width (void)
-{
- msg (MM, _("WIDTH is %d."), get_viewwidth ());
-}
-
-struct show_sbc
- {
- const char *name;
- void (*function) (void);
- };
-
-struct show_sbc show_table[] =
- {
- {"BLANKS", show_blanks},
- {"CCA", show_cca},
- {"CCB", show_ccb},
- {"CCC", show_ccc},
- {"CCD", show_ccd},
- {"CCE", show_cce},
- {"DECIMALS", show_decimals},
- {"ENDCMD", show_endcmd},
- {"FORMAT", show_format},
- {"LENGTH", show_length},
- {"MXERRS", show_mxerrs},
- {"MXLOOPS", show_mxloops},
- {"MXWARNS", show_mxwarns},
- {"SCOMPRESSION", show_scompression},
- {"UNDEFINED", show_undefined},
- {"WEIGHT", show_weight},
- {"WIDTH", show_width},
- };
-
-static void
-show_all (void)
-{
- size_t i;
-
- for (i = 0; i < sizeof show_table / sizeof *show_table; i++)
- show_table[i].function ();
-}
-
-static void
-show_all_cc (void)
-{
- int i;
-
- for (i = 0; i < 5; i++)
- show_cc (i);
-}
-
-static void
-show_warranty (void)
-{
- msg (MM, lack_of_warranty);
-}
-
-static void
-show_copying (void)
-{
- msg (MM, copyleft);
-}
-
-int
-cmd_show (void)
-{
- if (token == '.')
- {
- show_all ();
- return CMD_SUCCESS;
- }
-
- do
- {
- if (lex_match (T_ALL))
- show_all ();
- else if (lex_match_id ("CC"))
- show_all_cc ();
- else if (lex_match_id ("WARRANTY"))
- show_warranty ();
- else if (lex_match_id ("COPYING"))
- show_copying ();
- else if (token == T_ID)
- {
- int i;
-
- for (i = 0; i < sizeof show_table / sizeof *show_table; i++)
- if (lex_match_id (show_table[i].name))
- {
- show_table[i].function ();
- goto found;
- }
- lex_error (NULL);
- return CMD_PART_SUCCESS_MAYBE;
-
- found: ;
- }
- else
- {
- lex_error (NULL);
- return CMD_PART_SUCCESS_MAYBE;
- }
-
- lex_match ('/');
- }
- while (token != '.');
-
- return CMD_SUCCESS;
-}
-
-/*
- Local Variables:
- mode: c
- End:
-*/
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "settings.h"
-#include <assert.h>
-#include <stdlib.h>
-#include <time.h>
-#include "format.h"
-#include "val.h"
-#include "xalloc.h"
-
-static int viewlength = 24;
-static int viewwidth = 79;
-static bool long_view = false;
-
-static bool safer_mode = false;
-
-static char decimal = '.';
-static char grouping = ',';
-
-static char *prompt = NULL;
-static char *cprompt = NULL;
-static char *dprompt = NULL;
-
-static bool echo = false;
-static bool include = true;
-
-static int epoch = -1;
-
-static bool errorbreak = false;
-
-static bool scompress = false;
-
-static bool undefined = true;
-static double blanks = SYSMIS;
-
-static int mxwarns = 100;
-static int mxerrs = 100;
-
-static bool printback = true;
-static bool mprint = true;
-
-static int mxloops = 1;
-
-static bool nulline = true;
-
-static char endcmd = '.';
-
-static size_t workspace = 4L * 1024 * 1024;
-
-static struct fmt_spec default_format = {FMT_F, 8, 2};
-
-#define CC_INITIALIZER {"-", "", "", "", '.', ','}
-static struct custom_currency cc[CC_CNT] =
- {
- CC_INITIALIZER,
- CC_INITIALIZER,
- CC_INITIALIZER,
- CC_INITIALIZER,
- CC_INITIALIZER,
- };
-
-static bool testing_mode = false;
-
-static int global_algorithm = ENHANCED;
-static int cmd_algorithm = ENHANCED;
-static int *algorithm = &global_algorithm;
-
-static int syntax = ENHANCED;
-
-static void init_viewport (void);
-
-void
-settings_init (void)
-{
- init_viewport ();
-}
-
-void
-settings_done (void)
-{
- free (prompt);
- free (cprompt);
- free (dprompt);
-}
-
-/* Screen length in lines. */
-int
-get_viewlength (void)
-{
- return viewlength;
-}
-
-/* Sets the view length. */
-void
-set_viewlength (int viewlength_)
-{
- viewlength = viewlength_;
-}
-
-/* Set view width to a very long value, and prevent it from ever
- changing. */
-void
-force_long_view (void)
-{
- long_view = true;
- viewwidth = 9999;
-}
-
-/* Screen width. */
-int
-get_viewwidth(void)
-{
- return viewwidth;
-}
-
-/* Sets the screen width. */
-void
-set_viewwidth (int viewwidth_)
-{
- viewwidth = viewwidth_;
-}
-
-#if HAVE_LIBTERMCAP
-static void
-get_termcap_viewport (void)
-{
- char term_buffer[16384];
- if (getenv ("TERM") == NULL)
- return;
- else if (tgetent (term_buffer, getenv ("TERM")) <= 0)
- {
- msg (IE, _("Could not access definition for terminal `%s'."), termtype);
- return;
- }
-
- if (tgetnum ("li") > 0)
- viewlength = tgetnum ("li");
-
- if (tgetnum ("co") > 1)
- viewwidth = tgetnum ("co") - 1;
-}
-#endif /* HAVE_LIBTERMCAP */
-
-static void
-init_viewport (void)
-{
- if (long_view)
- return;
-
- viewwidth = viewlength = -1;
-
-#if HAVE_LIBTERMCAP
- get_termcap_viewport ();
-#endif /* HAVE_LIBTERMCAP */
-
- if (viewwidth < 0 && getenv ("COLUMNS") != NULL)
- viewwidth = atoi (getenv ("COLUMNS"));
- if (viewlength < 0 && getenv ("LINES") != NULL)
- viewlength = atoi (getenv ("LINES"));
-
- if (viewwidth < 0)
- viewwidth = 79;
- if (viewlength < 0)
- viewlength = 24;
-}
-
-/* Whether PSPP can erase and overwrite files. */
-bool
-get_safer_mode (void)
-{
- return safer_mode;
-}
-
-/* Set safer mode. */
-void
-set_safer_mode (void)
-{
- safer_mode = true;
-}
-
-/* The character used for a decimal point: ',' or '.'. Only
- respected for data input and output. */
-char
-get_decimal (void)
-{
- return decimal;
-}
-
-/* Sets the character used for a decimal point, which must be
- either ',' or '.'. */
-void
-set_decimal (char decimal_)
-{
- assert (decimal_ == '.' || decimal_ == ',');
- decimal = decimal_;
-}
-
-/* The character used for grouping in numbers: '.' or ','; the
- opposite of set_decimal. Only used in COMMA data input and
- output. */
-char
-get_grouping (void)
-{
- return grouping;
-}
-
-/* Sets the character used for grouping, which must be either ','
- or '.'. */
-void
-set_grouping (char grouping_)
-{
- assert (grouping_ == '.' || grouping_ == ',');
- grouping = grouping_;
-}
-
-/* Gets the normal command prompt. */
-const char *
-get_prompt (void)
-{
- return prompt != NULL ? prompt : "PSPP> ";
-}
-
-/* Sets the normal command prompt. */
-void
-set_prompt (const char *prompt_)
-{
- free (prompt);
- prompt = xstrdup (prompt_);
-}
-
-/* Gets the prompt used for data (after BEGIN DATA and before END
- DATA). */
-const char *
-get_dprompt (void)
-{
- return dprompt != NULL ? dprompt : "data> ";
-}
-
-/* Sets the prompt used for data (after BEGIN DATA and before END
- DATA). */
-void
-set_dprompt (const char *dprompt_)
-{
- free (dprompt);
- dprompt = xstrdup (dprompt_);
-}
-
-/* Gets the continuation prompt used for second and subsequent
- lines of commands. */
-const char *
-get_cprompt (void)
-{
- return cprompt != NULL ? cprompt : " > ";
-}
-
-/* Sets the continuation prompt used for second and subsequent
- lines of commands. */
-void
-set_cprompt (const char *cprompt_)
-{
- free (cprompt);
- cprompt = xstrdup (cprompt_);
-}
-
-/* Echo commands to the listing file/printer? */
-bool
-get_echo (void)
-{
- return echo;
-}
-
-/* Set echo. */
-void
-set_echo (bool echo_)
-{
- echo = echo_;
-}
-
-/* If echo is on, whether commands from include files are echoed. */
-bool
-get_include (void)
-{
- return include;
-}
-
-/* Set include file echo. */
-void
-set_include (bool include_)
-{
- include = include_;
-}
-
-/* What year to use as the start of the epoch. */
-int
-get_epoch (void)
-{
- if (epoch < 0)
- {
- time_t t = time (0);
- struct tm *tm = localtime (&t);
- epoch = (tm != NULL ? tm->tm_year + 1900 : 2000) - 69;
- }
-
- return epoch;
-}
-
-/* Sets the year that starts the epoch. */
-void
-set_epoch (int epoch_)
-{
- epoch = epoch_;
-}
-
-/* Does an error stop execution? */
-bool
-get_errorbreak (void)
-{
- return errorbreak;
-}
-
-/* Sets whether an error stops execution. */
-void
-set_errorbreak (bool errorbreak_)
-{
- errorbreak = errorbreak_;
-}
-
-/* Compress system files by default? */
-bool
-get_scompression (void)
-{
- return scompress;
-}
-
-/* Set system file default compression. */
-void
-set_scompression (bool scompress_)
-{
- scompress = scompress_;
-}
-
-/* Whether to warn on undefined values in numeric data. */
-bool
-get_undefined (void)
-{
- return undefined;
-}
-
-/* Set whether to warn on undefined values. */
-void
-set_undefined (bool undefined_)
-{
- undefined = undefined_;
-}
-
-/* The value that blank numeric fields are set to when read in. */
-double
-get_blanks (void)
-{
- return blanks;
-}
-
-/* Set the value that blank numeric fields are set to when read
- in. */
-void
-set_blanks (double blanks_)
-{
- blanks = blanks_;
-}
-
-/* Maximum number of warnings + errors. */
-int
-get_mxwarns (void)
-{
- return mxwarns;
-}
-
-/* Sets maximum number of warnings + errors. */
-void
-set_mxwarns (int mxwarns_)
-{
- mxwarns = mxwarns_;
-}
-
-/* Maximum number of errors. */
-int
-get_mxerrs (void)
-{
- return mxerrs;
-}
-
-/* Sets maximum number of errors. */
-void
-set_mxerrs (int mxerrs_)
-{
- mxerrs = mxerrs_;
-}
-
-/* Whether commands are written to the display. */
-bool
-get_printback (void)
-{
- return printback;
-}
-
-/* Sets whether commands are written to the display. */
-void
-set_printback (bool printback_)
-{
- printback = printback_;
-}
-
-/* Independent of get_printback, controls whether the commands
- generated by macro invocations are displayed. */
-bool
-get_mprint (void)
-{
- return mprint;
-}
-
-/* Sets whether the commands generated by macro invocations are
- displayed. */
-void
-set_mprint (bool mprint_)
-{
- mprint = mprint_;
-}
-
-/* Implied limit of unbounded loop. */
-int
-get_mxloops (void)
-{
- return mxloops;
-}
-
-/* Set implied limit of unbounded loop. */
-void
-set_mxloops (int mxloops_)
-{
- mxloops = mxloops_;
-}
-
-/* Whether a blank line is a command terminator. */
-bool
-get_nulline (void)
-{
- return nulline;
-}
-
-/* Set whether a blank line is a command terminator. */
-void
-set_nulline (bool nulline_)
-{
- nulline = nulline_;
-}
-
-/* The character used to terminate commands. */
-char
-get_endcmd (void)
-{
- return endcmd;
-}
-
-/* Set the character used to terminate commands. */
-void
-set_endcmd (char endcmd_)
-{
- endcmd = endcmd_;
-}
-
-/* Approximate maximum amount of memory to use for cases, in
- bytes. */
-size_t
-get_workspace (void)
-{
- return workspace;
-}
-
-/* Set approximate maximum amount of memory to use for cases, in
- bytes. */
-
-void
-set_workspace (size_t workspace_)
-{
- workspace = workspace_;
-}
-
-/* Default format for variables created by transformations and by
- DATA LIST {FREE,LIST}. */
-const struct fmt_spec *
-get_format (void)
-{
- return &default_format;
-}
-
-/* Set default format for variables created by transformations
- and by DATA LIST {FREE,LIST}. */
-void
-set_format (const struct fmt_spec *default_format_)
-{
- default_format = *default_format_;
-}
-
-/* Gets the custom currency specification with the given IDX. */
-const struct custom_currency *
-get_cc (int idx)
-{
- assert (idx >= 0 && idx < CC_CNT);
- return &cc[idx];
-}
-
-/* Gets custom currency specification IDX to CC. */
-void
-set_cc (int idx, const struct custom_currency *cc_)
-{
- assert (idx >= 0 && idx < CC_CNT);
- cc[idx] = *cc_;
-}
-
-/* Are we in testing mode? (e.g. --testing-mode command line
- option) */
-bool
-get_testing_mode (void)
-{
- return testing_mode;
-}
-
-/* Set testing mode. */
-void
-set_testing_mode (bool testing_mode_)
-{
- testing_mode = testing_mode_;
-}
-
-/* Return the current algorithm setting */
-enum behavior_mode
-get_algorithm (void)
-{
- return *algorithm;
-}
-
-/* Set the algorithm option globally. */
-void
-set_algorithm (enum behavior_mode mode)
-{
- global_algorithm = mode;
-}
-
-/* Set the algorithm option for this command only */
-void
-set_cmd_algorithm (enum behavior_mode mode)
-{
- cmd_algorithm = mode;
- algorithm = &cmd_algorithm;
-}
-
-/* Unset the algorithm option for this command */
-void
-unset_cmd_algorithm (void)
-{
- algorithm = &global_algorithm;
-}
-
-/* Get the current syntax setting */
-enum behavior_mode
-get_syntax (void)
-{
- return syntax;
-}
-
-/* Set the syntax option */
-void
-set_syntax (enum behavior_mode mode)
-{
- syntax = mode;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !settings_h
-#define settings_h 1
-
-#include <stdbool.h>
-#include <stddef.h>
-
-/* Types of routing. */
-enum
- {
- SET_ROUTE_SCREEN = 001, /* Output to screen devices? */
- SET_ROUTE_LISTING = 002, /* Output to listing devices? */
- SET_ROUTE_OTHER = 004, /* Output to other devices? */
- SET_ROUTE_DISABLE = 010 /* Disable output--overrides all other bits. */
- };
-
-void settings_init (void);
-void settings_done (void);
-
-void force_long_view (void);
-int get_viewlength (void);
-void set_viewlength (int);
-
-int get_viewwidth (void);
-void set_viewwidth (int);
-
-bool get_safer_mode (void);
-void set_safer_mode (void);
-
-char get_decimal (void);
-void set_decimal (char);
-char get_grouping (void);
-void set_grouping (char);
-
-const char *get_prompt (void);
-void set_prompt (const char *);
-const char *get_cprompt (void);
-void set_cprompt (const char *);
-const char *get_dprompt (void);
-void set_dprompt (const char *);
-
-bool get_echo (void);
-void set_echo (bool);
-bool get_include (void);
-void set_include (bool);
-
-int get_epoch (void);
-void set_epoch (int);
-
-bool get_errorbreak (void);
-void set_errorbreak (bool);
-
-bool get_scompression (void);
-void set_scompression (bool);
-
-bool get_undefined (void);
-void set_undefined (bool);
-double get_blanks (void);
-void set_blanks (double);
-
-int get_mxwarns (void);
-void set_mxwarns (int);
-int get_mxerrs (void);
-void set_mxerrs (int);
-
-bool get_printback (void);
-void set_printback (bool);
-bool get_mprint (void);
-void set_mprint (bool);
-
-int get_mxloops (void);
-void set_mxloops (int);
-
-bool get_nulline (void);
-void set_nulline (bool);
-
-char get_endcmd (void);
-void set_endcmd (char);
-
-size_t get_workspace (void);
-void set_workspace (size_t);
-
-const struct fmt_spec *get_format (void);
-void set_format (const struct fmt_spec *);
-
-/* Maximum number of custom currency specifications */
-#define CC_CNT 5
-
-/* One custom currency specification. */
-#define CC_WIDTH 16
-struct custom_currency
- {
- char neg_prefix[CC_WIDTH]; /* Negative prefix. */
- char prefix[CC_WIDTH]; /* Prefix. */
- char suffix[CC_WIDTH]; /* Suffix. */
- char neg_suffix[CC_WIDTH]; /* Negative suffix. */
- char decimal; /* Decimal point. */
- char grouping; /* Grouping character. */
- };
-
-const struct custom_currency *get_cc (int idx);
-void set_cc (int idx, const struct custom_currency *);
-
-bool get_testing_mode (void);
-void set_testing_mode (bool);
-
-enum behavior_mode {
- ENHANCED, /* Use improved PSPP behavior. */
- COMPATIBLE /* Be as compatible as possible. */
-};
-
-enum behavior_mode get_algorithm (void);
-void set_algorithm (enum behavior_mode);
-enum behavior_mode get_syntax (void);
-void set_syntax(enum behavior_mode);
-void set_cmd_algorithm (enum behavior_mode);
-void unset_cmd_algorithm (void);
-
-#endif /* !settings_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "sfm-read.h"
-#include "sfmP.h"
-#include "error.h"
-#include <stdlib.h>
-#include <ctype.h>
-#include <errno.h>
-#include <float.h>
-#include <setjmp.h>
-#include "alloc.h"
-#include "case.h"
-#include "dictionary.h"
-#include "error.h"
-#include "file-handle.h"
-#include "filename.h"
-#include "format.h"
-#include "getl.h"
-#include "hash.h"
-#include "magic.h"
-#include "misc.h"
-#include "value-labels.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-/* System file reader. */
-struct sfm_reader
- {
- struct file_handle *fh; /* File handle. */
- FILE *file; /* File stream. */
-
- int reverse_endian; /* 1=file has endianness opposite us. */
- int fix_specials; /* 1=SYSMIS/HIGHEST/LOWEST differs from us. */
- int value_cnt; /* Number of `union values's per case. */
- long case_cnt; /* Number of cases, -1 if unknown. */
- int compressed; /* 1=compressed, 0=not compressed. */
- double bias; /* Compression bias, usually 100.0. */
- int weight_idx; /* 0-based index of weighting variable, or -1. */
-
- /* Variables. */
- struct sfm_var *vars; /* Variables. */
-
- /* File's special constants. */
- flt64 sysmis;
- flt64 highest;
- flt64 lowest;
-
- /* Decompression buffer. */
- flt64 *buf; /* Buffer data. */
- flt64 *ptr; /* Current location in buffer. */
- flt64 *end; /* End of buffer data. */
-
- /* Compression instruction octet. */
- unsigned char x[8]; /* Current instruction octet. */
- unsigned char *y; /* Location in current instruction octet. */
- };
-
-/* A variable in a system file. */
-struct sfm_var
- {
- int width; /* 0=numeric, otherwise string width. */
- int fv; /* Index into case. */
- };
-\f
-/* Utilities. */
-
-/* Swap bytes *A and *B. */
-static inline void
-bswap (char *a, char *b)
-{
- char t = *a;
- *a = *b;
- *b = t;
-}
-
-/* Reverse the byte order of 32-bit integer *X. */
-static inline void
-bswap_int32 (int32 *x_)
-{
- char *x = (char *) x_;
- bswap (x + 0, x + 3);
- bswap (x + 1, x + 2);
-}
-
-/* Reverse the byte order of 64-bit floating point *X. */
-static inline void
-bswap_flt64 (flt64 *x_)
-{
- char *x = (char *) x_;
- bswap (x + 0, x + 7);
- bswap (x + 1, x + 6);
- bswap (x + 2, x + 5);
- bswap (x + 3, x + 4);
-}
-
-static void
-corrupt_msg (int class, const char *format,...)
- PRINTF_FORMAT (2, 3);
-
-/* Displays a corrupt sysfile error. */
-static void
-corrupt_msg (int class, const char *format,...)
-{
- struct error e;
- va_list args;
-
- e.class = class;
- getl_location (&e.where.filename, &e.where.line_number);
- e.title = _("corrupt system file: ");
-
- va_start (args, format);
- err_vmsg (&e, format, args);
- va_end (args);
-}
-
-/* Closes a system file after we're done with it. */
-void
-sfm_close_reader (struct sfm_reader *r)
-{
- if (r == NULL)
- return;
-
- if (r->file)
- {
- if (fn_close (fh_get_filename (r->fh), r->file) == EOF)
- msg (ME, _("%s: Closing system file: %s."),
- fh_get_filename (r->fh), strerror (errno));
- r->file = NULL;
- }
-
- if (r->fh != NULL)
- fh_close (r->fh, "system file", "rs");
-
- free (r->vars);
- free (r->buf);
- free (r);
-}
-\f
-/* Dictionary reader. */
-
-static void buf_unread(struct sfm_reader *r, size_t byte_cnt);
-
-static void *buf_read (struct sfm_reader *, void *buf, size_t byte_cnt,
- size_t min_alloc);
-
-static int read_header (struct sfm_reader *,
- struct dictionary *, struct sfm_read_info *);
-static int parse_format_spec (struct sfm_reader *, int32,
- struct fmt_spec *, struct variable *);
-static int read_value_labels (struct sfm_reader *, struct dictionary *,
- struct variable **var_by_idx);
-static int read_variables (struct sfm_reader *,
- struct dictionary *, struct variable ***var_by_idx);
-static int read_machine_int32_info (struct sfm_reader *, int size, int count);
-static int read_machine_flt64_info (struct sfm_reader *, int size, int count);
-static int read_documents (struct sfm_reader *, struct dictionary *);
-
-static int fread_ok (struct sfm_reader *, void *, size_t);
-
-/* Displays the message X with corrupt_msg, then jumps to the error
- label. */
-#define lose(X) \
- do { \
- corrupt_msg X; \
- goto error; \
- } while (0)
-
-/* Calls buf_read with the specified arguments, and jumps to
- error if the read fails. */
-#define assertive_buf_read(a,b,c,d) \
- do { \
- if (!buf_read (a,b,c,d)) \
- goto error; \
- } while (0)
-
-/* Opens the system file designated by file handle FH for
- reading. Reads the system file's dictionary into *DICT.
- If INFO is non-null, then it receives additional info about the
- system file. */
-struct sfm_reader *
-sfm_open_reader (struct file_handle *fh, struct dictionary **dict,
- struct sfm_read_info *info)
-{
- struct sfm_reader *r = NULL;
- struct variable **var_by_idx = NULL;
-
- *dict = dict_create ();
- if (!fh_open (fh, FH_REF_FILE, "system file", "rs"))
- goto error;
-
- /* Create and initialize reader. */
- r = xmalloc (sizeof *r);
- r->fh = fh;
- r->file = fn_open (fh_get_filename (fh), "rb");
-
- r->reverse_endian = 0;
- r->fix_specials = 0;
- r->value_cnt = 0;
- r->case_cnt = 0;
- r->compressed = 0;
- r->bias = 100.0;
- r->weight_idx = -1;
-
- r->vars = NULL;
-
- r->sysmis = -FLT64_MAX;
- r->highest = FLT64_MAX;
- r->lowest = second_lowest_flt64;
-
- r->buf = r->ptr = r->end = NULL;
- r->y = r->x + sizeof r->x;
-
- /* Check that file open succeeded. */
- if (r->file == NULL)
- {
- msg (ME, _("An error occurred while opening \"%s\" for reading "
- "as a system file: %s."),
- fh_get_filename (r->fh), strerror (errno));
- err_cond_fail ();
- goto error;
- }
-
- /* Read header and variables. */
- if (!read_header (r, *dict, info) || !read_variables (r, *dict, &var_by_idx))
- goto error;
-
-
- /* Handle weighting. */
- if (r->weight_idx != -1)
- {
- struct variable *weight_var;
-
- if (r->weight_idx < 0 || r->weight_idx >= r->value_cnt)
- lose ((ME, _("%s: Index of weighting variable (%d) is not between 0 "
- "and number of elements per case (%d)."),
- fh_get_filename (r->fh), r->weight_idx, r->value_cnt));
-
-
- weight_var = var_by_idx[r->weight_idx];
-
- if (weight_var == NULL)
- lose ((ME,
- _("%s: Weighting variable may not be a continuation of "
- "a long string variable."), fh_get_filename (fh)));
- else if (weight_var->type == ALPHA)
- lose ((ME, _("%s: Weighting variable may not be a string variable."),
- fh_get_filename (fh)));
-
- dict_set_weight (*dict, weight_var);
- }
- else
- dict_set_weight (*dict, NULL);
-
- /* Read records of types 3, 4, 6, and 7. */
- for (;;)
- {
- int32 rec_type;
-
- assertive_buf_read (r, &rec_type, sizeof rec_type, 0);
- if (r->reverse_endian)
- bswap_int32 (&rec_type);
-
- switch (rec_type)
- {
- case 3:
- if (!read_value_labels (r, *dict, var_by_idx))
- goto error;
- break;
-
- case 4:
- lose ((ME, _("%s: Orphaned variable index record (type 4). Type 4 "
- "records must always immediately follow type 3 "
- "records."),
- fh_get_filename (r->fh)));
-
- case 6:
- if (!read_documents (r, *dict))
- goto error;
- break;
-
- case 7:
- {
- struct
- {
- int32 subtype P;
- int32 size P;
- int32 count P;
- }
- data;
- unsigned long bytes;
-
- int skip = 0;
-
- assertive_buf_read (r, &data, sizeof data, 0);
- if (r->reverse_endian)
- {
- bswap_int32 (&data.subtype);
- bswap_int32 (&data.size);
- bswap_int32 (&data.count);
- }
- bytes = data.size * data.count;
- if (bytes < data.size || bytes < data.count)
- lose ((ME, "%s: Record type %d subtype %d too large.",
- fh_get_filename (r->fh), rec_type, data.subtype));
-
- switch (data.subtype)
- {
- case 3:
- if (!read_machine_int32_info (r, data.size, data.count))
- goto error;
- break;
-
- case 4:
- if (!read_machine_flt64_info (r, data.size, data.count))
- goto error;
- break;
-
- case 5:
- case 6: /* ?? Used by SPSS 8.0. */
- skip = 1;
- break;
-
- case 11: /* Variable display parameters */
- {
- const int n_vars = data.count / 3 ;
- int i;
- if ( data.count % 3 || n_vars > dict_get_var_cnt(*dict) )
- {
- msg (MW, _("%s: Invalid subrecord length. "
- "Record: 7; Subrecord: 11"),
- fh_get_filename (r->fh));
- skip = 1;
- }
-
- for ( i = 0 ; i < min(n_vars, dict_get_var_cnt(*dict)) ; ++i )
- {
- struct
- {
- int32 measure P;
- int32 width P;
- int32 align P;
- }
- params;
-
- struct variable *v;
-
- assertive_buf_read (r, ¶ms, sizeof(params), 0);
-
- v = dict_get_var(*dict, i);
-
- v->measure = params.measure;
- v->display_width = params.width;
- v->alignment = params.align;
- }
- }
- break;
-
- case 13: /* SPSS 12.0 Long variable name map */
- {
- char *buf, *short_name, *save_ptr;
- int idx;
-
- /* Read data. */
- buf = xmalloc (bytes + 1);
- if (!buf_read (r, buf, bytes, 0))
- {
- free (buf);
- goto error;
- }
- buf[bytes] = '\0';
-
- /* Parse data. */
- for (short_name = strtok_r (buf, "=", &save_ptr), idx = 0;
- short_name != NULL;
- short_name = strtok_r (NULL, "=", &save_ptr), idx++)
- {
- char *long_name = strtok_r (NULL, "\t", &save_ptr);
- struct variable *v;
-
- /* Validate long name. */
- if (long_name == NULL)
- {
- msg (MW, _("%s: Trailing garbage in long variable "
- "name map."),
- fh_get_filename (r->fh));
- break;
- }
- if (!var_is_valid_name (long_name, false))
- {
- msg (MW, _("%s: Long variable mapping to invalid "
- "variable name `%s'."),
- fh_get_filename (r->fh), long_name);
- break;
- }
-
- /* Find variable using short name. */
- v = dict_lookup_var (*dict, short_name);
- if (v == NULL)
- {
- msg (MW, _("%s: Long variable mapping for "
- "nonexistent variable %s."),
- fh_get_filename (r->fh), short_name);
- break;
- }
-
- /* Identify any duplicates. */
- if ( compare_var_names(short_name, long_name, 0) &&
- NULL != dict_lookup_var (*dict, long_name))
- {
- lose ((ME, _("%s: Duplicate long variable name `%s' "
- "within system file."),
- fh_get_filename (r->fh), long_name));
- break;
- }
-
- /* Set long name.
- Renaming a variable may clear the short
- name, but we want to retain it, so
- re-set it explicitly. */
- dict_rename_var (*dict, v, long_name);
- var_set_short_name (v, short_name);
-
- /* For compatability, make sure dictionary
- is in long variable name map order. In
- the common case, this has no effect,
- because the dictionary and the long
- variable name map are already in the
- same order. */
- dict_reorder_var (*dict, v, idx);
- }
-
- /* Free data. */
- free (buf);
- }
- break;
-
- default:
- msg (MW, _("%s: Unrecognized record type 7, subtype %d "
- "encountered in system file."),
- fh_get_filename (r->fh), data.subtype);
- skip = 1;
- }
-
- if (skip)
- {
- void *x = buf_read (r, NULL, data.size * data.count, 0);
- if (x == NULL)
- goto error;
- free (x);
- }
- }
- break;
-
- case 999:
- {
- int32 filler;
-
- assertive_buf_read (r, &filler, sizeof filler, 0);
- goto success;
- }
-
- default:
- corrupt_msg(MW, _("%s: Unrecognized record type %d."),
- fh_get_filename (r->fh), rec_type);
- }
- }
-
-success:
- /* Come here on successful completion. */
- free (var_by_idx);
- return r;
-
-error:
- /* Come here on unsuccessful completion. */
- sfm_close_reader (r);
- free (var_by_idx);
- if (*dict != NULL)
- {
- dict_destroy (*dict);
- *dict = NULL;
- }
- return NULL;
-}
-
-/* Read record type 7, subtype 3. */
-static int
-read_machine_int32_info (struct sfm_reader *r, int size, int count)
-{
- int32 data[8];
- int file_bigendian;
-
- int i;
-
- if (size != sizeof (int32) || count != 8)
- lose ((ME, _("%s: Bad size (%d) or count (%d) field on record type 7, "
- "subtype 3. Expected size %d, count 8."),
- fh_get_filename (r->fh), size, count, sizeof (int32)));
-
- assertive_buf_read (r, data, sizeof data, 0);
- if (r->reverse_endian)
- for (i = 0; i < 8; i++)
- bswap_int32 (&data[i]);
-
-#ifdef FPREP_IEEE754
- if (data[4] != 1)
- lose ((ME, _("%s: Floating-point representation in system file is not "
- "IEEE-754. PSPP cannot convert between floating-point "
- "formats."),
- fh_get_filename (r->fh)));
-#else
-#error Add support for your floating-point format.
-#endif
-
-#ifdef WORDS_BIGENDIAN
- file_bigendian = 1;
-#else
- file_bigendian = 0;
-#endif
- if (r->reverse_endian)
- file_bigendian ^= 1;
- if (file_bigendian ^ (data[6] == 1))
- lose ((ME, _("%s: File-indicated endianness (%s) does not match "
- "endianness intuited from file header (%s)."),
- fh_get_filename (r->fh),
- file_bigendian ? _("big-endian") : _("little-endian"),
- data[6] == 1 ? _("big-endian") : (data[6] == 2 ? _("little-endian")
- : _("unknown"))));
-
- /* PORTME: Character representation code. */
- if (data[7] != 2 && data[7] != 3)
- lose ((ME, _("%s: File-indicated character representation code (%s) is "
- "not ASCII."),
- fh_get_filename (r->fh),
- (data[7] == 1 ? "EBCDIC"
- : (data[7] == 4 ? _("DEC Kanji") : _("Unknown")))));
-
- return 1;
-
-error:
- return 0;
-}
-
-/* Read record type 7, subtype 4. */
-static int
-read_machine_flt64_info (struct sfm_reader *r, int size, int count)
-{
- flt64 data[3];
- int i;
-
- if (size != sizeof (flt64) || count != 3)
- lose ((ME, _("%s: Bad size (%d) or count (%d) field on record type 7, "
- "subtype 4. Expected size %d, count 8."),
- fh_get_filename (r->fh), size, count, sizeof (flt64)));
-
- assertive_buf_read (r, data, sizeof data, 0);
- if (r->reverse_endian)
- for (i = 0; i < 3; i++)
- bswap_flt64 (&data[i]);
-
- if (data[0] != SYSMIS || data[1] != FLT64_MAX
- || data[2] != second_lowest_flt64)
- {
- r->sysmis = data[0];
- r->highest = data[1];
- r->lowest = data[2];
- msg (MW, _("%s: File-indicated value is different from internal value "
- "for at least one of the three system values. SYSMIS: "
- "indicated %g, expected %g; HIGHEST: %g, %g; LOWEST: "
- "%g, %g."),
- fh_get_filename (r->fh), (double) data[0], (double) SYSMIS,
- (double) data[1], (double) FLT64_MAX,
- (double) data[2], (double) second_lowest_flt64);
- }
-
- return 1;
-
-error:
- return 0;
-}
-
-static int
-read_header (struct sfm_reader *r,
- struct dictionary *dict, struct sfm_read_info *info)
-{
- struct sysfile_header hdr; /* Disk buffer. */
- char prod_name[sizeof hdr.prod_name + 1]; /* Buffer for product name. */
- int skip_amt = 0; /* Amount of product name to omit. */
- int i;
-
- /* Read header, check magic. */
- assertive_buf_read (r, &hdr, sizeof hdr, 0);
- if (strncmp ("$FL2", hdr.rec_type, 4) != 0)
- lose ((ME, _("%s: Bad magic. Proper system files begin with "
- "the four characters `$FL2'. This file will not be read."),
- fh_get_filename (r->fh)));
-
- /* Check eye-catcher string. */
- memcpy (prod_name, hdr.prod_name, sizeof hdr.prod_name);
- for (i = 0; i < 60; i++)
- if (!isprint ((unsigned char) prod_name[i]))
- prod_name[i] = ' ';
- for (i = 59; i >= 0; i--)
- if (!isgraph ((unsigned char) prod_name[i]))
- {
- prod_name[i] = '\0';
- break;
- }
- prod_name[60] = '\0';
-
- {
-#define N_PREFIXES 2
- static const char *prefix[N_PREFIXES] =
- {
- "@(#) SPSS DATA FILE",
- "SPSS SYSTEM FILE.",
- };
-
- int i;
-
- for (i = 0; i < N_PREFIXES; i++)
- if (!strncmp (prefix[i], hdr.prod_name, strlen (prefix[i])))
- {
- skip_amt = strlen (prefix[i]);
- break;
- }
- }
-
- /* Check endianness. */
- if (hdr.layout_code == 2)
- r->reverse_endian = 0;
- else
- {
- bswap_int32 (&hdr.layout_code);
- if (hdr.layout_code != 2)
- lose ((ME, _("%s: File layout code has unexpected value %d. Value "
- "should be 2, in big-endian or little-endian format."),
- fh_get_filename (r->fh), hdr.layout_code));
-
- r->reverse_endian = 1;
- bswap_int32 (&hdr.case_size);
- bswap_int32 (&hdr.compress);
- bswap_int32 (&hdr.weight_idx);
- bswap_int32 (&hdr.case_cnt);
- bswap_flt64 (&hdr.bias);
- }
-
-
- /* Copy basic info and verify correctness. */
- r->value_cnt = hdr.case_size;
-
- /* If value count is rediculous, then force it to -1 (a sentinel value) */
- if ( r->value_cnt < 0 ||
- r->value_cnt > (INT_MAX / (int) sizeof (union value) / 2))
- r->value_cnt = -1;
-
- r->compressed = hdr.compress;
-
- r->weight_idx = hdr.weight_idx - 1;
-
- r->case_cnt = hdr.case_cnt;
- if (r->case_cnt < -1 || r->case_cnt > INT_MAX / 2)
- lose ((ME,
- _("%s: Number of cases in file (%ld) is not between -1 and %d."),
- fh_get_filename (r->fh), (long) r->case_cnt, INT_MAX / 2));
-
- r->bias = hdr.bias;
- if (r->bias != 100.0)
- corrupt_msg (MW, _("%s: Compression bias (%g) is not the usual "
- "value of 100."),
- fh_get_filename (r->fh), r->bias);
-
- /* Make a file label only on the condition that the given label is
- not all spaces or nulls. */
- {
- int i;
-
- for (i = sizeof hdr.file_label - 1; i >= 0; i--)
- if (!isspace ((unsigned char) hdr.file_label[i])
- && hdr.file_label[i] != 0)
- {
- char *label = xmalloc (i + 2);
- memcpy (label, hdr.file_label, i + 1);
- label[i + 1] = 0;
- dict_set_label (dict, label);
- free (label);
- break;
- }
- }
-
- if (info)
- {
- char *cp;
-
- memcpy (info->creation_date, hdr.creation_date, 9);
- info->creation_date[9] = 0;
-
- memcpy (info->creation_time, hdr.creation_time, 8);
- info->creation_time[8] = 0;
-
-#ifdef WORDS_BIGENDIAN
- info->big_endian = !r->reverse_endian;
-#else
- info->big_endian = r->reverse_endian;
-#endif
-
- info->compressed = hdr.compress;
-
- info->case_cnt = hdr.case_cnt;
-
- for (cp = &prod_name[skip_amt]; cp < &prod_name[60]; cp++)
- if (isgraph ((unsigned char) *cp))
- break;
- strcpy (info->product, cp);
- }
-
- return 1;
-
-error:
- return 0;
-}
-
-/* Reads most of the dictionary from file H; also fills in the
- associated VAR_BY_IDX array. */
-static int
-read_variables (struct sfm_reader *r,
- struct dictionary *dict, struct variable ***var_by_idx)
-{
- int i;
-
- struct sysfile_variable sv; /* Disk buffer. */
- int long_string_count = 0; /* # of long string continuation
- records still expected. */
- int next_value = 0; /* Index to next `value' structure. */
-
- assert(r);
-
- *var_by_idx = 0;
-
- /* Pre-allocate variables. */
- if (r->value_cnt != -1)
- {
- *var_by_idx = xnmalloc (r->value_cnt, sizeof **var_by_idx);
- r->vars = xnmalloc (r->value_cnt, sizeof *r->vars);
- }
-
-
- /* Read in the entry for each variable and use the info to
- initialize the dictionary. */
- for (i = 0; ; ++i)
- {
- struct variable *vv;
- char name[SHORT_NAME_LEN + 1];
- int nv;
- int j;
-
- if ( r->value_cnt != -1 && i >= r->value_cnt )
- break;
-
- assertive_buf_read (r, &sv, sizeof sv, 0);
-
- if (r->reverse_endian)
- {
- bswap_int32 (&sv.rec_type);
- bswap_int32 (&sv.type);
- bswap_int32 (&sv.has_var_label);
- bswap_int32 (&sv.n_missing_values);
- bswap_int32 (&sv.print);
- bswap_int32 (&sv.write);
- }
-
- /* We've come to the end of the variable entries */
- if (sv.rec_type != 2)
- {
- buf_unread(r, sizeof sv);
- r->value_cnt = i;
- break;
- }
-
- if ( -1 == r->value_cnt )
- {
- *var_by_idx = xnrealloc (*var_by_idx, i + 1, sizeof **var_by_idx);
- r->vars = xnrealloc (r->vars, i + 1, sizeof *r->vars);
- }
-
- /* If there was a long string previously, make sure that the
- continuations are present; otherwise make sure there aren't
- any. */
- if (long_string_count)
- {
- if (sv.type != -1)
- lose ((ME, _("%s: position %d: String variable does not have "
- "proper number of continuation records."),
- fh_get_filename (r->fh), i));
-
-
- r->vars[i].width = -1;
- (*var_by_idx)[i] = NULL;
- long_string_count--;
- continue;
- }
- else if (sv.type == -1)
- lose ((ME, _("%s: position %d: Superfluous long string continuation "
- "record."),
- fh_get_filename (r->fh), i));
-
- /* Check fields for validity. */
- if (sv.type < 0 || sv.type > 255)
- lose ((ME, _("%s: position %d: Bad variable type code %d."),
- fh_get_filename (r->fh), i, sv.type));
- if (sv.has_var_label != 0 && sv.has_var_label != 1)
- lose ((ME, _("%s: position %d: Variable label indicator field is not "
- "0 or 1."), fh_get_filename (r->fh), i));
- if (sv.n_missing_values < -3 || sv.n_missing_values > 3
- || sv.n_missing_values == -1)
- lose ((ME, _("%s: position %d: Missing value indicator field is not "
- "-3, -2, 0, 1, 2, or 3."), fh_get_filename (r->fh), i));
-
- /* Copy first character of variable name. */
- if (!isalpha ((unsigned char) sv.name[0])
- && sv.name[0] != '@' && sv.name[0] != '#')
- lose ((ME, _("%s: position %d: Variable name begins with invalid "
- "character."),
- fh_get_filename (r->fh), i));
- if (islower ((unsigned char) sv.name[0]))
- msg (MW, _("%s: position %d: Variable name begins with lowercase letter "
- "%c."),
- fh_get_filename (r->fh), i, sv.name[0]);
- if (sv.name[0] == '#')
- msg (MW, _("%s: position %d: Variable name begins with octothorpe "
- "(`#'). Scratch variables should not appear in system "
- "files."),
- fh_get_filename (r->fh), i);
- name[0] = toupper ((unsigned char) (sv.name[0]));
-
- /* Copy remaining characters of variable name. */
- for (j = 1; j < SHORT_NAME_LEN; j++)
- {
- int c = (unsigned char) sv.name[j];
-
- if (isspace (c))
- break;
- else if (islower (c))
- {
- msg (MW, _("%s: position %d: Variable name character %d is "
- "lowercase letter %c."),
- fh_get_filename (r->fh), i, j + 1, sv.name[j]);
- name[j] = toupper ((unsigned char) (c));
- }
- else if (isalnum (c) || c == '.' || c == '@'
- || c == '#' || c == '$' || c == '_')
- name[j] = c;
- else
- lose ((ME, _("%s: position %d: character `\\%03o' (%c) is not valid in a "
- "variable name."),
- fh_get_filename (r->fh), i, c, c));
- }
- name[j] = 0;
-
- if ( ! var_is_valid_name(name, false) )
- lose ((ME, _("%s: Invalid variable name `%s' within system file."),
- fh_get_filename (r->fh), name));
-
- /* Create variable. */
-
- vv = (*var_by_idx)[i] = dict_create_var (dict, name, sv.type);
- if (vv == NULL)
- lose ((ME, _("%s: Duplicate variable name `%s' within system file."),
- fh_get_filename (r->fh), name));
-
- var_set_short_name (vv, vv->name);
-
- /* Case reading data. */
- nv = sv.type == 0 ? 1 : DIV_RND_UP (sv.type, sizeof (flt64));
- long_string_count = nv - 1;
- next_value += nv;
-
- /* Get variable label, if any. */
- if (sv.has_var_label == 1)
- {
- /* Disk buffer. */
- int32 len;
-
- /* Read length of label. */
- assertive_buf_read (r, &len, sizeof len, 0);
- if (r->reverse_endian)
- bswap_int32 (&len);
-
- /* Check len. */
- if (len < 0 || len > 255)
- lose ((ME, _("%s: Variable %s indicates variable label of invalid "
- "length %d."),
- fh_get_filename (r->fh), vv->name, len));
-
- if ( len != 0 )
- {
- /* Read label into variable structure. */
- vv->label = buf_read (r, NULL, ROUND_UP (len, sizeof (int32)), len + 1);
- if (vv->label == NULL)
- goto error;
- vv->label[len] = '\0';
- }
- }
-
- /* Set missing values. */
- if (sv.n_missing_values != 0)
- {
- flt64 mv[3];
- int mv_cnt = abs (sv.n_missing_values);
-
- if (vv->width > MAX_SHORT_STRING)
- lose ((ME, _("%s: Long string variable %s may not have missing "
- "values."),
- fh_get_filename (r->fh), vv->name));
-
- assertive_buf_read (r, mv, sizeof *mv * mv_cnt, 0);
-
- if (r->reverse_endian && vv->type == NUMERIC)
- for (j = 0; j < mv_cnt; j++)
- bswap_flt64 (&mv[j]);
-
- if (sv.n_missing_values > 0)
- {
- for (j = 0; j < sv.n_missing_values; j++)
- if (vv->type == NUMERIC)
- mv_add_num (&vv->miss, mv[j]);
- else
- mv_add_str (&vv->miss, (char *) &mv[j]);
- }
- else
- {
- if (vv->type == ALPHA)
- lose ((ME, _("%s: String variable %s may not have missing "
- "values specified as a range."),
- fh_get_filename (r->fh), vv->name));
-
- if (mv[0] == r->lowest)
- mv_add_num_range (&vv->miss, LOWEST, mv[1]);
- else if (mv[1] == r->highest)
- mv_add_num_range (&vv->miss, mv[0], HIGHEST);
- else
- mv_add_num_range (&vv->miss, mv[0], mv[1]);
-
- if (sv.n_missing_values == -3)
- mv_add_num (&vv->miss, mv[2]);
- }
- }
-
- if (!parse_format_spec (r, sv.print, &vv->print, vv)
- || !parse_format_spec (r, sv.write, &vv->write, vv))
- goto error;
-
- r->vars[i].width = vv->width;
- r->vars[i].fv = vv->fv;
-
- }
-
- /* Some consistency checks. */
- if (long_string_count != 0)
- lose ((ME, _("%s: Long string continuation records omitted at end of "
- "dictionary."),
- fh_get_filename (r->fh)));
-
- if (next_value != r->value_cnt)
- corrupt_msg(MW, _("%s: System file header indicates %d variable positions but "
- "%d were read from file."),
- fh_get_filename (r->fh), r->value_cnt, next_value);
-
-
- return 1;
-
-error:
- return 0;
-}
-
-/* Translates the format spec from sysfile format to internal
- format. */
-static int
-parse_format_spec (struct sfm_reader *r, int32 s,
- struct fmt_spec *f, struct variable *v)
-{
- f->type = translate_fmt ((s >> 16) & 0xff);
- if (f->type == -1)
- lose ((ME, _("%s: Bad format specifier byte (%d)."),
- fh_get_filename (r->fh), (s >> 16) & 0xff));
- f->w = (s >> 8) & 0xff;
- f->d = s & 0xff;
-
- if ((v->type == ALPHA) ^ ((formats[f->type].cat & FCAT_STRING) != 0))
- lose ((ME, _("%s: %s variable %s has %s format specifier %s."),
- fh_get_filename (r->fh),
- v->type == ALPHA ? _("String") : _("Numeric"),
- v->name,
- formats[f->type].cat & FCAT_STRING ? _("string") : _("numeric"),
- formats[f->type].name));
-
- if (!check_output_specifier (f, false)
- || !check_specifier_width (f, v->width, false))
- {
- msg (ME, _("%s variable %s has invalid format specifier %s."),
- v->type == NUMERIC ? _("Numeric") : _("String"),
- v->name, fmt_to_string (f));
- *f = v->type == NUMERIC ? f8_2 : make_output_format (FMT_A, v->width, 0);
- }
- return 1;
-
-error:
- return 0;
-}
-
-/* Reads value labels from sysfile H and inserts them into the
- associated dictionary. */
-int
-read_value_labels (struct sfm_reader *r,
- struct dictionary *dict, struct variable **var_by_idx)
-{
- struct label
- {
- char raw_value[8]; /* Value as uninterpreted bytes. */
- union value value; /* Value. */
- char *label; /* Null-terminated label string. */
- };
-
- struct label *labels = NULL;
- int32 n_labels; /* Number of labels. */
-
- struct variable **var = NULL; /* Associated variables. */
- int32 n_vars; /* Number of associated variables. */
-
- int i;
-
- /* First step: read the contents of the type 3 record and record its
- contents. Note that we can't do much with the data since we
- don't know yet whether it is of numeric or string type. */
-
- /* Read number of labels. */
- assertive_buf_read (r, &n_labels, sizeof n_labels, 0);
- if (r->reverse_endian)
- bswap_int32 (&n_labels);
-
- if ( n_labels >= ((int32) ~0) / sizeof *labels)
- {
- corrupt_msg(MW, _("%s: Invalid number of labels: %d. Ignoring labels."),
- fh_get_filename (r->fh), n_labels);
- n_labels = 0;
- }
-
- /* Allocate memory. */
- labels = xcalloc (n_labels, sizeof *labels);
- for (i = 0; i < n_labels; i++)
- labels[i].label = NULL;
-
- /* Read each value/label tuple into labels[]. */
- for (i = 0; i < n_labels; i++)
- {
- struct label *label = labels + i;
- unsigned char label_len;
- size_t padded_len;
-
- /* Read value. */
- assertive_buf_read (r, label->raw_value, sizeof label->raw_value, 0);
-
- /* Read label length. */
- assertive_buf_read (r, &label_len, sizeof label_len, 0);
- padded_len = ROUND_UP (label_len + 1, sizeof (flt64));
-
- /* Read label, padding. */
- label->label = xmalloc (padded_len + 1);
- assertive_buf_read (r, label->label, padded_len - 1, 0);
- label->label[label_len] = 0;
- }
-
- /* Second step: Read the type 4 record that has the list of
- variables to which the value labels are to be applied. */
-
- /* Read record type of type 4 record. */
- {
- int32 rec_type;
-
- assertive_buf_read (r, &rec_type, sizeof rec_type, 0);
- if (r->reverse_endian)
- bswap_int32 (&rec_type);
-
- if (rec_type != 4)
- lose ((ME, _("%s: Variable index record (type 4) does not immediately "
- "follow value label record (type 3) as it should."),
- fh_get_filename (r->fh)));
- }
-
- /* Read number of variables associated with value label from type 4
- record. */
- assertive_buf_read (r, &n_vars, sizeof n_vars, 0);
- if (r->reverse_endian)
- bswap_int32 (&n_vars);
- if (n_vars < 1 || n_vars > dict_get_var_cnt (dict))
- lose ((ME, _("%s: Number of variables associated with a value label (%d) "
- "is not between 1 and the number of variables (%d)."),
- fh_get_filename (r->fh), n_vars, dict_get_var_cnt (dict)));
-
- /* Read the list of variables. */
- var = xnmalloc (n_vars, sizeof *var);
- for (i = 0; i < n_vars; i++)
- {
- int32 var_idx;
- struct variable *v;
-
- /* Read variable index, check range. */
- assertive_buf_read (r, &var_idx, sizeof var_idx, 0);
- if (r->reverse_endian)
- bswap_int32 (&var_idx);
- if (var_idx < 1 || var_idx > r->value_cnt)
- lose ((ME, _("%s: Variable index associated with value label (%d) is "
- "not between 1 and the number of values (%d)."),
- fh_get_filename (r->fh), var_idx, r->value_cnt));
-
- /* Make sure it's a real variable. */
- v = var_by_idx[var_idx - 1];
- if (v == NULL)
- lose ((ME, _("%s: Variable index associated with value label (%d) "
- "refers to a continuation of a string variable, not to "
- "an actual variable."),
- fh_get_filename (r->fh), var_idx));
- if (v->type == ALPHA && v->width > MAX_SHORT_STRING)
- lose ((ME, _("%s: Value labels are not allowed on long string "
- "variables (%s)."),
- fh_get_filename (r->fh), v->name));
-
- /* Add it to the list of variables. */
- var[i] = v;
- }
-
- /* Type check the variables. */
- for (i = 1; i < n_vars; i++)
- if (var[i]->type != var[0]->type)
- lose ((ME, _("%s: Variables associated with value label are not all of "
- "identical type. Variable %s has %s type, but variable "
- "%s has %s type."),
- fh_get_filename (r->fh),
- var[0]->name, var[0]->type == ALPHA ? _("string") : _("numeric"),
- var[i]->name, var[i]->type == ALPHA ? _("string") : _("numeric")));
-
- /* Fill in labels[].value, now that we know the desired type. */
- for (i = 0; i < n_labels; i++)
- {
- struct label *label = labels + i;
-
- if (var[0]->type == ALPHA)
- {
- const int copy_len = min (sizeof label->raw_value,
- sizeof label->label);
- memcpy (label->value.s, label->raw_value, copy_len);
- } else {
- flt64 f;
- assert (sizeof f == sizeof label->raw_value);
- memcpy (&f, label->raw_value, sizeof f);
- if (r->reverse_endian)
- bswap_flt64 (&f);
- label->value.f = f;
- }
- }
-
- /* Assign the value_label's to each variable. */
- for (i = 0; i < n_vars; i++)
- {
- struct variable *v = var[i];
- int j;
-
- /* Add each label to the variable. */
- for (j = 0; j < n_labels; j++)
- {
- struct label *label = labels + j;
- if (!val_labs_replace (v->val_labs, label->value, label->label))
- continue;
-
- if (var[0]->type == NUMERIC)
- msg (MW, _("%s: File contains duplicate label for value %g for "
- "variable %s."),
- fh_get_filename (r->fh), label->value.f, v->name);
- else
- msg (MW, _("%s: File contains duplicate label for value `%.*s' "
- "for variable %s."),
- fh_get_filename (r->fh), v->width, label->value.s, v->name);
- }
- }
-
- for (i = 0; i < n_labels; i++)
- free (labels[i].label);
- free (labels);
- free (var);
- return 1;
-
-error:
- if (labels)
- {
- for (i = 0; i < n_labels; i++)
- free (labels[i].label);
- free (labels);
- }
- free (var);
- return 0;
-}
-
-/* Reads BYTE_CNT bytes from the file represented by H. If BUF is
- non-NULL, uses that as the buffer; otherwise allocates at least
- MIN_ALLOC bytes. Returns a pointer to the buffer on success, NULL
- on failure. */
-static void *
-buf_read (struct sfm_reader *r, void *buf, size_t byte_cnt, size_t min_alloc)
-{
- assert (r);
-
- if (buf == NULL && byte_cnt > 0 )
- buf = xmalloc (max (byte_cnt, min_alloc));
-
- if ( byte_cnt == 0 )
- return buf;
-
-
- if (1 != fread (buf, byte_cnt, 1, r->file))
- {
- if (ferror (r->file))
- msg (ME, _("%s: Reading system file: %s."),
- fh_get_filename (r->fh), strerror (errno));
- else
- corrupt_msg (ME, _("%s: Unexpected end of file."),
- fh_get_filename (r->fh));
- return NULL;
- }
- return buf;
-}
-
-/* Winds the reader BYTE_CNT bytes back in the reader stream. */
-void
-buf_unread(struct sfm_reader *r, size_t byte_cnt)
-{
- assert(byte_cnt > 0);
-
- if ( 0 != fseek(r->file, -byte_cnt, SEEK_CUR))
- {
- msg (ME, _("%s: Seeking system file: %s."),
- fh_get_filename (r->fh), strerror (errno));
- }
-}
-
-/* Reads a document record, type 6, from system file R, and sets up
- the documents and n_documents fields in the associated
- dictionary. */
-static int
-read_documents (struct sfm_reader *r, struct dictionary *dict)
-{
- int32 line_cnt;
- char *documents;
-
- if (dict_get_documents (dict) != NULL)
- lose ((ME, _("%s: System file contains multiple "
- "type 6 (document) records."),
- fh_get_filename (r->fh)));
-
- assertive_buf_read (r, &line_cnt, sizeof line_cnt, 0);
- if (line_cnt <= 0)
- lose ((ME, _("%s: Number of document lines (%ld) "
- "must be greater than 0."),
- fh_get_filename (r->fh), (long) line_cnt));
-
- documents = buf_read (r, NULL, 80 * line_cnt, line_cnt * 80 + 1);
- /* FIXME? Run through asciify. */
- if (documents == NULL)
- return 0;
- documents[80 * line_cnt] = '\0';
- dict_set_documents (dict, documents);
- free (documents);
- return 1;
-
-error:
- return 0;
-}
-\f
-/* Data reader. */
-
-/* Reads compressed data into H->BUF and sets other pointers
- appropriately. Returns nonzero only if both no errors occur and
- data was read. */
-static int
-buffer_input (struct sfm_reader *r)
-{
- size_t amt;
-
- if (r->buf == NULL)
- r->buf = xnmalloc (128, sizeof *r->buf);
- amt = fread (r->buf, sizeof *r->buf, 128, r->file);
- if (ferror (r->file))
- {
- msg (ME, _("%s: Error reading file: %s."),
- fh_get_filename (r->fh), strerror (errno));
- return 0;
- }
- r->ptr = r->buf;
- r->end = &r->buf[amt];
- return amt;
-}
-
-/* Reads a single case consisting of compressed data from system
- file H into the array BUF[] according to reader R, and
- returns nonzero only if successful. */
-/* Data in system files is compressed in this manner. Data
- values are grouped into sets of eight ("octets"). Each value
- in an octet has one instruction byte that are output together.
- Each instruction byte gives a value for that byte or indicates
- that the value can be found following the instructions. */
-static int
-read_compressed_data (struct sfm_reader *r, flt64 *buf)
-{
- const unsigned char *p_end = r->x + sizeof (flt64);
- unsigned char *p = r->y;
-
- const flt64 *buf_beg = buf;
- const flt64 *buf_end = &buf[r->value_cnt];
-
- for (;;)
- {
- for (; p < p_end; p++){
- switch (*p)
- {
- case 0:
- /* Code 0 is ignored. */
- continue;
- case 252:
- /* Code 252 is end of file. */
- if (buf_beg != buf)
- lose ((ME, _("%s: Compressed data is corrupted. Data ends "
- "in partial case."),
- fh_get_filename (r->fh)));
- goto error;
- case 253:
- /* Code 253 indicates that the value is stored explicitly
- following the instruction bytes. */
- if (r->ptr == NULL || r->ptr >= r->end)
- if (!buffer_input (r))
- {
- lose ((ME, _("%s: Unexpected end of file."),
- fh_get_filename (r->fh)));
- goto error;
- }
- memcpy (buf++, r->ptr++, sizeof *buf);
- if (buf >= buf_end)
- goto success;
- break;
- case 254:
- /* Code 254 indicates a string that is all blanks. */
- memset (buf++, ' ', sizeof *buf);
- if (buf >= buf_end)
- goto success;
- break;
- case 255:
- /* Code 255 indicates the system-missing value. */
- *buf = r->sysmis;
- if (r->reverse_endian)
- bswap_flt64 (buf);
- buf++;
- if (buf >= buf_end)
- goto success;
- break;
- default:
- /* Codes 1 through 251 inclusive are taken to indicate a
- value of (BYTE - BIAS), where BYTE is the byte's value
- and BIAS is the compression bias (generally 100.0). */
- *buf = *p - r->bias;
- if (r->reverse_endian)
- bswap_flt64 (buf);
- buf++;
- if (buf >= buf_end)
- goto success;
- break;
- }
- }
- /* We have reached the end of this instruction octet. Read
- another. */
- if (r->ptr == NULL || r->ptr >= r->end)
- if (!buffer_input (r))
- {
- if (buf_beg != buf)
- lose ((ME, _("%s: Unexpected end of file."),
- fh_get_filename (r->fh)));
- goto error;
- }
- memcpy (r->x, r->ptr++, sizeof *buf);
- p = r->x;
- }
-
- /* Not reached. */
- assert (0);
-
-success:
- /* We have filled up an entire record. Update state and return
- successfully. */
- r->y = ++p;
- return 1;
-
-error:
- /* We have been unsuccessful at filling a record, either through i/o
- error or through an end-of-file indication. Update state and
- return unsuccessfully. */
- return 0;
-}
-
-/* Reads one case from READER's file into C. Returns nonzero
- only if successful. */
-int
-sfm_read_case (struct sfm_reader *r, struct ccase *c)
-{
- if (!r->compressed && sizeof (flt64) == sizeof (double))
- {
- /* Fast path: external and internal representations are the
- same, except possibly for endianness or SYSMIS. Read
- directly into the case's buffer, then fix up any minor
- details as needed. */
- if (!fread_ok (r, case_data_all_rw (c),
- sizeof (union value) * r->value_cnt))
- return 0;
-
- /* Fix up endianness if needed. */
- if (r->reverse_endian)
- {
- int i;
-
- for (i = 0; i < r->value_cnt; i++)
- if (r->vars[i].width == 0)
- bswap_flt64 (&case_data_rw (c, r->vars[i].fv)->f);
- }
-
- /* Fix up SYSMIS values if needed.
- I don't think this will ever actually kick in, but it
- can't hurt. */
- if (r->sysmis != SYSMIS)
- {
- int i;
-
- for (i = 0; i < r->value_cnt; i++)
- if (r->vars[i].width == 0 && case_num (c, i) == r->sysmis)
- case_data_rw (c, r->vars[i].fv)->f = SYSMIS;
- }
- }
- else
- {
- /* Slow path: internal and external representations differ.
- Read into a bounce buffer, then copy to C. */
- flt64 *bounce;
- flt64 *bounce_cur;
- size_t bounce_size;
- int read_ok;
- int i;
-
- bounce_size = sizeof *bounce * r->value_cnt;
- bounce = bounce_cur = local_alloc (bounce_size);
-
- if (!r->compressed)
- read_ok = fread_ok (r, bounce, bounce_size);
- else
- read_ok = read_compressed_data (r, bounce);
- if (!read_ok)
- {
- local_free (bounce);
- return 0;
- }
-
- for (i = 0; i < r->value_cnt; i++)
- {
- struct sfm_var *v = &r->vars[i];
-
- if (v->width == 0)
- {
- flt64 f = *bounce_cur++;
- if (r->reverse_endian)
- bswap_flt64 (&f);
- case_data_rw (c, v->fv)->f = f == r->sysmis ? SYSMIS : f;
- }
- else if (v->width != -1)
- {
- memcpy (case_data_rw (c, v->fv)->s, bounce_cur, v->width);
- bounce_cur += DIV_RND_UP (v->width, sizeof (flt64));
- }
- }
-
- local_free (bounce);
- }
- return 1;
-}
-
-static int
-fread_ok (struct sfm_reader *r, void *buffer, size_t byte_cnt)
-{
- size_t read_bytes = fread (buffer, 1, byte_cnt, r->file);
-
- if (read_bytes == byte_cnt)
- return 1;
- else
- {
- if (ferror (r->file))
- msg (ME, _("%s: Reading system file: %s."),
- fh_get_filename (r->fh), strerror (errno));
- else if (read_bytes != 0)
- msg (ME, _("%s: Partial record at end of system file."),
- fh_get_filename (r->fh));
- return 0;
- }
-}
-\f
-/* Returns true if FILE is an SPSS system file,
- false otherwise. */
-bool
-sfm_detect (FILE *file)
-{
- struct sysfile_header hdr;
-
- if (fread (&hdr, sizeof hdr, 1, file) != 1)
- return false;
- if (strncmp ("$FL2", hdr.rec_type, 4))
- return false;
- return true;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef SFM_READ_H
-#define SFM_READ_H 1
-
-#include <stdbool.h>
-#include <stdio.h>
-
-/* Reading system files. */
-
-/* System file info that doesn't fit in struct dictionary. */
-struct sfm_read_info
- {
- char creation_date[10]; /* `dd mmm yy' plus a null. */
- char creation_time[9]; /* `hh:mm:ss' plus a null. */
- int big_endian; /* 1=big-endian, 0=little-endian. */
- int compressed; /* 0=no, 1=yes. */
- int case_cnt; /* -1 if unknown. */
- char product[61]; /* Product name plus a null. */
- };
-
-struct dictionary;
-struct file_handle;
-struct ccase;
-struct sfm_reader *sfm_open_reader (struct file_handle *,
- struct dictionary **,
- struct sfm_read_info *);
-int sfm_read_case (struct sfm_reader *, struct ccase *);
-void sfm_close_reader (struct sfm_reader *);
-bool sfm_detect (FILE *);
-
-#endif /* sfm-read.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "sfm-write.h"
-#include "sfmP.h"
-#include "error.h"
-#include <stdlib.h>
-#include <ctype.h>
-#include <errno.h>
-#include <fcntl.h>
-#include <sys/stat.h>
-#include <time.h>
-#if HAVE_UNISTD_H
-#include <unistd.h> /* Required by SunOS4. */
-#endif
-#include "alloc.h"
-#include "case.h"
-#include "dictionary.h"
-#include "error.h"
-#include "file-handle.h"
-#include "getl.h"
-#include "hash.h"
-#include "magic.h"
-#include "misc.h"
-#include "settings.h"
-#include "stat-macros.h"
-#include "str.h"
-#include "value-labels.h"
-#include "var.h"
-#include "version.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-/* Compression bias used by PSPP. Values between (1 -
- COMPRESSION_BIAS) and (251 - COMPRESSION_BIAS) inclusive can be
- compressed. */
-#define COMPRESSION_BIAS 100
-
-/* System file writer. */
-struct sfm_writer
- {
- struct file_handle *fh; /* File handle. */
- FILE *file; /* File stream. */
-
- int needs_translation; /* 0=use fast path, 1=translation needed. */
- int compress; /* 1=compressed, 0=not compressed. */
- int case_cnt; /* Number of cases written so far. */
- size_t flt64_cnt; /* Number of flt64 elements in case. */
-
- /* Compression buffering. */
- flt64 *buf; /* Buffered data. */
- flt64 *end; /* Buffer end. */
- flt64 *ptr; /* Current location in buffer. */
- unsigned char *x; /* Location in current instruction octet. */
- unsigned char *y; /* End of instruction octet. */
-
- /* Variables. */
- struct sfm_var *vars; /* Variables. */
- size_t var_cnt; /* Number of variables. */
- };
-
-/* A variable in a system file. */
-struct sfm_var
- {
- int width; /* 0=numeric, otherwise string width. */
- int fv; /* Index into case. */
- size_t flt64_cnt; /* Number of flt64 elements. */
- };
-
-static char *append_string_max (char *, const char *, const char *);
-static int write_header (struct sfm_writer *, const struct dictionary *);
-static int buf_write (struct sfm_writer *, const void *, size_t);
-static int write_variable (struct sfm_writer *, struct variable *);
-static int write_value_labels (struct sfm_writer *,
- struct variable *, int idx);
-static int write_rec_7_34 (struct sfm_writer *);
-
-static int write_longvar_table (struct sfm_writer *w,
- const struct dictionary *dict);
-
-static int write_variable_display_parameters (struct sfm_writer *w,
- const struct dictionary *dict);
-
-
-static int write_documents (struct sfm_writer *, const struct dictionary *);
-static int does_dict_need_translation (const struct dictionary *);
-
-static inline int
-var_flt64_cnt (const struct variable *v)
-{
- return v->type == NUMERIC ? 1 : DIV_RND_UP (v->width, sizeof (flt64));
-}
-
-/* Returns default options for writing a system file. */
-struct sfm_write_options
-sfm_writer_default_options (void)
-{
- struct sfm_write_options opts;
- opts.create_writeable = true;
- opts.compress = get_scompression ();
- opts.version = 3;
- return opts;
-}
-
-/* Opens the system file designated by file handle FH for writing
- cases from dictionary D according to the given OPTS. If
- COMPRESS is nonzero, the system file will be compressed.
-
- No reference to D is retained, so it may be modified or
- destroyed at will after this function returns. D is not
- modified by this function, except to assign short names. */
-struct sfm_writer *
-sfm_open_writer (struct file_handle *fh, struct dictionary *d,
- struct sfm_write_options opts)
-{
- struct sfm_writer *w = NULL;
- mode_t mode;
- int fd;
- int idx;
- int i;
-
- /* Check version. */
- if (opts.version != 2 && opts.version != 3)
- {
- msg (ME, _("Unknown system file version %d. Treating as version %d."),
- opts.version, 3);
- opts.version = 3;
- }
-
- /* Create file. */
- mode = S_IRUSR | S_IRGRP | S_IROTH;
- if (opts.create_writeable)
- mode |= S_IWUSR | S_IWGRP | S_IWOTH;
- fd = open (fh_get_filename (fh), O_WRONLY | O_CREAT | O_TRUNC, mode);
- if (fd < 0)
- goto open_error;
-
- /* Open file handle. */
- if (!fh_open (fh, FH_REF_FILE, "system file", "we"))
- goto error;
-
- /* Create and initialize writer. */
- w = xmalloc (sizeof *w);
- w->fh = fh;
- w->file = fdopen (fd, "w");
-
- w->needs_translation = does_dict_need_translation (d);
- w->compress = opts.compress;
- w->case_cnt = 0;
- w->flt64_cnt = 0;
-
- w->buf = w->end = w->ptr = NULL;
- w->x = w->y = NULL;
-
- w->var_cnt = dict_get_var_cnt (d);
- w->vars = xnmalloc (w->var_cnt, sizeof *w->vars);
- for (i = 0; i < w->var_cnt; i++)
- {
- const struct variable *dv = dict_get_var (d, i);
- struct sfm_var *sv = &w->vars[i];
- sv->width = dv->width;
- sv->fv = dv->fv;
- sv->flt64_cnt = var_flt64_cnt (dv);
- }
-
- /* Check that file create succeeded. */
- if (w->file == NULL)
- {
- close (fd);
- goto open_error;
- }
-
- /* Write the file header. */
- if (!write_header (w, d))
- goto error;
-
- /* Write basic variable info. */
- dict_assign_short_names (d);
- for (i = 0; i < dict_get_var_cnt (d); i++)
- write_variable (w, dict_get_var (d, i));
-
- /* Write out value labels. */
- for (idx = i = 0; i < dict_get_var_cnt (d); i++)
- {
- struct variable *v = dict_get_var (d, i);
-
- if (!write_value_labels (w, v, idx))
- goto error;
- idx += var_flt64_cnt (v);
- }
-
- if (dict_get_documents (d) != NULL && !write_documents (w, d))
- goto error;
-
- if (!write_rec_7_34 (w))
- goto error;
-
- if (!write_variable_display_parameters (w, d))
- goto error;
-
- if (opts.version >= 3)
- {
- if (!write_longvar_table (w, d))
- goto error;
- }
-
- /* Write end-of-headers record. */
- {
- struct
- {
- int32 rec_type P;
- int32 filler P;
- }
- rec_999;
-
- rec_999.rec_type = 999;
- rec_999.filler = 0;
-
- if (!buf_write (w, &rec_999, sizeof rec_999))
- goto error;
- }
-
- if (w->compress)
- {
- w->buf = xnmalloc (128, sizeof *w->buf);
- w->ptr = w->buf;
- w->end = &w->buf[128];
- w->x = (unsigned char *) w->ptr++;
- w->y = (unsigned char *) w->ptr;
- }
-
- return w;
-
- error:
- sfm_close_writer (w);
- return NULL;
-
- open_error:
- msg (ME, _("Error opening \"%s\" for writing as a system file: %s."),
- fh_get_filename (fh), strerror (errno));
- err_cond_fail ();
- goto error;
-}
-
-static int
-does_dict_need_translation (const struct dictionary *d)
-{
- size_t case_idx;
- size_t i;
-
- case_idx = 0;
- for (i = 0; i < dict_get_var_cnt (d); i++)
- {
- struct variable *v = dict_get_var (d, i);
- if (v->fv != case_idx)
- return 0;
- case_idx += v->nv;
- }
- return 1;
-}
-
-/* Returns value of X truncated to two least-significant digits. */
-static int
-rerange (int x)
-{
- if (x < 0)
- x = -x;
- if (x >= 100)
- x %= 100;
- return x;
-}
-
-/* Write the sysfile_header header to system file W. */
-static int
-write_header (struct sfm_writer *w, const struct dictionary *d)
-{
- struct sysfile_header hdr;
- char *p;
- int i;
-
- time_t t;
-
- memcpy (hdr.rec_type, "$FL2", 4);
-
- p = stpcpy (hdr.prod_name, "@(#) SPSS DATA FILE ");
- p = append_string_max (p, version, &hdr.prod_name[60]);
- p = append_string_max (p, " - ", &hdr.prod_name[60]);
- p = append_string_max (p, host_system, &hdr.prod_name[60]);
- memset (p, ' ', &hdr.prod_name[60] - p);
-
- hdr.layout_code = 2;
-
- w->flt64_cnt = 0;
- for (i = 0; i < dict_get_var_cnt (d); i++)
- w->flt64_cnt += var_flt64_cnt (dict_get_var (d, i));
- hdr.case_size = w->flt64_cnt;
-
- hdr.compress = w->compress;
-
- if (dict_get_weight (d) != NULL)
- {
- struct variable *weight_var;
- int recalc_weight_idx = 1;
- int i;
-
- weight_var = dict_get_weight (d);
- for (i = 0; ; i++)
- {
- struct variable *v = dict_get_var (d, i);
- if (v == weight_var)
- break;
- recalc_weight_idx += var_flt64_cnt (v);
- }
- hdr.weight_idx = recalc_weight_idx;
- }
- else
- hdr.weight_idx = 0;
-
- hdr.case_cnt = -1;
- hdr.bias = COMPRESSION_BIAS;
-
- if (time (&t) == (time_t) -1)
- {
- memcpy (hdr.creation_date, "01 Jan 70", 9);
- memcpy (hdr.creation_time, "00:00:00", 8);
- }
- else
- {
- static const char *month_name[12] =
- {
- "Jan", "Feb", "Mar", "Apr", "May", "Jun",
- "Jul", "Aug", "Sep", "Oct", "Nov", "Dec",
- };
- struct tm *tmp = localtime (&t);
- int day = rerange (tmp->tm_mday);
- int mon = rerange (tmp->tm_mon + 1);
- int year = rerange (tmp->tm_year);
- int hour = rerange (tmp->tm_hour + 1);
- int min = rerange (tmp->tm_min + 1);
- int sec = rerange (tmp->tm_sec + 1);
- char buf[10];
-
- sprintf (buf, "%02d %s %02d", day, month_name[mon - 1], year);
- memcpy (hdr.creation_date, buf, sizeof hdr.creation_date);
- sprintf (buf, "%02d:%02d:%02d", hour - 1, min - 1, sec - 1);
- memcpy (hdr.creation_time, buf, sizeof hdr.creation_time);
- }
-
- {
- const char *label = dict_get_label (d);
- if (label == NULL)
- label = "";
-
- buf_copy_str_rpad (hdr.file_label, sizeof hdr.file_label, label);
- }
-
- memset (hdr.padding, 0, sizeof hdr.padding);
-
- if (!buf_write (w, &hdr, sizeof hdr))
- return 0;
- return 1;
-}
-
-/* Translates format spec from internal form in SRC to system file
- format in DEST. */
-static inline void
-write_format_spec (struct fmt_spec *src, int32 *dest)
-{
- *dest = (formats[src->type].spss << 16) | (src->w << 8) | src->d;
-}
-
-/* Write the variable record(s) for primary variable P and secondary
- variable S to system file W. */
-static int
-write_variable (struct sfm_writer *w, struct variable *v)
-{
- struct sysfile_variable sv;
-
- /* Missing values. */
- struct missing_values mv;
- flt64 m[3]; /* Missing value values. */
- int nm; /* Number of missing values, possibly negative. */
-
- sv.rec_type = 2;
- sv.type = v->width;
- sv.has_var_label = (v->label != NULL);
-
- mv_copy (&mv, &v->miss);
- nm = 0;
- if (mv_has_range (&mv))
- {
- double x, y;
- mv_pop_range (&mv, &x, &y);
- m[nm++] = x == LOWEST ? second_lowest_flt64 : x;
- m[nm++] = y == HIGHEST ? FLT64_MAX : y;
- }
- while (mv_has_value (&mv))
- {
- union value value;
- mv_pop_value (&mv, &value);
- if (v->type == NUMERIC)
- m[nm] = value.f;
- else
- buf_copy_rpad ((char *) &m[nm], sizeof m[nm], value.s, v->width);
- nm++;
- }
- if (mv_has_range (&v->miss))
- nm = -nm;
-
- sv.n_missing_values = nm;
- write_format_spec (&v->print, &sv.print);
- write_format_spec (&v->write, &sv.write);
- buf_copy_str_rpad (sv.name, sizeof sv.name, v->short_name);
- if (!buf_write (w, &sv, sizeof sv))
- return 0;
-
- if (v->label)
- {
- struct label
- {
- int32 label_len P;
- char label[255] P;
- }
- l;
-
- int ext_len;
-
- l.label_len = min (strlen (v->label), 255);
- ext_len = ROUND_UP (l.label_len, sizeof l.label_len);
- memcpy (l.label, v->label, l.label_len);
- memset (&l.label[l.label_len], ' ', ext_len - l.label_len);
-
- if (!buf_write (w, &l, offsetof (struct label, label) + ext_len))
- return 0;
- }
-
- if (nm && !buf_write (w, m, sizeof *m * abs (nm)))
- return 0;
-
- if (v->type == ALPHA && v->width > (int) sizeof (flt64))
- {
- int i;
- int pad_count;
-
- sv.type = -1;
- sv.has_var_label = 0;
- sv.n_missing_values = 0;
- memset (&sv.print, 0, sizeof sv.print);
- memset (&sv.write, 0, sizeof sv.write);
- memset (&sv.name, 0, sizeof sv.name);
-
- pad_count = DIV_RND_UP (v->width, (int) sizeof (flt64)) - 1;
- for (i = 0; i < pad_count; i++)
- if (!buf_write (w, &sv, sizeof sv))
- return 0;
- }
-
- return 1;
-}
-
-/* Writes the value labels for variable V having system file variable
- index IDX to system file W. Returns
- nonzero only if successful. */
-static int
-write_value_labels (struct sfm_writer *w, struct variable *v, int idx)
-{
- struct value_label_rec
- {
- int32 rec_type P;
- int32 n_labels P;
- flt64 labels[1] P;
- };
-
- struct var_idx_rec
- {
- int32 rec_type P;
- int32 n_vars P;
- int32 vars[1] P;
- };
-
- struct val_labs_iterator *i;
- struct value_label_rec *vlr;
- struct var_idx_rec vir;
- struct val_lab *vl;
- size_t vlr_size;
- flt64 *loc;
-
- if (!val_labs_count (v->val_labs))
- return 1;
-
- /* Pass 1: Count bytes. */
- vlr_size = (sizeof (struct value_label_rec)
- + sizeof (flt64) * (val_labs_count (v->val_labs) - 1));
- for (vl = val_labs_first (v->val_labs, &i); vl != NULL;
- vl = val_labs_next (v->val_labs, &i))
- vlr_size += ROUND_UP (strlen (vl->label) + 1, sizeof (flt64));
-
- /* Pass 2: Copy bytes. */
- vlr = xmalloc (vlr_size);
- vlr->rec_type = 3;
- vlr->n_labels = val_labs_count (v->val_labs);
- loc = vlr->labels;
- for (vl = val_labs_first_sorted (v->val_labs, &i); vl != NULL;
- vl = val_labs_next (v->val_labs, &i))
- {
- size_t len = strlen (vl->label);
-
- *loc++ = vl->value.f;
- *(unsigned char *) loc = len;
- memcpy (&((char *) loc)[1], vl->label, len);
- memset (&((char *) loc)[1 + len], ' ',
- REM_RND_UP (len + 1, sizeof (flt64)));
- loc += DIV_RND_UP (len + 1, sizeof (flt64));
- }
-
- if (!buf_write (w, vlr, vlr_size))
- {
- free (vlr);
- return 0;
- }
- free (vlr);
-
- vir.rec_type = 4;
- vir.n_vars = 1;
- vir.vars[0] = idx + 1;
- if (!buf_write (w, &vir, sizeof vir))
- return 0;
-
- return 1;
-}
-
-/* Writes record type 6, document record. */
-static int
-write_documents (struct sfm_writer *w, const struct dictionary *d)
-{
- struct
- {
- int32 rec_type P; /* Always 6. */
- int32 n_lines P; /* Number of lines of documents. */
- }
- rec_6;
-
- const char *documents;
- size_t n_lines;
-
- documents = dict_get_documents (d);
- n_lines = strlen (documents) / 80;
-
- rec_6.rec_type = 6;
- rec_6.n_lines = n_lines;
- if (!buf_write (w, &rec_6, sizeof rec_6))
- return 0;
- if (!buf_write (w, documents, 80 * n_lines))
- return 0;
-
- return 1;
-}
-
-/* Write the alignment, width and scale values */
-static int
-write_variable_display_parameters (struct sfm_writer *w,
- const struct dictionary *dict)
-{
- int i;
-
- struct
- {
- int32 rec_type P;
- int32 subtype P;
- int32 elem_size P;
- int32 n_elem P;
- } vdp_hdr;
-
- vdp_hdr.rec_type = 7;
- vdp_hdr.subtype = 11;
- vdp_hdr.elem_size = 4;
- vdp_hdr.n_elem = w->var_cnt * 3;
-
- if (!buf_write (w, &vdp_hdr, sizeof vdp_hdr))
- return 0;
-
- for ( i = 0 ; i < w->var_cnt ; ++i )
- {
- struct variable *v;
- struct
- {
- int32 measure P;
- int32 width P;
- int32 align P;
- }
- params;
-
- v = dict_get_var(dict, i);
-
- params.measure = v->measure;
- params.width = v->display_width;
- params.align = v->alignment;
-
- if (!buf_write (w, ¶ms, sizeof(params)))
- return 0;
- }
-
- return 1;
-}
-
-/* Writes the long variable name table */
-static int
-write_longvar_table (struct sfm_writer *w, const struct dictionary *dict)
-{
- struct
- {
- int32 rec_type P;
- int32 subtype P;
- int32 elem_size P;
- int32 n_elem P;
- }
- lv_hdr;
-
- struct string long_name_map;
- size_t i;
-
- ds_init (&long_name_map, 10 * dict_get_var_cnt (dict));
- for (i = 0; i < dict_get_var_cnt (dict); i++)
- {
- struct variable *v = dict_get_var (dict, i);
-
- if (i)
- ds_putc (&long_name_map, '\t');
- ds_printf (&long_name_map, "%s=%s", v->short_name, v->name);
- }
-
- lv_hdr.rec_type = 7;
- lv_hdr.subtype = 13;
- lv_hdr.elem_size = 1;
- lv_hdr.n_elem = ds_length (&long_name_map);
-
- if (!buf_write (w, &lv_hdr, sizeof lv_hdr)
- || !buf_write (w, ds_data (&long_name_map), ds_length (&long_name_map)))
- goto error;
-
- ds_destroy (&long_name_map);
- return 1;
-
- error:
- ds_destroy (&long_name_map);
- return 0;
-}
-
-/* Writes record type 7, subtypes 3 and 4. */
-static int
-write_rec_7_34 (struct sfm_writer *w)
-{
- struct
- {
- int32 rec_type_3 P;
- int32 subtype_3 P;
- int32 data_type_3 P;
- int32 n_elem_3 P;
- int32 elem_3[8] P;
- int32 rec_type_4 P;
- int32 subtype_4 P;
- int32 data_type_4 P;
- int32 n_elem_4 P;
- flt64 elem_4[3] P;
- }
- rec_7;
-
- /* Components of the version number, from major to minor. */
- int version_component[3];
-
- /* Used to step through the version string. */
- char *p;
-
- /* Parses the version string, which is assumed to be of the form
- #.#x, where each # is a string of digits, and x is a single
- letter. */
- version_component[0] = strtol (bare_version, &p, 10);
- if (*p == '.')
- p++;
- version_component[1] = strtol (bare_version, &p, 10);
- version_component[2] = (isalpha ((unsigned char) *p)
- ? tolower ((unsigned char) *p) - 'a' : 0);
-
- rec_7.rec_type_3 = 7;
- rec_7.subtype_3 = 3;
- rec_7.data_type_3 = sizeof (int32);
- rec_7.n_elem_3 = 8;
- rec_7.elem_3[0] = version_component[0];
- rec_7.elem_3[1] = version_component[1];
- rec_7.elem_3[2] = version_component[2];
- rec_7.elem_3[3] = -1;
-
- /* PORTME: 1=IEEE754, 2=IBM 370, 3=DEC VAX E. */
-#ifdef FPREP_IEEE754
- rec_7.elem_3[4] = 1;
-#endif
-
- rec_7.elem_3[5] = 1;
-
- /* PORTME: 1=big-endian, 2=little-endian. */
-#if WORDS_BIGENDIAN
- rec_7.elem_3[6] = 1;
-#else
- rec_7.elem_3[6] = 2;
-#endif
-
- /* PORTME: 1=EBCDIC, 2=7-bit ASCII, 3=8-bit ASCII, 4=DEC Kanji. */
- rec_7.elem_3[7] = 2;
-
- rec_7.rec_type_4 = 7;
- rec_7.subtype_4 = 4;
- rec_7.data_type_4 = sizeof (flt64);
- rec_7.n_elem_4 = 3;
- rec_7.elem_4[0] = -FLT64_MAX;
- rec_7.elem_4[1] = FLT64_MAX;
- rec_7.elem_4[2] = second_lowest_flt64;
-
- if (!buf_write (w, &rec_7, sizeof rec_7))
- return 0;
- return 1;
-}
-
-/* Write NBYTES starting at BUF to the system file represented by
- H. */
-static int
-buf_write (struct sfm_writer *w, const void *buf, size_t nbytes)
-{
- assert (buf != NULL);
- if (fwrite (buf, nbytes, 1, w->file) != 1)
- {
- msg (ME, _("%s: Writing system file: %s."),
- fh_get_filename (w->fh), strerror (errno));
- return 0;
- }
- return 1;
-}
-
-/* Copies string DEST to SRC with the proviso that DEST does not reach
- byte END; no null terminator is copied. Returns a pointer to the
- byte after the last byte copied. */
-static char *
-append_string_max (char *dest, const char *src, const char *end)
-{
- int nbytes = min (end - dest, (int) strlen (src));
- memcpy (dest, src, nbytes);
- return dest + nbytes;
-}
-
-/* Makes certain that the compression buffer of H has room for another
- element. If there's not room, pads out the current instruction
- octet with zero and dumps out the buffer. */
-static inline int
-ensure_buf_space (struct sfm_writer *w)
-{
- if (w->ptr >= w->end)
- {
- memset (w->x, 0, w->y - w->x);
- w->x = w->y;
- w->ptr = w->buf;
- if (!buf_write (w, w->buf, sizeof *w->buf * 128))
- return 0;
- }
- return 1;
-}
-
-static void write_compressed_data (struct sfm_writer *w, const flt64 *elem);
-
-/* Writes case C to system file W.
- Returns nonzero if successful. */
-int
-sfm_write_case (struct sfm_writer *w, const struct ccase *c)
-{
- w->case_cnt++;
-
- if (!w->needs_translation && !w->compress
- && sizeof (flt64) == sizeof (union value))
- {
- /* Fast path: external and internal representations are the
- same and the dictionary is properly ordered. Write
- directly to file. */
- buf_write (w, case_data_all (c), sizeof (union value) * w->flt64_cnt);
- }
- else
- {
- /* Slow path: internal and external representations differ.
- Write into a bounce buffer, then write to W. */
- flt64 *bounce;
- flt64 *bounce_cur;
- size_t bounce_size;
- size_t i;
-
- bounce_size = sizeof *bounce * w->flt64_cnt;
- bounce = bounce_cur = local_alloc (bounce_size);
-
- for (i = 0; i < w->var_cnt; i++)
- {
- struct sfm_var *v = &w->vars[i];
-
- if (v->width == 0)
- *bounce_cur = case_num (c, v->fv);
- else
- memcpy (bounce_cur, case_data (c, v->fv)->s, v->width);
- bounce_cur += v->flt64_cnt;
- }
-
- if (!w->compress)
- buf_write (w, bounce, bounce_size);
- else
- write_compressed_data (w, bounce);
-
- local_free (bounce);
- }
-
- return 1;
-}
-
-static void
-put_instruction (struct sfm_writer *w, unsigned char instruction)
-{
- if (w->x >= w->y)
- {
- if (!ensure_buf_space (w))
- return;
- w->x = (unsigned char *) w->ptr++;
- w->y = (unsigned char *) w->ptr;
- }
- *w->x++ = instruction;
-}
-
-static void
-put_element (struct sfm_writer *w, const flt64 *elem)
-{
- if (!ensure_buf_space (w))
- return;
- memcpy (w->ptr++, elem, sizeof *elem);
-}
-
-static void
-write_compressed_data (struct sfm_writer *w, const flt64 *elem)
-{
- size_t i;
-
- for (i = 0; i < w->var_cnt; i++)
- {
- struct sfm_var *v = &w->vars[i];
-
- if (v->width == 0)
- {
- if (*elem == -FLT64_MAX)
- put_instruction (w, 255);
- else if (*elem >= 1 - COMPRESSION_BIAS
- && *elem <= 251 - COMPRESSION_BIAS
- && *elem == (int) *elem)
- put_instruction (w, (int) *elem + COMPRESSION_BIAS);
- else
- {
- put_instruction (w, 253);
- put_element (w, elem);
- }
- elem++;
- }
- else
- {
- size_t j;
-
- for (j = 0; j < v->flt64_cnt; j++, elem++)
- {
- if (!memcmp (elem, " ", sizeof (flt64)))
- put_instruction (w, 254);
- else
- {
- put_instruction (w, 253);
- put_element (w, elem);
- }
- }
- }
- }
-}
-
-/* Closes a system file after we're done with it. */
-void
-sfm_close_writer (struct sfm_writer *w)
-{
- if (w == NULL)
- return;
-
- if (w->file != NULL)
- {
- /* Flush buffer. */
- if (w->buf != NULL && w->ptr > w->buf)
- {
- memset (w->x, 0, w->y - w->x);
- buf_write (w, w->buf, (w->ptr - w->buf) * sizeof *w->buf);
- }
-
- /* Seek back to the beginning and update the number of cases.
- This is just a courtesy to later readers, so there's no need
- to check return values or report errors. */
- if (!fseek (w->file, offsetof (struct sysfile_header, case_cnt), SEEK_SET))
- {
- int32 case_cnt = w->case_cnt;
-
- /* I don't really care about the return value: it doesn't
- matter whether this data is written. */
- fwrite (&case_cnt, sizeof case_cnt, 1, w->file);
- }
-
- if (fclose (w->file) == EOF)
- msg (ME, _("%s: Closing system file: %s."),
- fh_get_filename (w->fh), strerror (errno));
- }
-
- fh_close (w->fh, "system file", "we");
-
- free (w->buf);
- free (w->vars);
- free (w);
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef SFM_WRITE_H
-#define SFM_WRITE_H 1
-
-#include <stdbool.h>
-
-/* Writing system files. */
-
-/* Options for creating a system file. */
-struct sfm_write_options
- {
- bool create_writeable; /* File perms: writeable or read/only? */
- bool compress; /* Compress file? */
- int version; /* System file version (currently 2 or 3). */
- };
-
-struct file_handle;
-struct dictionary;
-struct ccase;
-struct sfm_writer *sfm_open_writer (struct file_handle *, struct dictionary *,
- struct sfm_write_options);
-struct sfm_write_options sfm_writer_default_options (void);
-
-int sfm_write_case (struct sfm_writer *, const struct ccase *);
-void sfm_close_writer (struct sfm_writer *);
-
-#endif /* sfm-write.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-/* PORTME: There might easily be alignment problems with some of these
- structures. */
-
-/* This attribute might avoid some problems. On the other hand... */
-#define P ATTRIBUTE ((packed))
-
-#if __BORLANDC__
-#pragma option -a- /* Turn off alignment. */
-#endif
-
-/* Find 32-bit signed integer type. */
-#if SIZEOF_SHORT == 4
- #define int32 short
-#elif SIZEOF_INT == 4
- #define int32 int
-#elif SIZEOF_LONG == 4
- #define int32 long
-#else
- #error Which one of your basic types is 32-bit signed integer?
-#endif
-
-/* Find 64-bit floating-point type. */
-#if SIZEOF_FLOAT == 8
- #define flt64 float
- #define FLT64_MAX FLT_MAX
-#elif SIZEOF_DOUBLE == 8
- #define flt64 double
- #define FLT64_MAX DBL_MAX
-#elif SIZEOF_LONG_DOUBLE == 8
- #define flt64 long double
- #define FLT64_MAX LDBL_MAX
-#else
- #error Which one of your basic types is 64-bit floating point?
- #define flt64 double
- #define FLT64_MAX DBL_MAX
-#endif
-
-/* Figure out SYSMIS value for flt64. */
-#include "magic.h"
-#if SIZEOF_DOUBLE == 8
-#define second_lowest_flt64 second_lowest_value
-#else
-#error Must define second_lowest_flt64 for your architecture.
-#endif
-
-/* Record Type 1: General Information. */
-struct sysfile_header
- {
- char rec_type[4] P; /* 00: Record-type code, "$FL2". */
- char prod_name[60] P; /* 04: Product identification. */
- int32 layout_code P; /* 40: 2. */
- int32 case_size P; /* 44: Number of `value's per case.
- Note: some systems set this to -1 */
- int32 compress P; /* 48: 1=compressed, 0=not compressed. */
- int32 weight_idx P; /* 4c: 1-based index of weighting var, or 0. */
- int32 case_cnt P; /* 50: Number of cases, -1 if unknown. */
- flt64 bias P; /* 54: Compression bias (100.0). */
- char creation_date[9] P; /* 5c: `dd mmm yy' creation date of file. */
- char creation_time[8] P; /* 65: `hh:mm:ss' 24-hour creation time. */
- char file_label[64] P; /* 6d: File label. */
- char padding[3] P; /* ad: Ignored padding. */
- };
-
-/* Record Type 2: Variable. */
-struct sysfile_variable
- {
- int32 rec_type P; /* 2. */
- int32 type P; /* 0=numeric, 1-255=string width,
- -1=continued string. */
- int32 has_var_label P; /* 1=has a variable label, 0=doesn't. */
- int32 n_missing_values P; /* Missing value code of -3,-2,0,1,2, or 3. */
- int32 print P; /* Print format. */
- int32 write P; /* Write format. */
- char name[SHORT_NAME_LEN] P; /* Variable name. */
- /* The rest of the structure varies. */
- };
-
-#if __BORLANDC__
-#pragma -a4
-#endif
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "som.h"
-#include "error.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include "output.h"
-#include "debug-print.h"
-
-/* Table. */
-int table_num = 1;
-int subtable_num;
-\f
-/* Increments table_num so different procedures' output can be
- distinguished. */
-void
-som_new_series (void)
-{
- if (subtable_num != 0)
- {
- table_num++;
- subtable_num = 0;
- }
-}
-
-/* Ejects the paper for all active devices. */
-void
-som_eject_page (void)
-{
- struct outp_driver *d;
-
- for (d = outp_drivers (NULL); d; d = outp_drivers (d))
- outp_eject_page (d);
-}
-
-/* Skip down a single line on all active devices. */
-void
-som_blank_line (void)
-{
- struct outp_driver *d;
-
- for (d = outp_drivers (NULL); d; d = outp_drivers (d))
- if (d->page_open && d->cp_y != 0)
- d->cp_y += d->font_height;
-}
-\f
-/* Driver. */
-static struct outp_driver *d=0;
-
-/* Table. */
-static struct som_entity *t=0;
-
-/* Flags. */
-static unsigned flags;
-
-/* Number of columns, rows. */
-static int nc, nr;
-
-/* Number of columns or rows in left, right, top, bottom headers. */
-static int hl, hr, ht, hb;
-
-/* Column style. */
-static int cs;
-
-/* Table height, width. */
-static int th, tw;
-
-static void render_columns (void);
-static void render_simple (void);
-static void render_segments (void);
-
-static void output_entity (struct outp_driver *, struct som_entity *);
-
-/* Output table T to appropriate output devices. */
-void
-som_submit (struct som_entity *t)
-{
-#if GLOBAL_DEBUGGING
- static int entry;
-
- assert (entry++ == 0);
-#endif
-
- if ( t->type == SOM_TABLE)
- {
- t->class->table (t);
- t->class->flags (&flags);
- t->class->count (&nc, &nr);
- t->class->headers (&hl, &hr, &ht, &hb);
-
-
-#if GLOBAL_DEBUGGING
- if (hl + hr > nc || ht + hb > nr)
- {
- printf ("headers: (l,r)=(%d,%d), (t,b)=(%d,%d) in table size (%d,%d)\n",
- hl, hr, ht, hb, nc, nr);
- abort ();
- }
- else if (hl + hr == nc)
- printf ("warning: headers (l,r)=(%d,%d) in table width %d\n", hl, hr, nc);
- else if (ht + hb == nr)
- printf ("warning: headers (t,b)=(%d,%d) in table height %d\n", ht, hb, nr);
-#endif
-
- t->class->columns (&cs);
-
- if (!(flags & SOMF_NO_TITLE))
- subtable_num++;
-
- }
-
- {
- struct outp_driver *d;
-
- for (d = outp_drivers (NULL); d; d = outp_drivers (d))
- output_entity (d, t);
-
- }
-
-#if GLOBAL_DEBUGGING
- assert (--entry == 0);
-#endif
-}
-
-/* Output entity ENTITY to driver DRIVER. */
-static void
-output_entity (struct outp_driver *driver, struct som_entity *entity)
-{
- bool fits_width, fits_length;
- d = driver;
-
- assert (d->driver_open);
- if (!d->page_open && !d->class->open_page (d))
- {
- d->device = OUTP_DEV_DISABLED;
- return;
- }
-
- if (d->class->special || entity->type == SOM_CHART)
- {
- driver->class->submit (d, entity);
- return;
- }
-
- t = entity;
-
- t->class->driver (d);
- t->class->area (&tw, &th);
- fits_width = t->class->fits_width (d->width);
- fits_length = t->class->fits_length (d->length);
- if (!fits_width || !fits_length)
- {
- int tl, tr, tt, tb;
- tl = fits_width ? hl : 0;
- tr = fits_width ? hr : 0;
- tt = fits_length ? ht : 0;
- tb = fits_length ? hb : 0;
- t->class->set_headers (tl, tr, tt, tb);
- t->class->driver (d);
- t->class->area (&tw, &th);
- }
-
- if (!(flags & SOMF_NO_SPACING) && d->cp_y != 0)
- d->cp_y += d->font_height;
-
- if (cs != SOM_COL_NONE
- && 2 * (tw + d->prop_em_width) <= d->width
- && nr - (ht + hb) > 5)
- render_columns ();
- else if (tw < d->width && th + d->cp_y < d->length)
- render_simple ();
- else
- render_segments ();
-
- t->class->set_headers (hl, hr, ht, hb);
-}
-
-/* Render the table into multiple columns. */
-static void
-render_columns (void)
-{
- int y0, y1;
- int max_len = 0;
- int index = 0;
-
- assert (cs == SOM_COL_DOWN);
- assert (d->cp_x == 0);
-
- for (y0 = ht; y0 < nr - hb; y0 = y1)
- {
- int len;
-
- t->class->cumulate (SOM_ROWS, y0, &y1, d->length - d->cp_y, &len);
-
- if (y0 == y1)
- {
- assert (d->cp_y);
- outp_eject_page (d);
- } else {
- if (len > max_len)
- max_len = len;
-
- t->class->title (index++, 0);
- t->class->render (0, y0, nc, y1);
-
- d->cp_x += tw + 2 * d->prop_em_width;
- if (d->cp_x + tw > d->width)
- {
- d->cp_x = 0;
- d->cp_y += max_len;
- max_len = 0;
- }
- }
- }
-
- if (d->cp_x > 0)
- {
- d->cp_x = 0;
- d->cp_y += max_len;
- }
-}
-
-/* Render the table by itself on the current page. */
-static void
-render_simple (void)
-{
- assert (d->cp_x == 0);
- assert (tw < d->width && th + d->cp_y < d->length);
-
- t->class->title (0, 0);
- t->class->render (hl, ht, nc - hr, nr - hb);
- d->cp_y += th;
-}
-
-/* General table breaking routine. */
-static void
-render_segments (void)
-{
- int count = 0;
-
- int x_index;
- int x0, x1;
-
- assert (d->cp_x == 0);
-
- for (x_index = 0, x0 = hl; x0 < nc - hr; x0 = x1, x_index++)
- {
- int y_index;
- int y0, y1;
-
- t->class->cumulate (SOM_COLUMNS, x0, &x1, d->width, NULL);
- if (x_index == 0 && x1 != nc - hr)
- x_index++;
-
- for (y_index = 0, y0 = ht; y0 < nr - hb; y0 = y1, y_index++)
- {
- int len;
-
- if (count++ != 0 && d->cp_y != 0)
- d->cp_y += d->font_height;
-
- t->class->cumulate (SOM_ROWS, y0, &y1, d->length - d->cp_y, &len);
- if (y_index == 0 && y1 != nr - hb)
- y_index++;
-
- if (y0 == y1)
- {
- assert (d->cp_y);
- outp_eject_page (d);
- } else {
- t->class->title (x_index ? x_index : y_index,
- x_index ? y_index : 0);
- t->class->render (x0, y0, x1, y1);
-
- d->cp_y += len;
- }
- }
- }
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !som_h
-#define som_h 1
-
-/* Structured Output Manager.
-
- som considers the output stream to be a series of tables. Each
- table is made up of a rectangular grid of cells. Cells can be
- joined to form larger cells. Rows and columns can be separated by
- rules of various types. Tables too large to fit on a single page
- will be divided into sections. Rows and columns can be designated
- as headers, which causes them to be repeated in each section.
-
- Every table is an instance of a particular table class. A table
- class is responsible for keeping track of cell data, for handling
- requests from the som, and finally for rendering cell data to the
- output drivers. Tables may implement these operations in any way
- desired, and in fact almost every operation performed by som may be
- overridden in a table class. */
-
-#include <stdbool.h>
-
-enum som_type
- {
- SOM_TABLE,
- SOM_CHART
- } ;
-
-/* Entity (Table or Chart) . */
-struct som_entity
- {
- struct som_table_class *class; /* Table class. */
- enum som_type type; /* Table or Chart */
- void *ext; /* Owned by */
- };
-
-/* Group styles. */
-enum
- {
- SOM_COL_NONE, /* No columns. */
- SOM_COL_DOWN /* Columns down first. */
- };
-
-/* Cumulation types. */
-enum
- {
- SOM_ROWS, SOM_ROW = SOM_ROWS, /* Rows. */
- SOM_COLUMNS, SOM_COLUMN = SOM_COLUMNS /* Columns. */
- };
-
-/* Flags. */
-enum
- {
- SOMF_NONE = 0,
- SOMF_NO_SPACING = 01, /* No spacing before the table. */
- SOMF_NO_TITLE = 02 /* No title. */
- };
-
-/* Table class. */
-struct outp_driver;
-struct som_table_class
- {
- /* Set table, driver. */
- void (*table) (struct som_entity *);
- void (*driver) (struct outp_driver *);
-
- /* Query columns and rows. */
- void (*count) (int *n_columns, int *n_rows);
- void (*area) (int *horiz, int *vert);
- void (*width) (int *columns);
- void (*height) (int *rows);
- void (*columns) (int *style);
- int (*breakable) (int row); /* ? */
- void (*headers) (int *l, int *r, int *t, int *b);
- void (*join) (int *(column[2]), int *(row[2])); /* ? */
- void (*cumulate) (int cumtype, int start, int *end, int max, int *actual);
- void (*flags) (unsigned *);
- bool (*fits_width) (int width);
- bool (*fits_length) (int length);
-
- /* Set columns and rows. */
- void (*set_width) (int column, int width); /* ? */
- void (*set_height) (int row, int height); /* ? */
- void (*set_headers) (int l, int r, int t, int b);
-
- /* Rendering. */
- void (*title) (int x, int y);
- void (*render) (int x1, int y1, int x2, int y2);
- };
-
-/* Table indexes. */
-extern int table_num;
-extern int subtable_num;
-
-/* Submission. */
-void som_new_series (void);
-void som_submit (struct som_entity *t);
-
-/* Miscellaneous. */
-void som_eject_page (void);
-void som_blank_line (void);
-
-#endif /* som_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <sys/types.h>
-#include <assert.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "error.h"
-#include "lexer.h"
-#include "sort-prs.h"
-#include "sort.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-static bool is_terminator(int tok, const int *terminators);
-
-
-/* Parses a list of sort keys and returns a struct sort_criteria
- based on it. Returns a null pointer on error.
- If SAW_DIRECTION is nonnull, sets *SAW_DIRECTION to true if at
- least one parenthesized sort direction was specified, false
- otherwise.
- If TERMINATORS is non-null, then it must be a pointer to a
- null terminated list of tokens, in addition to the defaults,
- which are to be considered terminators of the clause being parsed.
- The default terminators are '/' and '.'
-
-*/
-struct sort_criteria *
-sort_parse_criteria (const struct dictionary *dict,
- struct variable ***vars, size_t *var_cnt,
- bool *saw_direction,
- const int *terminators
- )
-{
- struct sort_criteria *criteria;
- struct variable **local_vars = NULL;
- size_t local_var_cnt;
-
- assert ((vars == NULL) == (var_cnt == NULL));
- if (vars == NULL)
- {
- vars = &local_vars;
- var_cnt = &local_var_cnt;
- }
-
- criteria = xmalloc (sizeof *criteria);
- criteria->crits = NULL;
- criteria->crit_cnt = 0;
-
- *vars = NULL;
- *var_cnt = 0;
- if (saw_direction != NULL)
- *saw_direction = false;
-
- do
- {
- size_t prev_var_cnt = *var_cnt;
- enum sort_direction direction;
-
- /* Variables. */
- if (!parse_variables (dict, vars, var_cnt,
- PV_NO_DUPLICATE | PV_APPEND | PV_NO_SCRATCH))
- goto error;
-
- /* Sort direction. */
- if (lex_match ('('))
- {
- if (lex_match_id ("D") || lex_match_id ("DOWN"))
- direction = SRT_DESCEND;
- else if (lex_match_id ("A") || lex_match_id ("UP"))
- direction = SRT_ASCEND;
- else
- {
- msg (SE, _("`A' or `D' expected inside parentheses."));
- goto error;
- }
- if (!lex_match (')'))
- {
- msg (SE, _("`)' expected."));
- goto error;
- }
- if (saw_direction != NULL)
- *saw_direction = true;
- }
- else
- direction = SRT_ASCEND;
-
- criteria->crits = xnrealloc (criteria->crits,
- *var_cnt, sizeof *criteria->crits);
- criteria->crit_cnt = *var_cnt;
- for (; prev_var_cnt < criteria->crit_cnt; prev_var_cnt++)
- {
- struct sort_criterion *c = &criteria->crits[prev_var_cnt];
- c->fv = (*vars)[prev_var_cnt]->fv;
- c->width = (*vars)[prev_var_cnt]->width;
- c->dir = direction;
- }
- }
- while (token != '.' && token != '/' && !is_terminator(token, terminators));
-
- free (local_vars);
- return criteria;
-
- error:
- free (local_vars);
- sort_destroy_criteria (criteria);
- return NULL;
-}
-
-/* Return TRUE if TOK is a member of the list of TERMINATORS.
- FALSE otherwise */
-static bool
-is_terminator(int tok, const int *terminators)
-{
- if (terminators == NULL )
- return false;
-
- while ( *terminators)
- {
- if (tok == *terminators++)
- return true;
- }
-
- return false;
-}
-
-
-
-/* Destroys a SORT CASES program. */
-void
-sort_destroy_criteria (struct sort_criteria *criteria)
-{
- if (criteria != NULL)
- {
- free (criteria->crits);
- free (criteria);
- }
-}
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef SORT_PRS_H
-#define SORT_PRS_H
-
-#include <config.h>
-#include <stdbool.h>
-
-struct variable;
-struct dictionary;
-
-struct sort_criteria *sort_parse_criteria (const struct dictionary *,
- struct variable ***, size_t *,
- bool *saw_direction,
- const int *terminators
- );
-
-void sort_destroy_criteria (struct sort_criteria *criteria) ;
-
-
-#endif /* SORT_PRS_H */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "sort.h"
-#include "error.h"
-#include <limits.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <errno.h>
-#include "algorithm.h"
-#include "alloc.h"
-#include <stdbool.h>
-#include "case.h"
-#include "casefile.h"
-#include "command.h"
-#include "error.h"
-#include "expressions/public.h"
-#include "glob.h"
-#include "lexer.h"
-#include "misc.h"
-#include "settings.h"
-#include "sort-prs.h"
-#include "str.h"
-#include "var.h"
-#include "vfm.h"
-#include "vfmP.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-/* These should only be changed for testing purposes. */
-static int min_buffers = 64;
-static int max_buffers = INT_MAX;
-static bool allow_internal_sort = true;
-
-static int compare_record (const struct ccase *, const struct ccase *,
- const struct sort_criteria *);
-static struct casefile *do_internal_sort (struct casereader *,
- const struct sort_criteria *);
-static struct casefile *do_external_sort (struct casereader *,
- const struct sort_criteria *);
-
-/* Performs the SORT CASES procedures. */
-int
-cmd_sort_cases (void)
-{
- struct sort_criteria *criteria;
- bool success = false;
-
- lex_match (T_BY);
-
- criteria = sort_parse_criteria (default_dict, NULL, NULL, NULL, NULL);
- if (criteria == NULL)
- return CMD_FAILURE;
-
- if (get_testing_mode () && lex_match ('/'))
- {
- if (!lex_force_match_id ("BUFFERS") || !lex_match ('=')
- || !lex_force_int ())
- goto done;
-
- min_buffers = max_buffers = lex_integer ();
- allow_internal_sort = false;
- if (max_buffers < 2)
- {
- msg (SE, _("Buffer limit must be at least 2."));
- goto done;
- }
-
- lex_get ();
- }
-
- success = sort_active_file_in_place (criteria);
-
- done:
- min_buffers = 64;
- max_buffers = INT_MAX;
- allow_internal_sort = true;
-
- sort_destroy_criteria (criteria);
- return success ? lex_end_of_command () : CMD_FAILURE;
-}
-
-/* Gets ready to sort the active file, either in-place or to a
- separate casefile. */
-static void
-prepare_to_sort_active_file (void)
-{
- /* Cancel temporary transformations and PROCESS IF. */
- if (temporary != 0)
- cancel_temporary ();
- expr_free (process_if_expr);
- process_if_expr = NULL;
-
- /* Make sure source cases are in a storage source. */
- procedure (NULL, NULL);
- assert (case_source_is_class (vfm_source, &storage_source_class));
-}
-
-/* Sorts the active file in-place according to CRITERIA.
- Returns nonzero if successful. */
-int
-sort_active_file_in_place (const struct sort_criteria *criteria)
-{
- struct casefile *src, *dst;
-
- prepare_to_sort_active_file ();
-
- src = storage_source_get_casefile (vfm_source);
- dst = sort_execute (casefile_get_destructive_reader (src), criteria);
- free_case_source (vfm_source);
- vfm_source = NULL;
-
- if (dst == NULL)
- return 0;
-
- vfm_source = storage_source_create (dst);
- return 1;
-}
-
-/* Sorts the active file to a separate casefile. If successful,
- returns the sorted casefile. Returns a null pointer on
- failure. */
-struct casefile *
-sort_active_file_to_casefile (const struct sort_criteria *criteria)
-{
- struct casefile *src;
-
- prepare_to_sort_active_file ();
-
- src = storage_source_get_casefile (vfm_source);
- return sort_execute (casefile_get_reader (src), criteria);
-}
-
-
-/* Reads all the cases from READER, which is destroyed. Sorts
- the cases according to CRITERIA. Returns the sorted cases in
- a newly created casefile. */
-struct casefile *
-sort_execute (struct casereader *reader, const struct sort_criteria *criteria)
-{
- struct casefile *output = do_internal_sort (reader, criteria);
- if (output == NULL)
- output = do_external_sort (reader, criteria);
- casereader_destroy (reader);
- return output;
-}
-\f
-/* A case and its index. */
-struct indexed_case
- {
- struct ccase c; /* Case. */
- unsigned long idx; /* Index to allow for stable sorting. */
- };
-
-static int compare_indexed_cases (const void *, const void *, void *);
-
-/* If the data is in memory, do an internal sort and return a new
- casefile for the data. Otherwise, return a null pointer. */
-static struct casefile *
-do_internal_sort (struct casereader *reader,
- const struct sort_criteria *criteria)
-{
- const struct casefile *src;
- struct casefile *dst;
- unsigned long case_cnt;
-
- if (!allow_internal_sort)
- return NULL;
-
- src = casereader_get_casefile (reader);
- if (casefile_get_case_cnt (src) > 1 && !casefile_in_core (src))
- return NULL;
-
- case_cnt = casefile_get_case_cnt (src);
- dst = casefile_create (casefile_get_value_cnt (src));
- if (case_cnt != 0)
- {
- struct indexed_case *cases = nmalloc (sizeof *cases, case_cnt);
- if (cases != NULL)
- {
- unsigned long i;
-
- for (i = 0; i < case_cnt; i++)
- {
- casereader_read_xfer_assert (reader, &cases[i].c);
- cases[i].idx = i;
- }
-
- sort (cases, case_cnt, sizeof *cases, compare_indexed_cases,
- (void *) criteria);
-
- for (i = 0; i < case_cnt; i++)
- casefile_append_xfer (dst, &cases[i].c);
-
- free (cases);
- }
- else
- {
- /* Failure. */
- casefile_destroy (dst);
- dst = NULL;
- }
- }
-
- return dst;
-}
-
-/* Compares the variables specified by CRITERIA between the cases
- at A and B, with a "last resort" comparison for stability, and
- returns a strcmp()-type result. */
-static int
-compare_indexed_cases (const void *a_, const void *b_, void *criteria_)
-{
- struct sort_criteria *criteria = criteria_;
- const struct indexed_case *a = a_;
- const struct indexed_case *b = b_;
- int result = compare_record (&a->c, &b->c, criteria);
- if (result == 0)
- result = a->idx < b->idx ? -1 : a->idx > b->idx;
- return result;
-}
-\f
-/* External sort. */
-
-/* Maximum order of merge (external sort only). The maximum
- reasonable value is about 7. Above that, it would be a good
- idea to use a heap in merge_once() to select the minimum. */
-#define MAX_MERGE_ORDER 7
-
-/* Results of an external sort. */
-struct external_sort
- {
- const struct sort_criteria *criteria; /* Sort criteria. */
- size_t value_cnt; /* Size of data in `union value's. */
- struct casefile **runs; /* Array of initial runs. */
- size_t run_cnt, run_cap; /* Number of runs, allocated capacity. */
- };
-
-/* Prototypes for helper functions. */
-static int write_runs (struct external_sort *, struct casereader *);
-static struct casefile *merge (struct external_sort *);
-static void destroy_external_sort (struct external_sort *);
-
-/* Performs a stable external sort of the active file according
- to the specification in SCP. Forms initial runs using a heap
- as a reservoir. Merges the initial runs according to a
- pattern that assures stability. */
-static struct casefile *
-do_external_sort (struct casereader *reader,
- const struct sort_criteria *criteria)
-{
- struct external_sort *xsrt;
-
- casefile_to_disk (casereader_get_casefile (reader));
-
- xsrt = xmalloc (sizeof *xsrt);
- xsrt->criteria = criteria;
- xsrt->value_cnt = casefile_get_value_cnt (casereader_get_casefile (reader));
- xsrt->run_cap = 512;
- xsrt->run_cnt = 0;
- xsrt->runs = xnmalloc (xsrt->run_cap, sizeof *xsrt->runs);
- if (write_runs (xsrt, reader))
- {
- struct casefile *output = merge (xsrt);
- destroy_external_sort (xsrt);
- return output;
- }
- else
- {
- destroy_external_sort (xsrt);
- return NULL;
- }
-}
-
-/* Destroys XSRT. */
-static void
-destroy_external_sort (struct external_sort *xsrt)
-{
- if (xsrt != NULL)
- {
- int i;
-
- for (i = 0; i < xsrt->run_cnt; i++)
- casefile_destroy (xsrt->runs[i]);
- free (xsrt->runs);
- free (xsrt);
- }
-}
-\f
-/* Replacement selection. */
-
-/* Pairs a record with a run number. */
-struct record_run
- {
- int run; /* Run number of case. */
- struct ccase record; /* Case data. */
- size_t idx; /* Case number (for stability). */
- };
-
-/* Represents a set of initial runs during an external sort. */
-struct initial_run_state
- {
- struct external_sort *xsrt;
-
- /* Reservoir. */
- struct record_run *records; /* Records arranged as a heap. */
- size_t record_cnt; /* Current number of records. */
- size_t record_cap; /* Capacity for records. */
-
- /* Run currently being output. */
- int run; /* Run number. */
- size_t case_cnt; /* Number of cases so far. */
- struct casefile *casefile; /* Output file. */
- struct ccase last_output; /* Record last output. */
-
- int okay; /* Zero if an error has been encountered. */
- };
-
-static const struct case_sink_class sort_sink_class;
-
-static void destroy_initial_run_state (struct initial_run_state *);
-static void process_case (struct initial_run_state *, const struct ccase *,
- size_t);
-static int allocate_cases (struct initial_run_state *);
-static void output_record (struct initial_run_state *);
-static void start_run (struct initial_run_state *);
-static void end_run (struct initial_run_state *);
-static int compare_record_run (const struct record_run *,
- const struct record_run *,
- struct initial_run_state *);
-static int compare_record_run_minheap (const void *, const void *, void *);
-
-/* Reads cases from READER and composes initial runs in XSRT. */
-static int
-write_runs (struct external_sort *xsrt, struct casereader *reader)
-{
- struct initial_run_state *irs;
- struct ccase c;
- size_t idx = 0;
- int success = 0;
-
- /* Allocate memory for cases. */
- irs = xmalloc (sizeof *irs);
- irs->xsrt = xsrt;
- irs->records = NULL;
- irs->record_cnt = irs->record_cap = 0;
- irs->run = 0;
- irs->case_cnt = 0;
- irs->casefile = NULL;
- case_nullify (&irs->last_output);
- irs->okay = 1;
- if (!allocate_cases (irs))
- goto done;
-
- /* Create initial runs. */
- start_run (irs);
- for (; irs->okay && casereader_read (reader, &c); case_destroy (&c))
- process_case (irs, &c, idx++);
- while (irs->okay && irs->record_cnt > 0)
- output_record (irs);
- end_run (irs);
-
- success = irs->okay;
-
- done:
- destroy_initial_run_state (irs);
-
- return success;
-}
-
-/* Add a single case to an initial run. */
-static void
-process_case (struct initial_run_state *irs, const struct ccase *c, size_t idx)
-{
- struct record_run *rr;
-
- /* Compose record_run for this run and add to heap. */
- assert (irs->record_cnt < irs->record_cap - 1);
- rr = irs->records + irs->record_cnt++;
- case_copy (&rr->record, 0, c, 0, irs->xsrt->value_cnt);
- rr->run = irs->run;
- rr->idx = idx;
- if (!case_is_null (&irs->last_output)
- && compare_record (c, &irs->last_output, irs->xsrt->criteria) < 0)
- rr->run = irs->run + 1;
- push_heap (irs->records, irs->record_cnt, sizeof *irs->records,
- compare_record_run_minheap, irs);
-
- /* Output a record if the reservoir is full. */
- if (irs->record_cnt == irs->record_cap - 1 && irs->okay)
- output_record (irs);
-}
-
-/* Destroys the initial run state represented by IRS. */
-static void
-destroy_initial_run_state (struct initial_run_state *irs)
-{
- int i;
-
- if (irs == NULL)
- return;
-
- for (i = 0; i < irs->record_cap; i++)
- case_destroy (&irs->records[i].record);
- free (irs->records);
-
- if (irs->casefile != NULL)
- casefile_sleep (irs->casefile);
-
- free (irs);
-}
-
-/* Allocates room for lots of cases as a buffer. */
-static int
-allocate_cases (struct initial_run_state *irs)
-{
- int approx_case_cost; /* Approximate memory cost of one case in bytes. */
- int max_cases; /* Maximum number of cases to allocate. */
- int i;
-
- /* Allocate as many cases as we can within the workspace
- limit. */
- approx_case_cost = (sizeof *irs->records
- + irs->xsrt->value_cnt * sizeof (union value)
- + 4 * sizeof (void *));
- max_cases = get_workspace() / approx_case_cost;
- if (max_cases > max_buffers)
- max_cases = max_buffers;
- irs->records = nmalloc (sizeof *irs->records, max_cases);
- if (irs->records != NULL)
- for (i = 0; i < max_cases; i++)
- if (!case_try_create (&irs->records[i].record, irs->xsrt->value_cnt))
- {
- max_cases = i;
- break;
- }
- irs->record_cap = max_cases;
-
- /* Fail if we didn't allocate an acceptable number of cases. */
- if (irs->records == NULL || max_cases < min_buffers)
- {
- msg (SE, _("Out of memory. Could not allocate room for minimum of %d "
- "cases of %d bytes each. (PSPP workspace is currently "
- "restricted to a maximum of %d KB.)"),
- min_buffers, approx_case_cost, get_workspace() / 1024);
- return 0;
- }
- return 1;
-}
-
-/* Compares the VAR_CNT variables in VARS[] between the `value's at
- A and B, and returns a strcmp()-type result. */
-static int
-compare_record (const struct ccase *a, const struct ccase *b,
- const struct sort_criteria *criteria)
-{
- int i;
-
- assert (a != NULL);
- assert (b != NULL);
-
- for (i = 0; i < criteria->crit_cnt; i++)
- {
- const struct sort_criterion *c = &criteria->crits[i];
- int result;
-
- if (c->width == 0)
- {
- double af = case_num (a, c->fv);
- double bf = case_num (b, c->fv);
-
- result = af < bf ? -1 : af > bf;
- }
- else
- result = memcmp (case_str (a, c->fv), case_str (b, c->fv), c->width);
-
- if (result != 0)
- return c->dir == SRT_ASCEND ? result : -result;
- }
-
- return 0;
-}
-
-/* Compares record-run tuples A and B on run number first, then
- on record, then on case index. */
-static int
-compare_record_run (const struct record_run *a,
- const struct record_run *b,
- struct initial_run_state *irs)
-{
- int result = a->run < b->run ? -1 : a->run > b->run;
- if (result == 0)
- result = compare_record (&a->record, &b->record, irs->xsrt->criteria);
- if (result == 0)
- result = a->idx < b->idx ? -1 : a->idx > b->idx;
- return result;
-}
-
-/* Compares record-run tuples A and B on run number first, then
- on the current record according to SCP, but in descending
- order. */
-static int
-compare_record_run_minheap (const void *a, const void *b, void *irs)
-{
- return -compare_record_run (a, b, irs);
-}
-
-/* Begins a new initial run, specifically its output file. */
-static void
-start_run (struct initial_run_state *irs)
-{
- irs->run++;
- irs->case_cnt = 0;
- irs->casefile = casefile_create (irs->xsrt->value_cnt);
- casefile_to_disk (irs->casefile);
- case_nullify (&irs->last_output);
-}
-
-/* Ends the current initial run. */
-static void
-end_run (struct initial_run_state *irs)
-{
- struct external_sort *xsrt = irs->xsrt;
-
- /* Record initial run. */
- if (irs->casefile != NULL)
- {
- casefile_sleep (irs->casefile);
- if (xsrt->run_cnt >= xsrt->run_cap)
- {
- xsrt->run_cap *= 2;
- xsrt->runs = xnrealloc (xsrt->runs,
- xsrt->run_cap, sizeof *xsrt->runs);
- }
- xsrt->runs[xsrt->run_cnt++] = irs->casefile;
- irs->casefile = NULL;
- }
-}
-
-/* Writes a record to the current initial run. */
-static void
-output_record (struct initial_run_state *irs)
-{
- struct record_run *record_run;
- struct ccase case_tmp;
-
- /* Extract minimum case from heap. */
- assert (irs->record_cnt > 0);
- pop_heap (irs->records, irs->record_cnt--, sizeof *irs->records,
- compare_record_run_minheap, irs);
- record_run = irs->records + irs->record_cnt;
-
- /* Bail if an error has occurred. */
- if (!irs->okay)
- return;
-
- /* Start new run if necessary. */
- assert (record_run->run == irs->run
- || record_run->run == irs->run + 1);
- if (record_run->run != irs->run)
- {
- end_run (irs);
- start_run (irs);
- }
- assert (record_run->run == irs->run);
- irs->case_cnt++;
-
- /* Write to disk. */
- if (irs->casefile != NULL)
- casefile_append (irs->casefile, &record_run->record);
-
- /* This record becomes last_output. */
- irs->last_output = case_tmp = record_run->record;
- record_run->record = irs->records[irs->record_cap - 1].record;
- irs->records[irs->record_cap - 1].record = case_tmp;
-}
-\f
-/* Merging. */
-
-static int choose_merge (struct casefile *runs[], int run_cnt, int order);
-static struct casefile *merge_once (struct external_sort *,
- struct casefile *[], size_t);
-
-/* Repeatedly merges run until only one is left,
- and returns the final casefile. */
-static struct casefile *
-merge (struct external_sort *xsrt)
-{
- while (xsrt->run_cnt > 1)
- {
- int order = min (MAX_MERGE_ORDER, xsrt->run_cnt);
- int idx = choose_merge (xsrt->runs, xsrt->run_cnt, order);
- xsrt->runs[idx] = merge_once (xsrt, xsrt->runs + idx, order);
- remove_range (xsrt->runs, xsrt->run_cnt, sizeof *xsrt->runs,
- idx + 1, order - 1);
- xsrt->run_cnt -= order - 1;
- }
- assert (xsrt->run_cnt == 1);
- xsrt->run_cnt = 0;
- return xsrt->runs[0];
-}
-
-/* Chooses ORDER runs out of the RUN_CNT runs in RUNS to merge,
- and returns the index of the first one.
-
- For stability, we must merge only consecutive runs. For
- efficiency, we choose the shortest consecutive sequence of
- runs. */
-static int
-choose_merge (struct casefile *runs[], int run_cnt, int order)
-{
- int min_idx, min_sum;
- int cur_idx, cur_sum;
- int i;
-
- /* Sum up the length of the first ORDER runs. */
- cur_sum = 0;
- for (i = 0; i < order; i++)
- cur_sum += casefile_get_case_cnt (runs[i]);
-
- /* Find the shortest group of ORDER runs,
- using a running total for efficiency. */
- min_idx = 0;
- min_sum = cur_sum;
- for (cur_idx = 1; cur_idx + order <= run_cnt; cur_idx++)
- {
- cur_sum -= casefile_get_case_cnt (runs[cur_idx - 1]);
- cur_sum += casefile_get_case_cnt (runs[cur_idx + order - 1]);
- if (cur_sum < min_sum)
- {
- min_sum = cur_sum;
- min_idx = cur_idx;
- }
- }
-
- return min_idx;
-}
-
-/* Merges the RUN_CNT initial runs specified in INPUT_FILES into a
- new run, and returns the new run. */
-static struct casefile *
-merge_once (struct external_sort *xsrt,
- struct casefile **const input_files,
- size_t run_cnt)
-{
- struct run
- {
- struct casefile *file;
- struct casereader *reader;
- struct ccase ccase;
- }
- *runs;
-
- struct casefile *output = NULL;
- int i;
-
- /* Open input files. */
- runs = xnmalloc (run_cnt, sizeof *runs);
- for (i = 0; i < run_cnt; i++)
- {
- struct run *r = &runs[i];
- r->file = input_files[i];
- r->reader = casefile_get_destructive_reader (r->file);
- if (!casereader_read_xfer (r->reader, &r->ccase))
- {
- run_cnt--;
- i--;
- }
- }
-
- /* Create output file. */
- output = casefile_create (xsrt->value_cnt);
- casefile_to_disk (output);
-
- /* Merge. */
- while (run_cnt > 0)
- {
- struct run *min_run, *run;
-
- /* Find minimum. */
- min_run = runs;
- for (run = runs + 1; run < runs + run_cnt; run++)
- if (compare_record (&run->ccase, &min_run->ccase, xsrt->criteria) < 0)
- min_run = run;
-
- /* Write minimum to output file. */
- casefile_append_xfer (output, &min_run->ccase);
-
- /* Read another case from minimum run. */
- if (!casereader_read_xfer (min_run->reader, &min_run->ccase))
- {
- casereader_destroy (min_run->reader);
- casefile_destroy (min_run->file);
-
- remove_element (runs, run_cnt, sizeof *runs, min_run - runs);
- run_cnt--;
- }
- }
-
- casefile_sleep (output);
- free (runs);
-
- return output;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !sort_h
-#define sort_h 1
-
-#include <stddef.h>
-#include <stdbool.h>
-
-struct casereader;
-struct dictionary;
-struct variable;
-
-
-/* Sort direction. */
-enum sort_direction
- {
- SRT_ASCEND, /* A, B, C, ..., X, Y, Z. */
- SRT_DESCEND /* Z, Y, X, ..., C, B, A. */
- };
-
-/* A sort criterion. */
-struct sort_criterion
- {
- int fv; /* Variable data index. */
- int width; /* 0=numeric, otherwise string width. */
- enum sort_direction dir; /* Sort direction. */
- };
-
-/* A set of sort criteria. */
-struct sort_criteria
- {
- struct sort_criterion *crits;
- size_t crit_cnt;
- };
-
-
-void sort_destroy_criteria (struct sort_criteria *);
-
-struct casefile *sort_execute (struct casereader *,
- const struct sort_criteria *);
-
-int sort_active_file_in_place (const struct sort_criteria *);
-
-struct casefile *sort_active_file_to_casefile (const struct sort_criteria *);
-
-#endif /* !sort_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "lexer.h"
-#include "str.h"
-#include "var.h"
-
-int
-cmd_split_file (void)
-{
- if (lex_match_id ("OFF"))
- dict_set_split_vars (default_dict, NULL, 0);
- else
- {
- struct variable **v;
- size_t n;
-
- /* For now, ignore SEPARATE and LAYERED. */
- lex_match_id ("SEPARATE") || lex_match_id ("LAYERED");
-
- lex_match (T_BY);
- if (!parse_variables (default_dict, &v, &n, PV_NO_DUPLICATE))
- return CMD_FAILURE;
-
- dict_set_split_vars (default_dict, v, n);
- free (v);
- }
-
- return lex_end_of_command ();
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "str.h"
-#include "error.h"
-#include <ctype.h>
-#include <limits.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "error.h"
-\f
-/* sprintf() wrapper functions for convenience. */
-
-#if !__GNUC__
-char *
-spprintf (char *buf, const char *format,...)
-{
-#if HAVE_GOOD_SPRINTF
- int count;
-#endif
- va_list args;
-
- va_start (args, format);
-#if HAVE_GOOD_SPRINTF
- count =
-#endif
- vsprintf (buf, format, args);
- va_end (args);
-
-#if HAVE_GOOD_SPRINTF
- return &buf[count];
-#else
- return strchr (buf, 0);
-#endif
-}
-#endif /* !__GNUC__ */
-
-#if !__GNUC__ && !HAVE_GOOD_SPRINTF
-int
-nsprintf (char *buf, const char *format,...)
-{
- va_list args;
-
- va_start (args, format);
- vsprintf (buf, format, args);
- va_end (args);
-
- return strlen (buf);
-}
-
-int
-nvsprintf (char *buf, const char *format, va_list args)
-{
- vsprintf (buf, format, args);
- return strlen (buf);
-}
-#endif /* Not GNU C and not good sprintf(). */
-\f
-/* Reverses the order of NBYTES bytes at address P, thus converting
- between little- and big-endian byte orders. */
-void
-buf_reverse (char *p, size_t nbytes)
-{
- char *h = p, *t = &h[nbytes - 1];
- char temp;
-
- nbytes /= 2;
- while (nbytes--)
- {
- temp = *h;
- *h++ = *t;
- *t-- = temp;
- }
-}
-
-/* Finds the last NEEDLE of length NEEDLE_LEN in a HAYSTACK of length
- HAYSTACK_LEN. Returns a pointer to the needle found. */
-char *
-buf_find_reverse (const char *haystack, size_t haystack_len,
- const char *needle, size_t needle_len)
-{
- int i;
- for (i = haystack_len - needle_len; i >= 0; i--)
- if (!memcmp (needle, &haystack[i], needle_len))
- return (char *) &haystack[i];
- return 0;
-}
-
-/* Compares the SIZE bytes in A to those in B, disregarding case,
- and returns a strcmp()-type result. */
-int
-buf_compare_case (const char *a_, const char *b_, size_t size)
-{
- const unsigned char *a = (unsigned char *) a_;
- const unsigned char *b = (unsigned char *) b_;
-
- while (size-- > 0)
- {
- unsigned char ac = toupper (*a++);
- unsigned char bc = toupper (*b++);
-
- if (ac != bc)
- return ac > bc ? 1 : -1;
- }
-
- return 0;
-}
-
-/* Compares A of length A_LEN to B of length B_LEN. The shorter
- string is considered to be padded with spaces to the length of
- the longer. */
-int
-buf_compare_rpad (const char *a, size_t a_len, const char *b, size_t b_len)
-{
- size_t min_len;
- int result;
-
- min_len = a_len < b_len ? a_len : b_len;
- result = memcmp (a, b, min_len);
- if (result != 0)
- return result;
- else
- {
- size_t idx;
-
- if (a_len < b_len)
- {
- for (idx = min_len; idx < b_len; idx++)
- if (' ' != b[idx])
- return ' ' > b[idx] ? 1 : -1;
- }
- else
- {
- for (idx = min_len; idx < a_len; idx++)
- if (a[idx] != ' ')
- return a[idx] > ' ' ? 1 : -1;
- }
- return 0;
- }
-}
-
-/* Compares strin A to string B. The shorter string is
- considered to be padded with spaces to the length of the
- longer. */
-int
-str_compare_rpad (const char *a, const char *b)
-{
- return buf_compare_rpad (a, strlen (a), b, strlen (b));
-}
-
-/* Copies string SRC to buffer DST, of size DST_SIZE bytes.
- DST is truncated to DST_SIZE bytes or padded on the right with
- spaces as needed. */
-void
-buf_copy_str_rpad (char *dst, size_t dst_size, const char *src)
-{
- size_t src_len = strlen (src);
- if (src_len >= dst_size)
- memcpy (dst, src, dst_size);
- else
- {
- memcpy (dst, src, src_len);
- memset (&dst[src_len], ' ', dst_size - src_len);
- }
-}
-
-/* Copies string SRC to buffer DST, of size DST_SIZE bytes.
- DST is truncated to DST_SIZE bytes or padded on the left with
- spaces as needed. */
-void
-buf_copy_str_lpad (char *dst, size_t dst_size, const char *src)
-{
- size_t src_len = strlen (src);
- if (src_len >= dst_size)
- memcpy (dst, src, dst_size);
- else
- {
- size_t pad_cnt = dst_size - src_len;
- memset (&dst[0], ' ', pad_cnt);
- memcpy (dst + pad_cnt, src, src_len);
- }
-}
-
-/* Copies buffer SRC, of SRC_SIZE bytes, to DST, of DST_SIZE bytes.
- DST is truncated to DST_SIZE bytes or padded on the right with
- spaces as needed. */
-void
-buf_copy_rpad (char *dst, size_t dst_size,
- const char *src, size_t src_size)
-{
- if (src_size >= dst_size)
- memmove (dst, src, dst_size);
- else
- {
- memmove (dst, src, src_size);
- memset (&dst[src_size], ' ', dst_size - src_size);
- }
-}
-
-/* Copies string SRC to string DST, which is in a buffer DST_SIZE
- bytes long.
- Truncates DST to DST_SIZE - 1 characters or right-pads with
- spaces to DST_SIZE - 1 characters if necessary. */
-void
-str_copy_rpad (char *dst, size_t dst_size, const char *src)
-{
- size_t src_len = strlen (src);
- if (src_len < dst_size - 1)
- {
- memcpy (dst, src, src_len);
- memset (&dst[src_len], ' ', dst_size - 1 - src_len);
- }
- else
- memcpy (dst, src, dst_size - 1);
- dst[dst_size - 1] = 0;
-}
-
-/* Copies SRC to DST, which is in a buffer DST_SIZE bytes long.
- Truncates DST to DST_SIZE - 1 characters, if necessary. */
-void
-str_copy_trunc (char *dst, size_t dst_size, const char *src)
-{
- size_t src_len = strlen (src);
- assert (dst_size > 0);
- if (src_len + 1 < dst_size)
- memcpy (dst, src, src_len + 1);
- else
- {
- memcpy (dst, src, dst_size - 1);
- dst[dst_size - 1] = '\0';
- }
-}
-
-/* Copies buffer SRC, of SRC_LEN bytes,
- to DST, which is in a buffer DST_SIZE bytes long.
- Truncates DST to DST_SIZE - 1 characters, if necessary. */
-void
-str_copy_buf_trunc (char *dst, size_t dst_size,
- const char *src, size_t src_size)
-{
- size_t dst_len;
- assert (dst_size > 0);
-
- dst_len = src_size < dst_size ? src_size : dst_size - 1;
- memcpy (dst, src, dst_len);
- dst[dst_len] = '\0';
-}
-
-/* Converts each character in S to uppercase. */
-void
-str_uppercase (char *s)
-{
- for (; *s != '\0'; s++)
- *s = toupper ((unsigned char) *s);
-}
-
-/* Converts each character in S to lowercase. */
-void
-str_lowercase (char *s)
-{
- for (; *s != '\0'; s++)
- *s = tolower ((unsigned char) *s);
-}
-\f
-/* Initializes ST with initial contents S. */
-void
-ds_create (struct string *st, const char *s)
-{
- st->length = strlen (s);
- st->capacity = 8 + st->length * 2;
- st->string = xmalloc (st->capacity + 1);
- strcpy (st->string, s);
-}
-
-/* Initializes ST, making room for at least CAPACITY characters. */
-void
-ds_init (struct string *st, size_t capacity)
-{
- st->length = 0;
- if (capacity > 8)
- st->capacity = capacity;
- else
- st->capacity = 8;
- st->string = xmalloc (st->capacity + 1);
-}
-
-/* Replaces the contents of ST with STRING. STRING may overlap with
- ST. */
-void
-ds_replace (struct string *st, const char *string)
-{
- size_t new_length = strlen (string);
- if (new_length > st->capacity)
- {
- /* The new length is longer than the allocated length, so
- there can be no overlap. */
- st->length = 0;
- ds_concat (st, string, new_length);
- }
- else
- {
- /* Overlap is possible, but the new string will fit in the
- allocated space, so we can just copy data. */
- st->length = new_length;
- memmove (st->string, string, st->length);
- }
-}
-
-/* Frees ST. */
-void
-ds_destroy (struct string *st)
-{
- free (st->string);
- st->string = NULL;
-}
-
-/* Truncates ST to zero length. */
-void
-ds_clear (struct string *st)
-{
- st->length = 0;
-}
-
-/* Pad ST on the right with copies of PAD until ST is at least
- LENGTH characters in size. If ST is initially LENGTH
- characters or longer, this is a no-op. */
-void
-ds_rpad (struct string *st, size_t length, char pad)
-{
- assert (st != NULL);
- if (st->length < length)
- {
- if (st->capacity < length)
- ds_extend (st, length);
- memset (&st->string[st->length], pad, length - st->length);
- st->length = length;
- }
-}
-
-/* Ensures that ST can hold at least MIN_CAPACITY characters plus a null
- terminator. */
-void
-ds_extend (struct string *st, size_t min_capacity)
-{
- if (min_capacity > st->capacity)
- {
- st->capacity *= 2;
- if (st->capacity < min_capacity)
- st->capacity = min_capacity * 2;
-
- st->string = xrealloc (st->string, st->capacity + 1);
- }
-}
-
-/* Shrink ST to the minimum capacity need to contain its content. */
-void
-ds_shrink (struct string *st)
-{
- if (st->capacity != st->length)
- {
- st->capacity = st->length;
- st->string = xrealloc (st->string, st->capacity + 1);
- }
-}
-
-/* Truncates ST to at most LENGTH characters long. */
-void
-ds_truncate (struct string *st, size_t length)
-{
- if (length >= st->length)
- return;
- st->length = length;
-}
-
-/* Returns the length of ST. */
-size_t
-ds_length (const struct string *st)
-{
- return st->length;
-}
-
-/* Returns the allocation size of ST. */
-size_t
-ds_capacity (const struct string *st)
-{
- return st->capacity;
-}
-
-/* Returns the value of ST as a null-terminated string. */
-char *
-ds_c_str (const struct string *st)
-{
- ((char *) st->string)[st->length] = '\0';
- return st->string;
-}
-
-/* Returns the string data inside ST. */
-char *
-ds_data (const struct string *st)
-{
- return st->string;
-}
-
-/* Returns a pointer to the null terminator ST.
- This might not be an actual null character unless ds_c_str() has
- been called since the last modification to ST. */
-char *
-ds_end (const struct string *st)
-{
- return st->string + st->length;
-}
-
-/* Concatenates S onto ST. */
-void
-ds_puts (struct string *st, const char *s)
-{
- size_t s_len;
-
- if (!s) return;
-
- s_len = strlen (s);
- ds_extend (st, st->length + s_len);
- strcpy (st->string + st->length, s);
- st->length += s_len;
-}
-
-/* Concatenates LEN characters from BUF onto ST. */
-void
-ds_concat (struct string *st, const char *buf, size_t len)
-{
- ds_extend (st, st->length + len);
- memcpy (st->string + st->length, buf, len);
- st->length += len;
-}
-
-void ds_vprintf (struct string *st, const char *format, va_list args);
-
-
-/* Formats FORMAT as a printf string and appends the result to ST. */
-void
-ds_printf (struct string *st, const char *format, ...)
-{
- va_list args;
-
- va_start (args, format);
- ds_vprintf(st,format,args);
- va_end (args);
-
-}
-
-/* Formats FORMAT as a printf string and appends the result to ST. */
-void
-ds_vprintf (struct string *st, const char *format, va_list args)
-{
- /* Fscking glibc silently changed behavior between 2.0 and 2.1.
- Fsck fsck fsck. Before, it returned -1 on buffer overflow. Now,
- it returns the number of characters (not bytes) that would have
- been written. */
-
- int avail, needed;
- va_list a1;
-
- va_copy(a1, args);
- avail = st->capacity - st->length + 1;
- needed = vsnprintf (st->string + st->length, avail, format, args);
-
-
- if (needed >= avail)
- {
- ds_extend (st, st->length + needed);
-
- vsprintf (st->string + st->length, format, a1);
- }
- else
- while (needed == -1)
- {
- va_list a2;
- va_copy(a2, a1);
-
- ds_extend (st, (st->capacity + 1) * 2);
- avail = st->capacity - st->length + 1;
-
- needed = vsnprintf (st->string + st->length, avail, format, a2);
- va_end(a2);
-
- }
- va_end(a1);
-
- st->length += needed;
-}
-
-/* Appends character CH to ST. */
-void
-ds_putc (struct string *st, int ch)
-{
- if (st->length == st->capacity)
- ds_extend (st, st->length + 1);
- st->string[st->length++] = ch;
-}
-
-/* Appends to ST a newline-terminated line read from STREAM.
- Newline is the last character of ST on return, unless an I/O error
- or end of file is encountered after reading some characters.
- Returns 1 if a line is successfully read, or 0 if no characters at
- all were read before an I/O error or end of file was
- encountered. */
-int
-ds_gets (struct string *st, FILE *stream)
-{
- int c;
-
- c = getc (stream);
- if (c == EOF)
- return 0;
-
- for (;;)
- {
- ds_putc (st, c);
- if (c == '\n')
- return 1;
-
- c = getc (stream);
- if (c == EOF)
- return 1;
- }
-}
-
-/* Reads a line from STREAM into ST, then preprocesses as follows:
-
- - Splices lines terminated with `\'.
-
- - Deletes comments introduced by `#' outside of single or double
- quotes.
-
- - Trailing whitespace will be deleted.
-
- Increments cust_ln as appropriate.
-
- Returns nonzero only if a line was successfully read. */
-int
-ds_get_config_line (FILE *stream, struct string *st, struct file_locator *where)
-{
- /* Read the first line. */
- ds_clear (st);
- where->line_number++;
- if (!ds_gets (st, stream))
- return 0;
-
- /* Read additional lines, if any. */
- for (;;)
- {
- /* Remove trailing whitespace. */
- {
- char *s = ds_c_str (st);
- size_t len = ds_length (st);
-
- while (len > 0 && isspace ((unsigned char) s[len - 1]))
- len--;
- ds_truncate (st, len);
- }
-
- /* Check for trailing \. Remove if found, bail otherwise. */
- if (ds_length (st) == 0 || ds_c_str (st)[ds_length (st) - 1] != '\\')
- break;
- ds_truncate (st, ds_length (st) - 1);
-
- /* Append another line and go around again. */
- {
- int success = ds_gets (st, stream);
- where->line_number++;
- if (!success)
- return 1;
- }
- }
-
- /* Find a comment and remove. */
- {
- char *cp;
- int quote = 0;
-
- for (cp = ds_c_str (st); *cp; cp++)
- if (quote)
- {
- if (*cp == quote)
- quote = 0;
- else if (*cp == '\\')
- cp++;
- }
- else if (*cp == '\'' || *cp == '"')
- quote = *cp;
- else if (*cp == '#')
- {
- ds_truncate (st, cp - ds_c_str (st));
- break;
- }
- }
-
- return 1;
-}
-\f
-/* Lengthed strings. */
-
-/* Creates a new lengthed string LS with contents as a copy of
- S. */
-void
-ls_create (struct fixed_string *ls, const char *s)
-{
- ls->length = strlen (s);
- ls->string = xmalloc (ls->length + 1);
- memcpy (ls->string, s, ls->length + 1);
-}
-
-/* Creates a new lengthed string LS with contents as a copy of
- BUFFER with length LEN. */
-void
-ls_create_buffer (struct fixed_string *ls,
- const char *buffer, size_t len)
-{
- ls->length = len;
- ls->string = xmalloc (len + 1);
- memcpy (ls->string, buffer, len);
- ls->string[len] = '\0';
-}
-
-/* Sets the fields of LS to the specified values. */
-void
-ls_init (struct fixed_string *ls, const char *string, size_t length)
-{
- ls->string = (char *) string;
- ls->length = length;
-}
-
-/* Copies the fields of SRC to DST. */
-void
-ls_shallow_copy (struct fixed_string *dst, const struct fixed_string *src)
-{
- *dst = *src;
-}
-
-/* Frees the memory backing LS. */
-void
-ls_destroy (struct fixed_string *ls)
-{
- free (ls->string);
-}
-
-/* Sets LS to a null pointer value. */
-void
-ls_null (struct fixed_string *ls)
-{
- ls->string = NULL;
-}
-
-/* Returns nonzero only if LS has a null pointer value. */
-int
-ls_null_p (const struct fixed_string *ls)
-{
- return ls->string == NULL;
-}
-
-/* Returns nonzero only if LS is a null pointer or has length 0. */
-int
-ls_empty_p (const struct fixed_string *ls)
-{
- return ls->string == NULL || ls->length == 0;
-}
-
-/* Returns the length of LS, which must not be null. */
-size_t
-ls_length (const struct fixed_string *ls)
-{
- return ls->length;
-}
-
-/* Returns a pointer to the character string in LS. */
-char *
-ls_c_str (const struct fixed_string *ls)
-{
- return (char *) ls->string;
-}
-
-/* Returns a pointer to the null terminator of the character string in
- LS. */
-char *
-ls_end (const struct fixed_string *ls)
-{
- return (char *) (ls->string + ls->length);
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !str_h
-#define str_h 1
-
-/* Headers and miscellaneous. */
-
-#include <stdarg.h>
-#include <stdio.h>
-#include <string.h>
-
-#include "memmem.h"
-#include "snprintf.h"
-#include "stpcpy.h"
-#include "strcase.h"
-#include "strftime.h"
-#include "strstr.h"
-#include "strtok_r.h"
-#include "vsnprintf.h"
-#include "xvasprintf.h"
-
-#ifndef HAVE_STRCHR
-#define strchr index
-#endif
-#ifndef HAVE_STRRCHR
-#define strrchr rindex
-#endif
-\f
-/* sprintf() wrapper functions for convenience. */
-
-/* spprintf() calls sprintf() and returns the address of the null
- terminator in the resulting string. It should be portable the way
- it's been implemented. */
-#if __GNUC__
- #if HAVE_GOOD_SPRINTF
- #define spprintf(BUF, FORMAT, ARGS...) \
- ((BUF) + sprintf ((BUF), (FORMAT) , ## ARGS))
- #else
- #define spprintf(BUF, FORMAT, ARGS...) \
- ({ sprintf ((BUF), (FORMAT) , ## ARGS); \
- strchr ((BUF), 0); })
- #endif
-#else /* Not GNU C. */
- char *spprintf (char *buf, const char *format, ...);
-#endif /* Not GNU C. */
-
-/* nsprintf() calls sprintf() and returns the strlen() of the
- resulting string. It should be portable the way it's been
- implemented. */
-#if __GNUC__
- #if HAVE_GOOD_SPRINTF
- #define nsprintf(BUF, FORMAT, ARGS...) \
- (sprintf ((BUF), (FORMAT) , ## ARGS))
- #define nvsprintf(BUF, FORMAT, ARGS) \
- (vsprintf ((BUF), (FORMAT), (ARGS)))
- #else /* Not good sprintf(). */
- #define nsprintf(BUF, FORMAT, ARGS...) \
- ({ \
- char *pbuf = BUF; \
- sprintf ((pbuf), (FORMAT) , ## ARGS); \
- strlen (pbuf); \
- })
- #define nvsprintf(BUF, FORMAT, ARGS) \
- ({ \
- char *pbuf = BUF; \
- vsprintf ((pbuf), (FORMAT), (ARGS)); \
- strlen (pbuf); \
- })
- #endif /* Not good sprintf(). */
-#else /* Not GNU C. */
- #if HAVE_GOOD_SPRINTF
- #define nsprintf sprintf
- #define nvsprintf vsprintf
- #else /* Not good sprintf(). */
- int nsprintf (char *buf, const char *format, ...);
- int nvsprintf (char *buf, const char *format, va_list args);
- #endif /* Not good sprintf(). */
-#endif /* Not GNU C. */
-\f
-/* Miscellaneous. */
-
-void buf_reverse (char *, size_t);
-char *buf_find_reverse (const char *, size_t, const char *, size_t);
-int buf_compare_case (const char *, const char *, size_t);
-int buf_compare_rpad (const char *, size_t, const char *, size_t);
-void buf_copy_rpad (char *, size_t, const char *, size_t);
-void buf_copy_str_lpad (char *, size_t, const char *);
-void buf_copy_str_rpad (char *, size_t, const char *);
-
-int str_compare_rpad (const char *, const char *);
-void str_copy_rpad (char *, size_t, const char *);
-void str_copy_trunc (char *, size_t, const char *);
-void str_copy_buf_trunc (char *, size_t, const char *, size_t);
-void str_uppercase (char *);
-void str_lowercase (char *);
-\f
-/* Fixed-length strings. */
-struct fixed_string
- {
- char *string;
- size_t length;
- };
-
-void ls_create (struct fixed_string *, const char *);
-void ls_create_buffer (struct fixed_string *,
- const char *, size_t len);
-void ls_init (struct fixed_string *, const char *, size_t);
-void ls_shallow_copy (struct fixed_string *, const struct fixed_string *);
-void ls_destroy (struct fixed_string *);
-
-void ls_null (struct fixed_string *);
-int ls_null_p (const struct fixed_string *);
-int ls_empty_p (const struct fixed_string *);
-
-size_t ls_length (const struct fixed_string *);
-char *ls_c_str (const struct fixed_string *);
-char *ls_end (const struct fixed_string *);
-
-#if __GNUC__ > 1
-extern inline size_t
-ls_length (const struct fixed_string *st)
-{
- return st->length;
-}
-
-extern inline char *
-ls_c_str (const struct fixed_string *st)
-{
- return st->string;
-}
-
-extern inline char *
-ls_end (const struct fixed_string *st)
-{
- return st->string + st->length;
-}
-#endif
-\f
-/* Variable length strings. */
-
-struct string
- {
- size_t length; /* Length, not including a null terminator. */
- size_t capacity; /* Allocated capacity, not including one
- extra byte allocated for null terminator. */
- char *string; /* String data, not necessarily null
- terminated. */
- };
-
-/* Constructors, destructors. */
-void ds_create (struct string *, const char *);
-void ds_init (struct string *, size_t);
-void ds_destroy (struct string *);
-
-/* Copy, shrink, extend. */
-void ds_replace (struct string *, const char *);
-void ds_clear (struct string *);
-void ds_extend (struct string *, size_t);
-void ds_shrink (struct string *);
-void ds_truncate (struct string *, size_t);
-void ds_rpad (struct string *, size_t length, char pad);
-
-/* Inspectors. */
-size_t ds_length (const struct string *);
-char *ds_c_str (const struct string *);
-char *ds_data (const struct string *);
-char *ds_end (const struct string *);
-size_t ds_capacity (const struct string *);
-
-/* File input. */
-struct file_locator;
-int ds_gets (struct string *, FILE *);
-int ds_get_config_line (FILE *, struct string *, struct file_locator *);
-
-/* Append. */
-void ds_putc (struct string *, int ch);
-void ds_puts (struct string *, const char *);
-void ds_concat (struct string *, const char *, size_t);
-void ds_vprintf (struct string *st, const char *, va_list);
-void ds_printf (struct string *, const char *, ...)
- PRINTF_FORMAT (2, 3);
-
-#if __GNUC__ > 1
-extern inline void
-ds_putc (struct string *st, int ch)
-{
- if (st->length == st->capacity)
- ds_extend (st, st->length + 1);
- st->string[st->length++] = ch;
-}
-
-extern inline size_t
-ds_length (const struct string *st)
-{
- return st->length;
-}
-
-extern inline char *
-ds_c_str (const struct string *st)
-{
- ((char *) st->string)[st->length] = '\0';
- return st->string;
-}
-
-extern inline char *
-ds_data (const struct string *st)
-{
- return st->string;
-}
-
-extern inline char *
-ds_end (const struct string *st)
-{
- return st->string + st->length;
-}
-#endif
-
-#endif /* str_h */
+++ /dev/null
-/* subclist - lists for PSPP subcommands
-
-Copyright (C) 2004 Free Software Foundation, Inc.
-
-Written by John Darrington <john@darrington.wattle.id.au>
-
-
-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 the Free Software Foundation; either version 2 of the
-License, or (at your option) any later version.
-
-This program is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA. */
-
-
-#include "subclist.h"
-#include <stdlib.h>
-#include "xalloc.h"
-
-/* I call these objects `lists' but they are in fact simple dynamic arrays */
-
-#define CHUNKSIZE 16
-
-/* Create a list */
-void
-subc_list_double_create(subc_list_double *l)
-{
- l->data = xnmalloc (CHUNKSIZE, sizeof *l->data);
- l->sz = CHUNKSIZE;
- l->n_data = 0;
-}
-
-/* Push a value onto the list */
-void
-subc_list_double_push(subc_list_double *l, double d)
-{
- l->data[l->n_data++] = d;
-
- if (l->n_data >= l->sz )
- {
- l->sz += CHUNKSIZE;
- l->data = xnrealloc (l->data, l->sz, sizeof *l->data);
- }
-
-}
-
-/* Return the number of items in the list */
-int
-subc_list_double_count(const subc_list_double *l)
-{
- return l->n_data;
-}
-
-
-/* Index into the list (array) */
-double
-subc_list_double_at(const subc_list_double *l, int idx)
-{
- return l->data[idx];
-}
-
-/* Free up the list */
-void
-subc_list_double_destroy(subc_list_double *l)
-{
- free(l->data);
-}
+++ /dev/null
-#ifndef SUBCLIST_H
-#define SUBCLIST_H
-
-/* subclist - lists for PSPP subcommands
-
- Copyright (C) 2004 Free Software Foundation, Inc.
-
- Written by John Darrington <john@darrington.wattle.id.au>
-
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-
-
-#include <sys/types.h>
-
-/* This module provides a rudimentary list class
- It is intended for use by the command line parser for list subcommands
-*/
-
-
-struct subc_list_double {
- double *data ;
- size_t sz;
- int n_data;
-};
-
-struct subc_list_int {
- int *data ;
- size_t sz;
- int n_data;
-};
-
-
-typedef struct subc_list_double subc_list_double ;
-typedef struct subc_list_int subc_list_int ;
-
-/* Create a list */
-void subc_list_double_create(subc_list_double *l) ;
-void subc_list_int_create(subc_list_int *l) ;
-
-/* Push a value onto the list */
-void subc_list_double_push(subc_list_double *l, double d) ;
-void subc_list_int_push(subc_list_int *l, int i) ;
-
-/* Index into the list */
-double subc_list_double_at(const subc_list_double *l, int idx);
-int subc_list_int_at(const subc_list_int *l, int idx);
-
-/* Return the number of values in the list */
-int subc_list_double_count(const subc_list_double *l);
-int subc_list_int_count(const subc_list_int *l);
-
-/* Destroy the list */
-void subc_list_double_destroy(subc_list_double *l) ;
-void subc_list_int_destroy(subc_list_int *l) ;
-
-
-#endif
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <ctype.h>
-#include <stdlib.h>
-#include "algorithm.h"
-#include "alloc.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "file-handle.h"
-#include "hash.h"
-#include "lexer.h"
-#include "magic.h"
-#include "misc.h"
-#include "output.h"
-#include "sfm-read.h"
-#include "som.h"
-#include "tab.h"
-#include "value-labels.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* Constants for DISPLAY utility. */
-enum
- {
- AS_NAMES = 0,
- AS_INDEX,
- AS_VARIABLES,
- AS_LABELS,
- AS_DICTIONARY,
- AS_SCRATCH,
- AS_VECTOR
- };
-
-static int describe_variable (struct variable *v, struct tab_table *t, int r, int as);
-
-/* Sets the widths of all the columns and heights of all the rows in
- table T for driver D. */
-static void
-sysfile_info_dim (struct tab_table *t, struct outp_driver *d)
-{
- static const int max[] = {20, 5, 35, 3, 0};
- const int *p;
- int i;
-
- for (p = max; *p; p++)
- t->w[p - max] = min (tab_natural_width (t, d, p - max),
- *p * d->prop_em_width);
- for (i = 0; i < t->nr; i++)
- t->h[i] = tab_natural_height (t, d, i);
-}
-
-/* SYSFILE INFO utility. */
-int
-cmd_sysfile_info (void)
-{
- struct file_handle *h;
- struct dictionary *d;
- struct tab_table *t;
- struct sfm_reader *reader;
- struct sfm_read_info info;
- int r, nr;
- int i;
-
- lex_match_id ("FILE");
- lex_match ('=');
-
- h = fh_parse (FH_REF_FILE);
- if (!h)
- return CMD_FAILURE;
-
- reader = sfm_open_reader (h, &d, &info);
- if (!reader)
- return CMD_FAILURE;
- sfm_close_reader (reader);
-
- t = tab_create (2, 9, 0);
- tab_vline (t, TAL_1 | TAL_SPACING, 1, 0, 8);
- tab_text (t, 0, 0, TAB_LEFT, _("File:"));
- tab_text (t, 1, 0, TAB_LEFT, fh_get_filename (h));
- tab_text (t, 0, 1, TAB_LEFT, _("Label:"));
- {
- const char *label = dict_get_label (d);
- if (label == NULL)
- label = _("No label.");
- tab_text (t, 1, 1, TAB_LEFT, label);
- }
- tab_text (t, 0, 2, TAB_LEFT, _("Created:"));
- tab_text (t, 1, 2, TAB_LEFT | TAT_PRINTF, "%s %s by %s",
- info.creation_date, info.creation_time, info.product);
- tab_text (t, 0, 3, TAB_LEFT, _("Endian:"));
- tab_text (t, 1, 3, TAB_LEFT, info.big_endian ? _("Big.") : _("Little."));
- tab_text (t, 0, 4, TAB_LEFT, _("Variables:"));
- tab_text (t, 1, 4, TAB_LEFT | TAT_PRINTF, "%d",
- dict_get_var_cnt (d));
- tab_text (t, 0, 5, TAB_LEFT, _("Cases:"));
- tab_text (t, 1, 5, TAB_LEFT | TAT_PRINTF,
- info.case_cnt == -1 ? _("Unknown") : "%d", info.case_cnt);
- tab_text (t, 0, 6, TAB_LEFT, _("Type:"));
- tab_text (t, 1, 6, TAB_LEFT, _("System File."));
- tab_text (t, 0, 7, TAB_LEFT, _("Weight:"));
- {
- struct variable *weight_var = dict_get_weight (d);
- tab_text (t, 1, 7, TAB_LEFT,
- weight_var != NULL ? weight_var->name : _("Not weighted."));
- }
- tab_text (t, 0, 8, TAB_LEFT, _("Mode:"));
- tab_text (t, 1, 8, TAB_LEFT | TAT_PRINTF,
- _("Compression %s."), info.compressed ? _("on") : _("off"));
- tab_dim (t, tab_natural_dimensions);
- tab_submit (t);
-
- nr = 1 + 2 * dict_get_var_cnt (d);
-
- t = tab_create (4, nr, 1);
- tab_dim (t, sysfile_info_dim);
- tab_headers (t, 0, 0, 1, 0);
- tab_text (t, 0, 0, TAB_LEFT | TAT_TITLE, _("Variable"));
- tab_joint_text (t, 1, 0, 2, 0, TAB_LEFT | TAT_TITLE, _("Description"));
- tab_text (t, 3, 0, TAB_LEFT | TAT_TITLE, _("Position"));
- tab_hline (t, TAL_2, 0, 3, 1);
- for (r = 1, i = 0; i < dict_get_var_cnt (d); i++)
- {
- struct variable *v = dict_get_var (d, i);
- const int nvl = val_labs_count (v->val_labs);
-
- if (r + 10 + nvl > nr)
- {
- nr = max (nr * dict_get_var_cnt (d) / (i + 1), nr);
- nr += 10 + nvl;
- tab_realloc (t, 4, nr);
- }
-
- r = describe_variable (v, t, r, AS_DICTIONARY);
- }
-
- tab_box (t, TAL_1, TAL_1, -1, -1, 0, 0, 3, r);
- tab_vline (t, TAL_1, 1, 0, r);
- tab_vline (t, TAL_1, 3, 0, r);
-
- tab_resize (t, -1, r);
- tab_flags (t, SOMF_NO_TITLE);
- tab_submit (t);
-
- dict_destroy (d);
-
- return lex_end_of_command ();
-}
-\f
-/* DISPLAY utility. */
-
-static void display_macros (void);
-static void display_documents (void);
-static void display_variables (struct variable **, size_t, int);
-static void display_vectors (int sorted);
-
-int
-cmd_display (void)
-{
- /* Whether to sort the list of variables alphabetically. */
- int sorted;
-
- /* Variables to display. */
- size_t n;
- struct variable **vl;
-
- if (lex_match_id ("MACROS"))
- display_macros ();
- else if (lex_match_id ("DOCUMENTS"))
- display_documents ();
- else if (lex_match_id ("FILE"))
- {
- som_blank_line ();
- if (!lex_force_match_id ("LABEL"))
- return CMD_FAILURE;
- if (dict_get_label (default_dict) == NULL)
- tab_output_text (TAB_LEFT,
- _("The active file does not have a file label."));
- else
- {
- tab_output_text (TAB_LEFT | TAT_TITLE, _("File label:"));
- tab_output_text (TAB_LEFT | TAT_FIX, dict_get_label (default_dict));
- }
- }
- else
- {
- static const char *sbc[] =
- {"NAMES", "INDEX", "VARIABLES", "LABELS",
- "DICTIONARY", "SCRATCH", "VECTORS", NULL};
- const char **cp;
- int as;
-
- sorted = lex_match_id ("SORTED");
-
- for (cp = sbc; *cp; cp++)
- if (token == T_ID && lex_id_match (*cp, tokid))
- {
- lex_get ();
- break;
- }
- as = cp - sbc;
-
- if (*cp == NULL)
- as = AS_NAMES;
-
- if (as == AS_VECTOR)
- {
- display_vectors (sorted);
- return CMD_SUCCESS;
- }
-
- lex_match ('/');
- lex_match_id ("VARIABLES");
- lex_match ('=');
-
- if (token != '.')
- {
- if (!parse_variables (default_dict, &vl, &n, PV_NONE))
- {
- free (vl);
- return CMD_FAILURE;
- }
- as = AS_DICTIONARY;
- }
- else
- dict_get_vars (default_dict, &vl, &n, 0);
-
- if (as == AS_SCRATCH)
- {
- size_t i, m;
- for (i = 0, m = n; i < n; i++)
- if (dict_class_from_id (vl[i]->name) != DC_SCRATCH)
- {
- vl[i] = NULL;
- m--;
- }
- as = AS_NAMES;
- n = m;
- }
-
- if (n == 0)
- {
- msg (SW, _("No variables to display."));
- return CMD_FAILURE;
- }
-
- if (sorted)
- sort (vl, n, sizeof *vl, compare_var_names, NULL);
-
- display_variables (vl, n, as);
-
- free (vl);
- }
-
- return lex_end_of_command ();
-}
-
-static void
-display_macros (void)
-{
- som_blank_line ();
- tab_output_text (TAB_LEFT, _("Macros not supported."));
-}
-
-static void
-display_documents (void)
-{
- const char *documents = dict_get_documents (default_dict);
-
- som_blank_line ();
- if (documents == NULL)
- tab_output_text (TAB_LEFT, _("The active file dictionary does not "
- "contain any documents."));
- else
- {
- size_t n_lines = strlen (documents) / 80;
- char buf[81];
- size_t i;
-
- tab_output_text (TAB_LEFT | TAT_TITLE,
- _("Documents in the active file:"));
- som_blank_line ();
- buf[80] = 0;
- for (i = 0; i < n_lines; i++)
- {
- int len = 79;
-
- memcpy (buf, &documents[i * 80], 80);
- while ((isspace ((unsigned char) buf[len]) || buf[len] == 0)
- && len > 0)
- len--;
- buf[len + 1] = 0;
- tab_output_text (TAB_LEFT | TAT_FIX | TAT_NOWRAP, buf);
- }
- }
-}
-
-static int _as;
-
-/* Sets the widths of all the columns and heights of all the rows in
- table T for driver D. */
-static void
-variables_dim (struct tab_table *t, struct outp_driver *d)
-{
- int pc;
- int i;
-
- t->w[0] = tab_natural_width (t, d, 0);
- if (_as == AS_DICTIONARY || _as == AS_VARIABLES || _as == AS_LABELS)
- {
- t->w[1] = max (tab_natural_width (t, d, 1), d->prop_em_width * 5);
- t->w[2] = max (tab_natural_width (t, d, 2), d->prop_em_width * 35);
- pc = 3;
- }
- else pc = 1;
- if (_as != AS_NAMES)
- t->w[pc] = tab_natural_width (t, d, pc);
-
- for (i = 0; i < t->nr; i++)
- t->h[i] = tab_natural_height (t, d, i);
-}
-
-static void
-display_variables (struct variable **vl, size_t n, int as)
-{
- struct variable **vp = vl; /* Variable pointer. */
- struct tab_table *t;
- int nc; /* Number of columns. */
- int nr; /* Number of rows. */
- int pc; /* `Position column' */
- int r; /* Current row. */
- size_t i;
-
- _as = as;
- switch (as)
- {
- case AS_INDEX:
- nc = 2;
- break;
- case AS_NAMES:
- nc = 1;
- break;
- default:
- nc = 4;
- break;
- }
-
- t = tab_create (nc, n + 5, 1);
- tab_headers (t, 0, 0, 1, 0);
- nr = n + 5;
- tab_hline (t, TAL_2, 0, nc - 1, 1);
- tab_text (t, 0, 0, TAB_LEFT | TAT_TITLE, _("Variable"));
- pc = (as == AS_INDEX ? 1 : 3);
- if (as != AS_NAMES)
- tab_text (t, pc, 0, TAB_LEFT | TAT_TITLE, _("Position"));
- if (as == AS_DICTIONARY || as == AS_VARIABLES)
- tab_joint_text (t, 1, 0, 2, 0, TAB_LEFT | TAT_TITLE, _("Description"));
- else if (as == AS_LABELS)
- tab_joint_text (t, 1, 0, 2, 0, TAB_LEFT | TAT_TITLE, _("Label"));
- tab_dim (t, variables_dim);
-
- for (i = r = 1; i <= n; i++)
- {
- struct variable *v;
-
- while (*vp == NULL)
- vp++;
- v = *vp++;
-
- if (as == AS_DICTIONARY || as == AS_VARIABLES)
- {
- int nvl = val_labs_count (v->val_labs);
-
- if (r + 10 + nvl > nr)
- {
- nr = max (nr * n / (i + 1), nr);
- nr += 10 + nvl;
- tab_realloc (t, nc, nr);
- }
-
- r = describe_variable (v, t, r, as);
- } else {
- tab_text (t, 0, r, TAB_LEFT, v->name);
- if (as == AS_LABELS)
- tab_joint_text (t, 1, r, 2, r, TAB_LEFT,
- v->label == NULL ? "(no label)" : v->label);
- if (as != AS_NAMES)
- {
- tab_text (t, pc, r, TAT_PRINTF, "%d", v->index + 1);
- tab_hline (t, TAL_1, 0, nc - 1, r);
- }
- r++;
- }
- }
- tab_hline (t, as == AS_NAMES ? TAL_1 : TAL_2, 0, nc - 1, 1);
- if (as != AS_NAMES)
- {
- tab_box (t, TAL_1, TAL_1, -1, -1, 0, 0, nc - 1, r - 1);
- tab_vline (t, TAL_1, 1, 0, r - 1);
- }
- else
- tab_flags (t, SOMF_NO_TITLE);
- if (as == AS_DICTIONARY || as == AS_VARIABLES || as == AS_LABELS)
- tab_vline (t, TAL_1, 3, 0, r - 1);
- tab_resize (t, -1, r);
- tab_columns (t, TAB_COL_DOWN, 1);
- tab_submit (t);
-}
-\f
-/* Puts a description of variable V into table T starting at row R.
- The variable will be described in the format AS. Returns the next
- row available for use in the table. */
-static int
-describe_variable (struct variable *v, struct tab_table *t, int r, int as)
-{
- /* Put the name, var label, and position into the first row. */
- tab_text (t, 0, r, TAB_LEFT, v->name);
- tab_text (t, 3, r, TAT_PRINTF, "%d", v->index + 1);
-
- if (as == AS_DICTIONARY && v->label)
- {
- tab_joint_text (t, 1, r, 2, r, TAB_LEFT, v->label);
- r++;
- }
-
- /* Print/write format, or print and write formats. */
- if (v->print.type == v->write.type
- && v->print.w == v->write.w
- && v->print.d == v->write.d)
- {
- tab_joint_text (t, 1, r, 2, r, TAB_LEFT | TAT_PRINTF, _("Format: %s"),
- fmt_to_string (&v->print));
- r++;
- }
- else
- {
- tab_joint_text (t, 1, r, 2, r, TAB_LEFT | TAT_PRINTF,
- _("Print Format: %s"), fmt_to_string (&v->print));
- r++;
- tab_joint_text (t, 1, r, 2, r, TAB_LEFT | TAT_PRINTF,
- _("Write Format: %s"), fmt_to_string (&v->write));
- r++;
- }
-
- /* Missing values if any. */
- if (!mv_is_empty (&v->miss))
- {
- char buf[128];
- char *cp;
- struct missing_values mv;
- int cnt = 0;
-
- cp = stpcpy (buf, _("Missing Values: "));
- mv_copy (&mv, &v->miss);
- if (mv_has_range (&mv))
- {
- double x, y;
- mv_pop_range (&mv, &x, &y);
- if (x == LOWEST)
- cp += nsprintf (cp, "LOWEST THRU %g", y);
- else if (y == HIGHEST)
- cp += nsprintf (cp, "%g THRU HIGHEST", x);
- else
- cp += nsprintf (cp, "%g THRU %g", x, y);
- cnt++;
- }
- while (mv_has_value (&mv))
- {
- union value value;
- mv_pop_value (&mv, &value);
- if (cnt++ > 0)
- cp += nsprintf (cp, "; ");
- if (v->type == NUMERIC)
- cp += nsprintf (cp, "%g", value.f);
- else
- {
- *cp++ = '"';
- memcpy (cp, value.s, v->width);
- cp += v->width;
- *cp++ = '"';
- *cp = '\0';
- }
- }
-
- tab_joint_text (t, 1, r, 2, r, TAB_LEFT, buf);
- r++;
- }
-
- /* Value labels. */
- if (as == AS_DICTIONARY && val_labs_count (v->val_labs))
- {
- struct val_labs_iterator *i;
- struct val_lab *vl;
- int orig_r = r;
-
-#if 0
- tab_text (t, 1, r, TAB_LEFT, _("Value"));
- tab_text (t, 2, r, TAB_LEFT, _("Label"));
- r++;
-#endif
-
- tab_hline (t, TAL_1, 1, 2, r);
- for (vl = val_labs_first_sorted (v->val_labs, &i); vl != NULL;
- vl = val_labs_next (v->val_labs, &i))
- {
- char buf[128];
-
- if (v->type == ALPHA)
- {
- memcpy (buf, vl->value.s, v->width);
- buf[v->width] = 0;
- }
- else
- sprintf (buf, "%g", vl->value.f);
-
- tab_text (t, 1, r, TAB_NONE, buf);
- tab_text (t, 2, r, TAB_LEFT, vl->label);
- r++;
- }
-
- tab_vline (t, TAL_1, 2, orig_r, r - 1);
- }
-
- /* Draw a line below the last row of information on this variable. */
- tab_hline (t, TAL_1, 0, 3, r);
-
- return r;
-}
-
-static int
-compare_vectors_by_name (const void *a_, const void *b_)
-{
- struct vector *const *pa = a_;
- struct vector *const *pb = b_;
- struct vector *a = *pa;
- struct vector *b = *pb;
-
- return strcasecmp (a->name, b->name);
-}
-
-/* Display a list of vectors. If SORTED is nonzero then they are
- sorted alphabetically. */
-static void
-display_vectors (int sorted)
-{
- const struct vector **vl;
- int i;
- struct tab_table *t;
- size_t nvec;
-
- nvec = dict_get_vector_cnt (default_dict);
- if (nvec == 0)
- {
- msg (SW, _("No vectors defined."));
- return;
- }
-
- vl = xnmalloc (nvec, sizeof *vl);
- for (i = 0; i < nvec; i++)
- vl[i] = dict_get_vector (default_dict, i);
- if (sorted)
- qsort (vl, nvec, sizeof *vl, compare_vectors_by_name);
-
- t = tab_create (1, nvec + 1, 0);
- tab_headers (t, 0, 0, 1, 0);
- tab_columns (t, TAB_COL_DOWN, 1);
- tab_dim (t, tab_natural_dimensions);
- tab_hline (t, TAL_1, 0, 0, 1);
- tab_text (t, 0, 0, TAT_TITLE | TAB_LEFT, _("Vector"));
- tab_flags (t, SOMF_NO_TITLE);
- for (i = 0; i < nvec; i++)
- tab_text (t, 0, i + 1, TAB_LEFT, vl[i]->name);
- tab_submit (t);
-
- free (vl);
-}
-
-
-
-
-
-
-
-
-
-
-
+++ /dev/null
-/* PSPP - computes sample statistics. -*-c-*-
-
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by John Williams <johnr.williams@stonebow.otago.ac.nz>.
- Almost completly re-written by John Darrington 2004
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <gsl/gsl_cdf.h>
-#include "error.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include <math.h>
-#include "alloc.h"
-#include "case.h"
-#include "casefile.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "group_proc.h"
-#include "hash.h"
-#include "levene.h"
-#include "lexer.h"
-#include "magic.h"
-#include "misc.h"
-#include "size_max.h"
-#include "som.h"
-#include "str.h"
-#include "tab.h"
-#include "value-labels.h"
-#include "var.h"
-#include "vfm.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* (headers) */
-
-/* (specification)
- "T-TEST" (tts_):
- +groups=custom;
- testval=double;
- variables=varlist("PV_NO_SCRATCH | PV_NUMERIC");
- pairs=custom;
- +missing=miss:!analysis/listwise,
- incl:include/!exclude;
- format=fmt:!labels/nolabels;
- criteria=:cin(d:criteria,"%s > 0. && %s < 1.").
-*/
-/* (declarations) */
-/* (functions) */
-
-
-
-
-/* Function to use for testing for missing values */
-static is_missing_func *value_is_missing;
-
-/* Variable for the GROUPS subcommand, if given. */
-static struct variable *indep_var;
-
-enum comparison
- {
- CMP_LE = -2,
- CMP_EQ = 0,
- };
-
-struct group_properties
-{
- /* The comparison criterion */
- enum comparison criterion;
-
- /* The width of the independent variable */
- int indep_width ;
-
- union {
- /* The value of the independent variable at which groups are determined to
- belong to one group or the other */
- double critical_value;
-
-
- /* The values of the independent variable for each group */
- union value g_value[2];
- } v ;
-
-};
-
-
-static struct group_properties gp ;
-
-
-
-/* PAIRS: Number of pairs to be compared ; each pair. */
-static int n_pairs = 0 ;
-struct pair
-{
- /* The variables comprising the pair */
- struct variable *v[2];
-
- /* The number of valid variable pairs */
- double n;
-
- /* The sum of the members */
- double sum[2];
-
- /* sum of squares of the members */
- double ssq[2];
-
- /* Std deviation of the members */
- double std_dev[2];
-
-
- /* Sample Std deviation of the members */
- double s_std_dev[2];
-
- /* The means of the members */
- double mean[2];
-
- /* The correlation coefficient between the variables */
- double correlation;
-
- /* The sum of the differences */
- double sum_of_diffs;
-
- /* The sum of the products */
- double sum_of_prod;
-
- /* The mean of the differences */
- double mean_diff;
-
- /* The sum of the squares of the differences */
- double ssq_diffs;
-
- /* The std deviation of the differences */
- double std_dev_diff;
-};
-
-static struct pair *pairs=0;
-
-static int parse_value (union value * v, int type) ;
-
-/* Structures and Functions for the Statistics Summary Box */
-struct ssbox;
-typedef void populate_ssbox_func(struct ssbox *ssb,
- struct cmd_t_test *cmd);
-typedef void finalize_ssbox_func(struct ssbox *ssb);
-
-struct ssbox
-{
- struct tab_table *t;
-
- populate_ssbox_func *populate;
- finalize_ssbox_func *finalize;
-
-};
-
-/* Create a ssbox */
-void ssbox_create(struct ssbox *ssb, struct cmd_t_test *cmd, int mode);
-
-/* Populate a ssbox according to cmd */
-void ssbox_populate(struct ssbox *ssb, struct cmd_t_test *cmd);
-
-/* Submit and destroy a ssbox */
-void ssbox_finalize(struct ssbox *ssb);
-
-/* A function to create, populate and submit the Paired Samples Correlation
- box */
-void pscbox(void);
-
-
-/* Structures and Functions for the Test Results Box */
-struct trbox;
-
-typedef void populate_trbox_func(struct trbox *trb,
- struct cmd_t_test *cmd);
-typedef void finalize_trbox_func(struct trbox *trb);
-
-struct trbox {
- struct tab_table *t;
- populate_trbox_func *populate;
- finalize_trbox_func *finalize;
-};
-
-/* Create a trbox */
-void trbox_create(struct trbox *trb, struct cmd_t_test *cmd, int mode);
-
-/* Populate a ssbox according to cmd */
-void trbox_populate(struct trbox *trb, struct cmd_t_test *cmd);
-
-/* Submit and destroy a ssbox */
-void trbox_finalize(struct trbox *trb);
-
-/* Which mode was T-TEST invoked */
-enum {
- T_1_SAMPLE = 0 ,
- T_IND_SAMPLES,
- T_PAIRED
-};
-
-
-static int common_calc (const struct ccase *, void *);
-static void common_precalc (struct cmd_t_test *);
-static void common_postcalc (struct cmd_t_test *);
-
-static int one_sample_calc (const struct ccase *, void *);
-static void one_sample_precalc (struct cmd_t_test *);
-static void one_sample_postcalc (struct cmd_t_test *);
-
-static int paired_calc (const struct ccase *, void *);
-static void paired_precalc (struct cmd_t_test *);
-static void paired_postcalc (struct cmd_t_test *);
-
-static void group_precalc (struct cmd_t_test *);
-static int group_calc (const struct ccase *, struct cmd_t_test *);
-static void group_postcalc (struct cmd_t_test *);
-
-
-static void calculate(const struct casefile *cf, void *_mode);
-
-static int mode;
-
-static struct cmd_t_test cmd;
-
-static int bad_weight_warn;
-
-
-static int compare_group_binary(const struct group_statistics *a,
- const struct group_statistics *b,
- const struct group_properties *p);
-
-
-static unsigned hash_group_binary(const struct group_statistics *g,
- const struct group_properties *p);
-
-
-
-int
-cmd_t_test(void)
-{
-
- if ( !parse_t_test(&cmd) )
- return CMD_FAILURE;
-
- if (! cmd.sbc_criteria)
- cmd.criteria=0.95;
-
- {
- int m=0;
- if (cmd.sbc_testval) ++m;
- if (cmd.sbc_groups) ++m;
- if (cmd.sbc_pairs) ++m;
-
- if ( m != 1)
- {
- msg(SE,
- _("TESTVAL, GROUPS and PAIRS subcommands are mutually exclusive.")
- );
- free_t_test(&cmd);
- return CMD_FAILURE;
- }
- }
-
- if (cmd.sbc_testval)
- mode=T_1_SAMPLE;
- else if (cmd.sbc_groups)
- mode=T_IND_SAMPLES;
- else
- mode=T_PAIRED;
-
- if ( mode == T_PAIRED)
- {
- if (cmd.sbc_variables)
- {
- msg(SE, _("VARIABLES subcommand is not appropriate with PAIRS"));
- free_t_test(&cmd);
- return CMD_FAILURE;
- }
- else
- {
- /* Iterate through the pairs and put each variable that is a
- member of a pair into cmd.v_variables */
-
- int i;
- struct hsh_iterator hi;
- struct hsh_table *hash;
- struct variable *v;
-
- hash = hsh_create (n_pairs, compare_var_names, hash_var_name, 0, 0);
-
- for (i=0; i < n_pairs; ++i)
- {
- hsh_insert(hash,pairs[i].v[0]);
- hsh_insert(hash,pairs[i].v[1]);
- }
-
- assert(cmd.n_variables == 0);
- cmd.n_variables = hsh_count(hash);
-
- cmd.v_variables = xnrealloc (cmd.v_variables, cmd.n_variables,
- sizeof *cmd.v_variables);
- /* Iterate through the hash */
- for (i=0,v = (struct variable *) hsh_first(hash,&hi);
- v != 0;
- v=hsh_next(hash,&hi) )
- cmd.v_variables[i++]=v;
-
- hsh_destroy(hash);
- }
- }
- else if ( !cmd.sbc_variables)
- {
- msg(SE, _("One or more VARIABLES must be specified."));
- free_t_test(&cmd);
- return CMD_FAILURE;
- }
-
-
- /* If /MISSING=INCLUDE is set, then user missing values are ignored */
- if (cmd.incl == TTS_INCLUDE )
- value_is_missing = mv_is_value_system_missing;
- else
- value_is_missing = mv_is_value_missing;
-
- bad_weight_warn = 1;
-
- multipass_procedure_with_splits (calculate, &cmd);
-
- n_pairs=0;
- free(pairs);
- pairs=0;
-
- if ( mode == T_IND_SAMPLES)
- {
- int v;
- /* Destroy any group statistics we created */
- for (v = 0 ; v < cmd.n_variables ; ++v )
- {
- struct group_proc *grpp = group_proc_get (cmd.v_variables[v]);
- hsh_destroy (grpp->group_hash);
- }
- }
-
- free_t_test(&cmd);
- return CMD_SUCCESS;
-}
-
-static int
-tts_custom_groups (struct cmd_t_test *cmd UNUSED)
-{
- int n_group_values=0;
-
- lex_match('=');
-
- indep_var = parse_variable ();
- if (!indep_var)
- {
- lex_error ("expecting variable name in GROUPS subcommand");
- return 0;
- }
-
- if (indep_var->type == T_STRING && indep_var->width > MAX_SHORT_STRING)
- {
- msg (SE, _("Long string variable %s is not valid here."),
- indep_var->name);
- return 0;
- }
-
- if (!lex_match ('('))
- {
- if (indep_var->type == NUMERIC)
- {
- gp.v.g_value[0].f = 1;
- gp.v.g_value[1].f = 2;
-
- gp.criterion = CMP_EQ;
-
- n_group_values = 2;
-
- return 1;
- }
- else
- {
- msg (SE, _("When applying GROUPS to a string variable, two "
- "values must be specified."));
- return 0;
- }
- }
-
- if (!parse_value (&gp.v.g_value[0], indep_var->type))
- return 0;
-
- lex_match (',');
- if (lex_match (')'))
- {
- if (indep_var->type != NUMERIC)
- {
-
- msg (SE, _("When applying GROUPS to a string variable, two "
- "values must be specified."));
- return 0;
- }
- gp.criterion = CMP_LE;
- gp.v.critical_value = gp.v.g_value[0].f;
-
- n_group_values = 1;
- return 1;
- }
-
- if (!parse_value (&gp.v.g_value[1], indep_var->type))
- return 0;
-
- n_group_values = 2;
- if (!lex_force_match (')'))
- return 0;
-
- if ( n_group_values == 2 )
- gp.criterion = CMP_EQ ;
- else
- gp.criterion = CMP_LE ;
-
-
- return 1;
-}
-
-
-static int
-tts_custom_pairs (struct cmd_t_test *cmd UNUSED)
-{
- struct variable **vars;
- size_t n_vars;
- size_t n_pairs_local;
-
- size_t n_before_WITH;
- size_t n_after_WITH = SIZE_MAX;
- int paired ; /* Was the PAIRED keyword given ? */
-
- lex_match('=');
-
- n_vars=0;
- if (!parse_variables (default_dict, &vars, &n_vars,
- PV_DUPLICATE | PV_NUMERIC | PV_NO_SCRATCH))
- {
- free (vars);
- return 0;
- }
- assert (n_vars);
-
- n_before_WITH = 0;
- if (lex_match (T_WITH))
- {
- n_before_WITH = n_vars;
- if (!parse_variables (default_dict, &vars, &n_vars,
- PV_DUPLICATE | PV_APPEND
- | PV_NUMERIC | PV_NO_SCRATCH))
- {
- free (vars);
- return 0;
- }
- n_after_WITH = n_vars - n_before_WITH;
- }
-
- paired = (lex_match ('(') && lex_match_id ("PAIRED") && lex_match (')'));
-
- /* Determine the number of pairs needed */
- if (paired)
- {
- if (n_before_WITH != n_after_WITH)
- {
- free (vars);
- msg (SE, _("PAIRED was specified but the number of variables "
- "preceding WITH (%d) did not match the number "
- "following (%d)."),
- n_before_WITH, n_after_WITH );
- return 0;
- }
- n_pairs_local = n_before_WITH;
- }
- else if (n_before_WITH > 0) /* WITH keyword given, but not PAIRED keyword */
- {
- n_pairs_local = n_before_WITH * n_after_WITH ;
- }
- else /* Neither WITH nor PAIRED keyword given */
- {
- if (n_vars < 2)
- {
- free (vars);
- msg (SE, _("At least two variables must be specified "
- "on PAIRS."));
- return 0;
- }
-
- /* how many ways can you pick 2 from n_vars ? */
- n_pairs_local = n_vars * (n_vars - 1) / 2;
- }
-
-
- /* Allocate storage for the pairs */
- pairs = xnrealloc (pairs, n_pairs + n_pairs_local, sizeof *pairs);
-
- /* Populate the pairs with the appropriate variables */
- if ( paired )
- {
- int i;
-
- assert(n_pairs_local == n_vars / 2);
- for (i = 0; i < n_pairs_local; ++i)
- {
- pairs[i].v[n_pairs] = vars[i];
- pairs[i].v[n_pairs + 1] = vars[i + n_pairs_local];
- }
- }
- else if (n_before_WITH > 0) /* WITH keyword given, but not PAIRED keyword */
- {
- int i,j;
- size_t p = n_pairs;
-
- for(i=0 ; i < n_before_WITH ; ++i )
- {
- for(j=0 ; j < n_after_WITH ; ++j)
- {
- pairs[p].v[0] = vars[i];
- pairs[p].v[1] = vars[j+n_before_WITH];
- ++p;
- }
- }
- }
- else /* Neither WITH nor PAIRED given */
- {
- size_t i,j;
- size_t p=n_pairs;
-
- for(i=0 ; i < n_vars ; ++i )
- {
- for(j=i+1 ; j < n_vars ; ++j)
- {
- pairs[p].v[0] = vars[i];
- pairs[p].v[1] = vars[j];
- ++p;
- }
- }
- }
-
- n_pairs+=n_pairs_local;
-
- free (vars);
- return 1;
-}
-
-/* Parses the current token (numeric or string, depending on type)
- value v and returns success. */
-static int
-parse_value (union value * v, int type )
-{
- if (type == NUMERIC)
- {
- if (!lex_force_num ())
- return 0;
- v->f = tokval;
- }
- else
- {
- if (!lex_force_string ())
- return 0;
- strncpy (v->s, ds_c_str (&tokstr), ds_length (&tokstr));
- }
-
- lex_get ();
-
- return 1;
-}
-
-
-/* Implementation of the SSBOX object */
-
-void ssbox_base_init(struct ssbox *this, int cols,int rows);
-
-void ssbox_base_finalize(struct ssbox *ssb);
-
-void ssbox_one_sample_init(struct ssbox *this,
- struct cmd_t_test *cmd );
-
-void ssbox_independent_samples_init(struct ssbox *this,
- struct cmd_t_test *cmd);
-
-void ssbox_paired_init(struct ssbox *this,
- struct cmd_t_test *cmd);
-
-
-/* Factory to create an ssbox */
-void
-ssbox_create(struct ssbox *ssb, struct cmd_t_test *cmd, int mode)
-{
- switch (mode)
- {
- case T_1_SAMPLE:
- ssbox_one_sample_init(ssb,cmd);
- break;
- case T_IND_SAMPLES:
- ssbox_independent_samples_init(ssb,cmd);
- break;
- case T_PAIRED:
- ssbox_paired_init(ssb,cmd);
- break;
- default:
- assert(0);
- }
-}
-
-
-
-/* Despatcher for the populate method */
-void
-ssbox_populate(struct ssbox *ssb,struct cmd_t_test *cmd)
-{
- ssb->populate(ssb,cmd);
-}
-
-
-/* Despatcher for finalize */
-void
-ssbox_finalize(struct ssbox *ssb)
-{
- ssb->finalize(ssb);
-}
-
-
-/* Submit the box and clear up */
-void
-ssbox_base_finalize(struct ssbox *ssb)
-{
- tab_submit(ssb->t);
-}
-
-
-
-/* Initialize a ssbox struct */
-void
-ssbox_base_init(struct ssbox *this, int cols,int rows)
-{
- this->finalize = ssbox_base_finalize;
- this->t = tab_create (cols, rows, 0);
-
- tab_columns (this->t, SOM_COL_DOWN, 1);
- tab_headers (this->t,0,0,1,0);
- tab_box (this->t, TAL_2, TAL_2, TAL_0, TAL_1, 0, 0, cols -1, rows -1 );
- tab_hline(this->t, TAL_2,0,cols-1,1);
- tab_dim (this->t, tab_natural_dimensions);
-}
-
-void ssbox_one_sample_populate(struct ssbox *ssb,
- struct cmd_t_test *cmd);
-
-/* Initialize the one_sample ssbox */
-void
-ssbox_one_sample_init(struct ssbox *this,
- struct cmd_t_test *cmd )
-{
- const int hsize=5;
- const int vsize=cmd->n_variables+1;
-
- this->populate = ssbox_one_sample_populate;
-
- ssbox_base_init(this, hsize,vsize);
- tab_title (this->t, 0, _("One-Sample Statistics"));
- tab_vline(this->t, TAL_2, 1,0,vsize - 1);
- tab_text (this->t, 1, 0, TAB_CENTER | TAT_TITLE, _("N"));
- tab_text (this->t, 2, 0, TAB_CENTER | TAT_TITLE, _("Mean"));
- tab_text (this->t, 3, 0, TAB_CENTER | TAT_TITLE, _("Std. Deviation"));
- tab_text (this->t, 4, 0, TAB_CENTER | TAT_TITLE, _("SE. Mean"));
-}
-
-void ssbox_independent_samples_populate(struct ssbox *ssb,
- struct cmd_t_test *cmd);
-
-/* Initialize the independent samples ssbox */
-void
-ssbox_independent_samples_init(struct ssbox *this,
- struct cmd_t_test *cmd)
-{
- int hsize=6;
- int vsize = cmd->n_variables*2 +1;
-
- this->populate = ssbox_independent_samples_populate;
-
- ssbox_base_init(this, hsize,vsize);
- tab_title (this->t, 0, _("Group Statistics"));
- tab_vline(this->t,0,1,0,vsize - 1);
- tab_text (this->t, 1, 0, TAB_CENTER | TAT_TITLE, indep_var->name);
- tab_text (this->t, 2, 0, TAB_CENTER | TAT_TITLE, _("N"));
- tab_text (this->t, 3, 0, TAB_CENTER | TAT_TITLE, _("Mean"));
- tab_text (this->t, 4, 0, TAB_CENTER | TAT_TITLE, _("Std. Deviation"));
- tab_text (this->t, 5, 0, TAB_CENTER | TAT_TITLE, _("SE. Mean"));
-}
-
-
-/* Populate the ssbox for independent samples */
-void
-ssbox_independent_samples_populate(struct ssbox *ssb,
- struct cmd_t_test *cmd)
-{
- int i;
-
- char *val_lab0=0;
- char *val_lab1=0;
- double indep_value[2];
-
- char prefix[2][3]={"",""};
-
- if ( indep_var->type == NUMERIC )
- {
- val_lab0 = val_labs_find( indep_var->val_labs,gp.v.g_value[0]);
- val_lab1 = val_labs_find( indep_var->val_labs,gp.v.g_value[1]);
- }
- else
- {
- val_lab0 = gp.v.g_value[0].s;
- val_lab1 = gp.v.g_value[1].s;
- }
-
- if (gp.criterion == CMP_LE )
- {
- strcpy(prefix[0],"< ");
- strcpy(prefix[1],">=");
- indep_value[0] = gp.v.critical_value;
- indep_value[1] = gp.v.critical_value;
- }
- else
- {
- indep_value[0] = gp.v.g_value[0].f;
- indep_value[1] = gp.v.g_value[1].f;
- }
-
- assert(ssb->t);
-
- for (i=0; i < cmd->n_variables; ++i)
- {
- struct variable *var = cmd->v_variables[i];
- struct hsh_table *grp_hash = group_proc_get (var)->group_hash;
- int count=0;
-
- tab_text (ssb->t, 0, i*2+1, TAB_LEFT, cmd->v_variables[i]->name);
-
- if (val_lab0)
- tab_text (ssb->t, 1, i*2+1, TAB_LEFT | TAT_PRINTF,
- "%s%s", prefix[0], val_lab0);
- else
- tab_text (ssb->t, 1, i*2+1, TAB_LEFT | TAT_PRINTF,
- "%s%g", prefix[0], indep_value[0]);
-
-
- if (val_lab1)
- tab_text (ssb->t, 1, i*2+1+1, TAB_LEFT | TAT_PRINTF,
- "%s%s", prefix[1], val_lab1);
- else
- tab_text (ssb->t, 1, i*2+1+1, TAB_LEFT | TAT_PRINTF,
- "%s%g", prefix[1], indep_value[1]);
-
-
- /* Fill in the group statistics */
- for ( count = 0 ; count < 2 ; ++count )
- {
- union value search_val;
-
- struct group_statistics *gs;
-
- if ( gp.criterion == CMP_LE )
- {
- if ( count == 0 )
- {
- /* less than ( < ) case */
- search_val.f = gp.v.critical_value - 1.0;
- }
- else
- {
- /* >= case */
- search_val.f = gp.v.critical_value + 1.0;
- }
- }
- else
- {
- search_val = gp.v.g_value[count];
- }
-
- gs = hsh_find(grp_hash, (void *) &search_val);
- assert(gs);
-
- tab_float(ssb->t, 2 ,i*2+count+1, TAB_RIGHT, gs->n, 2, 0);
- tab_float(ssb->t, 3 ,i*2+count+1, TAB_RIGHT, gs->mean, 8, 2);
- tab_float(ssb->t, 4 ,i*2+count+1, TAB_RIGHT, gs->std_dev, 8, 3);
- tab_float(ssb->t, 5 ,i*2+count+1, TAB_RIGHT, gs->se_mean, 8, 3);
- }
- }
-}
-
-
-void ssbox_paired_populate(struct ssbox *ssb,
- struct cmd_t_test *cmd);
-
-/* Initialize the paired values ssbox */
-void
-ssbox_paired_init(struct ssbox *this, struct cmd_t_test *cmd UNUSED)
-{
- int hsize=6;
-
- int vsize = n_pairs*2+1;
-
- this->populate = ssbox_paired_populate;
-
- ssbox_base_init(this, hsize,vsize);
- tab_title (this->t, 0, _("Paired Sample Statistics"));
- tab_vline(this->t,TAL_0,1,0,vsize-1);
- tab_vline(this->t,TAL_2,2,0,vsize-1);
- tab_text (this->t, 2, 0, TAB_CENTER | TAT_TITLE, _("Mean"));
- tab_text (this->t, 3, 0, TAB_CENTER | TAT_TITLE, _("N"));
- tab_text (this->t, 4, 0, TAB_CENTER | TAT_TITLE, _("Std. Deviation"));
- tab_text (this->t, 5, 0, TAB_CENTER | TAT_TITLE, _("SE. Mean"));
-}
-
-
-/* Populate the ssbox for paired values */
-void
-ssbox_paired_populate(struct ssbox *ssb,struct cmd_t_test *cmd UNUSED)
-{
- int i;
-
- assert(ssb->t);
-
- for (i=0; i < n_pairs; ++i)
- {
- int j;
-
- tab_text (ssb->t, 0, i*2+1, TAB_LEFT | TAT_PRINTF , _("Pair %d"),i);
-
- for (j=0 ; j < 2 ; ++j)
- {
- struct group_statistics *gs;
-
- gs = &group_proc_get (pairs[i].v[j])->ugs;
-
- /* Titles */
-
- tab_text (ssb->t, 1, i*2+j+1, TAB_LEFT, pairs[i].v[j]->name);
-
- /* Values */
- tab_float (ssb->t,2, i*2+j+1, TAB_RIGHT, pairs[i].mean[j], 8, 2);
- tab_float (ssb->t,3, i*2+j+1, TAB_RIGHT, pairs[i].n, 2, 0);
- tab_float (ssb->t,4, i*2+j+1, TAB_RIGHT, pairs[i].std_dev[j], 8, 3);
- tab_float (ssb->t,5, i*2+j+1, TAB_RIGHT, pairs[i].std_dev[j]/sqrt(pairs[i].n), 8, 3);
-
- }
- }
-}
-
-/* Populate the one sample ssbox */
-void
-ssbox_one_sample_populate(struct ssbox *ssb, struct cmd_t_test *cmd)
-{
- int i;
-
- assert(ssb->t);
-
- for (i=0; i < cmd->n_variables; ++i)
- {
- struct group_statistics *gs = &group_proc_get (cmd->v_variables[i])->ugs;
-
- tab_text (ssb->t, 0, i+1, TAB_LEFT, cmd->v_variables[i]->name);
- tab_float (ssb->t,1, i+1, TAB_RIGHT, gs->n, 2, 0);
- tab_float (ssb->t,2, i+1, TAB_RIGHT, gs->mean, 8, 2);
- tab_float (ssb->t,3, i+1, TAB_RIGHT, gs->std_dev, 8, 2);
- tab_float (ssb->t,4, i+1, TAB_RIGHT, gs->se_mean, 8, 3);
- }
-
-}
-
-
-
-/* Implementation of the Test Results box struct */
-
-void trbox_base_init(struct trbox *self,size_t n_vars, int cols);
-void trbox_base_finalize(struct trbox *trb);
-
-void trbox_independent_samples_init(struct trbox *trb,
- struct cmd_t_test *cmd );
-
-void trbox_independent_samples_populate(struct trbox *trb,
- struct cmd_t_test *cmd);
-
-void trbox_one_sample_init(struct trbox *self,
- struct cmd_t_test *cmd );
-
-void trbox_one_sample_populate(struct trbox *trb,
- struct cmd_t_test *cmd);
-
-void trbox_paired_init(struct trbox *self,
- struct cmd_t_test *cmd );
-
-void trbox_paired_populate(struct trbox *trb,
- struct cmd_t_test *cmd);
-
-
-
-/* Create a trbox according to mode*/
-void
-trbox_create(struct trbox *trb,
- struct cmd_t_test *cmd, int mode)
-{
- switch (mode)
- {
- case T_1_SAMPLE:
- trbox_one_sample_init(trb,cmd);
- break;
- case T_IND_SAMPLES:
- trbox_independent_samples_init(trb,cmd);
- break;
- case T_PAIRED:
- trbox_paired_init(trb,cmd);
- break;
- default:
- assert(0);
- }
-}
-
-/* Populate a trbox according to cmd */
-void
-trbox_populate(struct trbox *trb, struct cmd_t_test *cmd)
-{
- trb->populate(trb,cmd);
-}
-
-/* Submit and destroy a trbox */
-void
-trbox_finalize(struct trbox *trb)
-{
- trb->finalize(trb);
-}
-
-/* Initialize the independent samples trbox */
-void
-trbox_independent_samples_init(struct trbox *self,
- struct cmd_t_test *cmd UNUSED)
-{
- const int hsize=11;
- const int vsize=cmd->n_variables*2+3;
-
- assert(self);
- self->populate = trbox_independent_samples_populate;
-
- trbox_base_init(self,cmd->n_variables*2,hsize);
- tab_title(self->t,0,_("Independent Samples Test"));
- tab_hline(self->t,TAL_1,2,hsize-1,1);
- tab_vline(self->t,TAL_2,2,0,vsize-1);
- tab_vline(self->t,TAL_1,4,0,vsize-1);
- tab_box(self->t,-1,-1,-1,TAL_1, 2,1,hsize-2,vsize-1);
- tab_hline(self->t,TAL_1, hsize-2,hsize-1,2);
- tab_box(self->t,-1,-1,-1,TAL_1, hsize-2,2,hsize-1,vsize-1);
- tab_joint_text(self->t, 2, 0, 3, 0,
- TAB_CENTER,_("Levene's Test for Equality of Variances"));
- tab_joint_text(self->t, 4,0,hsize-1,0,
- TAB_CENTER,_("t-test for Equality of Means"));
-
- tab_text(self->t,2,2, TAB_CENTER | TAT_TITLE,_("F"));
- tab_text(self->t,3,2, TAB_CENTER | TAT_TITLE,_("Sig."));
- tab_text(self->t,4,2, TAB_CENTER | TAT_TITLE,_("t"));
- tab_text(self->t,5,2, TAB_CENTER | TAT_TITLE,_("df"));
- tab_text(self->t,6,2, TAB_CENTER | TAT_TITLE,_("Sig. (2-tailed)"));
- tab_text(self->t,7,2, TAB_CENTER | TAT_TITLE,_("Mean Difference"));
- tab_text(self->t,8,2, TAB_CENTER | TAT_TITLE,_("Std. Error Difference"));
- tab_text(self->t,9,2, TAB_CENTER | TAT_TITLE,_("Lower"));
- tab_text(self->t,10,2, TAB_CENTER | TAT_TITLE,_("Upper"));
-
- tab_joint_text(self->t, 9, 1, 10, 1, TAB_CENTER | TAT_PRINTF,
- _("%g%% Confidence Interval of the Difference"),
- cmd->criteria*100.0);
-
-}
-
-/* Populate the independent samples trbox */
-void
-trbox_independent_samples_populate(struct trbox *self,
- struct cmd_t_test *cmd )
-{
- int i;
-
- assert(self);
- for (i=0; i < cmd->n_variables; ++i)
- {
- double p,q;
-
- double t;
- double df;
-
- double df1, df2;
-
- double pooled_variance;
- double std_err_diff;
- double mean_diff;
-
- struct variable *var = cmd->v_variables[i];
- struct group_proc *grp_data = group_proc_get (var);
-
- struct hsh_table *grp_hash = grp_data->group_hash;
-
- struct group_statistics *gs0 ;
- struct group_statistics *gs1 ;
-
- union value search_val;
-
- if ( gp.criterion == CMP_LE )
- search_val.f = gp.v.critical_value - 1.0;
- else
- search_val = gp.v.g_value[0];
-
- gs0 = hsh_find(grp_hash, (void *) &search_val);
- assert(gs0);
-
- if ( gp.criterion == CMP_LE )
- search_val.f = gp.v.critical_value + 1.0;
- else
- search_val = gp.v.g_value[1];
-
- gs1 = hsh_find(grp_hash, (void *) &search_val);
- assert(gs1);
-
-
- tab_text (self->t, 0, i*2+3, TAB_LEFT, cmd->v_variables[i]->name);
-
- tab_text (self->t, 1, i*2+3, TAB_LEFT, _("Equal variances assumed"));
-
-
- tab_float(self->t, 2, i*2+3, TAB_CENTER, grp_data->levene, 8,3);
-
- /* Now work out the significance of the Levene test */
- df1 = 1; df2 = grp_data->ugs.n - 2;
- q = gsl_cdf_fdist_Q(grp_data->levene, df1, df2);
-
- tab_float(self->t, 3, i*2+3, TAB_CENTER, q, 8,3 );
-
- df = gs0->n + gs1->n - 2.0 ;
- tab_float (self->t, 5, i*2+3, TAB_RIGHT, df, 2, 0);
-
- pooled_variance = ( (gs0->n )*pow2(gs0->s_std_dev)
- +
- (gs1->n )*pow2(gs1->s_std_dev)
- ) / df ;
-
- t = (gs0->mean - gs1->mean) / sqrt(pooled_variance) ;
- t /= sqrt((gs0->n + gs1->n)/(gs0->n*gs1->n));
-
- tab_float (self->t, 4, i*2+3, TAB_RIGHT, t, 8, 3);
-
- p = gsl_cdf_tdist_P(t, df);
- q = gsl_cdf_tdist_Q(t, df);
-
- tab_float(self->t, 6, i*2+3, TAB_RIGHT, 2.0*(t>0?q:p) , 8, 3);
-
- mean_diff = gs0->mean - gs1->mean;
- tab_float(self->t, 7, i*2+3, TAB_RIGHT, mean_diff, 8, 3);
-
-
- std_err_diff = sqrt( pow2(gs0->se_mean) + pow2(gs1->se_mean));
- tab_float(self->t, 8, i*2+3, TAB_RIGHT, std_err_diff, 8, 3);
-
-
- /* Now work out the confidence interval */
- q = (1 - cmd->criteria)/2.0; /* 2-tailed test */
-
- t = gsl_cdf_tdist_Qinv(q,df);
- tab_float(self->t, 9, i*2+3, TAB_RIGHT,
- mean_diff - t * std_err_diff, 8, 3);
-
- tab_float(self->t, 10, i*2+3, TAB_RIGHT,
- mean_diff + t * std_err_diff, 8, 3);
-
-
- {
- double se2;
- /* Now for the \sigma_1 != \sigma_2 case */
- tab_text (self->t, 1, i*2+3+1,
- TAB_LEFT, _("Equal variances not assumed"));
-
-
- se2 = (pow2(gs0->s_std_dev)/(gs0->n -1) ) +
- (pow2(gs1->s_std_dev)/(gs1->n -1) );
-
- t = mean_diff / sqrt(se2) ;
- tab_float (self->t, 4, i*2+3+1, TAB_RIGHT, t, 8, 3);
-
- df = pow2(se2) / (
- (pow2(pow2(gs0->s_std_dev)/(gs0->n - 1 ))
- /(gs0->n -1 )
- )
- +
- (pow2(pow2(gs1->s_std_dev)/(gs1->n - 1 ))
- /(gs1->n -1 )
- )
- ) ;
- tab_float (self->t, 5, i*2+3+1, TAB_RIGHT, df, 8, 3);
-
- p = gsl_cdf_tdist_P(t, df);
- q = gsl_cdf_tdist_Q(t, df);
-
- tab_float(self->t, 6, i*2+3+1, TAB_RIGHT, 2.0*(t>0?q:p) , 8, 3);
-
- /* Now work out the confidence interval */
- q = (1 - cmd->criteria)/2.0; /* 2-tailed test */
-
- t = gsl_cdf_tdist_Qinv(q, df);
-
- tab_float(self->t, 7, i*2+3+1, TAB_RIGHT, mean_diff, 8, 3);
-
-
- tab_float(self->t, 8, i*2+3+1, TAB_RIGHT, std_err_diff, 8, 3);
-
-
- tab_float(self->t, 9, i*2+3+1, TAB_RIGHT,
- mean_diff - t * std_err_diff, 8, 3);
-
- tab_float(self->t, 10, i*2+3+1, TAB_RIGHT,
- mean_diff + t * std_err_diff, 8, 3);
-
- }
- }
-}
-
-/* Initialize the paired samples trbox */
-void
-trbox_paired_init(struct trbox *self,
- struct cmd_t_test *cmd UNUSED)
-{
-
- const int hsize=10;
- const int vsize=n_pairs+3;
-
- self->populate = trbox_paired_populate;
-
- trbox_base_init(self,n_pairs,hsize);
- tab_title (self->t, 0, _("Paired Samples Test"));
- tab_hline(self->t,TAL_1,2,6,1);
- tab_vline(self->t,TAL_2,2,0,vsize - 1);
- tab_joint_text(self->t,2,0,6,0,TAB_CENTER,_("Paired Differences"));
- tab_box(self->t,-1,-1,-1,TAL_1, 2,1,6,vsize-1);
- tab_box(self->t,-1,-1,-1,TAL_1, 6,0,hsize-1,vsize-1);
- tab_hline(self->t,TAL_1,5,6, 2);
- tab_vline(self->t,TAL_0,6,0,1);
-
- tab_joint_text(self->t, 5, 1, 6, 1, TAB_CENTER | TAT_PRINTF,
- _("%g%% Confidence Interval of the Difference"),
- cmd->criteria*100.0);
-
- tab_text (self->t, 2, 2, TAB_CENTER | TAT_TITLE, _("Mean"));
- tab_text (self->t, 3, 2, TAB_CENTER | TAT_TITLE, _("Std. Deviation"));
- tab_text (self->t, 4, 2, TAB_CENTER | TAT_TITLE, _("Std. Error Mean"));
- tab_text (self->t, 5, 2, TAB_CENTER | TAT_TITLE, _("Lower"));
- tab_text (self->t, 6, 2, TAB_CENTER | TAT_TITLE, _("Upper"));
- tab_text (self->t, 7, 2, TAB_CENTER | TAT_TITLE, _("t"));
- tab_text (self->t, 8, 2, TAB_CENTER | TAT_TITLE, _("df"));
- tab_text (self->t, 9, 2, TAB_CENTER | TAT_TITLE, _("Sig. (2-tailed)"));
-}
-
-/* Populate the paired samples trbox */
-void
-trbox_paired_populate(struct trbox *trb,
- struct cmd_t_test *cmd UNUSED)
-{
- int i;
-
- for (i=0; i < n_pairs; ++i)
- {
- double p,q;
- double se_mean;
-
- double n = pairs[i].n;
- double t;
- double df = n - 1;
-
- tab_text (trb->t, 0, i+3, TAB_LEFT | TAT_PRINTF, _("Pair %d"),i);
-
- tab_text (trb->t, 1, i+3, TAB_LEFT | TAT_PRINTF, "%s - %s",
- pairs[i].v[0]->name, pairs[i].v[1]->name);
-
- tab_float(trb->t, 2, i+3, TAB_RIGHT, pairs[i].mean_diff, 8, 4);
-
- tab_float(trb->t, 3, i+3, TAB_RIGHT, pairs[i].std_dev_diff, 8, 5);
-
- /* SE Mean */
- se_mean = pairs[i].std_dev_diff / sqrt(n) ;
- tab_float(trb->t, 4, i+3, TAB_RIGHT, se_mean, 8,5 );
-
- /* Now work out the confidence interval */
- q = (1 - cmd->criteria)/2.0; /* 2-tailed test */
-
- t = gsl_cdf_tdist_Qinv(q, df);
-
- tab_float(trb->t, 5, i+3, TAB_RIGHT,
- pairs[i].mean_diff - t * se_mean , 8, 4);
-
- tab_float(trb->t, 6, i+3, TAB_RIGHT,
- pairs[i].mean_diff + t * se_mean , 8, 4);
-
- t = (pairs[i].mean[0] - pairs[i].mean[1])
- / sqrt (
- ( pow2 (pairs[i].s_std_dev[0]) + pow2 (pairs[i].s_std_dev[1]) -
- 2 * pairs[i].correlation *
- pairs[i].s_std_dev[0] * pairs[i].s_std_dev[1] )
- / (n - 1)
- );
-
- tab_float(trb->t, 7, i+3, TAB_RIGHT, t , 8,3 );
-
- /* Degrees of freedom */
- tab_float(trb->t, 8, i+3, TAB_RIGHT, df , 2, 0 );
-
- p = gsl_cdf_tdist_P(t,df);
- q = gsl_cdf_tdist_P(t,df);
-
- tab_float(trb->t, 9, i+3, TAB_RIGHT, 2.0*(t>0?q:p) , 8, 3);
-
- }
-}
-
-/* Initialize the one sample trbox */
-void
-trbox_one_sample_init(struct trbox *self, struct cmd_t_test *cmd )
-{
- const int hsize=7;
- const int vsize=cmd->n_variables+3;
-
- self->populate = trbox_one_sample_populate;
-
- trbox_base_init(self, cmd->n_variables,hsize);
- tab_title (self->t, 0, _("One-Sample Test"));
- tab_hline(self->t, TAL_1, 1, hsize - 1, 1);
- tab_vline(self->t, TAL_2, 1, 0, vsize - 1);
-
- tab_joint_text(self->t, 1, 0, hsize-1,0, TAB_CENTER | TAT_PRINTF,
- _("Test Value = %f"), cmd->n_testval[0]);
-
- tab_box(self->t, -1, -1, -1, TAL_1, 1,1,hsize-1,vsize-1);
-
-
- tab_joint_text(self->t,5,1,6,1,TAB_CENTER | TAT_PRINTF,
- _("%g%% Confidence Interval of the Difference"),
- cmd->criteria*100.0);
-
- tab_vline(self->t,TAL_0,6,1,1);
- tab_hline(self->t,TAL_1,5,6,2);
- tab_text (self->t, 1, 2, TAB_CENTER | TAT_TITLE, _("t"));
- tab_text (self->t, 2, 2, TAB_CENTER | TAT_TITLE, _("df"));
- tab_text (self->t, 3, 2, TAB_CENTER | TAT_TITLE, _("Sig. (2-tailed)"));
- tab_text (self->t, 4, 2, TAB_CENTER | TAT_TITLE, _("Mean Difference"));
- tab_text (self->t, 5, 2, TAB_CENTER | TAT_TITLE, _("Lower"));
- tab_text (self->t, 6, 2, TAB_CENTER | TAT_TITLE, _("Upper"));
-
-}
-
-
-/* Populate the one sample trbox */
-void
-trbox_one_sample_populate(struct trbox *trb, struct cmd_t_test *cmd)
-{
- int i;
-
- assert(trb->t);
-
- for (i=0; i < cmd->n_variables; ++i)
- {
- double t;
- double p,q;
- double df;
- struct group_statistics *gs = &group_proc_get (cmd->v_variables[i])->ugs;
-
-
- tab_text (trb->t, 0, i+3, TAB_LEFT, cmd->v_variables[i]->name);
-
- t = (gs->mean - cmd->n_testval[0] ) * sqrt(gs->n) / gs->std_dev ;
-
- tab_float (trb->t, 1, i+3, TAB_RIGHT, t, 8,3);
-
- /* degrees of freedom */
- df = gs->n - 1;
-
- tab_float (trb->t, 2, i+3, TAB_RIGHT, df, 8,0);
-
- p = gsl_cdf_tdist_P(t, df);
- q = gsl_cdf_tdist_Q(t, df);
-
- /* Multiply by 2 to get 2-tailed significance, makeing sure we've got
- the correct tail*/
- tab_float (trb->t, 3, i+3, TAB_RIGHT, 2.0*(t>0?q:p), 8,3);
-
- tab_float (trb->t, 4, i+3, TAB_RIGHT, gs->mean_diff, 8,3);
-
-
- q = (1 - cmd->criteria)/2.0; /* 2-tailed test */
- t = gsl_cdf_tdist_Qinv(q, df);
-
- tab_float (trb->t, 5, i+3, TAB_RIGHT,
- gs->mean_diff - t * gs->se_mean, 8,4);
-
- tab_float (trb->t, 6, i+3, TAB_RIGHT,
- gs->mean_diff + t * gs->se_mean, 8,4);
- }
-}
-
-/* Base initializer for the generalized trbox */
-void
-trbox_base_init(struct trbox *self, size_t data_rows, int cols)
-{
- const size_t rows = 3 + data_rows;
-
- self->finalize = trbox_base_finalize;
- self->t = tab_create (cols, rows, 0);
- tab_headers (self->t,0,0,3,0);
- tab_box (self->t, TAL_2, TAL_2, TAL_0, TAL_0, 0, 0, cols -1, rows -1);
- tab_hline(self->t, TAL_2,0,cols-1,3);
- tab_dim (self->t, tab_natural_dimensions);
-}
-
-
-/* Base finalizer for the trbox */
-void
-trbox_base_finalize(struct trbox *trb)
-{
- tab_submit(trb->t);
-}
-
-
-/* Create , populate and submit the Paired Samples Correlation box */
-void
-pscbox(void)
-{
- const int rows=1+n_pairs;
- const int cols=5;
- int i;
-
- struct tab_table *table;
-
- table = tab_create (cols,rows,0);
-
- tab_columns (table, SOM_COL_DOWN, 1);
- tab_headers (table,0,0,1,0);
- tab_box (table, TAL_2, TAL_2, TAL_0, TAL_1, 0, 0, cols -1, rows -1 );
- tab_hline(table, TAL_2, 0, cols - 1, 1);
- tab_vline(table, TAL_2, 2, 0, rows - 1);
- tab_dim(table, tab_natural_dimensions);
- tab_title(table, 0, _("Paired Samples Correlations"));
-
- /* column headings */
- tab_text(table, 2,0, TAB_CENTER | TAT_TITLE, _("N"));
- tab_text(table, 3,0, TAB_CENTER | TAT_TITLE, _("Correlation"));
- tab_text(table, 4,0, TAB_CENTER | TAT_TITLE, _("Sig."));
-
- for (i=0; i < n_pairs; ++i)
- {
- double p,q;
-
- double df = pairs[i].n -2;
-
- double correlation_t =
- pairs[i].correlation * sqrt(df) /
- sqrt(1 - pow2(pairs[i].correlation));
-
-
- /* row headings */
- tab_text(table, 0,i+1, TAB_LEFT | TAT_TITLE | TAT_PRINTF,
- _("Pair %d"), i);
-
- tab_text(table, 1,i+1, TAB_LEFT | TAT_TITLE | TAT_PRINTF,
- _("%s & %s"), pairs[i].v[0]->name, pairs[i].v[1]->name);
-
-
- /* row data */
- tab_float(table, 2, i+1, TAB_RIGHT, pairs[i].n, 4, 0);
- tab_float(table, 3, i+1, TAB_RIGHT, pairs[i].correlation, 8, 3);
-
- p = gsl_cdf_tdist_P(correlation_t, df);
- q = gsl_cdf_tdist_Q(correlation_t, df);
-
- tab_float(table, 4, i+1, TAB_RIGHT, 2.0*(correlation_t>0?q:p), 8, 3);
- }
-
- tab_submit(table);
-}
-
-
-
-
-/* Calculation Implementation */
-
-/* Per case calculations common to all variants of the T test */
-static int
-common_calc (const struct ccase *c, void *_cmd)
-{
- int i;
- struct cmd_t_test *cmd = (struct cmd_t_test *)_cmd;
-
- double weight = dict_get_case_weight(default_dict,c,&bad_weight_warn);
-
-
- /* Skip the entire case if /MISSING=LISTWISE is set */
- if ( cmd->miss == TTS_LISTWISE )
- {
- for(i=0; i< cmd->n_variables ; ++i)
- {
- struct variable *v = cmd->v_variables[i];
- const union value *val = case_data (c, v->fv);
-
- if (value_is_missing(&v->miss, val) )
- {
- return 0;
- }
- }
- }
-
- /* Listwise has to be implicit if the independent variable is missing ?? */
- if ( cmd->sbc_groups )
- {
- const union value *gv = case_data (c, indep_var->fv);
- if ( value_is_missing(&indep_var->miss, gv) )
- {
- return 0;
- }
- }
-
-
- for(i=0; i< cmd->n_variables ; ++i)
- {
- struct group_statistics *gs;
- struct variable *v = cmd->v_variables[i];
- const union value *val = case_data (c, v->fv);
-
- gs= &group_proc_get (cmd->v_variables[i])->ugs;
-
- if (! value_is_missing(&v->miss, val) )
- {
- gs->n+=weight;
- gs->sum+=weight * val->f;
- gs->ssq+=weight * val->f * val->f;
- }
- }
- return 0;
-}
-
-/* Pre calculations common to all variants of the T test */
-static void
-common_precalc ( struct cmd_t_test *cmd )
-{
- int i=0;
-
- for(i=0; i< cmd->n_variables ; ++i)
- {
- struct group_statistics *gs;
- gs= &group_proc_get (cmd->v_variables[i])->ugs;
-
- gs->sum=0;
- gs->n=0;
- gs->ssq=0;
- gs->sum_diff=0;
- }
-}
-
-/* Post calculations common to all variants of the T test */
-void
-common_postcalc ( struct cmd_t_test *cmd )
-{
- int i=0;
-
-
- for(i=0; i< cmd->n_variables ; ++i)
- {
- struct group_statistics *gs;
- gs= &group_proc_get (cmd->v_variables[i])->ugs;
-
- gs->mean=gs->sum / gs->n;
- gs->s_std_dev= sqrt(
- ( (gs->ssq / gs->n ) - gs->mean * gs->mean )
- ) ;
-
- gs->std_dev= sqrt(
- gs->n/(gs->n-1) *
- ( (gs->ssq / gs->n ) - gs->mean * gs->mean )
- ) ;
-
- gs->se_mean = gs->std_dev / sqrt(gs->n);
- gs->mean_diff= gs->sum_diff / gs->n;
- }
-}
-
-/* Per case calculations for one sample t test */
-static int
-one_sample_calc (const struct ccase *c, void *cmd_)
-{
- int i;
- struct cmd_t_test *cmd = (struct cmd_t_test *)cmd_;
-
-
- double weight = dict_get_case_weight(default_dict,c,&bad_weight_warn);
-
- /* Skip the entire case if /MISSING=LISTWISE is set */
- if ( cmd->miss == TTS_LISTWISE )
- {
- for(i=0; i< cmd->n_variables ; ++i)
- {
- struct variable *v = cmd->v_variables[i];
- const union value *val = case_data (c, v->fv);
-
- if (value_is_missing(&v->miss, val) )
- {
- return 0;
- }
- }
- }
-
- for(i=0; i< cmd->n_variables ; ++i)
- {
- struct group_statistics *gs;
- struct variable *v = cmd->v_variables[i];
- const union value *val = case_data (c, v->fv);
-
- gs= &group_proc_get (cmd->v_variables[i])->ugs;
-
- if ( ! value_is_missing(&v->miss, val))
- gs->sum_diff += weight * (val->f - cmd->n_testval[0]);
- }
-
- return 0;
-}
-
-/* Pre calculations for one sample t test */
-static void
-one_sample_precalc ( struct cmd_t_test *cmd )
-{
- int i=0;
-
- for(i=0; i< cmd->n_variables ; ++i)
- {
- struct group_statistics *gs;
- gs= &group_proc_get (cmd->v_variables[i])->ugs;
-
- gs->sum_diff=0;
- }
-}
-
-/* Post calculations for one sample t test */
-static void
-one_sample_postcalc (struct cmd_t_test *cmd)
-{
- int i=0;
-
- for(i=0; i< cmd->n_variables ; ++i)
- {
- struct group_statistics *gs;
- gs= &group_proc_get (cmd->v_variables[i])->ugs;
-
- gs->mean_diff = gs->sum_diff / gs->n ;
- }
-}
-
-
-
-static void
-paired_precalc (struct cmd_t_test *cmd UNUSED)
-{
- int i;
-
- for(i=0; i < n_pairs ; ++i )
- {
- pairs[i].n = 0;
- pairs[i].sum[0] = 0; pairs[i].sum[1] = 0;
- pairs[i].ssq[0] = 0; pairs[i].ssq[1] = 0;
- pairs[i].sum_of_prod = 0;
- pairs[i].correlation = 0;
- pairs[i].sum_of_diffs = 0;
- pairs[i].ssq_diffs = 0;
- }
-
-}
-
-
-static int
-paired_calc (const struct ccase *c, void *cmd_)
-{
- int i;
-
- struct cmd_t_test *cmd = (struct cmd_t_test *) cmd_;
-
- double weight = dict_get_case_weight(default_dict,c,&bad_weight_warn);
-
- /* Skip the entire case if /MISSING=LISTWISE is set ,
- AND one member of a pair is missing */
- if ( cmd->miss == TTS_LISTWISE )
- {
- for(i=0; i < n_pairs ; ++i )
- {
- struct variable *v0 = pairs[i].v[0];
- struct variable *v1 = pairs[i].v[1];
-
- const union value *val0 = case_data (c, v0->fv);
- const union value *val1 = case_data (c, v1->fv);
-
- if ( value_is_missing(&v0->miss, val0) ||
- value_is_missing(&v1->miss, val1) )
- {
- return 0;
- }
- }
- }
-
- for(i=0; i < n_pairs ; ++i )
- {
- struct variable *v0 = pairs[i].v[0];
- struct variable *v1 = pairs[i].v[1];
-
- const union value *val0 = case_data (c, v0->fv);
- const union value *val1 = case_data (c, v1->fv);
-
- if ( ( !value_is_missing(&v0->miss, val0)
- && !value_is_missing(&v1->miss, val1) ) )
- {
- pairs[i].n += weight;
- pairs[i].sum[0] += weight * val0->f;
- pairs[i].sum[1] += weight * val1->f;
-
- pairs[i].ssq[0] += weight * pow2(val0->f);
- pairs[i].ssq[1] += weight * pow2(val1->f);
-
- pairs[i].sum_of_prod += weight * val0->f * val1->f ;
-
- pairs[i].sum_of_diffs += weight * ( val0->f - val1->f ) ;
- pairs[i].ssq_diffs += weight * pow2(val0->f - val1->f);
- }
- }
-
- return 0;
-}
-
-static void
-paired_postcalc (struct cmd_t_test *cmd UNUSED)
-{
- int i;
-
- for(i=0; i < n_pairs ; ++i )
- {
- int j;
- const double n = pairs[i].n;
-
- for (j=0; j < 2 ; ++j)
- {
- pairs[i].mean[j] = pairs[i].sum[j] / n ;
- pairs[i].s_std_dev[j] = sqrt((pairs[i].ssq[j] / n -
- pow2(pairs[i].mean[j]))
- );
-
- pairs[i].std_dev[j] = sqrt(n/(n-1)*(pairs[i].ssq[j] / n -
- pow2(pairs[i].mean[j]))
- );
- }
-
- pairs[i].correlation = pairs[i].sum_of_prod / pairs[i].n -
- pairs[i].mean[0] * pairs[i].mean[1] ;
- /* correlation now actually contains the covariance */
-
- pairs[i].correlation /= pairs[i].std_dev[0] * pairs[i].std_dev[1];
- pairs[i].correlation *= pairs[i].n / ( pairs[i].n - 1 );
-
- pairs[i].mean_diff = pairs[i].sum_of_diffs / n ;
-
- pairs[i].std_dev_diff = sqrt ( n / (n - 1) * (
- ( pairs[i].ssq_diffs / n )
- -
- pow2(pairs[i].mean_diff )
- ) );
- }
-}
-
-static void
-group_precalc (struct cmd_t_test *cmd )
-{
- int i;
- int j;
-
- for(i=0; i< cmd->n_variables ; ++i)
- {
- struct group_proc *ttpr = group_proc_get (cmd->v_variables[i]);
-
- /* There's always 2 groups for a T - TEST */
- ttpr->n_groups = 2;
-
- gp.indep_width = indep_var->width;
-
- ttpr->group_hash = hsh_create(2,
- (hsh_compare_func *) compare_group_binary,
- (hsh_hash_func *) hash_group_binary,
- (hsh_free_func *) free_group,
- (void *) &gp );
-
- for (j=0 ; j < 2 ; ++j)
- {
-
- struct group_statistics *gs = xmalloc (sizeof *gs);
-
- gs->sum = 0;
- gs->n = 0;
- gs->ssq = 0;
-
- if ( gp.criterion == CMP_EQ )
- {
- gs->id = gp.v.g_value[j];
- }
- else
- {
- if ( j == 0 )
- gs->id.f = gp.v.critical_value - 1.0 ;
- else
- gs->id.f = gp.v.critical_value + 1.0 ;
- }
-
- hsh_insert ( ttpr->group_hash, (void *) gs );
-
- }
- }
-
-}
-
-static int
-group_calc (const struct ccase *c, struct cmd_t_test *cmd)
-{
- int i;
-
- const union value *gv = case_data (c, indep_var->fv);
-
- const double weight = dict_get_case_weight(default_dict,c,&bad_weight_warn);
-
- if ( value_is_missing(&indep_var->miss, gv) )
- {
- return 0;
- }
-
- if ( cmd->miss == TTS_LISTWISE )
- {
- for(i=0; i< cmd->n_variables ; ++i)
- {
- struct variable *v = cmd->v_variables[i];
- const union value *val = case_data (c, v->fv);
-
- if (value_is_missing(&v->miss, val) )
- {
- return 0;
- }
- }
- }
-
- gv = case_data (c, indep_var->fv);
-
- for(i=0; i< cmd->n_variables ; ++i)
- {
- struct variable *var = cmd->v_variables[i];
- const union value *val = case_data (c, var->fv);
- struct hsh_table *grp_hash = group_proc_get (var)->group_hash;
- struct group_statistics *gs;
-
- gs = hsh_find(grp_hash, (void *) gv);
-
- /* If the independent variable doesn't match either of the values
- for this case then move on to the next case */
- if ( ! gs )
- return 0;
-
- if ( !value_is_missing(&var->miss, val) )
- {
- gs->n+=weight;
- gs->sum+=weight * val->f;
- gs->ssq+=weight * pow2(val->f);
- }
- }
-
- return 0;
-}
-
-
-static void
-group_postcalc ( struct cmd_t_test *cmd )
-{
- int i;
-
- for(i=0; i< cmd->n_variables ; ++i)
- {
- struct variable *var = cmd->v_variables[i];
- struct hsh_table *grp_hash = group_proc_get (var)->group_hash;
- struct hsh_iterator g;
- struct group_statistics *gs;
- int count=0;
-
- for (gs = hsh_first (grp_hash,&g);
- gs != 0;
- gs = hsh_next(grp_hash,&g))
- {
- gs->mean = gs->sum / gs->n;
-
- gs->s_std_dev= sqrt(
- ( (gs->ssq / gs->n ) - gs->mean * gs->mean )
- ) ;
-
- gs->std_dev= sqrt(
- gs->n/(gs->n-1) *
- ( (gs->ssq / gs->n ) - gs->mean * gs->mean )
- ) ;
-
- gs->se_mean = gs->std_dev / sqrt(gs->n);
- count ++;
- }
- assert(count == 2);
- }
-}
-
-
-
-static void
-calculate(const struct casefile *cf, void *cmd_)
-{
- struct ssbox stat_summary_box;
- struct trbox test_results_box;
-
- struct casereader *r;
- struct ccase c;
-
- struct cmd_t_test *cmd = (struct cmd_t_test *) cmd_;
-
- common_precalc(cmd);
- for(r = casefile_get_reader (cf);
- casereader_read (r, &c) ;
- case_destroy (&c))
- {
- common_calc(&c,cmd);
- }
- casereader_destroy (r);
- common_postcalc(cmd);
-
- switch(mode)
- {
- case T_1_SAMPLE:
- one_sample_precalc(cmd);
- for(r = casefile_get_reader (cf);
- casereader_read (r, &c) ;
- case_destroy (&c))
- {
- one_sample_calc(&c,cmd);
- }
- casereader_destroy (r);
- one_sample_postcalc(cmd);
-
- break;
- case T_PAIRED:
- paired_precalc(cmd);
- for(r = casefile_get_reader (cf);
- casereader_read (r, &c) ;
- case_destroy (&c))
- {
- paired_calc(&c,cmd);
- }
- casereader_destroy (r);
- paired_postcalc(cmd);
-
- break;
- case T_IND_SAMPLES:
-
- group_precalc(cmd);
- for(r = casefile_get_reader (cf);
- casereader_read (r, &c) ;
- case_destroy (&c))
- {
- group_calc(&c,cmd);
- }
- casereader_destroy (r);
- group_postcalc(cmd);
-
- levene(cf, indep_var, cmd->n_variables, cmd->v_variables,
- (cmd->miss == TTS_LISTWISE)?LEV_LISTWISE:LEV_ANALYSIS ,
- value_is_missing);
- break;
- }
-
- ssbox_create(&stat_summary_box,cmd,mode);
- ssbox_populate(&stat_summary_box,cmd);
- ssbox_finalize(&stat_summary_box);
-
- if ( mode == T_PAIRED)
- pscbox();
-
- trbox_create(&test_results_box,cmd,mode);
- trbox_populate(&test_results_box,cmd);
- trbox_finalize(&test_results_box);
-
-}
-
-short which_group(const struct group_statistics *g,
- const struct group_properties *p);
-
-/* Return -1 if the id of a is less than b; +1 if greater than and
- 0 if equal */
-static int
-compare_group_binary(const struct group_statistics *a,
- const struct group_statistics *b,
- const struct group_properties *p)
-{
- short flag_a;
- short flag_b;
-
- if ( p->criterion == CMP_LE )
- {
- /* less-than-or-equal comparision is not meaningfull for
- alpha variables, so we shouldn't ever arrive here */
- assert(p->indep_width == 0 ) ;
-
- flag_a = ( a->id.f < p->v.critical_value ) ;
- flag_b = ( b->id.f < p->v.critical_value ) ;
- }
- else
- {
- flag_a = which_group(a, p);
- flag_b = which_group(b, p);
- }
-
- if (flag_a < flag_b )
- return -1;
-
- return (flag_a > flag_b);
-}
-
-/* This is a degenerate case of a hash, since it can only return three possible
- values. It's really a comparison, being used as a hash function */
-
-static unsigned
-hash_group_binary(const struct group_statistics *g,
- const struct group_properties *p)
-{
- short flag = -1;
-
- if ( p->criterion == CMP_LE )
- {
- /* Not meaningfull to do a less than compare for alpha values ? */
- assert(p->indep_width == 0 ) ;
- flag = ( g->id.f < p->v.critical_value ) ;
- }
- else if ( p->criterion == CMP_EQ)
- {
- flag = which_group(g,p);
- }
- else
- assert(0);
-
- return flag;
-}
-
-/* return 0 if G belongs to group 0,
- 1 if it belongs to group 1,
- 2 if it belongs to neither group */
-short
-which_group(const struct group_statistics *g,
- const struct group_properties *p)
-{
-
- if ( 0 == compare_values (&g->id, &p->v.g_value[0], p->indep_width))
- return 0;
-
- if ( 0 == compare_values (&g->id, &p->v.g_value[1], p->indep_width))
- return 1;
-
- return 2;
-}
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "tab.h"
-#include <ctype.h>
-#include <stdarg.h>
-#include <limits.h>
-#include <stdlib.h>
-#include "error.h"
-#include "alloc.h"
-#include "command.h"
-#include "format.h"
-#include "magic.h"
-#include "misc.h"
-#include "output.h"
-#include "pool.h"
-#include "som.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-\f
-struct som_table_class tab_table_class;
-
-/* Creates a table with NC columns and NR rows. If REALLOCABLE is
- nonzero then the table's size can be increased later; otherwise,
- its size can only be reduced. */
-struct tab_table *
-tab_create (int nc, int nr, int reallocable)
-{
- void *(*alloc_func) (struct pool *, size_t n);
- void *(*nalloc_func) (struct pool *, size_t n, size_t s);
-
- struct tab_table *t;
-
- {
- struct pool *container = pool_create ();
- t = pool_alloc (container, sizeof *t);
- t->container = container;
- }
-
- t->col_style = TAB_COL_NONE;
- t->col_group = 0;
- ls_null (&t->title);
- t->flags = SOMF_NONE;
- t->nr = nr;
- t->nc = t->cf = nc;
- t->l = t->r = t->t = t->b = 0;
-
- nalloc_func = reallocable ? pool_nmalloc : pool_nalloc;
- alloc_func = reallocable ? pool_malloc : pool_alloc;
-#if GLOBAL_DEBUGGING
- t->reallocable = reallocable;
-#endif
-
- t->cc = nalloc_func (t->container, nr * nc, sizeof *t->cc);
- t->ct = alloc_func (t->container, nr * nc);
- memset (t->ct, TAB_EMPTY, nc * nr);
-
- t->rh = nalloc_func (t->container, nc, nr + 1);
- memset (t->rh, 0, nc * (nr + 1));
-
- t->hrh = nalloc_func (t->container, nr + 1, sizeof *t->hrh);
- memset (t->hrh, 0, sizeof *t->hrh * (nr + 1));
-
- t->trh = alloc_func (t->container, nr + 1);
- memset (t->trh, 0, nr + 1);
-
- t->rv = nalloc_func (t->container, nr, nc + 1);
- memset (t->rv, 0, (nc + 1) * nr);
-
- t->wrv = nalloc_func (t->container, nc + 1, sizeof *t->wrv);
- memset (t->wrv, 0, sizeof *t->wrv * (nc + 1));
-
- t->trv = alloc_func (t->container, nc + 1);
- memset (t->trv, 0, nc + 1);
-
- t->dim = NULL;
- t->w = t->h = NULL;
- t->col_ofs = t->row_ofs = 0;
-
- return t;
-}
-
-/* Destroys table T. */
-void
-tab_destroy (struct tab_table *t)
-{
- assert (t != NULL);
- pool_destroy (t->container);
- t=0;
-}
-
-/* Sets the width and height of a table, in columns and rows,
- respectively. Use only to reduce the size of a table, since it
- does not change the amount of allocated memory. */
-void
-tab_resize (struct tab_table *t, int nc, int nr)
-{
- assert (t != NULL);
- if (nc != -1)
- {
- assert (nc + t->col_ofs <= t->cf);
- t->nc = nc + t->col_ofs;
- }
- if (nr != -1)
- {
- assert (nr + t->row_ofs <= t->nr);
- t->nr = nr + t->row_ofs;
- }
-}
-
-/* Changes either or both dimensions of a table. Consider using the
- above routine instead if it won't waste a lot of space.
-
- Changing the number of columns in a table is particularly expensive
- in space and time. Avoid doing such. FIXME: In fact, transferring
- of rules isn't even implemented yet. */
-void
-tab_realloc (struct tab_table *t, int nc, int nr)
-{
- int ro, co;
-
- assert (t != NULL);
-#if GLOBAL_DEBUGGING
- assert (t->reallocable);
-#endif
- ro = t->row_ofs;
- co = t->col_ofs;
- if (ro || co)
- tab_offset (t, 0, 0);
-
- if (nc == -1)
- nc = t->nc;
- if (nr == -1)
- nr = t->nr;
-
- assert (nc == t->nc);
-
- if (nc > t->cf)
- {
- int mr1 = min (nr, t->nr);
- int mc1 = min (nc, t->nc);
-
- struct fixed_string *new_cc;
- unsigned char *new_ct;
- int r;
-
- new_cc = pool_nmalloc (t->container, nr * nc, sizeof *new_cc);
- new_ct = pool_malloc (t->container, nr * nc);
- for (r = 0; r < mr1; r++)
- {
- memcpy (&new_cc[r * nc], &t->cc[r * t->nc], mc1 * sizeof *t->cc);
- memcpy (&new_ct[r * nc], &t->ct[r * t->nc], mc1);
- memset (&new_ct[r * nc + t->nc], TAB_EMPTY, nc - t->nc);
- }
- pool_free (t->container, t->cc);
- pool_free (t->container, t->ct);
- t->cc = new_cc;
- t->ct = new_ct;
- t->cf = nc;
- }
- else if (nr != t->nr)
- {
- t->cc = pool_nrealloc (t->container, t->cc, nr * nc, sizeof *t->cc);
- t->ct = pool_realloc (t->container, t->ct, nr * nc);
-
- t->rh = pool_nrealloc (t->container, t->rh, nc, nr + 1);
- t->rv = pool_nrealloc (t->container, t->rv, nr, nc + 1);
- t->trh = pool_realloc (t->container, t->trh, nr + 1);
- t->hrh = pool_nrealloc (t->container, t->hrh, nr + 1, sizeof *t->hrh);
-
- if (nr > t->nr)
- {
- memset (&t->rh[nc * (t->nr + 1)], 0, (nr - t->nr) * nc);
- memset (&t->rv[(nc + 1) * t->nr], 0, (nr - t->nr) * (nc + 1));
- memset (&t->trh[t->nr + 1], 0, nr - t->nr);
- }
- }
-
- memset (&t->ct[nc * t->nr], TAB_EMPTY, nc * (nr - t->nr));
-
- t->nr = nr;
- t->nc = nc;
-
- if (ro || co)
- tab_offset (t, co, ro);
-}
-
-/* Sets the number of header rows on each side of TABLE to L on the
- left, R on the right, T on the top, B on the bottom. Header rows
- are repeated when a table is broken across multiple columns or
- multiple pages. */
-void
-tab_headers (struct tab_table *table, int l, int r, int t, int b)
-{
- assert (table != NULL);
- assert (l < table->nc);
- assert (r < table->nc);
- assert (t < table->nr);
- assert (b < table->nr);
-
-
- table->l = l;
- table->r = r;
- table->t = t;
- table->b = b;
-}
-
-/* Set up table T so that, when it is an appropriate size, it will be
- displayed across the page in columns.
-
- STYLE is a TAB_COL_* constant. GROUP is the number of rows to take
- as a unit. */
-void
-tab_columns (struct tab_table *t, int style, int group)
-{
- assert (t != NULL);
- t->col_style = style;
- t->col_group = group;
-}
-\f
-/* Rules. */
-
-/* Draws a vertical line to the left of cells at horizontal position X
- from Y1 to Y2 inclusive in style STYLE, if style is not -1. */
-void
-tab_vline (struct tab_table *t, int style, int x, int y1, int y2)
-{
- int y;
-
- assert (t != NULL);
-
-#if GLOBAL_DEBUGGING
- if (x + t->col_ofs < 0 || x + t->col_ofs > t->nc
- || y1 + t->row_ofs < 0 || y1 + t->row_ofs >= t->nr
- || y2 + t->row_ofs < 0 || y2 + t->row_ofs >= t->nr)
- {
- printf (_("bad vline: x=%d+%d=%d y=(%d+%d=%d,%d+%d=%d) in "
- "table size (%d,%d)\n"),
- x, t->col_ofs, x + t->col_ofs,
- y1, t->row_ofs, y1 + t->row_ofs,
- y2, t->row_ofs, y2 + t->row_ofs,
- t->nc, t->nr);
- return;
- }
-#endif
-
- x += t->col_ofs;
- y1 += t->row_ofs;
- y2 += t->row_ofs;
-
- assert (x > 0);
- assert (x < t->nc);
- assert (y1 >= 0);
- assert (y2 >= y1);
- assert (y2 <= t->nr);
-
- if (style != -1)
- {
- if ((style & TAL_SPACING) == 0)
- for (y = y1; y <= y2; y++)
- t->rv[x + (t->cf + 1) * y] = style;
- t->trv[x] |= (1 << (style & ~TAL_SPACING));
- }
-}
-
-/* Draws a horizontal line above cells at vertical position Y from X1
- to X2 inclusive in style STYLE, if style is not -1. */
-void
-tab_hline (struct tab_table * t, int style, int x1, int x2, int y)
-{
- int x;
-
- assert (t != NULL);
-
- x1 += t->col_ofs;
- x2 += t->col_ofs;
- y += t->row_ofs;
-
- assert (y >= 0);
- assert (y < t->nr);
- assert (x2 >= x1 );
- assert (x1 >= 0 );
- assert (x2 < t->nc);
-
- if (style != -1)
- {
- if ((style & TAL_SPACING) == 0)
- for (x = x1; x <= x2; x++)
- t->rh[x + t->cf * y] = style;
- t->trh[y] |= (1 << (style & ~TAL_SPACING));
- }
-}
-
-/* Draws a box around cells (X1,Y1)-(X2,Y2) inclusive with horizontal
- lines of style F_H and vertical lines of style F_V. Fills the
- interior of the box with horizontal lines of style I_H and vertical
- lines of style I_V. Any of the line styles may be -1 to avoid
- drawing those lines. This is distinct from 0, which draws a null
- line. */
-void
-tab_box (struct tab_table *t, int f_h, int f_v, int i_h, int i_v,
- int x1, int y1, int x2, int y2)
-{
- assert (t != NULL);
-
-#if GLOBAL_DEBUGGING
- if (x1 + t->col_ofs < 0 || x1 + t->col_ofs >= t->nc
- || x2 + t->col_ofs < 0 || x2 + t->col_ofs >= t->nc
- || y1 + t->row_ofs < 0 || y1 + t->row_ofs >= t->nr
- || y2 + t->row_ofs < 0 || y2 + t->row_ofs >= t->nr)
- {
- printf (_("bad box: (%d+%d=%d,%d+%d=%d)-(%d+%d=%d,%d+%d=%d) "
- "in table size (%d,%d)\n"),
- x1, t->col_ofs, x1 + t->col_ofs,
- y1, t->row_ofs, y1 + t->row_ofs,
- x2, t->col_ofs, x2 + t->col_ofs,
- y2, t->row_ofs, y2 + t->row_ofs,
- t->nc, t->nr);
- abort ();
- }
-#endif
-
- x1 += t->col_ofs;
- x2 += t->col_ofs;
- y1 += t->row_ofs;
- y2 += t->row_ofs;
-
- assert (x2 >= x1);
- assert (y2 >= y1);
- assert (x1 >= 0);
- assert (y1 >= 0);
- assert (x2 < t->nc);
- assert (y2 < t->nr);
-
- if (f_h != -1)
- {
- int x;
- if ((f_h & TAL_SPACING) == 0)
- for (x = x1; x <= x2; x++)
- {
- t->rh[x + t->cf * y1] = f_h;
- t->rh[x + t->cf * (y2 + 1)] = f_h;
- }
- t->trh[y1] |= (1 << (f_h & ~TAL_SPACING));
- t->trh[y2 + 1] |= (1 << (f_h & ~TAL_SPACING));
- }
- if (f_v != -1)
- {
- int y;
- if ((f_v & TAL_SPACING) == 0)
- for (y = y1; y <= y2; y++)
- {
- t->rv[x1 + (t->cf + 1) * y] = f_v;
- t->rv[(x2 + 1) + (t->cf + 1) * y] = f_v;
- }
- t->trv[x1] |= (1 << (f_v & ~TAL_SPACING));
- t->trv[x2 + 1] |= (1 << (f_v & ~TAL_SPACING));
- }
-
- if (i_h != -1)
- {
- int y;
-
- for (y = y1 + 1; y <= y2; y++)
- {
- int x;
-
- if ((i_h & TAL_SPACING) == 0)
- for (x = x1; x <= x2; x++)
- t->rh[x + t->cf * y] = i_h;
-
- t->trh[y] |= (1 << (i_h & ~TAL_SPACING));
- }
- }
- if (i_v != -1)
- {
- int x;
-
- for (x = x1 + 1; x <= x2; x++)
- {
- int y;
-
- if ((i_v & TAL_SPACING) == 0)
- for (y = y1; y <= y2; y++)
- t->rv[x + (t->cf + 1) * y] = i_v;
-
- t->trv[x] |= (1 << (i_v & ~TAL_SPACING));
- }
- }
-}
-
-/* Formats text TEXT and arguments ARGS as indicated in OPT and sets
- the resultant string into S in TABLE's pool. */
-static void
-text_format (struct tab_table *table, int opt, const char *text, va_list args,
- struct fixed_string *s)
-{
- int len;
-
- assert (table != NULL && text != NULL && s != NULL);
-
- if (opt & TAT_PRINTF)
- {
- char *temp_buf = local_alloc (1024);
-
- len = nvsprintf (temp_buf, text, args);
- text = temp_buf;
- }
- else
- len = strlen (text);
-
- ls_create_buffer (s, text, len);
- pool_register (table->container, free, s->string);
-
- if (opt & TAT_PRINTF)
- local_free (text);
-}
-
-/* Set the title of table T to TITLE, which is formatted with printf
- if FORMAT is nonzero. */
-void
-tab_title (struct tab_table *t, int format, const char *title, ...)
-{
- va_list args;
-
- assert (t != NULL && title != NULL);
- va_start (args, title);
- text_format (t, format ? TAT_PRINTF : TAT_NONE, title, args, &t->title);
- va_end (args);
-}
-
-/* Set DIM_FUNC as the dimension function for table T. */
-void
-tab_dim (struct tab_table *t, tab_dim_func *dim_func)
-{
- assert (t != NULL && t->dim == NULL);
- t->dim = dim_func;
-}
-
-/* Returns the natural width of column C in table T for driver D, that
- is, the smallest width necessary to display all its cells without
- wrapping. The width will be no larger than the page width minus
- left and right rule widths. */
-int
-tab_natural_width (struct tab_table *t, struct outp_driver *d, int c)
-{
- int width;
-
- assert (t != NULL && c >= 0 && c < t->nc);
- {
- int r;
-
- for (width = r = 0; r < t->nr; r++)
- {
- struct outp_text text;
- unsigned char opt = t->ct[c + r * t->cf];
-
- if (opt & (TAB_JOIN | TAB_EMPTY))
- continue;
-
- text.s = t->cc[c + r * t->cf];
- assert (!ls_null_p (&text.s));
- text.options = OUTP_T_JUST_LEFT;
-
- d->class->text_metrics (d, &text);
- if (text.h > width)
- width = text.h;
- }
- }
-
- if (width == 0)
- {
- width = d->prop_em_width * 8;
-#if GLOBAL_DEBUGGING
- printf ("warning: table column %d contains no data.\n", c);
-#endif
- }
-
- {
- const int clamp = d->width - t->wrv[0] - t->wrv[t->nc];
-
- if (width > clamp)
- width = clamp;
- }
-
- return width;
-}
-
-/* Returns the natural height of row R in table T for driver D, that
- is, the minimum height necessary to display the information in the
- cell at the widths set for each column. */
-int
-tab_natural_height (struct tab_table *t, struct outp_driver *d, int r)
-{
- int height;
-
- assert (t != NULL && r >= 0 && r < t->nr);
-
- {
- int c;
-
- for (height = d->font_height, c = 0; c < t->nc; c++)
- {
- struct outp_text text;
- unsigned char opt = t->ct[c + r * t->cf];
-
- assert (t->w[c] != NOT_INT);
- if (opt & (TAB_JOIN | TAB_EMPTY))
- continue;
-
- text.s = t->cc[c + r * t->cf];
- assert (!ls_null_p (&text.s));
- text.options = OUTP_T_HORZ | OUTP_T_JUST_LEFT;
- text.h = t->w[c];
- d->class->text_metrics (d, &text);
-
- if (text.v > height)
- height = text.v;
- }
- }
-
- return height;
-}
-
-/* Callback function to set all columns and rows to their natural
- dimensions. Not really meant to be called directly. */
-void
-tab_natural_dimensions (struct tab_table *t, struct outp_driver *d)
-{
- int i;
-
- assert (t != NULL);
-
- for (i = 0; i < t->nc; i++)
- t->w[i] = tab_natural_width (t, d, i);
-
- for (i = 0; i < t->nr; i++)
- t->h[i] = tab_natural_height (t, d, i);
-}
-
-\f
-/* Cells. */
-
-/* Sets cell (C,R) in TABLE, with options OPT, to have a value taken
- from V, displayed with format spec F. */
-void
-tab_value (struct tab_table *table, int c, int r, unsigned char opt,
- const union value *v, const struct fmt_spec *f)
-{
- char *contents;
-
- assert (table != NULL && v != NULL && f != NULL);
-#if GLOBAL_DEBUGGING
- if (c + table->col_ofs < 0 || r + table->row_ofs < 0
- || c + table->col_ofs >= table->nc
- || r + table->row_ofs >= table->nr)
- {
- printf ("tab_value(): bad cell (%d+%d=%d,%d+%d=%d) in table size "
- "(%d,%d)\n",
- c, table->col_ofs, c + table->col_ofs,
- r, table->row_ofs, r + table->row_ofs,
- table->nc, table->nr);
- return;
- }
-#endif
-
- contents = pool_alloc (table->container, f->w);
- ls_init (&table->cc[c + r * table->cf], contents, f->w);
- table->ct[c + r * table->cf] = opt;
-
- data_out (contents, f, v);
-}
-
-/* Sets cell (C,R) in TABLE, with options OPT, to have value VAL
- with NDEC decimal places. */
-void
-tab_float (struct tab_table *table, int c, int r, unsigned char opt,
- double val, int w, int d)
-{
- char *contents;
- char buf[40], *cp;
-
- struct fmt_spec f;
- union value double_value;
-
- assert (table != NULL && w <= 40);
-
- assert (c >= 0);
- assert (c < table->nc);
- assert (r >= 0);
- assert (r < table->nr);
-
- f = make_output_format (FMT_F, w, d);
-
-#if GLOBAL_DEBUGGING
- if (c + table->col_ofs < 0 || r + table->row_ofs < 0
- || c + table->col_ofs >= table->nc
- || r + table->row_ofs >= table->nr)
- {
- printf ("tab_float(): bad cell (%d+%d=%d,%d+%d=%d) in table size "
- "(%d,%d)\n",
- c, table->col_ofs, c + table->col_ofs,
- r, table->row_ofs, r + table->row_ofs,
- table->nc, table->nr);
- return;
- }
-#endif
-
- double_value.f = val;
- data_out (buf, &f, &double_value);
-
- cp = buf;
- while (isspace ((unsigned char) *cp) && cp < &buf[w])
- cp++;
- f.w = w - (cp - buf);
-
- contents = pool_alloc (table->container, f.w);
- ls_init (&table->cc[c + r * table->cf], contents, f.w);
- table->ct[c + r * table->cf] = opt;
- memcpy (contents, cp, f.w);
-}
-
-/* Sets cell (C,R) in TABLE, with options OPT, to have text value
- TEXT. */
-void
-tab_text (struct tab_table *table, int c, int r, unsigned opt, const char *text, ...)
-{
- va_list args;
-
- assert (table != NULL && text != NULL);
-
- assert (c >= 0 );
- assert (r >= 0 );
- assert (c < table->nc);
- assert (r < table->nr);
-
-
-#if GLOBAL_DEBUGGING
- if (c + table->col_ofs < 0 || r + table->row_ofs < 0
- || c + table->col_ofs >= table->nc
- || r + table->row_ofs >= table->nr)
- {
- printf ("tab_text(): bad cell (%d+%d=%d,%d+%d=%d) in table size "
- "(%d,%d)\n",
- c, table->col_ofs, c + table->col_ofs,
- r, table->row_ofs, r + table->row_ofs,
- table->nc, table->nr);
- return;
- }
-#endif
-
- va_start (args, text);
- text_format (table, opt, text, args, &table->cc[c + r * table->cf]);
- table->ct[c + r * table->cf] = opt;
- va_end (args);
-}
-
-/* Joins cells (X1,X2)-(Y1,Y2) inclusive in TABLE, and sets them with
- options OPT to have text value TEXT. */
-void
-tab_joint_text (struct tab_table *table, int x1, int y1, int x2, int y2,
- unsigned opt, const char *text, ...)
-{
- struct tab_joined_cell *j;
-
- assert (table != NULL && text != NULL);
-
- assert (x1 + table->col_ofs >= 0);
- assert (y1 + table->row_ofs >= 0);
- assert (y2 >= y1);
- assert (x2 >= x1);
- assert (y2 + table->row_ofs < table->nr);
- assert (x2 + table->col_ofs < table->nc);
-
-#if GLOBAL_DEBUGGING
- if (x1 + table->col_ofs < 0 || x1 + table->col_ofs >= table->nc
- || y1 + table->row_ofs < 0 || y1 + table->row_ofs >= table->nr
- || x2 < x1 || x2 + table->col_ofs >= table->nc
- || y2 < y2 || y2 + table->row_ofs >= table->nr)
- {
- printf ("tab_joint_text(): bad cell "
- "(%d+%d=%d,%d+%d=%d)-(%d+%d=%d,%d+%d=%d) in table size (%d,%d)\n",
- x1, table->col_ofs, x1 + table->col_ofs,
- y1, table->row_ofs, y1 + table->row_ofs,
- x2, table->col_ofs, x2 + table->col_ofs,
- y2, table->row_ofs, y2 + table->row_ofs,
- table->nc, table->nr);
- return;
- }
-#endif
-
- j = pool_alloc (table->container, sizeof *j);
- j->hit = 0;
- j->x1 = x1 + table->col_ofs;
- j->y1 = y1 + table->row_ofs;
- j->x2 = ++x2 + table->col_ofs;
- j->y2 = ++y2 + table->row_ofs;
-
- {
- va_list args;
-
- va_start (args, text);
- text_format (table, opt, text, args, &j->contents);
- va_end (args);
- }
-
- opt |= TAB_JOIN;
-
- {
- struct fixed_string *cc = &table->cc[x1 + y1 * table->cf];
- unsigned char *ct = &table->ct[x1 + y1 * table->cf];
- const int ofs = table->cf - (x2 - x1);
-
- int y;
-
- for (y = y1; y < y2; y++)
- {
- int x;
-
- for (x = x1; x < x2; x++)
- {
- ls_init (cc++, (char *) j, 0);
- *ct++ = opt;
- }
-
- cc += ofs;
- ct += ofs;
- }
- }
-}
-
-/* Sets cell (C,R) in TABLE, with options OPT, to contents STRING. */
-void
-tab_raw (struct tab_table *table, int c, int r, unsigned opt,
- struct fixed_string *string)
-{
- assert (table != NULL && string != NULL);
-
-#if GLOBAL_DEBUGGING
- if (c + table->col_ofs < 0 || r + table->row_ofs < 0
- || c + table->col_ofs >= table->nc
- || r + table->row_ofs >= table->nr)
- {
- printf ("tab_float(): bad cell (%d+%d=%d,%d+%d=%d) in table size "
- "(%d,%d)\n",
- c, table->col_ofs, c + table->col_ofs,
- r, table->row_ofs, r + table->row_ofs,
- table->nc, table->nr);
- return;
- }
-#endif
-
- table->cc[c + r * table->cf] = *string;
- table->ct[c + r * table->cf] = opt;
-}
-\f
-/* Miscellaneous. */
-
-/* Sets the widths of all the columns and heights of all the rows in
- table T for driver D. */
-static void
-nowrap_dim (struct tab_table *t, struct outp_driver *d)
-{
- t->w[0] = tab_natural_width (t, d, 0);
- t->h[0] = d->font_height;
-}
-
-/* Sets the widths of all the columns and heights of all the rows in
- table T for driver D. */
-static void
-wrap_dim (struct tab_table *t, struct outp_driver *d)
-{
- t->w[0] = tab_natural_width (t, d, 0);
- t->h[0] = tab_natural_height (t, d, 0);
-}
-
-/* Outputs text BUF as a table with a single cell having cell options
- OPTIONS, which is a combination of the TAB_* and TAT_*
- constants. */
-void
-tab_output_text (int options, const char *buf, ...)
-{
- struct tab_table *t = tab_create (1, 1, 0);
-
- assert (buf != NULL);
- if (options & TAT_PRINTF)
- {
- va_list args;
- char *temp_buf = local_alloc (4096);
-
- va_start (args, buf);
- nvsprintf (temp_buf, buf, args);
- buf = temp_buf;
- va_end (args);
- }
-
- if (options & TAT_FIX)
- {
- struct outp_driver *d;
-
- for (d = outp_drivers (NULL); d; d = outp_drivers (d))
- {
- if (!d->page_open)
- d->class->open_page (d);
-
- if (d->class->text_set_font_by_name != NULL)
- d->class->text_set_font_by_name (d, "FIXED");
- else
- {
- /* FIXME */
- }
- }
- }
-
- tab_text (t, 0, 0, options &~ TAT_PRINTF, buf);
- tab_flags (t, SOMF_NO_TITLE | SOMF_NO_SPACING);
- if (options & TAT_NOWRAP)
- tab_dim (t, nowrap_dim);
- else
- tab_dim (t, wrap_dim);
- tab_submit (t);
-
- if (options & TAT_FIX)
- {
- struct outp_driver *d;
-
- for (d = outp_drivers (NULL); d; d = outp_drivers (d))
- if (d->class->text_set_font_by_name != NULL)
- d->class->text_set_font_by_name (d, "PROP");
- else
- {
- /* FIXME */
- }
- }
-
- if (options & TAT_PRINTF)
- local_free (buf);
-}
-
-/* Set table flags to FLAGS. */
-void
-tab_flags (struct tab_table *t, unsigned flags)
-{
- assert (t != NULL);
- t->flags = flags;
-}
-
-/* Easy, type-safe way to submit a tab table to som. */
-void
-tab_submit (struct tab_table *t)
-{
- struct som_entity s;
-
- assert (t != NULL);
- s.class = &tab_table_class;
- s.ext = t;
- s.type = SOM_TABLE;
- som_submit (&s);
- tab_destroy (t);
-}
-\f
-/* Editing. */
-
-/* Set table row and column offsets for all functions that affect
- cells or rules. */
-void
-tab_offset (struct tab_table *t, int col, int row)
-{
- int diff = 0;
-
- assert (t != NULL);
-#if GLOBAL_DEBUGGING
- if (row < -1 || row >= t->nr)
- {
- printf ("tab_offset(): row=%d in %d-row table\n", row, t->nr);
- abort ();
- }
- if (col < -1 || col >= t->nc)
- {
- printf ("tab_offset(): col=%d in %d-column table\n", col, t->nc);
- abort ();
- }
-#endif
-
- if (row != -1)
- diff += (row - t->row_ofs) * t->cf, t->row_ofs = row;
- if (col != -1)
- diff += (col - t->col_ofs), t->col_ofs = col;
-
- t->cc += diff;
- t->ct += diff;
-}
-
-/* Increment the row offset by one. If the table is too small,
- increase its size. */
-void
-tab_next_row (struct tab_table *t)
-{
- assert (t != NULL);
- t->cc += t->cf;
- t->ct += t->cf;
- if (++t->row_ofs >= t->nr)
- tab_realloc (t, -1, t->nr * 4 / 3);
-}
-\f
-static struct tab_table *t;
-static struct outp_driver *d;
-int tab_hit;
-
-/* Set the current table to TABLE. */
-static void
-tabi_table (struct som_entity *table)
-{
- assert (table != NULL);
- assert (table->type == SOM_TABLE);
-
- t = table->ext;
- tab_offset (t, 0, 0);
-
- assert (t->w == NULL && t->h == NULL);
- t->w = pool_nalloc (t->container, t->nc, sizeof *t->w);
- t->h = pool_nalloc (t->container, t->nr, sizeof *t->h);
-}
-
-/* Set the current output device to DRIVER. */
-static void
-tabi_driver (struct outp_driver *driver)
-{
- int i;
-
- assert (driver != NULL);
- d = driver;
-
- /* Figure out sizes of rules. */
- for (t->hr_tot = i = 0; i <= t->nr; i++)
- t->hr_tot += t->hrh[i] = d->horiz_line_spacing[t->trh[i]];
- for (t->vr_tot = i = 0; i <= t->nc; i++)
- t->vr_tot += t->wrv[i] = d->vert_line_spacing[t->trv[i]];
-
-#if GLOBAL_DEBUGGING
- for (i = 0; i < t->nr; i++)
- t->h[i] = -1;
- for (i = 0; i < t->nc; i++)
- t->w[i] = -1;
-#endif
-
- assert (t->dim != NULL);
- t->dim (t, d);
-
-#if GLOBAL_DEBUGGING
- {
- int error = 0;
-
- for (i = 0; i < t->nr; i++)
- {
- if (t->h[i] == -1)
- {
- printf ("Table row %d height not initialized.\n", i);
- error = 1;
- }
- assert (t->h[i] > 0);
- }
-
- for (i = 0; i < t->nc; i++)
- {
- if (t->w[i] == -1)
- {
- printf ("Table column %d width not initialized.\n", i);
- error = 1;
- }
- assert (t->w[i] > 0);
- }
- }
-#endif
-
- /* Add up header sizes. */
- for (i = 0, t->wl = t->wrv[0]; i < t->l; i++)
- t->wl += t->w[i] + t->wrv[i + 1];
- for (i = 0, t->ht = t->hrh[0]; i < t->t; i++)
- t->ht += t->h[i] + t->hrh[i + 1];
- for (i = t->nc - t->r, t->wr = t->wrv[i]; i < t->nc; i++)
- t->wr += t->w[i] + t->wrv[i + 1];
- for (i = t->nr - t->b, t->hb = t->hrh[i]; i < t->nr; i++)
- t->hb += t->h[i] + t->hrh[i + 1];
-
- /* Title. */
- if (!(t->flags & SOMF_NO_TITLE))
- t->ht += d->font_height;
-}
-
-/* Return the number of columns and rows in the table into N_COLUMNS
- and N_ROWS, respectively. */
-static void
-tabi_count (int *n_columns, int *n_rows)
-{
- assert (n_columns != NULL && n_rows != NULL);
- *n_columns = t->nc;
- *n_rows = t->nr;
-}
-
-static void tabi_cumulate (int cumtype, int start, int *end, int max, int *actual);
-
-/* Return the horizontal and vertical size of the entire table,
- including headers, for the current output device, into HORIZ and
- VERT. */
-static void
-tabi_area (int *horiz, int *vert)
-{
- assert (horiz != NULL && vert != NULL);
-
- {
- int w, c;
-
- for (c = t->l + 1, w = t->wl + t->wr + t->w[t->l];
- c < t->nc - t->r; c++)
- w += t->w[c] + t->wrv[c];
- *horiz = w;
- }
-
- {
- int h, r;
- for (r = t->t + 1, h = t->ht + t->hb + t->h[t->t];
- r < t->nr - t->b; r++)
- h += t->h[r] + t->hrh[r];
- *vert = h;
- }
-}
-
-/* Return the column style for this table into STYLE. */
-static void
-tabi_columns (int *style)
-{
- assert (style != NULL);
- *style = t->col_style;
-}
-
-/* Return the number of header rows/columns on the left, right, top,
- and bottom sides into HL, HR, HT, and HB, respectively. */
-static void
-tabi_headers (int *hl, int *hr, int *ht, int *hb)
-{
- assert (hl != NULL && hr != NULL && ht != NULL && hb != NULL);
- *hl = t->l;
- *hr = t->r;
- *ht = t->t;
- *hb = t->b;
-}
-
-/* Determines the number of rows or columns (including appropriate
- headers), depending on CUMTYPE, that will fit into the space
- specified. Takes rows/columns starting at index START and attempts
- to fill up available space MAX. Returns in END the index of the
- last row/column plus one; returns in ACTUAL the actual amount of
- space the selected rows/columns (including appropriate headers)
- filled. */
-static void
-tabi_cumulate (int cumtype, int start, int *end, int max, int *actual)
-{
- int n;
- int *d;
- int *r;
- int total;
-
- assert (end != NULL && (cumtype == SOM_ROWS || cumtype == SOM_COLUMNS));
- if (cumtype == SOM_ROWS)
- {
- assert (start >= 0 && start < t->nr);
- n = t->nr - t->b;
- d = &t->h[start];
- r = &t->hrh[start + 1];
- total = t->ht + t->hb;
- } else {
- assert (start >= 0 && start < t->nc);
- n = t->nc - t->r;
- d = &t->w[start];
- r = &t->wrv[start + 1];
- total = t->wl + t->wr;
- }
-
- total += *d++;
- if (total > max)
- {
- if (end)
- *end = start;
- if (actual)
- *actual = 0;
- return;
- }
-
- {
- int x;
-
- for (x = start + 1; x < n; x++)
- {
- int amt = *d++ + *r++;
-
- total += amt;
- if (total > max)
- {
- total -= amt;
- break;
- }
- }
-
- if (end)
- *end = x;
-
- if (actual)
- *actual = total;
- }
-}
-
-/* Return flags set for the current table into FLAGS. */
-static void
-tabi_flags (unsigned *flags)
-{
- assert (flags != NULL);
- *flags = t->flags;
-}
-
-/* Returns true if the table will fit in the given page WIDTH,
- false otherwise. */
-static bool
-tabi_fits_width (int width)
-{
- int i;
-
- for (i = t->l; i < t->nc - t->r; i++)
- if (t->wl + t->wr + t->w[i] > width)
- return false;
-
- return true;
-}
-
-/* Returns true if the table will fit in the given page LENGTH,
- false otherwise. */
-static bool
-tabi_fits_length (int length)
-{
- int i;
-
- for (i = t->t; i < t->nr - t->b; i++)
- if (t->ht + t->hb + t->h[i] > length)
- return false;
-
- return true;
-}
-
-/* Sets the number of header rows/columns on the left, right, top,
- and bottom sides to HL, HR, HT, and HB, respectively. */
-static void
-tabi_set_headers (int hl, int hr, int ht, int hb)
-{
- t->l = hl;
- t->r = hr;
- t->t = ht;
- t->b = hb;
-}
-
-/* Render title for current table, with major index X and minor index
- Y. Y may be zero, or X and Y may be zero, but X should be nonzero
- if Y is nonzero. */
-static void
-tabi_title (int x, int y)
-{
- char buf[1024];
- char *cp;
-
- if (t->flags & SOMF_NO_TITLE)
- return;
-
- cp = spprintf (buf, "%d.%d", table_num, subtable_num);
- if (x && y)
- cp = spprintf (cp, "(%d:%d)", x, y);
- else if (x)
- cp = spprintf (cp, "(%d)", x);
- if (cur_proc)
- cp = spprintf (cp, " %s", cur_proc);
- cp = stpcpy (cp, ". ");
- if (!ls_empty_p (&t->title))
- {
- memcpy (cp, ls_c_str (&t->title), ls_length (&t->title));
- cp += ls_length (&t->title);
- }
- *cp = 0;
-
- {
- struct outp_text text;
-
- text.options = OUTP_T_JUST_LEFT | OUTP_T_HORZ | OUTP_T_VERT;
- ls_init (&text.s, buf, cp - buf);
- text.h = d->width;
- text.v = d->font_height;
- text.x = 0;
- text.y = d->cp_y;
- d->class->text_draw (d, &text);
- }
-}
-
-static int render_strip (int x, int y, int r, int c1, int c2, int r1, int r2);
-
-/* Draws the table region in rectangle (X1,Y1)-(X2,Y2), where column
- X2 and row Y2 are not included in the rectangle, at the current
- position on the current output device. Draws headers as well. */
-static void
-tabi_render (int x1, int y1, int x2, int y2)
-{
- int i, y;
- int ranges[3][2];
-
- tab_hit++;
-
- y = d->cp_y;
- if (!(t->flags & SOMF_NO_TITLE))
- y += d->font_height;
-
- /* Top headers. */
- ranges[0][0] = 0;
- ranges[0][1] = t->t * 2 + 1;
-
- /* Requested rows. */
- ranges[1][0] = y1 * 2 + 1;
- ranges[1][1] = y2 * 2;
-
- /* Bottom headers. */
- ranges[2][0] = (t->nr - t->b) * 2;
- ranges[2][1] = t->nr * 2 + 1;
-
- for (i = 0; i < 3; i++)
- {
- int r;
-
- for (r = ranges[i][0]; r < ranges[i][1]; r++)
- {
- int x = d->cp_x;
- x += render_strip (x, y, r, 0, t->l * 2 + 1, y1, y2);
- x += render_strip (x, y, r, x1 * 2 + 1, x2 * 2, y1, y2);
- x += render_strip (x, y, r, (t->nc - t->r) * 2,
- t->nc * 2 + 1, y1, y2);
- y += (r & 1) ? t->h[r / 2] : t->hrh[r / 2];
- }
- }
-}
-
-struct som_table_class tab_table_class =
- {
- tabi_table,
- tabi_driver,
-
- tabi_count,
- tabi_area,
- NULL,
- NULL,
- tabi_columns,
- NULL,
- tabi_headers,
- NULL,
- tabi_cumulate,
- tabi_flags,
- tabi_fits_width,
- tabi_fits_length,
-
- NULL,
- NULL,
- tabi_set_headers,
-
- tabi_title,
- tabi_render,
- };
-\f
-/* Render contiguous strip consisting of columns C1...C2, exclusive,
- on row R, at location (X,Y). Return width of the strip thus
- rendered.
-
- Renders joined cells, even those outside the strip, within the
- rendering region (C1,R1)-(C2,R2).
-
- For the purposes of counting rows and columns in this function
- only, horizontal rules are considered rows and vertical rules are
- considered columns.
-
- FIXME: Doesn't use r1? Huh? */
-static int
-render_strip (int x, int y, int r, int c1, int c2, int r1 UNUSED, int r2)
-{
- int x_origin = x;
-
- /* Horizontal rules. */
- if ((r & 1) == 0)
- {
- int hrh = t->hrh[r / 2];
- int c;
-
- for (c = c1; c < c2; c++)
- {
- if (c & 1)
- {
- int style = t->rh[(c / 2) + (r / 2 * t->cf)];
-
- if (style != TAL_0)
- {
- const struct color clr = {0, 0, 0, 0};
- struct rect rct;
-
- rct.x1 = x;
- rct.y1 = y;
- rct.x2 = x + t->w[c / 2];
- rct.y2 = y + hrh;
- d->class->line_horz (d, &rct, &clr, style);
- }
- x += t->w[c / 2];
- } else {
- const struct color clr = {0, 0, 0, 0};
- struct rect rct;
- struct outp_styles s;
-
- rct.x1 = x;
- rct.y1 = y;
- rct.x2 = x + t->wrv[c / 2];
- rct.y2 = y + hrh;
-
- s.t = r > 0 ? t->rv[(c / 2) + (t->cf + 1) * (r / 2 - 1)] : 0;
- s.b = r < 2 * t->nr ? t->rv[(c / 2) + (t->cf + 1) * (r / 2)] : 0;
- s.l = c > 0 ? t->rh[(c / 2 - 1) + t->cf * (r / 2)] : 0;
- s.r = c < 2 * t->nc ? t->rh[(c / 2) + t->cf * (r / 2)] : 0;
-
- if (s.t | s.b | s.l | s.r)
- d->class->line_intersection (d, &rct, &clr, &s);
-
- x += t->wrv[c / 2];
- }
- }
- } else {
- int c;
-
- for (c = c1; c < c2; c++)
- {
- if (c & 1)
- {
- const int index = (c / 2) + (r / 2 * t->cf);
-
- if (!(t->ct[index] & TAB_JOIN))
- {
- struct outp_text text;
-
- text.options = ((t->ct[index] & OUTP_T_JUST_MASK)
- | OUTP_T_HORZ | OUTP_T_VERT);
- if ((t->ct[index] & TAB_EMPTY) == 0)
- {
- text.s = t->cc[index];
- assert (!ls_null_p (&text.s));
- text.h = t->w[c / 2];
- text.v = t->h[r / 2];
- text.x = x;
- text.y = y;
- d->class->text_draw (d, &text);
- }
- } else {
- struct tab_joined_cell *j =
- (struct tab_joined_cell *) ls_c_str (&t->cc[index]);
-
- if (j->hit != tab_hit)
- {
- j->hit = tab_hit;
-
- if (j->x1 == c / 2 && j->y1 == r / 2)
- {
- struct outp_text text;
-
- text.options = ((t->ct[index] & OUTP_T_JUST_MASK)
- | OUTP_T_HORZ | OUTP_T_VERT);
- text.s = j->contents;
- text.x = x;
- text.y = y;
-
- {
- int c;
-
- for (c = j->x1, text.h = -t->wrv[j->x2];
- c < j->x2 && c < c2 / 2; c++)
- text.h += t->w[c] + t->wrv[c + 1];
- }
-
- {
- int r;
-
- for (r = j->y1, text.v = -t->hrh[j->y2];
- r < j->y2 && r < r2 / 2; r++)
- text.v += t->h[r] + t->hrh[r + 1];
- }
- d->class->text_draw (d, &text);
- }
- }
- }
- x += t->w[c / 2];
- } else {
- int style = t->rv[(c / 2) + (r / 2 * (t->cf + 1))];
-
- if (style != TAL_0)
- {
- const struct color clr = {0, 0, 0, 0};
- struct rect rct;
-
- rct.x1 = x;
- rct.y1 = y;
- rct.x2 = x + t->wrv[c / 2];
- rct.y2 = y + t->h[r / 2];
- d->class->line_vert (d, &rct, &clr, style);
- }
- x += t->wrv[c / 2];
- }
- }
- }
-
- return x - x_origin;
-}
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !tab_h
-#define tab_h 1
-
-#include <limits.h>
-#include "str.h"
-
-/* Cell options. */
-enum
- {
- TAB_NONE = 0,
-
- /* Must match output.h: OUTP_T_JUST_*. */
- TAB_ALIGN_MASK = 03, /* Alignment mask. */
- TAB_RIGHT = 00, /* Right justify. */
- TAB_LEFT = 01, /* Left justify. */
- TAB_CENTER = 02, /* Center. */
-
- /* Oddball cell types. */
- TAB_JOIN = 010, /* Joined cell. */
- TAB_EMPTY = 020 /* Empty cell. */
- };
-
-/* Line styles. These must match output.h:OUTP_L_*. */
-enum
- {
- TAL_0 = 0, /* No line. */
- TAL_1 = 1, /* Single line. */
- TAL_2 = 2, /* Double line. */
- TAL_3 = 3, /* Special line of driver-defined style. */
- TAL_COUNT, /* Number of line styles. */
-
- TAL_SPACING = 0200 /* Don't draw the line, just reserve space. */
- };
-
-/* Column styles. Must correspond to SOM_COL_*. */
-enum
- {
- TAB_COL_NONE, /* No columns. */
- TAB_COL_DOWN /* Columns down first. */
- };
-
-/* Joined cell. */
-struct tab_joined_cell
- {
- int x1, y1;
- int x2, y2;
- int hit;
- struct fixed_string contents;
- };
-
-struct outp_driver;
-struct tab_table;
-typedef void tab_dim_func (struct tab_table *, struct outp_driver *);
-
-/* A table. */
-struct tab_table
- {
- struct pool *container;
-
- /* Contents. */
- int col_style; /* Columns: One of TAB_COL_*. */
- int col_group; /* Number of rows per column group. */
- struct fixed_string title; /* Table title. */
- unsigned flags; /* SOMF_*. */
- int nc, nr; /* Number of columns, rows. */
- int cf; /* Column factor for indexing purposes. */
- int l, r, t, b; /* Number of header rows on each side. */
- struct fixed_string *cc; /* Cell contents; fixed_string *[nr][nc]. */
- unsigned char *ct; /* Cell types; unsigned char[nr][nc]. */
- unsigned char *rh; /* Horiz rules; unsigned char[nr+1][nc]. */
- unsigned char *trh; /* Types of horiz rules; [nr+1]. */
- unsigned char *rv; /* Vert rules; unsigned char[nr][nc+1]. */
- unsigned char *trv; /* Types of vert rules; [nc+1]. */
- tab_dim_func *dim; /* Calculates cell widths and heights. */
-
- /* Calculated during output. */
- int *w; /* Column widths; [nc]. */
- int *h; /* Row heights; [nr]. */
- int *hrh; /* Heights of horizontal rules; [nr+1]. */
- int *wrv; /* Widths of vertical rules; [nc+1]. */
- int wl, wr, ht, hb; /* Width/height of header rows/columns. */
- int hr_tot, vr_tot; /* Hrules total height, vrules total width. */
-
- /* Editing info. */
- int col_ofs, row_ofs; /* X and Y offsets. */
-#if GLOBAL_DEBUGGING
- int reallocable; /* Can table be reallocated? */
-#endif
- };
-
-extern int tab_hit;
-
-/* Number of rows in TABLE. */
-#define tab_nr(TABLE) ((TABLE)->nr)
-
-/* Number of columns in TABLE. */
-#define tab_nc(TABLE) ((TABLE)->nc)
-
-/* Number of left header columns in TABLE. */
-#define tab_l(TABLE) ((TABLE)->l)
-
-/* Number of right header columns in TABLE. */
-#define tab_r(TABLE) ((TABLE)->r)
-
-/* Number of top header rows in TABLE. */
-#define tab_t(TABLE) ((TABLE)->t)
-
-/* Number of bottom header rows in TABLE. */
-#define tab_b(TABLE) ((TABLE)->b)
-
-/* Tables. */
-struct tab_table *tab_create (int nc, int nr, int reallocable);
-void tab_destroy (struct tab_table *);
-void tab_resize (struct tab_table *, int nc, int nr);
-void tab_realloc (struct tab_table *, int nc, int nr);
-void tab_headers (struct tab_table *, int l, int r, int t, int b);
-void tab_columns (struct tab_table *, int style, int group);
-void tab_title (struct tab_table *, int format, const char *, ...);
-void tab_flags (struct tab_table *, unsigned);
-void tab_submit (struct tab_table *);
-
-/* Dimensioning. */
-tab_dim_func tab_natural_dimensions;
-int tab_natural_width (struct tab_table *t, struct outp_driver *d, int c);
-int tab_natural_height (struct tab_table *t, struct outp_driver *d, int r);
-void tab_dim (struct tab_table *, tab_dim_func *);
-
-/* Rules. */
-void tab_hline (struct tab_table *, int style, int x1, int x2, int y);
-void tab_vline (struct tab_table *, int style, int x, int y1, int y2);
-void tab_box (struct tab_table *, int f_h, int f_v, int i_h, int i_v,
- int x1, int y1, int x2, int y2);
-
-/* Text options, passed in the `opt' argument. */
-enum
- {
- TAT_NONE = 0, /* No options. */
- TAT_PRINTF = 0x0100, /* Format the text string with sprintf. */
- TAT_TITLE = 0x0204, /* Title attributes. */
- TAT_FIX = 0x0400, /* Use fixed-pitch font. */
- TAT_NOWRAP = 0x0800 /* No text wrap (tab_output_text() only). */
- };
-
-/* Cells. */
-struct fmt_spec;
-union value;
-void tab_value (struct tab_table *, int c, int r, unsigned char opt,
- const union value *, const struct fmt_spec *);
-void tab_float (struct tab_table *, int c, int r, unsigned char opt,
- double v, int w, int d);
-void tab_text (struct tab_table *, int c, int r, unsigned opt,
- const char *, ...)
- PRINTF_FORMAT (5, 6);
-void tab_joint_text (struct tab_table *, int x1, int y1, int x2, int y2,
- unsigned opt, const char *, ...)
- PRINTF_FORMAT (7, 8);
-
-/* Cell low-level access. */
-#define tab_alloc(TABLE, AMT) pool_alloc ((TABLE)->container, (AMT))
-void tab_raw (struct tab_table *, int c, int r, unsigned opt,
- struct fixed_string *);
-
-/* Editing. */
-void tab_offset (struct tab_table *, int col, int row);
-void tab_next_row (struct tab_table *);
-
-/* Current row/column offset. */
-#define tab_row(TABLE) ((TABLE)->row_ofs)
-#define tab_col(TABLE) ((TABLE)->col_ofs)
-
-/* Simple output. */
-void tab_output_text (int options, const char *string, ...)
- PRINTF_FORMAT (2, 3);
-
-#endif /* tab_h */
-
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <stddef.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "command.h"
-#include "dictionary.h"
-#include "ctl-stack.h"
-#include "error.h"
-#include "hash.h"
-#include "lexer.h"
-#include "str.h"
-#include "value-labels.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-int temporary;
-struct dictionary *temp_dict;
-size_t temp_trns;
-
-/* Parses the TEMPORARY command. */
-int
-cmd_temporary (void)
-{
- /* TEMPORARY is not allowed inside DO IF or LOOP. */
- if (!ctl_stack_is_empty ())
- {
- msg (SE, _("This command is not valid inside DO IF or LOOP."));
- return CMD_FAILURE;
- }
-
- /* TEMPORARY can only appear once! */
- if (temporary)
- {
- msg (SE, _("This command may only appear once between "
- "procedures and procedure-like commands."));
- return CMD_FAILURE;
- }
-
- /* Make a copy of the current dictionary. */
- temporary = 1;
- temp_dict = dict_clone (default_dict);
- temp_trns = n_trns;
-
- return lex_end_of_command ();
-}
-
-/* Cancels the temporary transformation, if any. */
-void
-cancel_temporary (void)
-{
- if (temporary)
- {
- if (temp_dict)
- {
- dict_destroy (temp_dict);
- temp_dict = NULL;
- }
- temporary = 0;
- temp_trns = 0;
- }
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <ctype.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "glob.h"
-#include "lexer.h"
-#include "main.h"
-#include "output.h"
-#include "var.h"
-#include "version.h"
-#include "vfm.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-static int get_title (const char *cmd, char **title);
-
-int
-cmd_title (void)
-{
- return get_title ("TITLE", &outp_title);
-}
-
-int
-cmd_subtitle (void)
-{
- return get_title ("SUBTITLE", &outp_subtitle);
-}
-
-static int
-get_title (const char *cmd, char **title)
-{
- int c;
-
- c = lex_look_ahead ();
- debug_printf ((_("%s before: %s\n"), cmd, *title ? *title : _("<none>")));
- if (c == '"' || c == '\'')
- {
- lex_get ();
- if (!lex_force_string ())
- return CMD_FAILURE;
- if (*title)
- free (*title);
- *title = xstrdup (ds_c_str (&tokstr));
- lex_get ();
- if (token != '.')
- {
- msg (SE, _("%s: `.' expected after string."), cmd);
- return CMD_FAILURE;
- }
- }
- else
- {
- char *cp;
-
- if (*title)
- free (*title);
- *title = xstrdup (lex_rest_of_line (NULL));
- lex_discard_line ();
- for (cp = *title; *cp; cp++)
- *cp = toupper ((unsigned char) (*cp));
- token = '.';
- }
- debug_printf ((_("%s after: %s\n"), cmd, *title));
- return CMD_SUCCESS;
-}
-
-/* Performs the FILE LABEL command. */
-int
-cmd_file_label (void)
-{
- const char *label;
-
- label = lex_rest_of_line (NULL);
- lex_discard_line ();
- while (isspace ((unsigned char) *label))
- label++;
-
- dict_set_label (default_dict, label);
- token = '.';
-
- return CMD_SUCCESS;
-}
-
-/* Add LINE as a line of document information to default_dict,
- indented by INDENT spaces. */
-static void
-add_document_line (const char *line, int indent)
-{
- const char *old_documents;
- size_t old_len;
- char *new_documents;
-
- old_documents = dict_get_documents (default_dict);
- old_len = old_documents != NULL ? strlen (old_documents) : 0;
- new_documents = xmalloc (old_len + 81);
-
- memcpy (new_documents, old_documents, old_len);
- memset (new_documents + old_len, ' ', indent);
- buf_copy_str_rpad (new_documents + old_len + indent, 80 - indent, line);
- new_documents[old_len + 80] = '\0';
-
- dict_set_documents (default_dict, new_documents);
-
- free (new_documents);
-}
-
-/* Performs the DOCUMENT command. */
-int
-cmd_document (void)
-{
- /* Add a few header lines for reference. */
- {
- char buf[256];
-
- if (dict_get_documents (default_dict) != NULL)
- add_document_line ("", 0);
-
- sprintf (buf, _("Document entered %s by %s:"), get_start_date (), version);
- add_document_line (buf, 1);
- }
-
- for (;;)
- {
- int had_dot;
- const char *orig_line;
- char *copy_line;
-
- orig_line = lex_rest_of_line (&had_dot);
- lex_discard_line ();
- while (isspace ((unsigned char) *orig_line))
- orig_line++;
-
- copy_line = xmalloc (strlen (orig_line) + 2);
- strcpy (copy_line, orig_line);
- if (had_dot)
- strcat (copy_line, ".");
-
- add_document_line (copy_line, 3);
- free (copy_line);
-
- lex_get_line ();
- if (had_dot)
- break;
- }
-
- token = '.';
- return CMD_SUCCESS;
-}
-
-/* Performs the DROP DOCUMENTS command. */
-int
-cmd_drop_documents (void)
-{
- dict_set_documents (default_dict, NULL);
-
- return lex_end_of_command ();
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "command.h"
-#include "error.h"
-#include "hash.h"
-#include "lexer.h"
-#include "str.h"
-#include "value-labels.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-\f
-/* Declarations. */
-
-static int do_value_labels (int);
-static int verify_val_labs (struct variable **vars, size_t var_cnt);
-static void erase_labels (struct variable **vars, size_t var_cnt);
-static int get_label (struct variable **vars, size_t var_cnt);
-\f
-/* Stubs. */
-
-int
-cmd_value_labels (void)
-{
- return do_value_labels (1);
-}
-
-int
-cmd_add_value_labels (void)
-{
- return do_value_labels (0);
-}
-\f
-/* Do it. */
-
-static int
-do_value_labels (int erase)
-{
- struct variable **vars; /* Variable list. */
- size_t var_cnt; /* Number of variables. */
- int parse_err=0; /* true if error parsing variables */
-
- lex_match ('/');
-
- while (token != '.')
- {
- parse_err = !parse_variables (default_dict, &vars, &var_cnt,
- PV_SAME_TYPE) ;
- if (var_cnt < 1)
- {
- free(vars);
- return CMD_FAILURE;
- }
- if (!verify_val_labs (vars, var_cnt))
- goto lossage;
- if (erase)
- erase_labels (vars, var_cnt);
- while (token != '/' && token != '.')
- if (!get_label (vars, var_cnt))
- goto lossage;
-
- if (token != '/')
- {
- free (vars);
- break;
- }
-
- lex_get ();
-
- free (vars);
- }
-
- if (token != '.')
- {
- lex_error (NULL);
- return CMD_TRAILING_GARBAGE;
- }
-
- return parse_err ? CMD_PART_SUCCESS_MAYBE : CMD_SUCCESS;
-
- lossage:
- free (vars);
- return CMD_PART_SUCCESS_MAYBE;
-}
-
-/* Verifies that none of the VAR_CNT variables in VARS are long
- string variables. */
-static int
-verify_val_labs (struct variable **vars, size_t var_cnt)
-{
- size_t i;
-
- for (i = 0; i < var_cnt; i++)
- {
- struct variable *vp = vars[i];
-
- if (vp->type == ALPHA && vp->width > MAX_SHORT_STRING)
- {
- msg (SE, _("It is not possible to assign value labels to long "
- "string variables such as %s."), vp->name);
- return 0;
- }
- }
- return 1;
-}
-
-/* Erases all the labels for the VAR_CNT variables in VARS. */
-static void
-erase_labels (struct variable **vars, size_t var_cnt)
-{
- size_t i;
-
- /* Erase old value labels if desired. */
- for (i = 0; i < var_cnt; i++)
- val_labs_clear (vars[i]->val_labs);
-}
-
-/* Parse all the labels for the VAR_CNT variables in VARS and add
- the specified labels to those variables. */
-static int
-get_label (struct variable **vars, size_t var_cnt)
-{
- /* Parse all the labels and add them to the variables. */
- do
- {
- union value value;
- char *label;
- size_t i;
-
- /* Set value. */
- if (vars[0]->type == ALPHA)
- {
- if (token != T_STRING)
- {
- lex_error (_("expecting string"));
- return 0;
- }
- buf_copy_str_rpad (value.s, MAX_SHORT_STRING, ds_c_str (&tokstr));
- }
- else
- {
- if (!lex_is_number ())
- {
- lex_error (_("expecting integer"));
- return 0;
- }
- if (!lex_is_integer ())
- msg (SW, _("Value label `%g' is not integer."), tokval);
- value.f = tokval;
- }
- lex_get ();
-
- /* Set label. */
- if (!lex_force_string ())
- return 0;
- if (ds_length (&tokstr) > 60)
- {
- msg (SW, _("Truncating value label to 60 characters."));
- ds_truncate (&tokstr, 60);
- }
- label = ds_c_str (&tokstr);
-
- for (i = 0; i < var_cnt; i++)
- val_labs_replace (vars[i]->val_labs, value, label);
-
- lex_get ();
- }
- while (token != '/' && token != '.');
-
- return 1;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !val_h
-#define val_h 1
-
-#include <float.h>
-
-#include <config.h>
-
-/* Values. */
-
-/* Max length of a short string value, generally 8 chars. */
-#define MAX_SHORT_STRING ((SIZEOF_DOUBLE)>=8 ? ((SIZEOF_DOUBLE)+1)/2*2 : 8)
-#define MIN_LONG_STRING (MAX_SHORT_STRING+1)
-
-/* Max string length. */
-#define MAX_STRING 255
-
-/* FYI: It is a bad situation if sizeof(flt64) < MAX_SHORT_STRING:
- then short string missing values can be truncated in system files
- because there's only room for as many characters as can fit in a
- flt64. */
-#if MAX_SHORT_STRING > SHORT_NAME_LEN
-#error MAX_SHORT_STRING must be less than or equal to SHORT_NAME_LEN.
-#endif
-
-/* Special values. */
-#define SYSMIS (-DBL_MAX)
-#define LOWEST second_lowest_value
-#define HIGHEST DBL_MAX
-
-/* Describes one value, which is either a floating-point number or a
- short string. */
-union value
- {
- /* A numeric value. */
- double f;
-
- /* A short-string value. */
- char s[MAX_SHORT_STRING];
-
- /* Used by evaluate_expression() to return a string result.
- As currently implemented, it's a pointer to a dynamic
- buffer in the appropriate expression.
-
- Also used by the AGGREGATE procedure in handling string
- values. */
- char *c;
- };
-
-/* Maximum number of `union value's in a single number or string
- value. */
-#define MAX_ELEMS_PER_VALUE (MAX_STRING / sizeof (union value) + 1)
-
-int compare_values (const union value *a, const union value *b, int width);
-
-unsigned hash_value(const union value *v, int width);
-
-
-
-#endif /* !val_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "value-labels.h"
-#include "error.h"
-#include <stdlib.h>
-#include "alloc.h"
-#include "hash.h"
-#include "str.h"
-
-static hsh_compare_func compare_int_val_lab;
-static hsh_hash_func hash_int_val_lab;
-static hsh_free_func free_int_val_lab;
-
-struct atom;
-static struct atom *atom_create (const char *string);
-static void atom_destroy (struct atom *);
-static char *atom_to_string (const struct atom *);
-
-/* A set of value labels. */
-struct val_labs
- {
- int width; /* 0=numeric, otherwise string width. */
- struct hsh_table *labels; /* Hash table of `struct int_val_lab's. */
- };
-
-/* Creates and returns a new, empty set of value labels with the
- given WIDTH, which must designate a numeric (0) or short
- string (1...MAX_SHORT_STRING inclusive) width. */
-struct val_labs *
-val_labs_create (int width)
-{
- struct val_labs *vls;
-
- assert (width >= 0);
-
- vls = xmalloc (sizeof *vls);
- vls->width = width;
- vls->labels = NULL;
- return vls;
-}
-
-/* Creates and returns a new set of value labels identical to
- VLS. */
-struct val_labs *
-val_labs_copy (const struct val_labs *vls)
-{
- struct val_labs *copy;
- struct val_labs_iterator *i;
- struct val_lab *vl;
-
- assert (vls != NULL);
-
- copy = val_labs_create (vls->width);
- for (vl = val_labs_first (vls, &i); vl != NULL;
- vl = val_labs_next (vls, &i))
- val_labs_add (copy, vl->value, vl->label);
- return copy;
-}
-
-/* Changes the width of VLS to NEW_WIDTH. If VLS is numeric,
- NEW_WIDTH must be 0, otherwise it must be within the range
- 1...MAX_SHORT_STRING inclusive. */
-void
-val_labs_set_width (struct val_labs *vls, int new_width)
-{
- assert (vls != NULL);
- assert ((vls->width == 0) == (new_width == 0));
-
- vls->width = new_width;
-}
-
-/* Destroys VLS. */
-void
-val_labs_destroy (struct val_labs *vls)
-{
- if (vls != NULL)
- {
- if (vls->labels != NULL)
- hsh_destroy (vls->labels);
- free (vls);
- }
-}
-
-/* Removes all the value labels from VLS. */
-void
-val_labs_clear (struct val_labs *vls)
-{
- assert (vls != NULL);
-
- hsh_destroy (vls->labels);
- vls->labels = NULL;
-}
-
-/* Returns the number of value labels in VLS. */
-size_t
-val_labs_count (const struct val_labs *vls)
-{
- assert (vls != NULL);
-
- if (vls->labels == NULL)
- return 0;
- else
- return hsh_count (vls->labels);
-}
-\f
-/* One value label in internal format. */
-struct int_val_lab
- {
- union value value; /* The value being labeled. */
- struct atom *label; /* A ref-counted string. */
- };
-
-/* Creates and returns an int_val_lab based on VALUE and
- LABEL. */
-static struct int_val_lab *
-create_int_val_lab (struct val_labs *vls, union value value, const char *label)
-{
- struct int_val_lab *ivl;
-
- assert (label != NULL);
- assert (vls->width <= MAX_SHORT_STRING);
-
- ivl = xmalloc (sizeof *ivl);
- ivl->value = value;
- if (vls->width > 0)
- memset (ivl->value.s + vls->width, ' ', MAX_SHORT_STRING - vls->width);
- ivl->label = atom_create (label);
-
- return ivl;
-}
-
-/* If VLS does not already contain a value label for VALUE, adds
- LABEL for it and returns nonzero. Otherwise, returns zero.
- Behavior is undefined if VLS's width is greater than
- MAX_SHORT_STRING. */
-int
-val_labs_add (struct val_labs *vls, union value value, const char *label)
-{
- struct int_val_lab *ivl;
- void **vlpp;
-
- assert (vls != NULL);
- assert (vls->width <= MAX_SHORT_STRING);
- assert (label != NULL);
-
- if (vls->labels == NULL)
- vls->labels = hsh_create (8, compare_int_val_lab, hash_int_val_lab,
- free_int_val_lab, vls);
-
- ivl = create_int_val_lab (vls, value, label);
- vlpp = hsh_probe (vls->labels, ivl);
- if (*vlpp == NULL)
- {
- *vlpp = ivl;
- return 1;
- }
- else
- {
- free_int_val_lab (ivl, vls);
- return 0;
- }
-}
-
-/* Sets LABEL as the value label for VALUE in VLS. Returns zero
- if there wasn't already a value label for VALUE, or nonzero if
- there was. Behavior is undefined if VLS's width is greater
- than MAX_SHORT_STRING. */
-int
-val_labs_replace (struct val_labs *vls, union value value, const char *label)
-{
- struct int_val_lab *ivl;
-
- assert (vls != NULL);
- assert (vls->width <= MAX_SHORT_STRING);
- assert (label != NULL);
-
- if (vls->labels == NULL)
- {
- val_labs_add (vls, value, label);
- return 0;
- }
-
- ivl = hsh_replace (vls->labels, create_int_val_lab (vls, value, label));
- if (ivl == NULL)
- return 0;
- else
- {
- free_int_val_lab (ivl, vls);
- return 1;
- }
-}
-
-/* Removes any value label for VALUE within VLS. Returns nonzero
- if a value label was removed. Behavior is undefined if VLS's
- width is greater than MAX_SHORT_STRING. */
-int
-val_labs_remove (struct val_labs *vls, union value value)
-{
- assert (vls != NULL);
- assert (vls->width <= MAX_SHORT_STRING);
-
- if (vls->labels != NULL)
- {
- struct int_val_lab *ivl = create_int_val_lab (vls, value, "");
- int deleted = hsh_delete (vls->labels, ivl);
- free (ivl);
- return deleted;
- }
- else
- return 0;
-}
-
-/* Searches VLS for a value label for VALUE. If successful,
- returns the label; otherwise, returns a null pointer. If
- VLS's width is greater than MAX_SHORT_STRING, always returns a
- null pointer. */
-char *
-val_labs_find (const struct val_labs *vls, union value value)
-{
- assert (vls != NULL);
-
- if (vls->width > MAX_SHORT_STRING)
- return NULL;
-
- if (vls->labels != NULL)
- {
- struct int_val_lab ivl, *vlp;
-
- ivl.value = value;
- vlp = hsh_find (vls->labels, &ivl);
- if (vlp != NULL)
- return atom_to_string (vlp->label);
- }
- return NULL;
-}
-\f
-/* A value labels iterator. */
-struct val_labs_iterator
- {
- void **labels; /* The labels, in order. */
- void **lp; /* Current label. */
- struct val_lab vl; /* Structure presented to caller. */
- };
-
-/* Sets up *IP for iterating through the value labels in VLS in
- no particular order. Returns the first value label or a null
- pointer if VLS is empty. If the return value is non-null,
- then val_labs_next() may be used to continue iterating or
- val_labs_done() to free up the iterator. Otherwise, neither
- function may be called for *IP. */
-struct val_lab *
-val_labs_first (const struct val_labs *vls, struct val_labs_iterator **ip)
-{
- struct val_labs_iterator *i;
-
- assert (vls != NULL);
- assert (ip != NULL);
-
- if (vls->labels == NULL || vls->width > MAX_SHORT_STRING)
- return NULL;
-
- i = *ip = xmalloc (sizeof *i);
- i->labels = hsh_data_copy (vls->labels);
- i->lp = i->labels;
- return val_labs_next (vls, ip);
-}
-
-/* Sets up *IP for iterating through the value labels in VLS in
- sorted order of values. Returns the first value label or a
- null pointer if VLS is empty. If the return value is
- non-null, then val_labs_next() may be used to continue
- iterating or val_labs_done() to free up the iterator.
- Otherwise, neither function may be called for *IP. */
-struct val_lab *
-val_labs_first_sorted (const struct val_labs *vls,
- struct val_labs_iterator **ip)
-{
- struct val_labs_iterator *i;
-
- assert (vls != NULL);
- assert (ip != NULL);
-
- if (vls->labels == NULL || vls->width > MAX_SHORT_STRING)
- return NULL;
-
- i = *ip = xmalloc (sizeof *i);
- i->lp = i->labels = hsh_sort_copy (vls->labels);
- return val_labs_next (vls, ip);
-}
-
-/* Returns the next value label in an iteration begun by
- val_labs_first() or val_labs_first_sorted(). If the return
- value is non-null, then val_labs_next() may be used to
- continue iterating or val_labs_done() to free up the iterator.
- Otherwise, neither function may be called for *IP. */
-struct val_lab *
-val_labs_next (const struct val_labs *vls, struct val_labs_iterator **ip)
-{
- struct val_labs_iterator *i;
- struct int_val_lab *ivl;
-
- assert (vls != NULL);
- assert (vls->width <= MAX_SHORT_STRING);
- assert (ip != NULL);
- assert (*ip != NULL);
-
- i = *ip;
- ivl = *i->lp++;
- if (ivl != NULL)
- {
- i->vl.value = ivl->value;
- i->vl.label = atom_to_string (ivl->label);
- return &i->vl;
- }
- else
- {
- free (i->labels);
- free (i);
- *ip = NULL;
- return NULL;
- }
-}
-
-/* Discards the state for an incomplete iteration begun by
- val_labs_first() or val_labs_first_sorted(). */
-void
-val_labs_done (struct val_labs_iterator **ip)
-{
- struct val_labs_iterator *i;
-
- assert (ip != NULL);
- assert (*ip != NULL);
-
- i = *ip;
- free (i->labels);
- free (i);
- *ip = NULL;
-}
-\f
-/* Compares two value labels and returns a strcmp()-type result. */
-int
-compare_int_val_lab (const void *a_, const void *b_, void *vls_)
-{
- const struct int_val_lab *a = a_;
- const struct int_val_lab *b = b_;
- const struct val_labs *vls = vls_;
-
- if (vls->width == 0)
- return a->value.f < b->value.f ? -1 : a->value.f > b->value.f;
- else
- return memcmp (a->value.s, b->value.s, vls->width);
-}
-
-/* Hash a value label. */
-unsigned
-hash_int_val_lab (const void *vl_, void *vls_)
-{
- const struct int_val_lab *vl = vl_;
- const struct val_labs *vls = vls_;
-
- if (vls->width == 0)
- return hsh_hash_double (vl->value.f);
- else
- return hsh_hash_bytes (vl->value.s, sizeof vl->value.s);
-}
-
-/* Free a value label. */
-void
-free_int_val_lab (void *vl_, void *vls_ UNUSED)
-{
- struct int_val_lab *vl = vl_;
-
- atom_destroy (vl->label);
- free (vl);
-}
-\f
-/* Atoms. */
-
-/* An atom. */
-struct atom
- {
- char *string; /* String value. */
- unsigned ref_count; /* Number of references. */
- };
-
-static hsh_compare_func compare_atoms;
-static hsh_hash_func hash_atom;
-static hsh_free_func free_atom;
-
-/* Hash table of atoms. */
-static struct hsh_table *atoms;
-
-/* Creates and returns an atom for STRING. */
-static struct atom *
-atom_create (const char *string)
-{
- struct atom a;
- void **app;
-
- assert (string != NULL);
-
- if (atoms == NULL)
- atoms = hsh_create (8, compare_atoms, hash_atom, free_atom, NULL);
-
- a.string = (char *) string;
- app = hsh_probe (atoms, &a);
- if (*app != NULL)
- {
- struct atom *ap = *app;
- ap->ref_count++;
- return ap;
- }
- else
- {
- struct atom *ap = xmalloc (sizeof *ap);
- ap->string = xstrdup (string);
- ap->ref_count = 1;
- *app = ap;
- return ap;
- }
-}
-
-/* Destroys ATOM. */
-static void
-atom_destroy (struct atom *atom)
-{
- if (atom != NULL)
- {
- assert (atom->ref_count > 0);
- atom->ref_count--;
- if (atom->ref_count == 0)
- hsh_force_delete (atoms, atom);
- }
-}
-
-/* Returns the string associated with ATOM. */
-static char *
-atom_to_string (const struct atom *atom)
-{
- assert (atom != NULL);
-
- return atom->string;
-}
-
-/* A hsh_compare_func that compares A and B. */
-static int
-compare_atoms (const void *a_, const void *b_, void *aux UNUSED)
-{
- const struct atom *a = a_;
- const struct atom *b = b_;
-
- return strcmp (a->string, b->string);
-}
-
-/* A hsh_hash_func that hashes ATOM. */
-static unsigned
-hash_atom (const void *atom_, void *aux UNUSED)
-{
- const struct atom *atom = atom_;
-
- return hsh_hash_string (atom->string);
-}
-
-/* A hsh_free_func that destroys ATOM. */
-static void
-free_atom (void *atom_, void *aux UNUSED)
-{
- struct atom *atom = atom_;
-
- free (atom->string);
- free (atom);
-}
-
-
-/* Get a string representing the value.
- That is, if it has a label, then return that label,
- otherwise, if the value is alpha, then return the string for it,
- else format it and return the formatted string
-*/
-const char *
-value_to_string (const union value *val, const struct variable *var)
-{
- char *s;
-
- assert (val != NULL);
- assert (var != NULL);
-
- s = val_labs_find (var->val_labs, *val);
- if (s == NULL)
- {
- static char buf[256];
- if (var->width != 0)
- str_copy_buf_trunc (buf, sizeof buf, val->s, var->width);
- else
- snprintf(buf, 100, "%g", val->f);
- s = buf;
- }
-
- return s;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#ifndef VAL_LABS_H
-#define VAL_LABS_H 1
-
-#include <stddef.h>
-#include "var.h"
-
-struct val_labs;
-
-struct val_lab
- {
- union value value;
- const char *label;
- };
-
-struct val_labs *val_labs_create (int width);
-struct val_labs *val_labs_copy (const struct val_labs *);
-void val_labs_set_width (struct val_labs *, int new_width);
-void val_labs_destroy (struct val_labs *);
-void val_labs_clear (struct val_labs *);
-size_t val_labs_count (const struct val_labs *);
-
-int val_labs_add (struct val_labs *, union value, const char *);
-int val_labs_replace (struct val_labs *, union value, const char *);
-int val_labs_remove (struct val_labs *, union value);
-char *val_labs_find (const struct val_labs *, union value);
-
-struct val_labs_iterator;
-
-struct val_lab *val_labs_first (const struct val_labs *,
- struct val_labs_iterator **);
-struct val_lab *val_labs_first_sorted (const struct val_labs *,
- struct val_labs_iterator **);
-struct val_lab *val_labs_next (const struct val_labs *,
- struct val_labs_iterator **);
-void val_labs_done (struct val_labs_iterator **);
-
-/* Return a string representing this value, in the form most
- appropriate from a human factors perspective.
- (IE: the label if it has one, otherwise the alpha/numeric )
-*/
-const char *value_to_string(const union value *, const struct variable *);
-
-#endif /* value-labels.h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by John Darrington <john@darrington.wattle.id.au>
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "command.h"
-#include "error.h"
-#include "lexer.h"
-#include "str.h"
-#include "var.h"
-
-#include "debug-print.h"
-
-/* Set variables' alignment
- This is the alignment for GUI display only.
- It affects nothing but GUIs
-*/
-int
-cmd_variable_alignment (void)
-{
- do
- {
- struct variable **v;
- size_t nv;
-
- size_t i;
- enum alignment align;
-
-
- if (!parse_variables (default_dict, &v, &nv, PV_NONE))
- return CMD_PART_SUCCESS_MAYBE;
-
- if ( lex_force_match('(') )
- {
- if ( lex_match_id("LEFT"))
- align = ALIGN_LEFT;
- else if ( lex_match_id("RIGHT"))
- align = ALIGN_RIGHT;
- else if ( lex_match_id("CENTER"))
- align = ALIGN_CENTRE;
- else
- {
- free (v);
- return CMD_FAILURE;
- }
-
- lex_force_match(')');
- }
- else
- {
- free (v);
- return CMD_FAILURE;
- }
-
- for( i = 0 ; i < nv ; ++i )
- v[i]->alignment = align;
-
-
- while (token == '/')
- lex_get ();
- free (v);
-
- }
- while (token != '.');
- return CMD_SUCCESS;
-}
-
-/* Set variables' display width.
- This is the width for GUI display only.
- It affects nothing but GUIs
-*/
-int
-cmd_variable_width (void)
-{
- do
- {
- struct variable **v;
- size_t nv;
- size_t i;
-
- if (!parse_variables (default_dict, &v, &nv, PV_NONE))
- return CMD_PART_SUCCESS_MAYBE;
-
- if ( lex_force_match('(') )
- {
- if ( lex_force_int())
- lex_get();
- else
- return CMD_FAILURE;
- lex_force_match(')');
- }
-
- for( i = 0 ; i < nv ; ++i )
- v[i]->display_width = tokval;
-
- while (token == '/')
- lex_get ();
- free (v);
-
- }
- while (token != '.');
- return CMD_SUCCESS;
-}
-
-/* Set variables' measurement level */
-int
-cmd_variable_level (void)
-{
- do
- {
- struct variable **v;
- size_t nv;
- enum measure level;
- size_t i;
-
- if (!parse_variables (default_dict, &v, &nv, PV_NONE))
- return CMD_PART_SUCCESS_MAYBE;
-
- if ( lex_force_match('(') )
- {
- if ( lex_match_id("SCALE"))
- level = MEASURE_SCALE;
- else if ( lex_match_id("ORDINAL"))
- level = MEASURE_ORDINAL;
- else if ( lex_match_id("NOMINAL"))
- level = MEASURE_NOMINAL;
- else
- {
- free (v);
- return CMD_FAILURE;
- }
-
- lex_force_match(')');
- }
- else
- {
- free (v);
- return CMD_FAILURE;
- }
-
- for( i = 0 ; i < nv ; ++i )
- v[i]->measure = level ;
-
-
- while (token == '/')
- lex_get ();
- free (v);
-
- }
- while (token != '.');
- return CMD_SUCCESS;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "command.h"
-#include "error.h"
-#include "lexer.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-#include "debug-print.h"
-
-int
-cmd_variable_labels (void)
-{
- do
- {
- struct variable **v;
- size_t nv;
-
- size_t i;
-
- if (!parse_variables (default_dict, &v, &nv, PV_NONE))
- return CMD_PART_SUCCESS_MAYBE;
-
- if (token != T_STRING)
- {
- msg (SE, _("String expected for variable label."));
- free (v);
- return CMD_PART_SUCCESS_MAYBE;
- }
- if (ds_length (&tokstr) > 255)
- {
- msg (SW, _("Truncating variable label to 255 characters."));
- ds_truncate (&tokstr, 255);
- }
- for (i = 0; i < nv; i++)
- {
- if (v[i]->label)
- free (v[i]->label);
- v[i]->label = xstrdup (ds_c_str (&tokstr));
- }
-
- lex_get ();
- while (token == '/')
- lex_get ();
- free (v);
- }
- while (token != '.');
- return CMD_SUCCESS;
-}
-
-
-
-const char *
-var_to_string(const struct variable *var)
-{
- if ( !var )
- return 0;
-
- return ( var->label ? var->label : var->name);
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !var_h
-#define var_h 1
-
-
-#include <stddef.h>
-#include "config.h"
-#include <stdbool.h>
-#include "cat.h"
-#include "format.h"
-#include "missing-values.h"
-
-/* Script variables. */
-
-/* Variable type. */
-enum var_type
- {
- NUMERIC, /* A numeric variable. */
- ALPHA /* A string variable. */
- };
-
-const char *var_type_adj (enum var_type);
-const char *var_type_noun (enum var_type);
-
-/* A variable's dictionary entry. */
-struct variable
- {
- /* Dictionary information. */
- char name[LONG_NAME_LEN + 1]; /* Variable name. Mixed case. */
- enum var_type type; /* NUMERIC or ALPHA. */
- int width; /* Size of string variables in chars. */
- struct missing_values miss; /* Missing values. */
- struct fmt_spec print; /* Default format for PRINT. */
- struct fmt_spec write; /* Default format for WRITE. */
- struct val_labs *val_labs; /* Value labels. */
- char *label; /* Variable label. */
- enum measure measure; /* Nominal, ordinal, or continuous. */
- int display_width; /* Width of data editor column. */
- enum alignment alignment; /* Alignment of data in GUI. */
-
- /* Case information. */
- int fv, nv; /* Index into `value's, number of values. */
- bool init; /* True if needs init and possibly reinit. */
- bool reinit; /* True: reinitialize; false: leave. */
-
- /* Data for use by containing dictionary. */
- int index; /* Dictionary index. */
-
- /* Short name, used only for system and portable file input
- and output. Upper case only. There is no index for short
- names. Short names are not necessarily unique. Any
- variable may have no short name, indicated by an empty
- string. */
- char short_name[SHORT_NAME_LEN + 1];
-
- /* Each command may use these fields as needed. */
- void *aux;
- void (*aux_dtor) (struct variable *);
-
- /* Values of a categorical variable. Procedures need
- vectors with binary entries, so any variable of type ALPHA will
- have its values stored here. */
- struct cat_vals *obs_vals;
- };
-
-/* Variable names. */
-bool var_is_valid_name (const char *, bool issue_error);
-int compare_var_names (const void *, const void *, void *);
-unsigned hash_var_name (const void *, void *);
-
-/* Short names. */
-void var_set_short_name (struct variable *, const char *);
-void var_set_short_name_suffix (struct variable *, const char *, int suffix);
-void var_clear_short_name (struct variable *);
-
-/* Pointers to `struct variable', by name. */
-int compare_var_ptr_names (const void *, const void *, void *);
-unsigned hash_var_ptr_name (const void *, void *);
-
-/* Variable auxiliary data. */
-void *var_attach_aux (struct variable *,
- void *aux, void (*aux_dtor) (struct variable *));
-void var_clear_aux (struct variable *);
-void *var_detach_aux (struct variable *);
-void var_dtor_free (struct variable *);
-
-/* Classes of variables. */
-enum dict_class
- {
- DC_ORDINARY, /* Ordinary identifier. */
- DC_SYSTEM, /* System variable. */
- DC_SCRATCH /* Scratch variable. */
- };
-
-enum dict_class dict_class_from_id (const char *name);
-const char *dict_class_to_name (enum dict_class dict_class);
-\f
-/* Vector of variables. */
-struct vector
- {
- int idx; /* Index for dict_get_vector(). */
- char name[LONG_NAME_LEN + 1]; /* Name. */
- struct variable **var; /* Vector of variables. */
- int cnt; /* Number of variables. */
- };
-\f
-void discard_variables (void);
-
-/* This is the active file dictionary. */
-extern struct dictionary *default_dict;
-\f
-/* Transformation state. */
-
-/* PROCESS IF expression. */
-extern struct expression *process_if_expr;
-\f
-/* TEMPORARY support. */
-
-/* 1=TEMPORARY has been executed at some point. */
-extern int temporary;
-
-/* If temporary!=0, the saved dictionary. */
-extern struct dictionary *temp_dict;
-
-/* If temporary!=0, index into t_trns[] (declared far below) that
- gives the point at which data should be written out. -1 means that
- the data shouldn't be changed since all transformations are
- temporary. */
-extern size_t temp_trns;
-
-/* If FILTER is active, whether it was executed before or after
- TEMPORARY. */
-extern int FILTER_before_TEMPORARY;
-
-void cancel_temporary (void);
-\f
-struct ccase;
-void dump_split_vars (const struct ccase *);
-\f
-/* Transformations. */
-
-struct transformation;
-typedef int trns_proc_func (void *, struct ccase *, int);
-typedef void trns_free_func (void *);
-
-/* A transformation. */
-struct transformation
- {
- trns_proc_func *proc; /* Transformation proc. */
- trns_free_func *free; /* Garbage collector proc. */
- void *private; /* Private data. */
- };
-
-/* Array of transformations */
-extern struct transformation *t_trns;
-
-/* Number of transformations, maximum number in array currently. */
-extern size_t n_trns, m_trns;
-
-/* Index of first transformation that is really a transformation. Any
- transformations before this belong to INPUT PROGRAM. */
-extern size_t f_trns;
-
-void add_transformation (trns_proc_func *, trns_free_func *, void *);
-size_t next_transformation (void);
-void cancel_transformations (void);
-\f
-struct var_set;
-
-struct var_set *var_set_create_from_dict (const struct dictionary *d);
-struct var_set *var_set_create_from_array (struct variable *const *var,
- size_t);
-
-size_t var_set_get_cnt (const struct var_set *vs);
-struct variable *var_set_get_var (const struct var_set *vs, size_t idx);
-struct variable *var_set_lookup_var (const struct var_set *vs,
- const char *name);
-bool var_set_lookup_var_idx (const struct var_set *vs, const char *name,
- size_t *idx);
-void var_set_destroy (struct var_set *vs);
-\f
-/* Variable parsers. */
-
-enum
- {
- PV_NONE = 0, /* No options. */
- PV_SINGLE = 0001, /* Restrict to a single name or TO use. */
- PV_DUPLICATE = 0002, /* Don't merge duplicates. */
- PV_APPEND = 0004, /* Append to existing list. */
- PV_NO_DUPLICATE = 0010, /* Error on duplicates. */
- PV_NUMERIC = 0020, /* Vars must be numeric. */
- PV_STRING = 0040, /* Vars must be string. */
- PV_SAME_TYPE = 00100, /* All vars must be the same type. */
- PV_NO_SCRATCH = 00200 /* Disallow scratch variables. */
- };
-
-struct pool;
-struct variable *parse_variable (void);
-struct variable *parse_dict_variable (const struct dictionary *);
-int parse_variables (const struct dictionary *, struct variable ***, size_t *,
- int opts);
-int parse_var_set_vars (const struct var_set *, struct variable ***, size_t *,
- int opts);
-int parse_DATA_LIST_vars (char ***names, size_t *cnt, int opts);
-int parse_mixed_vars (char ***names, size_t *cnt, int opts);
-int parse_mixed_vars_pool (struct pool *,
- char ***names, size_t *cnt, int opts);
-
-
-/* Return a string representing this variable, in the form most
- appropriate from a human factors perspective.
- (IE: the label if it has one, otherwise the name )
-*/
-const char * var_to_string(const struct variable *var);
-
-
-#endif /* !var_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "var.h"
-#include "error.h"
-#include <stdlib.h>
-#include "alloc.h"
-#include "dictionary.h"
-#include "hash.h"
-#include "lex-def.h"
-#include "misc.h"
-#include "str.h"
-#include "value-labels.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* Returns an adjective describing the given variable TYPE,
- suitable for use in phrases like "numeric variable". */
-const char *
-var_type_adj (enum var_type type)
-{
- return type == NUMERIC ? _("numeric") : _("string");
-}
-
-/* Returns a noun describing a value of the given variable TYPE,
- suitable for use in phrases like "a number". */
-const char *
-var_type_noun (enum var_type type)
-{
- return type == NUMERIC ? _("number") : _("string");
-}
-
-/* Assign auxiliary data AUX to variable V, which must not
- already have auxiliary data. Before V's auxiliary data is
- cleared, AUX_DTOR(V) will be called. */
-void *
-var_attach_aux (struct variable *v,
- void *aux, void (*aux_dtor) (struct variable *))
-{
- assert (v->aux == NULL);
- assert (aux != NULL);
- v->aux = aux;
- v->aux_dtor = aux_dtor;
- return aux;
-}
-
-/* Remove auxiliary data, if any, from V, and returns it, without
- calling any associated destructor. */
-void *
-var_detach_aux (struct variable *v)
-{
- void *aux = v->aux;
- assert (aux != NULL);
- v->aux = NULL;
- return aux;
-}
-
-/* Clears auxiliary data, if any, from V, and calls any
- associated destructor. */
-void
-var_clear_aux (struct variable *v)
-{
- assert (v != NULL);
- if (v->aux != NULL)
- {
- if (v->aux_dtor != NULL)
- v->aux_dtor (v);
- v->aux = NULL;
- }
-}
-
-/* This function is appropriate for use an auxiliary data
- destructor (passed as AUX_DTOR to var_attach_aux()) for the
- case where the auxiliary data should be passed to free(). */
-void
-var_dtor_free (struct variable *v)
-{
- free (v->aux);
-}
-
-/* Compares A and B, which both have the given WIDTH, and returns
- a strcmp()-type result. */
-int
-compare_values (const union value *a, const union value *b, int width)
-{
- if (width == 0)
- return a->f < b->f ? -1 : a->f > b->f;
- else
- return memcmp (a->s, b->s, min(MAX_SHORT_STRING, width));
-}
-
-/* Create a hash of v */
-unsigned
-hash_value(const union value *v, int width)
-{
- unsigned id_hash;
-
- if ( 0 == width )
- id_hash = hsh_hash_double (v->f);
- else
- id_hash = hsh_hash_bytes (v->s, min(MAX_SHORT_STRING, width));
-
- return id_hash;
-}
-
-
-
-\f
-/* Returns true if NAME is an acceptable name for a variable,
- false otherwise. If ISSUE_ERROR is true, issues an
- explanatory error message on failure. */
-bool
-var_is_valid_name (const char *name, bool issue_error)
-{
- size_t length, i;
-
- assert (name != NULL);
-
- length = strlen (name);
- if (length < 1)
- {
- if (issue_error)
- msg (SE, _("Variable name cannot be empty string."));
- return false;
- }
- else if (length > LONG_NAME_LEN)
- {
- if (issue_error)
- msg (SE, _("Variable name %s exceeds %d-character limit."),
- name, (int) LONG_NAME_LEN);
- return false;
- }
-
- for (i = 0; i < length; i++)
- if (!CHAR_IS_IDN (name[i]))
- {
- if (issue_error)
- msg (SE, _("Character `%c' (in %s) may not appear in "
- "a variable name."),
- name[i], name);
- return false;
- }
-
- if (!CHAR_IS_ID1 (name[0]))
- {
- if (issue_error)
- msg (SE, _("Character `%c' (in %s), may not appear "
- "as the first character in a variable name."),
- name[0], name);
- return false;
- }
-
- if (lex_id_to_token (name, strlen (name)) != T_ID)
- {
- if (issue_error)
- msg (SE, _("`%s' may not be used as a variable name because it "
- "is a reserved word."), name);
- return false;
- }
-
- return true;
-}
-
-/* A hsh_compare_func that orders variables A and B by their
- names. */
-int
-compare_var_names (const void *a_, const void *b_, void *foo UNUSED)
-{
- const struct variable *a = a_;
- const struct variable *b = b_;
-
- return strcasecmp (a->name, b->name);
-}
-
-/* A hsh_hash_func that hashes variable V based on its name. */
-unsigned
-hash_var_name (const void *v_, void *foo UNUSED)
-{
- const struct variable *v = v_;
-
- return hsh_hash_case_string (v->name);
-}
-
-/* A hsh_compare_func that orders pointers to variables A and B
- by their names. */
-int
-compare_var_ptr_names (const void *a_, const void *b_, void *foo UNUSED)
-{
- struct variable *const *a = a_;
- struct variable *const *b = b_;
-
- return strcasecmp ((*a)->name, (*b)->name);
-}
-
-/* A hsh_hash_func that hashes pointer to variable V based on its
- name. */
-unsigned
-hash_var_ptr_name (const void *v_, void *foo UNUSED)
-{
- struct variable *const *v = v_;
-
- return hsh_hash_case_string ((*v)->name);
-}
-\f
-/* Sets V's short_name to SHORT_NAME, truncating it to
- SHORT_NAME_LEN characters and converting it to uppercase in
- the process. */
-void
-var_set_short_name (struct variable *v, const char *short_name)
-{
- assert (v != NULL);
- assert (short_name[0] == '\0' || var_is_valid_name (short_name, false));
-
- str_copy_trunc (v->short_name, sizeof v->short_name, short_name);
- str_uppercase (v->short_name);
-}
-
-/* Clears V's short name. */
-void
-var_clear_short_name (struct variable *v)
-{
- assert (v != NULL);
-
- v->short_name[0] = '\0';
-}
-
-/* Sets V's short name to BASE, followed by a suffix of the form
- _A, _B, _C, ..., _AA, _AB, etc. according to the value of
- SUFFIX. Truncates BASE as necessary to fit. */
-void
-var_set_short_name_suffix (struct variable *v, const char *base, int suffix)
-{
- char string[SHORT_NAME_LEN + 1];
- char *start, *end;
- int len, ofs;
-
- assert (v != NULL);
- assert (suffix >= 0);
- assert (strlen (v->short_name) > 0);
-
- /* Set base name. */
- var_set_short_name (v, base);
-
- /* Compose suffix_string. */
- start = end = string + sizeof string - 1;
- *end = '\0';
- do
- {
- *--start = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"[suffix % 26];
- if (start <= string + 1)
- msg (SE, _("Variable suffix too large."));
- suffix /= 26;
- }
- while (suffix > 0);
- *--start = '_';
-
- /* Append suffix_string to V's short name. */
- len = end - start;
- if (len + strlen (v->short_name) > SHORT_NAME_LEN)
- ofs = SHORT_NAME_LEN - len;
- else
- ofs = strlen (v->short_name);
- strcpy (v->short_name + ofs, start);
-}
-
-
-/* Returns the dictionary class corresponding to a variable named
- NAME. */
-enum dict_class
-dict_class_from_id (const char *name)
-{
- assert (name != NULL);
-
- switch (name[0])
- {
- default:
- return DC_ORDINARY;
- case '$':
- return DC_SYSTEM;
- case '#':
- return DC_SCRATCH;
- }
-}
-
-/* Returns the name of dictionary class DICT_CLASS. */
-const char *
-dict_class_to_name (enum dict_class dict_class)
-{
- switch (dict_class)
- {
- case DC_ORDINARY:
- return _("ordinary");
- case DC_SYSTEM:
- return _("system");
- case DC_SCRATCH:
- return _("scratch");
- default:
- assert (0);
- abort ();
- }
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "var.h"
-#include <ctype.h>
-#include <stdbool.h>
-#include <stdlib.h>
-#include "alloc.h"
-#include "bitvector.h"
-#include "dictionary.h"
-#include "error.h"
-#include "hash.h"
-#include "lexer.h"
-#include "misc.h"
-#include "pool.h"
-#include "size_max.h"
-#include "str.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/* Parses a name as a variable within VS. Sets *IDX to the
- variable's index and returns true if successful. On failure
- emits an error message and returns false. */
-static bool
-parse_vs_variable_idx (const struct var_set *vs, size_t *idx)
-{
- assert (idx != NULL);
-
- if (token != T_ID)
- {
- lex_error (_("expecting variable name"));
- return false;
- }
- else if (var_set_lookup_var_idx (vs, tokid, idx))
- {
- lex_get ();
- return true;
- }
- else
- {
- msg (SE, _("%s is not a variable name."), tokid);
- return false;
- }
-}
-
-/* Parses a name as a variable within VS and returns the variable
- if successful. On failure emits an error message and returns
- a null pointer. */
-static struct variable *
-parse_vs_variable (const struct var_set *vs)
-{
- size_t idx;
- return parse_vs_variable_idx (vs, &idx) ? var_set_get_var (vs, idx) : NULL;
-}
-
-/* Parses a variable name in dictionary D and returns the
- variable if successful. On failure emits an error message and
- returns a null pointer. */
-struct variable *
-parse_dict_variable (const struct dictionary *d)
-{
- struct var_set *vs = var_set_create_from_dict (d);
- struct variable *var = parse_vs_variable (vs);
- var_set_destroy (vs);
- return var;
-}
-
-/* Parses a variable name in default_dict and returns the
- variable if successful. On failure emits an error message and
- returns a null pointer. */
-struct variable *
-parse_variable (void)
-{
- return parse_dict_variable (default_dict);
-}
-
-
-/* Parses a set of variables from dictionary D given options
- OPTS. Resulting list of variables stored in *VAR and the
- number of variables into *CNT. Returns nonzero only if
- successful. */
-int
-parse_variables (const struct dictionary *d, struct variable ***var,
- size_t *cnt, int opts)
-{
- struct var_set *vs;
- int success;
-
- assert (d != NULL);
- assert (var != NULL);
- assert (cnt != NULL);
-
- vs = var_set_create_from_dict (d);
- success = parse_var_set_vars (vs, var, cnt, opts);
- if ( success == 0 )
- free ( *var ) ;
- var_set_destroy (vs);
- return success;
-}
-
-/* Parses a variable name from VS. If successful, sets *IDX to
- the variable's index in VS, *CLASS to the variable's
- dictionary class, and returns nonzero. Returns zero on
- failure. */
-static int
-parse_var_idx_class (const struct var_set *vs, size_t *idx,
- enum dict_class *class)
-{
- if (!parse_vs_variable_idx (vs, idx))
- return 0;
-
- *class = dict_class_from_id (var_set_get_var (vs, *idx)->name);
- return 1;
-}
-
-/* Add the variable from VS with index IDX to the list of
- variables V that has *NV elements and room for *MV.
- Uses and updates INCLUDED to avoid duplicates if indicated by
- PV_OPTS, which also affects what variables are allowed in
- appropriate ways. */
-static void
-add_variable (struct variable ***v, size_t *nv, size_t *mv,
- char *included, int pv_opts,
- const struct var_set *vs, size_t idx)
-{
- struct variable *add = var_set_get_var (vs, idx);
-
- if ((pv_opts & PV_NUMERIC) && add->type != NUMERIC)
- msg (SW, _("%s is not a numeric variable. It will not be "
- "included in the variable list."), add->name);
- else if ((pv_opts & PV_STRING) && add->type != ALPHA)
- msg (SE, _("%s is not a string variable. It will not be "
- "included in the variable list."), add->name);
- else if ((pv_opts & PV_NO_SCRATCH)
- && dict_class_from_id (add->name) == DC_SCRATCH)
- msg (SE, _("Scratch variables (such as %s) are not allowed "
- "here."), add->name);
- else if ((pv_opts & PV_SAME_TYPE) && *nv && add->type != (*v)[0]->type)
- msg (SE, _("%s and %s are not the same type. All variables in "
- "this variable list must be of the same type. %s "
- "will be omitted from list."),
- (*v)[0]->name, add->name, add->name);
- else if ((pv_opts & PV_NO_DUPLICATE) && included[idx])
- msg (SE, _("Variable %s appears twice in variable list."), add->name);
- else
- {
- if (*nv >= *mv)
- {
- *mv = 2 * (*nv + 1);
- *v = xnrealloc (*v, *mv, sizeof **v);
- }
-
- if ((pv_opts & PV_DUPLICATE) || !included[idx])
- {
- (*v)[(*nv)++] = add;
- if (!(pv_opts & PV_DUPLICATE))
- included[idx] = 1;
- }
- }
-}
-
-/* Adds the variables in VS with indexes FIRST_IDX through
- LAST_IDX, inclusive, to the list of variables V that has *NV
- elements and room for *MV. Uses and updates INCLUDED to avoid
- duplicates if indicated by PV_OPTS, which also affects what
- variables are allowed in appropriate ways. */
-static void
-add_variables (struct variable ***v, size_t *nv, size_t *mv, char *included,
- int pv_opts,
- const struct var_set *vs, int first_idx, int last_idx,
- enum dict_class class)
-{
- size_t i;
-
- for (i = first_idx; i <= last_idx; i++)
- if (dict_class_from_id (var_set_get_var (vs, i)->name) == class)
- add_variable (v, nv, mv, included, pv_opts, vs, i);
-}
-
-/* Note that if parse_variables() returns 0, *v is free()'d.
- Conversely, if parse_variables() returns non-zero, then *nv is
- nonzero and *v is non-NULL. */
-int
-parse_var_set_vars (const struct var_set *vs,
- struct variable ***v, size_t *nv,
- int pv_opts)
-{
- size_t mv;
- char *included;
-
- assert (vs != NULL);
- assert (v != NULL);
- assert (nv != NULL);
-
- /* At most one of PV_NUMERIC, PV_STRING, PV_SAME_TYPE may be
- specified. */
- assert ((((pv_opts & PV_NUMERIC) != 0)
- + ((pv_opts & PV_STRING) != 0)
- + ((pv_opts & PV_SAME_TYPE) != 0)) <= 1);
-
- /* PV_DUPLICATE and PV_NO_DUPLICATE are incompatible. */
- assert (!(pv_opts & PV_DUPLICATE) || !(pv_opts & PV_NO_DUPLICATE));
-
- if (!(pv_opts & PV_APPEND))
- {
- *v = NULL;
- *nv = 0;
- mv = 0;
- }
- else
- mv = *nv;
-
- if (!(pv_opts & PV_DUPLICATE))
- {
- size_t i;
-
- included = xcalloc (var_set_get_cnt (vs), sizeof *included);
- for (i = 0; i < *nv; i++)
- included[(*v)[i]->index] = 1;
- }
- else
- included = NULL;
-
- if (lex_match (T_ALL))
- add_variables (v, nv, &mv, included, pv_opts,
- vs, 0, var_set_get_cnt (vs) - 1, DC_ORDINARY);
- else
- {
- do
- {
- enum dict_class class;
- size_t first_idx;
-
- if (!parse_var_idx_class (vs, &first_idx, &class))
- goto fail;
-
- if (!lex_match (T_TO))
- add_variable (v, nv, &mv, included, pv_opts, vs, first_idx);
- else
- {
- size_t last_idx;
- enum dict_class last_class;
- struct variable *first_var, *last_var;
-
- if (!parse_var_idx_class (vs, &last_idx, &last_class))
- goto fail;
-
- first_var = var_set_get_var (vs, first_idx);
- last_var = var_set_get_var (vs, last_idx);
-
- if (last_idx < first_idx)
- {
- msg (SE, _("%s TO %s is not valid syntax since %s "
- "precedes %s in the dictionary."),
- first_var->name, last_var->name,
- first_var->name, last_var->name);
- goto fail;
- }
-
- if (class != last_class)
- {
- msg (SE, _("When using the TO keyword to specify several "
- "variables, both variables must be from "
- "the same variable dictionaries, of either "
- "ordinary, scratch, or system variables. "
- "%s is a %s variable, whereas %s is %s."),
- first_var->name, dict_class_to_name (class),
- last_var->name, dict_class_to_name (last_class));
- goto fail;
- }
-
- add_variables (v, nv, &mv, included, pv_opts,
- vs, first_idx, last_idx, class);
- }
- if (pv_opts & PV_SINGLE)
- break;
- lex_match (',');
- }
- while (token == T_ID && var_set_lookup_var (vs, tokid) != NULL);
- }
-
- if (*nv == 0)
- goto fail;
-
- free (included);
- return 1;
-
-fail:
- free (included);
- free (*v);
- *v = NULL;
- *nv = 0;
- return 0;
-}
-
-/* Extracts a numeric suffix from variable name S, copying it
- into string R. Sets *D to the length of R and *N to its
- value. */
-static int
-extract_num (char *s, char *r, int *n, int *d)
-{
- char *cp;
-
- /* Find first digit. */
- cp = s + strlen (s) - 1;
- while (isdigit ((unsigned char) *cp) && cp > s)
- cp--;
- cp++;
-
- /* Extract root. */
- strncpy (r, s, cp - s);
- r[cp - s] = 0;
-
- /* Count initial zeros. */
- *n = *d = 0;
- while (*cp == '0')
- {
- (*d)++;
- cp++;
- }
-
- /* Extract value. */
- while (isdigit ((unsigned char) *cp))
- {
- (*d)++;
- *n = (*n * 10) + (*cp - '0');
- cp++;
- }
-
- /* Sanity check. */
- if (*n == 0 && *d == 0)
- {
- msg (SE, _("incorrect use of TO convention"));
- return 0;
- }
- return 1;
-}
-
-/* Parses a list of variable names according to the DATA LIST version
- of the TO convention. */
-int
-parse_DATA_LIST_vars (char ***names, size_t *nnames, int pv_opts)
-{
- int n1, n2;
- int d1, d2;
- int n;
- size_t nvar, mvar;
- char name1[LONG_NAME_LEN + 1], name2[LONG_NAME_LEN + 1];
- char root1[LONG_NAME_LEN + 1], root2[LONG_NAME_LEN + 1];
- int success = 0;
-
- assert (names != NULL);
- assert (nnames != NULL);
- assert ((pv_opts & ~(PV_APPEND | PV_SINGLE
- | PV_NO_SCRATCH | PV_NO_DUPLICATE)) == 0);
- /* FIXME: PV_NO_DUPLICATE is not implemented. */
-
- if (pv_opts & PV_APPEND)
- nvar = mvar = *nnames;
- else
- {
- nvar = mvar = 0;
- *names = NULL;
- }
-
- do
- {
- if (token != T_ID)
- {
- lex_error ("expecting variable name");
- goto fail;
- }
- if (dict_class_from_id (tokid) == DC_SCRATCH
- && (pv_opts & PV_NO_SCRATCH))
- {
- msg (SE, _("Scratch variables not allowed here."));
- goto fail;
- }
- strcpy (name1, tokid);
- lex_get ();
- if (token == T_TO)
- {
- lex_get ();
- if (token != T_ID)
- {
- lex_error ("expecting variable name");
- goto fail;
- }
- strcpy (name2, tokid);
- lex_get ();
-
- if (!extract_num (name1, root1, &n1, &d1)
- || !extract_num (name2, root2, &n2, &d2))
- goto fail;
-
- if (strcasecmp (root1, root2))
- {
- msg (SE, _("Prefixes don't match in use of TO convention."));
- goto fail;
- }
- if (n1 > n2)
- {
- msg (SE, _("Bad bounds in use of TO convention."));
- goto fail;
- }
- if (d2 > d1)
- d2 = d1;
-
- if (mvar < nvar + (n2 - n1 + 1))
- {
- mvar += ROUND_UP (n2 - n1 + 1, 16);
- *names = xnrealloc (*names, mvar, sizeof **names);
- }
-
- for (n = n1; n <= n2; n++)
- {
- char name[LONG_NAME_LEN + 1];
- sprintf (name, "%s%0*d", root1, d1, n);
- (*names)[nvar] = xstrdup (name);
- nvar++;
- }
- }
- else
- {
- if (nvar >= mvar)
- {
- mvar += 16;
- *names = xnrealloc (*names, mvar, sizeof **names);
- }
- (*names)[nvar++] = xstrdup (name1);
- }
-
- lex_match (',');
-
- if (pv_opts & PV_SINGLE)
- break;
- }
- while (token == T_ID);
- success = 1;
-
-fail:
- *nnames = nvar;
- if (!success)
- {
- int i;
- for (i = 0; i < nvar; i++)
- free ((*names)[i]);
- free (*names);
- *names = NULL;
- *nnames = 0;
- }
- return success;
-}
-
-/* Parses a list of variables where some of the variables may be
- existing and the rest are to be created. Same args as
- parse_DATA_LIST_vars(). */
-int
-parse_mixed_vars (char ***names, size_t *nnames, int pv_opts)
-{
- size_t i;
-
- assert (names != NULL);
- assert (nnames != NULL);
- assert ((pv_opts & ~PV_APPEND) == 0);
-
- if (!(pv_opts & PV_APPEND))
- {
- *names = NULL;
- *nnames = 0;
- }
- while (token == T_ID || token == T_ALL)
- {
- if (token == T_ALL || dict_lookup_var (default_dict, tokid) != NULL)
- {
- struct variable **v;
- size_t nv;
-
- if (!parse_variables (default_dict, &v, &nv, PV_NONE))
- goto fail;
- *names = xnrealloc (*names, *nnames + nv, sizeof **names);
- for (i = 0; i < nv; i++)
- (*names)[*nnames + i] = xstrdup (v[i]->name);
- free (v);
- *nnames += nv;
- }
- else if (!parse_DATA_LIST_vars (names, nnames, PV_APPEND))
- goto fail;
- }
- return 1;
-
-fail:
- for (i = 0; i < *nnames; i++)
- free ((*names)[i]);
- free (*names);
- *names = NULL;
- *nnames = 0;
- return 0;
-}
-
-/* Parses a list of variables where some of the variables may be
- existing and the rest are to be created. Same args as
- parse_DATA_LIST_vars(), except that all allocations are taken
- from the given POOL. */
-int
-parse_mixed_vars_pool (struct pool *pool,
- char ***names, size_t *nnames, int pv_opts)
-{
- int retval = parse_mixed_vars (names, nnames, pv_opts);
- if (retval)
- {
- size_t i;
-
- for (i = 0; i < *nnames; i++)
- pool_register (pool, free, (*names)[i]);
- pool_register (pool, free, *names);
- }
- return retval;
-}
-
-\f
-/* A set of variables. */
-struct var_set
- {
- size_t (*get_cnt) (const struct var_set *);
- struct variable *(*get_var) (const struct var_set *, size_t idx);
- bool (*lookup_var_idx) (const struct var_set *, const char *, size_t *);
- void (*destroy) (struct var_set *);
- void *aux;
- };
-
-/* Returns the number of variables in VS. */
-size_t
-var_set_get_cnt (const struct var_set *vs)
-{
- assert (vs != NULL);
-
- return vs->get_cnt (vs);
-}
-
-/* Return variable with index IDX in VS.
- IDX must be less than the number of variables in VS. */
-struct variable *
-var_set_get_var (const struct var_set *vs, size_t idx)
-{
- assert (vs != NULL);
- assert (idx < var_set_get_cnt (vs));
-
- return vs->get_var (vs, idx);
-}
-
-/* Returns the variable in VS named NAME, or a null pointer if VS
- contains no variable with that name. */
-struct variable *
-var_set_lookup_var (const struct var_set *vs, const char *name)
-{
- size_t idx;
- return (var_set_lookup_var_idx (vs, name, &idx)
- ? var_set_get_var (vs, idx)
- : NULL);
-}
-
-/* If VS contains a variable named NAME, sets *IDX to its index
- and returns true. Otherwise, returns false. */
-bool
-var_set_lookup_var_idx (const struct var_set *vs, const char *name,
- size_t *idx)
-{
- assert (vs != NULL);
- assert (name != NULL);
- assert (strlen (name) <= LONG_NAME_LEN);
-
- return vs->lookup_var_idx (vs, name, idx);
-}
-
-/* Destroys VS. */
-void
-var_set_destroy (struct var_set *vs)
-{
- if (vs != NULL)
- vs->destroy (vs);
-}
-\f
-/* Returns the number of variables in VS. */
-static size_t
-dict_var_set_get_cnt (const struct var_set *vs)
-{
- struct dictionary *d = vs->aux;
-
- return dict_get_var_cnt (d);
-}
-
-/* Return variable with index IDX in VS.
- IDX must be less than the number of variables in VS. */
-static struct variable *
-dict_var_set_get_var (const struct var_set *vs, size_t idx)
-{
- struct dictionary *d = vs->aux;
-
- return dict_get_var (d, idx);
-}
-
-/* If VS contains a variable named NAME, sets *IDX to its index
- and returns true. Otherwise, returns false. */
-static bool
-dict_var_set_lookup_var_idx (const struct var_set *vs, const char *name,
- size_t *idx)
-{
- struct dictionary *d = vs->aux;
- struct variable *v = dict_lookup_var (d, name);
- if (v != NULL)
- {
- *idx = v->index;
- return true;
- }
- else
- return false;
-}
-
-/* Destroys VS. */
-static void
-dict_var_set_destroy (struct var_set *vs)
-{
- free (vs);
-}
-
-/* Returns a variable set based on D. */
-struct var_set *
-var_set_create_from_dict (const struct dictionary *d)
-{
- struct var_set *vs = xmalloc (sizeof *vs);
- vs->get_cnt = dict_var_set_get_cnt;
- vs->get_var = dict_var_set_get_var;
- vs->lookup_var_idx = dict_var_set_lookup_var_idx;
- vs->destroy = dict_var_set_destroy;
- vs->aux = (void *) d;
- return vs;
-}
-\f
-/* A variable set based on an array. */
-struct array_var_set
- {
- struct variable *const *var;/* Array of variables. */
- size_t var_cnt; /* Number of elements in var. */
- struct hsh_table *name_tab; /* Hash from variable names to variables. */
- };
-
-/* Returns the number of variables in VS. */
-static size_t
-array_var_set_get_cnt (const struct var_set *vs)
-{
- struct array_var_set *avs = vs->aux;
-
- return avs->var_cnt;
-}
-
-/* Return variable with index IDX in VS.
- IDX must be less than the number of variables in VS. */
-static struct variable *
-array_var_set_get_var (const struct var_set *vs, size_t idx)
-{
- struct array_var_set *avs = vs->aux;
-
- return (struct variable *) avs->var[idx];
-}
-
-/* If VS contains a variable named NAME, sets *IDX to its index
- and returns true. Otherwise, returns false. */
-static bool
-array_var_set_lookup_var_idx (const struct var_set *vs, const char *name,
- size_t *idx)
-{
- struct array_var_set *avs = vs->aux;
- struct variable v, *vp, *const *vpp;
-
- strcpy (v.name, name);
- vp = &v;
- vpp = hsh_find (avs->name_tab, &vp);
- if (vpp != NULL)
- {
- *idx = vpp - avs->var;
- return true;
- }
- else
- return false;
-}
-
-/* Destroys VS. */
-static void
-array_var_set_destroy (struct var_set *vs)
-{
- struct array_var_set *avs = vs->aux;
-
- hsh_destroy (avs->name_tab);
- free (avs);
- free (vs);
-}
-
-/* Returns a variable set based on the VAR_CNT variables in
- VAR. */
-struct var_set *
-var_set_create_from_array (struct variable *const *var, size_t var_cnt)
-{
- struct var_set *vs;
- struct array_var_set *avs;
- size_t i;
-
- vs = xmalloc (sizeof *vs);
- vs->get_cnt = array_var_set_get_cnt;
- vs->get_var = array_var_set_get_var;
- vs->lookup_var_idx = array_var_set_lookup_var_idx;
- vs->destroy = array_var_set_destroy;
- vs->aux = avs = xmalloc (sizeof *avs);
- avs->var = var;
- avs->var_cnt = var_cnt;
- avs->name_tab = hsh_create (2 * var_cnt,
- compare_var_ptr_names, hash_var_ptr_name, NULL,
- NULL);
- for (i = 0; i < var_cnt; i++)
- if (hsh_insert (avs->name_tab, (void *) &var[i]) != NULL)
- {
- var_set_destroy (vs);
- return NULL;
- }
-
- return vs;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <stdlib.h>
-#include "alloc.h"
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "lexer.h"
-#include "misc.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-int
-cmd_vector (void)
-{
- /* Just to be different, points to a set of null terminated strings
- containing the names of the vectors to be created. The list
- itself is terminated by a empty string. So a list of three
- elements, A B C, would look like this: "A\0B\0C\0\0". */
- char *vecnames;
-
- /* vecnames iterators. */
- char *cp, *cp2;
-
- /* Maximum allocated position for vecnames, plus one position. */
- char *endp = NULL;
-
- cp = vecnames = xmalloc (256);
- endp = &vecnames[256];
- do
- {
- /* Get the name(s) of the new vector(s). */
- if (!lex_force_id ())
- return CMD_FAILURE;
- while (token == T_ID)
- {
- if (cp + 16 > endp)
- {
- char *old_vecnames = vecnames;
- vecnames = xrealloc (vecnames, endp - vecnames + 256);
- cp = (cp - old_vecnames) + vecnames;
- endp = (endp - old_vecnames) + vecnames + 256;
- }
-
- for (cp2 = cp; cp2 < cp; cp2 += strlen (cp))
- if (!strcasecmp (cp2, tokid))
- {
- msg (SE, _("Vector name %s is given twice."), tokid);
- goto fail;
- }
-
- if (dict_lookup_vector (default_dict, tokid))
- {
- msg (SE, _("There is already a vector with name %s."), tokid);
- goto fail;
- }
-
- cp = stpcpy (cp, tokid) + 1;
- lex_get ();
- lex_match (',');
- }
- *cp++ = 0;
-
- /* Now that we have the names it's time to check for the short
- or long forms. */
- if (lex_match ('='))
- {
- /* Long form. */
- struct variable **v;
- size_t nv;
-
- if (strchr (vecnames, '\0')[1])
- {
- /* There's more than one vector name. */
- msg (SE, _("A slash must be used to separate each vector "
- "specification when using the long form. Commands "
- "such as VECTOR A,B=Q1 TO Q20 are not supported."));
- goto fail;
- }
-
- if (!parse_variables (default_dict, &v, &nv,
- PV_SAME_TYPE | PV_DUPLICATE))
- goto fail;
-
- dict_create_vector (default_dict, vecnames, v, nv);
- free (v);
- }
- else if (lex_match ('('))
- {
- int i;
-
- /* Maximum number of digits in a number to add to the base
- vecname. */
- int ndig;
-
- /* Name of an individual variable to be created. */
- char name[SHORT_NAME_LEN + 1];
-
- /* Vector variables. */
- struct variable **v;
- int nv;
-
- if (!lex_force_int ())
- return CMD_FAILURE;
- nv = lex_integer ();
- lex_get ();
- if (nv <= 0)
- {
- msg (SE, _("Vectors must have at least one element."));
- goto fail;
- }
- if (!lex_force_match (')'))
- goto fail;
-
- /* First check that all the generated variable names
- are LONG_NAME_LEN characters or shorter. */
- ndig = intlog10 (nv);
- for (cp = vecnames; *cp;)
- {
- int len = strlen (cp);
- if (len + ndig > LONG_NAME_LEN)
- {
- msg (SE, _("%s%d is too long for a variable name."), cp, nv);
- goto fail;
- }
- cp += len + 1;
- }
-
- /* Next check that none of the variables exist. */
- for (cp = vecnames; *cp;)
- {
- for (i = 0; i < nv; i++)
- {
- sprintf (name, "%s%d", cp, i + 1);
- if (dict_lookup_var (default_dict, name))
- {
- msg (SE, _("There is already a variable named %s."),
- name);
- goto fail;
- }
- }
- cp += strlen (cp) + 1;
- }
-
- /* Finally create the variables and vectors. */
- v = xmalloc (nv * sizeof *v);
- for (cp = vecnames; *cp;)
- {
- for (i = 0; i < nv; i++)
- {
- sprintf (name, "%s%d", cp, i + 1);
- v[i] = dict_create_var_assert (default_dict, name, 0);
- }
- if (!dict_create_vector (default_dict, cp, v, nv))
- assert (0);
- cp += strlen (cp) + 1;
- }
- free (v);
- }
- else
- {
- msg (SE, _("The syntax for this command does not match "
- "the expected syntax for either the long form "
- "or the short form of VECTOR."));
- goto fail;
- }
-
- free (vecnames);
- vecnames = NULL;
- }
- while (lex_match ('/'));
-
- if (token != '.')
- {
- lex_error (_("expecting end of command"));
- goto fail;
- }
- return CMD_SUCCESS;
-
-fail:
- free (vecnames);
- return CMD_PART_SUCCESS_MAYBE;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !version_h
-#define version_h 1
-
-/* "A.B.C" */
-extern const char bare_version[];
-
-/* "GNU PSPP A.B.C" */
-extern const char version[];
-
-/* "GNU PSPP version A.B (date), Copyright (C) XXXX Free Software
- Foundation, Inc." */
-extern const char stat_version[];
-
-/* Canonical name of host system type. */
-extern const char host_system[];
-
-/* Canonical name of build system type. */
-extern const char build_system[];
-
-/* Configuration path at build time. */
-extern const char default_config_path[];
-
-/* Include path. */
-extern const char include_path[];
-
-/* Font path. */
-extern const char groff_font_path[];
-
-/* Locale directory. */
-extern const char locale_dir[];
-
-#endif /* !version_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "vfm.h"
-#include "vfmP.h"
-#include "error.h"
-#include <errno.h>
-#include <stdio.h>
-#include <stdlib.h>
-#if HAVE_UNISTD_H
-#include <unistd.h> /* Required by SunOS4. */
-#endif
-#include "alloc.h"
-#include "case.h"
-#include "casefile.h"
-#include "command.h"
-#include "dictionary.h"
-#include "ctl-stack.h"
-#include "error.h"
-#include "expressions/public.h"
-#include "file-handle-def.h"
-#include "misc.h"
-#include "settings.h"
-#include "som.h"
-#include "str.h"
-#include "tab.h"
-#include "var.h"
-#include "value-labels.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-/*
- Virtual File Manager (vfm):
-
- vfm is used to process data files. It uses the model that
- data is read from one stream (the data source), processed,
- then written to another (the data sink). The data source is
- then deleted and the data sink becomes the data source for the
- next procedure. */
-
-/* Procedure execution data. */
-struct write_case_data
- {
- /* Function to call for each case. */
- int (*proc_func) (struct ccase *, void *); /* Function. */
- void *aux; /* Auxiliary data. */
-
- struct ccase trns_case; /* Case used for transformations. */
- struct ccase sink_case; /* Case written to sink, if
- compaction is necessary. */
- size_t cases_written; /* Cases output so far. */
- size_t cases_analyzed; /* Cases passed to procedure so far. */
- };
-
-/* The current active file, from which cases are read. */
-struct case_source *vfm_source;
-
-/* The replacement active file, to which cases are written. */
-struct case_sink *vfm_sink;
-
-/* The compactor used to compact a compact, if necessary;
- otherwise a null pointer. */
-static struct dict_compactor *compactor;
-
-/* Time at which vfm was last invoked. */
-static time_t last_vfm_invocation;
-
-/* Lag queue. */
-int n_lag; /* Number of cases to lag. */
-static int lag_count; /* Number of cases in lag_queue so far. */
-static int lag_head; /* Index where next case will be added. */
-static struct ccase *lag_queue; /* Array of n_lag ccase * elements. */
-
-static void internal_procedure (int (*proc_func) (struct ccase *, void *),
- void *aux);
-static void update_last_vfm_invocation (void);
-static void create_trns_case (struct ccase *, struct dictionary *);
-static void open_active_file (void);
-static int write_case (struct write_case_data *wc_data);
-static int execute_transformations (struct ccase *c,
- struct transformation *trns,
- int first_idx, int last_idx,
- int case_num);
-static int filter_case (const struct ccase *c, int case_num);
-static void lag_case (const struct ccase *c);
-static void clear_case (struct ccase *c);
-static void close_active_file (void);
-\f
-/* Public functions. */
-
-/* Returns the last time the data was read. */
-time_t
-vfm_last_invocation (void)
-{
- if (last_vfm_invocation == 0)
- update_last_vfm_invocation ();
- return last_vfm_invocation;
-}
-
-/* Reads the data from the input program and writes it to a new
- active file. For each case we read from the input program, we
- do the following
-
- 1. Execute permanent transformations. If these drop the case,
- start the next case from step 1.
-
- 2. N OF CASES. If we have already written N cases, start the
- next case from step 1.
-
- 3. Write case to replacement active file.
-
- 4. Execute temporary transformations. If these drop the case,
- start the next case from step 1.
-
- 5. FILTER, PROCESS IF. If these drop the case, start the next
- case from step 1.
-
- 6. Post-TEMPORARY N OF CASES. If we have already analyzed N
- cases, start the next case from step 1.
-
- 7. Pass case to PROC_FUNC, passing AUX as auxiliary data. */
-void
-procedure (int (*proc_func) (struct ccase *, void *), void *aux)
-{
- if (proc_func == NULL
- && case_source_is_class (vfm_source, &storage_source_class)
- && vfm_sink == NULL
- && !temporary
- && n_trns == 0)
- {
- /* Nothing to do. */
- update_last_vfm_invocation ();
- return;
- }
-
- open_active_file ();
- internal_procedure (proc_func, aux);
- close_active_file ();
-}
-
-/* Executes a procedure, as procedure(), except that the caller
- is responsible for calling open_active_file() and
- close_active_file(). */
-static void
-internal_procedure (int (*proc_func) (struct ccase *, void *), void *aux)
-{
- static int recursive_call;
-
- struct write_case_data wc_data;
-
- assert (++recursive_call == 1);
-
- wc_data.proc_func = proc_func;
- wc_data.aux = aux;
- create_trns_case (&wc_data.trns_case, default_dict);
- case_create (&wc_data.sink_case, dict_get_next_value_idx (default_dict));
- wc_data.cases_written = 0;
-
- update_last_vfm_invocation ();
-
- if (vfm_source != NULL)
- vfm_source->class->read (vfm_source,
- &wc_data.trns_case,
- write_case, &wc_data);
-
- case_destroy (&wc_data.sink_case);
- case_destroy (&wc_data.trns_case);
-
- assert (--recursive_call == 0);
-}
-
-/* Updates last_vfm_invocation. */
-static void
-update_last_vfm_invocation (void)
-{
- last_vfm_invocation = time (NULL);
-}
-
-/* Creates and returns a case, initializing it from the vectors
- that say which `value's need to be initialized just once, and
- which ones need to be re-initialized before every case. */
-static void
-create_trns_case (struct ccase *trns_case, struct dictionary *dict)
-{
- size_t var_cnt = dict_get_var_cnt (dict);
- size_t i;
-
- case_create (trns_case, dict_get_next_value_idx (dict));
- for (i = 0; i < var_cnt; i++)
- {
- struct variable *v = dict_get_var (dict, i);
- union value *value = case_data_rw (trns_case, v->fv);
-
- if (v->type == NUMERIC)
- value->f = v->reinit ? 0.0 : SYSMIS;
- else
- memset (value->s, ' ', v->width);
- }
-}
-
-/* Makes all preparations for reading from the data source and writing
- to the data sink. */
-static void
-open_active_file (void)
-{
- /* Make temp_dict refer to the dictionary right before data
- reaches the sink */
- if (!temporary)
- {
- temp_trns = n_trns;
- temp_dict = default_dict;
- }
-
- /* Figure out compaction. */
- compactor = (dict_needs_compaction (temp_dict)
- ? dict_make_compactor (temp_dict)
- : NULL);
-
- /* Prepare sink. */
- if (vfm_sink == NULL)
- vfm_sink = create_case_sink (&storage_sink_class, temp_dict, NULL);
- if (vfm_sink->class->open != NULL)
- vfm_sink->class->open (vfm_sink);
-
- /* Allocate memory for lag queue. */
- if (n_lag > 0)
- {
- int i;
-
- lag_count = 0;
- lag_head = 0;
- lag_queue = xnmalloc (n_lag, sizeof *lag_queue);
- for (i = 0; i < n_lag; i++)
- case_nullify (&lag_queue[i]);
- }
-
- /* Close any unclosed DO IF or LOOP constructs. */
- ctl_stack_clear ();
-}
-
-/* Transforms trns_case and writes it to the replacement active
- file if advisable. Returns nonzero if more cases can be
- accepted, zero otherwise. Do not call this function again
- after it has returned zero once. */
-static int
-write_case (struct write_case_data *wc_data)
-{
- /* Execute permanent transformations. */
- if (!execute_transformations (&wc_data->trns_case, t_trns, f_trns, temp_trns,
- wc_data->cases_written + 1))
- goto done;
-
- /* N OF CASES. */
- if (dict_get_case_limit (default_dict)
- && wc_data->cases_written >= dict_get_case_limit (default_dict))
- goto done;
- wc_data->cases_written++;
-
- /* Write case to LAG queue. */
- if (n_lag)
- lag_case (&wc_data->trns_case);
-
- /* Write case to replacement active file. */
- if (vfm_sink->class->write != NULL)
- {
- if (compactor != NULL)
- {
- dict_compactor_compact (compactor, &wc_data->sink_case,
- &wc_data->trns_case);
- vfm_sink->class->write (vfm_sink, &wc_data->sink_case);
- }
- else
- vfm_sink->class->write (vfm_sink, &wc_data->trns_case);
- }
-
- /* Execute temporary transformations. */
- if (!execute_transformations (&wc_data->trns_case, t_trns, temp_trns, n_trns,
- wc_data->cases_written))
- goto done;
-
- /* FILTER, PROCESS IF, post-TEMPORARY N OF CASES. */
- if (filter_case (&wc_data->trns_case, wc_data->cases_written)
- || (dict_get_case_limit (temp_dict)
- && wc_data->cases_analyzed >= dict_get_case_limit (temp_dict)))
- goto done;
- wc_data->cases_analyzed++;
-
- /* Pass case to procedure. */
- if (wc_data->proc_func != NULL)
- wc_data->proc_func (&wc_data->trns_case, wc_data->aux);
-
- done:
- clear_case (&wc_data->trns_case);
- return 1;
-}
-
-/* Transforms case C using the transformations in TRNS[] with
- indexes FIRST_IDX through LAST_IDX, exclusive. Case C will
- become case CASE_NUM (1-based) in the output file. Returns
- zero if the case was filtered out by one of the
- transformations, nonzero otherwise. */
-static int
-execute_transformations (struct ccase *c,
- struct transformation *trns,
- int first_idx, int last_idx,
- int case_num)
-{
- int idx;
-
- for (idx = first_idx; idx != last_idx; )
- {
- struct transformation *t = &trns[idx];
- int retval = t->proc (t->private, c, case_num);
- switch (retval)
- {
- case -1:
- idx++;
- break;
-
- case -2:
- return 0;
-
- default:
- idx = retval;
- break;
- }
- }
-
- return 1;
-}
-
-/* Returns nonzero if case C with case number CASE_NUM should be
- exclude as specified on FILTER or PROCESS IF, otherwise
- zero. */
-static int
-filter_case (const struct ccase *c, int case_idx)
-{
- /* FILTER. */
- struct variable *filter_var = dict_get_filter (default_dict);
- if (filter_var != NULL)
- {
- double f = case_num (c, filter_var->fv);
- if (f == 0.0 || mv_is_num_missing (&filter_var->miss, f))
- return 1;
- }
-
- /* PROCESS IF. */
- if (process_if_expr != NULL
- && expr_evaluate_num (process_if_expr, c, case_idx) != 1.0)
- return 1;
-
- return 0;
-}
-
-/* Add C to the lag queue. */
-static void
-lag_case (const struct ccase *c)
-{
- if (lag_count < n_lag)
- lag_count++;
- case_destroy (&lag_queue[lag_head]);
- case_clone (&lag_queue[lag_head], c);
- if (++lag_head >= n_lag)
- lag_head = 0;
-}
-
-/* Clears the variables in C that need to be cleared between
- processing cases. */
-static void
-clear_case (struct ccase *c)
-{
- size_t var_cnt = dict_get_var_cnt (default_dict);
- size_t i;
-
- for (i = 0; i < var_cnt; i++)
- {
- struct variable *v = dict_get_var (default_dict, i);
- if (v->init && v->reinit)
- {
- if (v->type == NUMERIC)
- case_data_rw (c, v->fv)->f = SYSMIS;
- else
- memset (case_data_rw (c, v->fv)->s, ' ', v->width);
- }
- }
-}
-
-/* Closes the active file. */
-static void
-close_active_file (void)
-{
- /* Free memory for lag queue, and turn off lagging. */
- if (n_lag > 0)
- {
- int i;
-
- for (i = 0; i < n_lag; i++)
- case_destroy (&lag_queue[i]);
- free (lag_queue);
- n_lag = 0;
- }
-
- /* Dictionary from before TEMPORARY becomes permanent.. */
- if (temporary)
- {
- dict_destroy (default_dict);
- default_dict = temp_dict;
- temp_dict = NULL;
- }
-
- /* Finish compaction. */
- if (compactor != NULL)
- {
- dict_compactor_destroy (compactor);
- dict_compact_values (default_dict);
- }
-
- /* Free data source. */
- free_case_source (vfm_source);
- vfm_source = NULL;
-
- /* Old data sink becomes new data source. */
- if (vfm_sink->class->make_source != NULL)
- vfm_source = vfm_sink->class->make_source (vfm_sink);
- free_case_sink (vfm_sink);
- vfm_sink = NULL;
-
- /* Cancel TEMPORARY, PROCESS IF, FILTER, N OF CASES, vectors,
- and get rid of all the transformations. */
- cancel_temporary ();
- expr_free (process_if_expr);
- process_if_expr = NULL;
- if (dict_get_filter (default_dict) != NULL && !FILTER_before_TEMPORARY)
- dict_set_filter (default_dict, NULL);
- dict_set_case_limit (default_dict, 0);
- dict_clear_vectors (default_dict);
- cancel_transformations ();
-}
-\f
-/* Storage case stream. */
-
-/* Information about storage sink or source. */
-struct storage_stream_info
- {
- struct casefile *casefile; /* Storage. */
- };
-
-/* Initializes a storage sink. */
-static void
-storage_sink_open (struct case_sink *sink)
-{
- struct storage_stream_info *info;
-
- sink->aux = info = xmalloc (sizeof *info);
- info->casefile = casefile_create (sink->value_cnt);
-}
-
-/* Destroys storage stream represented by INFO. */
-static void
-destroy_storage_stream_info (struct storage_stream_info *info)
-{
- if (info != NULL)
- {
- casefile_destroy (info->casefile);
- free (info);
- }
-}
-
-/* Writes case C to the storage sink SINK. */
-static void
-storage_sink_write (struct case_sink *sink, const struct ccase *c)
-{
- struct storage_stream_info *info = sink->aux;
-
- casefile_append (info->casefile, c);
-}
-
-/* Destroys internal data in SINK. */
-static void
-storage_sink_destroy (struct case_sink *sink)
-{
- destroy_storage_stream_info (sink->aux);
-}
-
-/* Closes the sink and returns a storage source to read back the
- written data. */
-static struct case_source *
-storage_sink_make_source (struct case_sink *sink)
-{
- struct case_source *source
- = create_case_source (&storage_source_class, sink->aux);
- sink->aux = NULL;
- return source;
-}
-
-/* Storage sink. */
-const struct case_sink_class storage_sink_class =
- {
- "storage",
- storage_sink_open,
- storage_sink_write,
- storage_sink_destroy,
- storage_sink_make_source,
- };
-\f
-/* Storage source. */
-
-/* Returns the number of cases that will be read by
- storage_source_read(). */
-static int
-storage_source_count (const struct case_source *source)
-{
- struct storage_stream_info *info = source->aux;
-
- return casefile_get_case_cnt (info->casefile);
-}
-
-/* Reads all cases from the storage source and passes them one by one to
- write_case(). */
-static void
-storage_source_read (struct case_source *source,
- struct ccase *output_case,
- write_case_func *write_case, write_case_data wc_data)
-{
- struct storage_stream_info *info = source->aux;
- struct ccase casefile_case;
- struct casereader *reader;
-
- for (reader = casefile_get_reader (info->casefile);
- casereader_read (reader, &casefile_case);
- case_destroy (&casefile_case))
- {
- case_copy (output_case, 0,
- &casefile_case, 0,
- casefile_get_value_cnt (info->casefile));
- write_case (wc_data);
- }
- casereader_destroy (reader);
-}
-
-/* Destroys the source's internal data. */
-static void
-storage_source_destroy (struct case_source *source)
-{
- destroy_storage_stream_info (source->aux);
-}
-
-/* Storage source. */
-const struct case_source_class storage_source_class =
- {
- "storage",
- storage_source_count,
- storage_source_read,
- storage_source_destroy,
- };
-
-struct casefile *
-storage_source_get_casefile (struct case_source *source)
-{
- struct storage_stream_info *info = source->aux;
-
- assert (source->class == &storage_source_class);
- return info->casefile;
-}
-
-struct case_source *
-storage_source_create (struct casefile *cf)
-{
- struct storage_stream_info *info;
-
- info = xmalloc (sizeof *info);
- info->casefile = cf;
-
- return create_case_source (&storage_source_class, info);
-}
-\f
-/* Null sink. Used by a few procedures that keep track of output
- themselves and would throw away anything that the sink
- contained anyway. */
-
-const struct case_sink_class null_sink_class =
- {
- "null",
- NULL,
- NULL,
- NULL,
- NULL,
- };
-\f
-/* Returns a pointer to the lagged case from N_BEFORE cases before the
- current one, or NULL if there haven't been that many cases yet. */
-struct ccase *
-lagged_case (int n_before)
-{
- assert (n_before >= 1 );
- assert (n_before <= n_lag);
-
- if (n_before <= lag_count)
- {
- int index = lag_head - n_before;
- if (index < 0)
- index += n_lag;
- return &lag_queue[index];
- }
- else
- return NULL;
-}
-
-/* Appends TRNS to t_trns[], the list of all transformations to be
- performed on data as it is read from the active file. */
-void
-add_transformation (trns_proc_func *proc, trns_free_func *free, void *private)
-{
- struct transformation *trns;
- if (n_trns >= m_trns)
- t_trns = x2nrealloc (t_trns, &m_trns, sizeof *t_trns);
- trns = &t_trns[n_trns++];
- trns->proc = proc;
- trns->free = free;
- trns->private = private;
-}
-
-/* Returns the index number that the next transformation added by
- add_transformation() will receive. A trns_proc_func that
- returns this index causes control flow to jump to it. */
-size_t
-next_transformation (void)
-{
- return n_trns;
-}
-
-/* Cancels all active transformations, including any transformations
- created by the input program. */
-void
-cancel_transformations (void)
-{
- size_t i;
- for (i = 0; i < n_trns; i++)
- {
- struct transformation *t = &t_trns[i];
- if (t->free != NULL)
- t->free (t->private);
- }
- n_trns = f_trns = 0;
- free (t_trns);
- t_trns = NULL;
- m_trns = 0;
-}
-\f
-/* Creates a case source with class CLASS and auxiliary data AUX
- and based on dictionary DICT. */
-struct case_source *
-create_case_source (const struct case_source_class *class,
- void *aux)
-{
- struct case_source *source = xmalloc (sizeof *source);
- source->class = class;
- source->aux = aux;
- return source;
-}
-
-/* Destroys case source SOURCE. It is the caller's responsible to
- call the source's destroy function, if any. */
-void
-free_case_source (struct case_source *source)
-{
- if (source != NULL)
- {
- if (source->class->destroy != NULL)
- source->class->destroy (source);
- free (source);
- }
-}
-
-/* Returns nonzero if a case source is "complex". */
-int
-case_source_is_complex (const struct case_source *source)
-{
- return source != NULL && (source->class == &input_program_source_class
- || source->class == &file_type_source_class);
-}
-
-/* Returns nonzero if CLASS is the class of SOURCE. */
-int
-case_source_is_class (const struct case_source *source,
- const struct case_source_class *class)
-{
- return source != NULL && source->class == class;
-}
-
-/* Creates a case sink to accept cases from the given DICT with
- class CLASS and auxiliary data AUX. */
-struct case_sink *
-create_case_sink (const struct case_sink_class *class,
- const struct dictionary *dict,
- void *aux)
-{
- struct case_sink *sink = xmalloc (sizeof *sink);
- sink->class = class;
- sink->value_cnt = dict_get_compacted_value_cnt (dict);
- sink->aux = aux;
- return sink;
-}
-
-/* Destroys case sink SINK. */
-void
-free_case_sink (struct case_sink *sink)
-{
- if (sink != NULL)
- {
- if (sink->class->destroy != NULL)
- sink->class->destroy (sink);
- free (sink);
- }
-}
-\f
-/* Represents auxiliary data for handling SPLIT FILE. */
-struct split_aux_data
- {
- size_t case_count; /* Number of cases so far. */
- struct ccase prev_case; /* Data in previous case. */
-
- /* Functions to call... */
- void (*begin_func) (void *); /* ...before data. */
- int (*proc_func) (struct ccase *, void *); /* ...with data. */
- void (*end_func) (void *); /* ...after data. */
- void *func_aux; /* Auxiliary data. */
- };
-
-static int equal_splits (const struct ccase *, const struct ccase *);
-static int procedure_with_splits_callback (struct ccase *, void *);
-static void dump_splits (struct ccase *);
-
-/* Like procedure(), but it automatically breaks the case stream
- into SPLIT FILE break groups. Before each group of cases with
- identical SPLIT FILE variable values, BEGIN_FUNC is called.
- Then PROC_FUNC is called with each case in the group.
- END_FUNC is called when the group is finished. FUNC_AUX is
- passed to each of the functions as auxiliary data.
-
- If the active file is empty, none of BEGIN_FUNC, PROC_FUNC,
- and END_FUNC will be called at all.
-
- If SPLIT FILE is not in effect, then there is one break group
- (if the active file is nonempty), and BEGIN_FUNC and END_FUNC
- will be called once. */
-void
-procedure_with_splits (void (*begin_func) (void *aux),
- int (*proc_func) (struct ccase *, void *aux),
- void (*end_func) (void *aux),
- void *func_aux)
-{
- struct split_aux_data split_aux;
-
- split_aux.case_count = 0;
- case_nullify (&split_aux.prev_case);
- split_aux.begin_func = begin_func;
- split_aux.proc_func = proc_func;
- split_aux.end_func = end_func;
- split_aux.func_aux = func_aux;
-
- open_active_file ();
- internal_procedure (procedure_with_splits_callback, &split_aux);
- if (split_aux.case_count > 0 && end_func != NULL)
- end_func (func_aux);
- close_active_file ();
-
- case_destroy (&split_aux.prev_case);
-}
-
-/* procedure() callback used by procedure_with_splits(). */
-static int
-procedure_with_splits_callback (struct ccase *c, void *split_aux_)
-{
- struct split_aux_data *split_aux = split_aux_;
-
- /* Start a new series if needed. */
- if (split_aux->case_count == 0
- || !equal_splits (c, &split_aux->prev_case))
- {
- if (split_aux->case_count > 0 && split_aux->end_func != NULL)
- split_aux->end_func (split_aux->func_aux);
-
- dump_splits (c);
- case_destroy (&split_aux->prev_case);
- case_clone (&split_aux->prev_case, c);
-
- if (split_aux->begin_func != NULL)
- split_aux->begin_func (split_aux->func_aux);
- }
-
- split_aux->case_count++;
- if (split_aux->proc_func != NULL)
- return split_aux->proc_func (c, split_aux->func_aux);
- else
- return 1;
-}
-
-/* Compares the SPLIT FILE variables in cases A and B and returns
- nonzero only if they differ. */
-static int
-equal_splits (const struct ccase *a, const struct ccase *b)
-{
- return case_compare (a, b,
- dict_get_split_vars (default_dict),
- dict_get_split_cnt (default_dict)) == 0;
-}
-
-/* Dumps out the values of all the split variables for the case C. */
-static void
-dump_splits (struct ccase *c)
-{
- struct variable *const *split;
- struct tab_table *t;
- size_t split_cnt;
- int i;
-
- split_cnt = dict_get_split_cnt (default_dict);
- if (split_cnt == 0)
- return;
-
- t = tab_create (3, split_cnt + 1, 0);
- tab_dim (t, tab_natural_dimensions);
- tab_vline (t, TAL_1 | TAL_SPACING, 1, 0, split_cnt);
- tab_vline (t, TAL_1 | TAL_SPACING, 2, 0, split_cnt);
- tab_text (t, 0, 0, TAB_NONE, _("Variable"));
- tab_text (t, 1, 0, TAB_LEFT, _("Value"));
- tab_text (t, 2, 0, TAB_LEFT, _("Label"));
- split = dict_get_split_vars (default_dict);
- for (i = 0; i < split_cnt; i++)
- {
- struct variable *v = split[i];
- char temp_buf[80];
- const char *val_lab;
-
- assert (v->type == NUMERIC || v->type == ALPHA);
- tab_text (t, 0, i + 1, TAB_LEFT | TAT_PRINTF, "%s", v->name);
-
- data_out (temp_buf, &v->print, case_data (c, v->fv));
-
- temp_buf[v->print.w] = 0;
- tab_text (t, 1, i + 1, TAT_PRINTF, "%.*s", v->print.w, temp_buf);
-
- val_lab = val_labs_find (v->val_labs, *case_data (c, v->fv));
- if (val_lab)
- tab_text (t, 2, i + 1, TAB_LEFT, val_lab);
- }
- tab_flags (t, SOMF_NO_TITLE);
- tab_submit (t);
-}
-\f
-/* Represents auxiliary data for handling SPLIT FILE in a
- multipass procedure. */
-struct multipass_split_aux_data
- {
- struct ccase prev_case; /* Data in previous case. */
- struct casefile *casefile; /* Accumulates data for a split. */
-
- /* Function to call with the accumulated data. */
- void (*split_func) (const struct casefile *, void *);
- void *func_aux; /* Auxiliary data. */
- };
-
-static int multipass_split_callback (struct ccase *c, void *aux_);
-static void multipass_split_output (struct multipass_split_aux_data *);
-
-void
-multipass_procedure_with_splits (void (*split_func) (const struct casefile *,
- void *),
- void *func_aux)
-{
- struct multipass_split_aux_data aux;
-
- assert (split_func != NULL);
-
- open_active_file ();
-
- case_nullify (&aux.prev_case);
- aux.casefile = NULL;
- aux.split_func = split_func;
- aux.func_aux = func_aux;
-
- internal_procedure (multipass_split_callback, &aux);
- if (aux.casefile != NULL)
- multipass_split_output (&aux);
- case_destroy (&aux.prev_case);
-
- close_active_file ();
-}
-
-/* procedure() callback used by multipass_procedure_with_splits(). */
-static int
-multipass_split_callback (struct ccase *c, void *aux_)
-{
- struct multipass_split_aux_data *aux = aux_;
-
- /* Start a new series if needed. */
- if (aux->casefile == NULL || !equal_splits (c, &aux->prev_case))
- {
- /* Pass any cases to split_func. */
- if (aux->casefile != NULL)
- multipass_split_output (aux);
-
- /* Start a new casefile. */
- aux->casefile = casefile_create (dict_get_next_value_idx (default_dict));
-
- /* Record split values. */
- dump_splits (c);
- case_destroy (&aux->prev_case);
- case_clone (&aux->prev_case, c);
- }
-
- casefile_append (aux->casefile, c);
-
- return 1;
-}
-
-static void
-multipass_split_output (struct multipass_split_aux_data *aux)
-{
- assert (aux->casefile != NULL);
- aux->split_func (aux->casefile, aux->func_aux);
- casefile_destroy (aux->casefile);
- aux->casefile = NULL;
-}
-
-
-/* Discards all the current state in preparation for a data-input
- command like DATA LIST or GET. */
-void
-discard_variables (void)
-{
- dict_clear (default_dict);
- fh_set_default_handle (NULL);
-
- n_lag = 0;
-
- if (vfm_source != NULL)
- {
- free_case_source (vfm_source);
- vfm_source = NULL;
- }
-
- cancel_transformations ();
-
- ctl_stack_clear ();
-
- expr_free (process_if_expr);
- process_if_expr = NULL;
-
- cancel_temporary ();
-
- pgm_state = STATE_INIT;
-}
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !vfm_h
-#define vfm_h 1
-
-#include <time.h>
-
-struct ccase;
-typedef struct write_case_data *write_case_data;
-typedef int write_case_func (write_case_data);
-\f
-/* The current active file, from which cases are read. */
-extern struct case_source *vfm_source;
-
-/* A case source. */
-struct case_source
- {
- const struct case_source_class *class; /* Class. */
- void *aux; /* Auxiliary data. */
- };
-
-/* A case source class. */
-struct case_source_class
- {
- const char *name; /* Identifying name. */
-
- /* Returns the exact number of cases that READ will pass to
- WRITE_CASE, if known, or -1 otherwise. */
- int (*count) (const struct case_source *);
-
- /* Reads the cases one by one into C and for each one calls
- WRITE_CASE passing the given AUX data. */
- void (*read) (struct case_source *,
- struct ccase *c,
- write_case_func *write_case, write_case_data aux);
-
- /* Destroys the source. */
- void (*destroy) (struct case_source *);
- };
-
-extern const struct case_source_class storage_source_class;
-extern const struct case_source_class file_type_source_class;
-extern const struct case_source_class input_program_source_class;
-
-struct dictionary;
-struct case_source *create_case_source (const struct case_source_class *,
- void *);
-void free_case_source (struct case_source *);
-
-int case_source_is_complex (const struct case_source *);
-int case_source_is_class (const struct case_source *,
- const struct case_source_class *);
-
-struct casefile *storage_source_get_casefile (struct case_source *);
-struct case_source *storage_source_create (struct casefile *);
-\f
-/* The replacement active file, to which cases are written. */
-extern struct case_sink *vfm_sink;
-
-/* A case sink. */
-struct case_sink
- {
- const struct case_sink_class *class; /* Class. */
- void *aux; /* Auxiliary data. */
- size_t value_cnt; /* Number of `union value's in case. */
- };
-
-/* A case sink class. */
-struct case_sink_class
- {
- const char *name; /* Identifying name. */
-
- /* Opens the sink for writing. */
- void (*open) (struct case_sink *);
-
- /* Writes a case to the sink. */
- void (*write) (struct case_sink *, const struct ccase *);
-
- /* Closes and destroys the sink. */
- void (*destroy) (struct case_sink *);
-
- /* Closes the sink and returns a source that can read back
- the cases that were written, perhaps transformed in some
- way. The sink must still be separately destroyed by
- calling destroy(). */
- struct case_source *(*make_source) (struct case_sink *);
- };
-
-extern const struct case_sink_class storage_sink_class;
-extern const struct case_sink_class null_sink_class;
-
-struct case_sink *create_case_sink (const struct case_sink_class *,
- const struct dictionary *,
- void *);
-void case_sink_open (struct case_sink *);
-void case_sink_write (struct case_sink *, const struct ccase *);
-void case_sink_destroy (struct case_sink *);
-void free_case_sink (struct case_sink *);
-\f
-/* Number of cases to lag. */
-extern int n_lag;
-
-void procedure (int (*proc_func) (struct ccase *, void *aux), void *aux);
-void procedure_with_splits (void (*begin_func) (void *aux),
- int (*proc_func) (struct ccase *, void *aux),
- void (*end_func) (void *aux),
- void *aux);
-struct ccase *lagged_case (int n_before);
-\f
-void multipass_procedure_with_splits (void (*) (const struct casefile *,
- void *),
- void *aux);
-\f
-time_t vfm_last_invocation (void);
-
-#endif /* !vfm_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#if !vfmP_h
-#define vfmP_h 1
-
-#include "var.h"
-
-#endif /* !vfmP_h */
+++ /dev/null
-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
-
- 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 the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- 02110-1301, USA. */
-
-#include <config.h>
-#include "error.h"
-#include <stdio.h>
-#include "command.h"
-#include "dictionary.h"
-#include "error.h"
-#include "lexer.h"
-#include "str.h"
-#include "var.h"
-
-#include "gettext.h"
-#define _(msgid) gettext (msgid)
-
-int
-cmd_weight (void)
-{
- if (lex_match_id ("OFF"))
- dict_set_weight (default_dict, NULL);
- else
- {
- struct variable *v;
-
- lex_match (T_BY);
- v = parse_variable ();
- if (!v)
- return CMD_FAILURE;
- if (v->type == ALPHA)
- {
- msg (SE, _("The weighting variable must be numeric."));
- return CMD_FAILURE;
- }
- if (dict_class_from_id (v->name) == DC_SCRATCH)
- {
- msg (SE, _("The weighting variable may not be scratch."));
- return CMD_FAILURE;
- }
-
- dict_set_weight (default_dict, v);
- }
-
- return lex_end_of_command ();
-}
projects / pspp-builds.git / commitdiff