From 44109cbee52068478208c7e8649a3a80e92f4bb4 Mon Sep 17 00:00:00 2001 From: John Darrington Date: Sat, 4 Mar 2006 02:16:55 +0000 Subject: [PATCH] Removed old files from src --- src/aggregate.c | 1081 ------------- src/algorithm.c | 987 ------------ src/algorithm.h | 212 --- src/alloc.c | 32 - src/alloc.h | 42 - src/any-reader.c | 188 --- src/any-reader.h | 33 - src/any-writer.c | 193 --- src/any-writer.h | 40 - src/apply-dict.c | 169 --- src/ascii.c | 1691 --------------------- src/autorecode.c | 363 ----- src/barchart.c | 253 ---- src/bitvector.h | 44 - src/box-whisker.c | 240 --- src/calendar.c | 211 --- src/calendar.h | 15 - src/cartesian.c | 196 --- src/case.c | 431 ------ src/case.h | 188 --- src/casefile-test.c | 213 --- src/casefile.c | 755 --------- src/casefile.h | 55 - src/cat-routines.h | 53 - src/cat.c | 142 -- src/cat.h | 57 - src/chart.c | 55 - src/chart.h | 254 ---- src/cmdline.c | 291 ---- src/cmdline.h | 25 - src/command.c | 868 ----------- src/command.h | 64 - src/compute.c | 415 ----- src/copyleft.c | 374 ----- src/copyleft.h | 27 - src/correlations.q | 170 --- src/count.c | 349 ----- src/crosstabs.q | 3201 --------------------------------------- src/ctl-stack.c | 93 -- src/ctl-stack.h | 39 - src/data-in.c | 1438 ------------------ src/data-in.h | 52 - src/data-list.c | 2059 ------------------------- src/data-list.h | 33 - src/data-out.c | 1256 --------------- src/date.c | 37 - src/debug-print.h | 54 - src/descript.c | 944 ------------ src/design-matrix.c | 271 ---- src/design-matrix.h | 85 -- src/dfm-read.c | 463 ------ src/dfm-read.h | 51 - src/dfm-write.c | 130 -- src/dfm-write.h | 32 - src/dictionary.c | 1208 --------------- src/dictionary.h | 116 -- src/do-if.c | 274 ---- src/dummy-chart.c | 113 -- src/echo.c | 49 - src/error.c | 498 ------ src/error.h | 103 -- src/examine.q | 2202 --------------------------- src/factor_stats.c | 335 ---- src/factor_stats.h | 167 -- src/file-handle-def.c | 456 ------ src/file-handle-def.h | 96 -- src/file-handle.h | 31 - src/file-handle.q | 216 --- src/file-type.c | 741 --------- src/filename.c | 954 ------------ src/filename.h | 79 - src/flip.c | 543 ------- src/font.h | 135 -- src/format-prs.c | 157 -- src/format.c | 374 ----- src/format.h | 128 -- src/formats.c | 118 -- src/frequencies.q | 1640 -------------------- src/get.c | 1660 -------------------- src/getl.c | 385 ----- src/getl.h | 125 -- src/glob.c | 62 - src/glob.h | 25 - src/groff-font.c | 1030 ------------- src/group.c | 68 - src/group.h | 91 -- src/group_proc.h | 51 - src/hash.c | 617 -------- src/hash.h | 83 - src/histogram.c | 55 - src/histogram.h | 28 - src/html.c | 657 -------- src/htmlP.h | 38 - src/include.c | 50 - src/inpt-pgm.c | 419 ----- src/levene.c | 378 ----- src/levene.h | 49 - src/lex-def.c | 98 -- src/lex-def.h | 83 - src/lexer.c | 1216 --------------- src/lexer.h | 91 -- src/linked-list.c | 102 -- src/linked-list.h | 48 - src/list.q | 723 --------- src/loop.c | 362 ----- src/magic.c | 32 - src/magic.h | 62 - src/main.c | 280 ---- src/main.h | 30 - src/matrix-data.c | 1999 ------------------------ src/means.q | 176 --- src/mis-val.c | 155 -- src/misc.c | 38 - src/misc.h | 95 -- src/missing-values.c | 440 ------ src/missing-values.h | 93 -- src/mkfile.c | 107 -- src/mkfile.h | 35 - src/modify-vars.c | 525 ------- src/moments.c | 611 -------- src/moments.h | 75 - src/numeric.c | 206 --- src/oneway.q | 1058 ------------- src/output.c | 1362 ----------------- src/output.h | 271 ---- src/percentiles.c | 428 ------ src/percentiles.h | 83 - src/permissions.c | 128 -- src/pfm-read.c | 724 --------- src/pfm-read.h | 48 - src/pfm-write.c | 860 ----------- src/pfm-write.h | 52 - src/piechart.c | 209 --- src/plot-chart.c | 265 ---- src/plot-hist.c | 183 --- src/pool.c | 962 ------------ src/pool.h | 85 -- src/postscript.c | 3053 ------------------------------------- src/print.c | 1118 -------------- src/q2c.c | 2078 ------------------------- src/random.c | 57 - src/random.h | 31 - src/range-prs.c | 111 -- src/range-prs.h | 28 - src/rank.q | 357 ----- src/readln.c | 279 ---- src/readln.h | 32 - src/recode.c | 660 -------- src/regression.q | 941 ------------ src/regression_export.h | 148 -- src/rename-vars.c | 116 -- src/repeat.c | 586 ------- src/repeat.h | 25 - src/sample.c | 155 -- src/scratch-handle.c | 36 - src/scratch-handle.h | 34 - src/scratch-reader.c | 88 -- src/scratch-reader.h | 33 - src/scratch-writer.c | 112 -- src/scratch-writer.h | 33 - src/sel-if.c | 146 -- src/set.q | 722 --------- src/settings.c | 594 -------- src/settings.h | 137 -- src/sfm-read.c | 1542 ------------------- src/sfm-read.h | 49 - src/sfm-write.c | 938 ------------ src/sfm-write.h | 45 - src/sfmP.h | 99 -- src/som.c | 297 ---- src/som.h | 121 -- src/sort-prs.c | 159 -- src/sort-prs.h | 38 - src/sort.c | 724 --------- src/sort.h | 63 - src/split-file.c | 52 - src/str.c | 705 --------- src/str.h | 235 --- src/subclist.c | 75 - src/subclist.h | 72 - src/sysfile-info.c | 608 -------- src/t-test.q | 1985 ------------------------ src/tab.c | 1438 ------------------ src/tab.h | 195 --- src/temporary.c | 83 - src/title.c | 182 --- src/val-labs.c | 193 --- src/val.h | 78 - src/value-labels.c | 518 ------- src/value-labels.h | 62 - src/var-display.c | 170 --- src/var-labs.c | 84 - src/var.h | 235 --- src/vars-atr.c | 319 ---- src/vars-prs.c | 745 --------- src/vector.c | 205 --- src/version.h | 51 - src/vfm.c | 972 ------------ src/vfm.h | 133 -- src/vfmP.h | 25 - src/weight.c | 61 - 201 files changed, 77284 deletions(-) delete mode 100644 src/aggregate.c delete mode 100644 src/algorithm.c delete mode 100644 src/algorithm.h delete mode 100644 src/alloc.c delete mode 100644 src/alloc.h delete mode 100644 src/any-reader.c delete mode 100644 src/any-reader.h delete mode 100644 src/any-writer.c delete mode 100644 src/any-writer.h delete mode 100644 src/apply-dict.c delete mode 100644 src/ascii.c delete mode 100644 src/autorecode.c delete mode 100644 src/barchart.c delete mode 100644 src/bitvector.h delete mode 100644 src/box-whisker.c delete mode 100644 src/calendar.c delete mode 100644 src/calendar.h delete mode 100644 src/cartesian.c delete mode 100644 src/case.c delete mode 100644 src/case.h delete mode 100644 src/casefile-test.c delete mode 100644 src/casefile.c delete mode 100644 src/casefile.h delete mode 100644 src/cat-routines.h delete mode 100644 src/cat.c delete mode 100644 src/cat.h delete mode 100644 src/chart.c delete mode 100644 src/chart.h delete mode 100644 src/cmdline.c delete mode 100644 src/cmdline.h delete mode 100644 src/command.c delete mode 100644 src/command.h delete mode 100644 src/compute.c delete mode 100644 src/copyleft.c delete mode 100644 src/copyleft.h delete mode 100644 src/correlations.q delete mode 100644 src/count.c delete mode 100644 src/crosstabs.q delete mode 100644 src/ctl-stack.c delete mode 100644 src/ctl-stack.h delete mode 100644 src/data-in.c delete mode 100644 src/data-in.h delete mode 100644 src/data-list.c delete mode 100644 src/data-list.h delete mode 100644 src/data-out.c delete mode 100644 src/date.c delete mode 100644 src/debug-print.h delete mode 100644 src/descript.c delete mode 100644 src/design-matrix.c delete mode 100644 src/design-matrix.h delete mode 100644 src/dfm-read.c delete mode 100644 src/dfm-read.h delete mode 100644 src/dfm-write.c delete mode 100644 src/dfm-write.h delete mode 100644 src/dictionary.c delete mode 100644 src/dictionary.h delete mode 100644 src/do-if.c delete mode 100644 src/dummy-chart.c delete mode 100644 src/echo.c delete mode 100644 src/error.c delete mode 100644 src/error.h delete mode 100644 src/examine.q delete mode 100644 src/factor_stats.c delete mode 100644 src/factor_stats.h delete mode 100644 src/file-handle-def.c delete mode 100644 src/file-handle-def.h delete mode 100644 src/file-handle.h delete mode 100644 src/file-handle.q delete mode 100644 src/file-type.c delete mode 100644 src/filename.c delete mode 100644 src/filename.h delete mode 100644 src/flip.c delete mode 100644 src/font.h delete mode 100644 src/format-prs.c delete mode 100644 src/format.c delete mode 100644 src/format.h delete mode 100644 src/formats.c delete mode 100644 src/frequencies.q delete mode 100644 src/get.c delete mode 100644 src/getl.c delete mode 100644 src/getl.h delete mode 100644 src/glob.c delete mode 100644 src/glob.h delete mode 100644 src/groff-font.c delete mode 100644 src/group.c delete mode 100644 src/group.h delete mode 100644 src/group_proc.h delete mode 100644 src/hash.c delete mode 100644 src/hash.h delete mode 100644 src/histogram.c delete mode 100644 src/histogram.h delete mode 100644 src/html.c delete mode 100644 src/htmlP.h delete mode 100644 src/include.c delete mode 100644 src/inpt-pgm.c delete mode 100644 src/levene.c delete mode 100644 src/levene.h delete mode 100644 src/lex-def.c delete mode 100644 src/lex-def.h delete mode 100644 src/lexer.c delete mode 100644 src/lexer.h delete mode 100644 src/linked-list.c delete mode 100644 src/linked-list.h delete mode 100644 src/list.q delete mode 100644 src/loop.c delete mode 100644 src/magic.c delete mode 100644 src/magic.h delete mode 100644 src/main.c delete mode 100644 src/main.h delete mode 100644 src/matrix-data.c delete mode 100644 src/means.q delete mode 100644 src/mis-val.c delete mode 100644 src/misc.c delete mode 100644 src/misc.h delete mode 100644 src/missing-values.c delete mode 100644 src/missing-values.h delete mode 100644 src/mkfile.c delete mode 100644 src/mkfile.h delete mode 100644 src/modify-vars.c delete mode 100644 src/moments.c delete mode 100644 src/moments.h delete mode 100644 src/numeric.c delete mode 100644 src/oneway.q delete mode 100644 src/output.c delete mode 100644 src/output.h delete mode 100644 src/percentiles.c delete mode 100644 src/percentiles.h delete mode 100644 src/permissions.c delete mode 100644 src/pfm-read.c delete mode 100644 src/pfm-read.h delete mode 100644 src/pfm-write.c delete mode 100644 src/pfm-write.h delete mode 100644 src/piechart.c delete mode 100644 src/plot-chart.c delete mode 100644 src/plot-hist.c delete mode 100644 src/pool.c delete mode 100644 src/pool.h delete mode 100644 src/postscript.c delete mode 100644 src/print.c delete mode 100644 src/q2c.c delete mode 100644 src/random.c delete mode 100644 src/random.h delete mode 100644 src/range-prs.c delete mode 100644 src/range-prs.h delete mode 100644 src/rank.q delete mode 100644 src/readln.c delete mode 100644 src/readln.h delete mode 100644 src/recode.c delete mode 100644 src/regression.q delete mode 100644 src/regression_export.h delete mode 100644 src/rename-vars.c delete mode 100644 src/repeat.c delete mode 100644 src/repeat.h delete mode 100644 src/sample.c delete mode 100644 src/scratch-handle.c delete mode 100644 src/scratch-handle.h delete mode 100644 src/scratch-reader.c delete mode 100644 src/scratch-reader.h delete mode 100644 src/scratch-writer.c delete mode 100644 src/scratch-writer.h delete mode 100644 src/sel-if.c delete mode 100644 src/set.q delete mode 100644 src/settings.c delete mode 100644 src/settings.h delete mode 100644 src/sfm-read.c delete mode 100644 src/sfm-read.h delete mode 100644 src/sfm-write.c delete mode 100644 src/sfm-write.h delete mode 100644 src/sfmP.h delete mode 100644 src/som.c delete mode 100644 src/som.h delete mode 100644 src/sort-prs.c delete mode 100644 src/sort-prs.h delete mode 100644 src/sort.c delete mode 100644 src/sort.h delete mode 100644 src/split-file.c delete mode 100644 src/str.c delete mode 100644 src/str.h delete mode 100644 src/subclist.c delete mode 100644 src/subclist.h delete mode 100644 src/sysfile-info.c delete mode 100644 src/t-test.q delete mode 100644 src/tab.c delete mode 100644 src/tab.h delete mode 100644 src/temporary.c delete mode 100644 src/title.c delete mode 100644 src/val-labs.c delete mode 100644 src/val.h delete mode 100644 src/value-labels.c delete mode 100644 src/value-labels.h delete mode 100644 src/var-display.c delete mode 100644 src/var-labs.c delete mode 100644 src/var.h delete mode 100644 src/vars-atr.c delete mode 100644 src/vars-prs.c delete mode 100644 src/vector.c delete mode 100644 src/version.h delete mode 100644 src/vfm.c delete mode 100644 src/vfm.h delete mode 100644 src/vfmP.h delete mode 100644 src/weight.c diff --git a/src/aggregate.c b/src/aggregate.c deleted file mode 100644 index 67e8bb91..00000000 --- a/src/aggregate.c +++ /dev/null @@ -1,1081 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#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[] = - { - {"", 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); - -/* 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); -} - -/* 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; - } - } -} - -/* 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; -} diff --git a/src/algorithm.c b/src/algorithm.c deleted file mode 100644 index cfb1ba9f..00000000 --- a/src/algorithm.c +++ /dev/null @@ -1,987 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "algorithm.h" -#include -#include -#include -#include -#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" - -/* 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; -} - -/* 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); -} - -/* 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; -} - -/* 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); -} - -/* 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; -} - -/* 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; -} - -/* 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 -#include -#include - -/* 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; -} - -/* 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; -} - -/* 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; -} - -/* 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; -} - diff --git a/src/algorithm.h b/src/algorithm.h deleted file mode 100644 index 10e589a1..00000000 --- a/src/algorithm.h +++ /dev/null @@ -1,212 +0,0 @@ -#ifndef ALGORITHM_H -#define ALGORITHM_H 1 - -#include - -/* 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 */ diff --git a/src/alloc.c b/src/alloc.c deleted file mode 100644 index a7b20283..00000000 --- a/src/alloc.c +++ /dev/null @@ -1,32 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "alloc.h" -#include - -/* 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; -} diff --git a/src/alloc.h b/src/alloc.h deleted file mode 100644 index 0f4492e3..00000000 --- a/src/alloc.h +++ /dev/null @@ -1,42 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -/* 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 -#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 */ diff --git a/src/any-reader.c b/src/any-reader.c deleted file mode 100644 index 0f6f610d..00000000 --- a/src/any-reader.c +++ /dev/null @@ -1,188 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "any-reader.h" -#include -#include -#include -#include -#include -#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 (); - } -} diff --git a/src/any-reader.h b/src/any-reader.h deleted file mode 100644 index d4f296ea..00000000 --- a/src/any-reader.h +++ /dev/null @@ -1,33 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -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 */ diff --git a/src/any-writer.c b/src/any-writer.c deleted file mode 100644 index 048a7205..00000000 --- a/src/any-writer.c +++ /dev/null @@ -1,193 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "any-writer.h" -#include -#include -#include -#include -#include -#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 (); - } -} diff --git a/src/any-writer.h b/src/any-writer.h deleted file mode 100644 index 9603b5ed..00000000 --- a/src/any-writer.h +++ /dev/null @@ -1,40 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -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 */ diff --git a/src/apply-dict.c b/src/apply-dict.c deleted file mode 100644 index ccfecb9e..00000000 --- a/src/apply-dict.c +++ /dev/null @@ -1,169 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#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 (); -} diff --git a/src/ascii.c b/src/ascii.c deleted file mode 100644 index 738526f3..00000000 --- a/src/ascii.c +++ /dev/null @@ -1,1691 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#include -#include -#include -#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<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; - } -} - -/* 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 -}; diff --git a/src/autorecode.c b/src/autorecode.c deleted file mode 100644 index e34e395c..00000000 --- a/src/autorecode.c +++ /dev/null @@ -1,363 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#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); -} - - -/* 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); -} - -/* 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; -} diff --git a/src/barchart.c b/src/barchart.c deleted file mode 100644 index 5c00d4f5..00000000 --- a/src/barchart.c +++ /dev/null @@ -1,253 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by 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 -#include -#include -#include -#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); -} diff --git a/src/bitvector.h b/src/bitvector.h deleted file mode 100644 index 70112506..00000000 --- a/src/bitvector.h +++ /dev/null @@ -1,44 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -/* 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 */ diff --git a/src/box-whisker.c b/src/box-whisker.c deleted file mode 100644 index 73d0866a..00000000 --- a/src/box-whisker.c +++ /dev/null @@ -1,240 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by 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 "chart.h" -#include -#include -#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); - } - -} diff --git a/src/calendar.c b/src/calendar.c deleted file mode 100644 index e5695c44..00000000 --- a/src/calendar.c +++ /dev/null @@ -1,211 +0,0 @@ -#include -#include "calendar.h" -#include -#include -#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; -} diff --git a/src/calendar.h b/src/calendar.h deleted file mode 100644 index 1a70592b..00000000 --- a/src/calendar.h +++ /dev/null @@ -1,15 +0,0 @@ -#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 */ diff --git a/src/cartesian.c b/src/cartesian.c deleted file mode 100644 index 9dceb304..00000000 --- a/src/cartesian.c +++ /dev/null @@ -1,196 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by 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 -#include "chart.h" -#include - - - -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); - -} diff --git a/src/case.c b/src/case.c deleted file mode 100644 index 1384791c..00000000 --- a/src/case.c +++ /dev/null @@ -1,431 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "case.h" -#include -#include -#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 - -/* 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; -} diff --git a/src/case.h b/src/case.h deleted file mode 100644 index cf99e022..00000000 --- a/src/case.h +++ /dev/null @@ -1,188 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#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 -#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 */ diff --git a/src/casefile-test.c b/src/casefile-test.c deleted file mode 100644 index 4a0c699c..00000000 --- a/src/casefile-test.c +++ /dev/null @@ -1,213 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "casefile.h" -#include "case.h" - -#include -#include -#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); -} diff --git a/src/casefile.c b/src/casefile.c deleted file mode 100644 index 8fe07403..00000000 --- a/src/casefile.c +++ /dev/null @@ -1,755 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "casefile.h" -#include -#include -#include -#include -#include -#include -#include -#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); -} diff --git a/src/casefile.h b/src/casefile.h deleted file mode 100644 index 4286a78a..00000000 --- a/src/casefile.h +++ /dev/null @@ -1,55 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include - -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 */ diff --git a/src/cat-routines.h b/src/cat-routines.h deleted file mode 100644 index 6842fab5..00000000 --- a/src/cat-routines.h +++ /dev/null @@ -1,53 +0,0 @@ -/* PSPP - Binary encodings for categorical variables. - Copyright (C) 2005 Free Software Foundation, Inc. - Written by Jason H Stover . - - 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 -#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 diff --git a/src/cat.c b/src/cat.c deleted file mode 100644 index 9b8ed966..00000000 --- a/src/cat.c +++ /dev/null @@ -1,142 +0,0 @@ -/* PSPP - binary encodings for categorical variables. - Copyright (C) 2005 Free Software Foundation, Inc. - Written by Jason H Stover . - - 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 -#include -#include -#include "alloc.h" -#include "error.h" -#include "cat.h" -#include "cat-routines.h" -#include - -#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; -} - diff --git a/src/cat.h b/src/cat.h deleted file mode 100644 index 69125035..00000000 --- a/src/cat.h +++ /dev/null @@ -1,57 +0,0 @@ -/* PSPP - Binary encodings for categorical variables. - Copyright (C) 2005 Free Software Foundation, Inc. - Written by Jason H Stover . - - 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 -#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 diff --git a/src/chart.c b/src/chart.c deleted file mode 100644 index 1a41ff1a..00000000 --- a/src/chart.c +++ /dev/null @@ -1,55 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by 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 -#include - -#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; - -} - diff --git a/src/chart.h b/src/chart.h deleted file mode 100644 index c0ab0a20..00000000 --- a/src/chart.h +++ /dev/null @@ -1,254 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by 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. */ - - -#ifndef CHART_H -#define CHART_H - -#include -#include -#include -#include "var.h" - -#ifndef NO_CHARTS -#include -#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 diff --git a/src/cmdline.c b/src/cmdline.c deleted file mode 100644 index b9205a14..00000000 --- a/src/cmdline.c +++ /dev/null @@ -1,291 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "cmdline.h" -#include "error.h" -#include -#include -#include -#include -#include -#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); -} diff --git a/src/cmdline.h b/src/cmdline.h deleted file mode 100644 index a275af3f..00000000 --- a/src/cmdline.h +++ /dev/null @@ -1,25 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 */ diff --git a/src/command.c b/src/command.c deleted file mode 100644 index bdefcb22..00000000 --- a/src/command.c +++ /dev/null @@ -1,868 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include "command.h" -#include -#include -#include -#include -#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 -#endif - -#if HAVE_SYS_WAIT_H -#include -#endif - -#include "gettext.h" -#define _(msgid) gettext (msgid) -#define N_(msgid) msgid - -/* 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; - -/* 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) - -/* 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; -} - -/* 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; -} diff --git a/src/command.h b/src/command.h deleted file mode 100644 index a62f8d60..00000000 --- a/src/command.h +++ /dev/null @@ -1,64 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 */ diff --git a/src/compute.c b/src/compute.c deleted file mode 100644 index 37592c88..00000000 --- a/src/compute.c +++ /dev/null @@ -1,415 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#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; - -/* 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; -} - -/* 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; -} - -/* 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; -} - -/* 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); - } -} - -/* 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); -} diff --git a/src/copyleft.c b/src/copyleft.c deleted file mode 100644 index f04bf58c..00000000 --- a/src/copyleft.c +++ /dev/null @@ -1,374 +0,0 @@ -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" -" \n" -" Copyright (C) \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" -" , 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. " -""; diff --git a/src/copyleft.h b/src/copyleft.h deleted file mode 100644 index 8abb426d..00000000 --- a/src/copyleft.h +++ /dev/null @@ -1,27 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 diff --git a/src/correlations.q b/src/correlations.q deleted file mode 100644 index f5348748..00000000 --- a/src/correlations.q +++ /dev/null @@ -1,170 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#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: -*/ diff --git a/src/count.c b/src/count.c deleted file mode 100644 index 26509dcf..00000000 --- a/src/count.c +++ /dev/null @@ -1,349 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#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 *); - -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; -} - -/* 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); -} diff --git a/src/crosstabs.q b/src/crosstabs.q deleted file mode 100644 index 7d9f334f..00000000 --- a/src/crosstabs.q +++ /dev/null @@ -1,3201 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#include -#include -#include -#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; -} - -/* 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; -} - -/* 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); -} - -/* 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); -} - -/* 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: -*/ diff --git a/src/ctl-stack.c b/src/ctl-stack.c deleted file mode 100644 index 1536094b..00000000 --- a/src/ctl-stack.c +++ /dev/null @@ -1,93 +0,0 @@ -#include -#include "ctl-stack.h" -#include -#include -#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; -} diff --git a/src/ctl-stack.h b/src/ctl-stack.h deleted file mode 100644 index 87ef4bee..00000000 --- a/src/ctl-stack.h +++ /dev/null @@ -1,39 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -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 */ diff --git a/src/data-in.c b/src/data-in.c deleted file mode 100644 index ae798062..00000000 --- a/src/data-in.c +++ /dev/null @@ -1,1438 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "data-in.h" -#include "error.h" -#include -#include -#include -#include -#include -#include -#include -#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" - -/* 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); -} - -/* 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); -} - -/* 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; -} - -/* 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; -} - -/* 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; -} - -/* 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; - } -} - -/* 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); -} diff --git a/src/data-in.h b/src/data-in.h deleted file mode 100644 index 287b2fbe..00000000 --- a/src/data-in.h +++ /dev/null @@ -1,52 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#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 */ diff --git a/src/data-list.c b/src/data-list.c deleted file mode 100644 index 49fbf0d7..00000000 --- a/src/data-list.c +++ /dev/null @@ -1,2059 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "data-list.h" -#include "error.h" -#include -#include -#include -#include -#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) - -/* 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; -} - -/* 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); -} - -/* 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); -} - -/* 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; -} - -/* 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, - }; - -/* 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; -} diff --git a/src/data-list.h b/src/data-list.h deleted file mode 100644 index 80545f7e..00000000 --- a/src/data-list.h +++ /dev/null @@ -1,33 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 */ diff --git a/src/data-out.c b/src/data-out.c deleted file mode 100644 index c9c17a5e..00000000 --- a/src/data-out.c +++ /dev/null @@ -1,1256 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#include -#include -#include -#include -#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" - -/* 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); -} - -/* 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; -} - -/* 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; -} diff --git a/src/date.c b/src/date.c deleted file mode 100644 index f21856a7..00000000 --- a/src/date.c +++ /dev/null @@ -1,37 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#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; -} diff --git a/src/debug-print.h b/src/debug-print.h deleted file mode 100644 index 061b2195..00000000 --- a/src/debug-print.h +++ /dev/null @@ -1,54 +0,0 @@ -/* 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 */ diff --git a/src/descript.c b/src/descript.c deleted file mode 100644 index a7152301..00000000 --- a/src/descript.c +++ /dev/null @@ -1,944 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#include -#include -#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); - -/* 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); -} - -/* 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); -} - -/* 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; -} - -/* 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; -} diff --git a/src/design-matrix.c b/src/design-matrix.c deleted file mode 100644 index 2e9ddf0b..00000000 --- a/src/design-matrix.c +++ /dev/null @@ -1,271 +0,0 @@ -/* PSPP - Creates design-matrices. - Copyright (C) 2005 Free Software Foundation, Inc. - Written by Jason H Stover . - - 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 -#include -#include -#include "alloc.h" -#include "error.h" -#include "var.h" -#include "cat.h" -#include "design-matrix.h" -#include -#include -#include -#include -#include - -#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); -} diff --git a/src/design-matrix.h b/src/design-matrix.h deleted file mode 100644 index 8cd8195c..00000000 --- a/src/design-matrix.h +++ /dev/null @@ -1,85 +0,0 @@ -/* PSPP - Creates design matrices. - Copyright (C) 2005 Free Software Foundation, Inc. - Written by Jason H Stover . - - 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 -#include -#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 diff --git a/src/dfm-read.c b/src/dfm-read.c deleted file mode 100644 index 6b3b3058..00000000 --- a/src/dfm-read.c +++ /dev/null @@ -1,463 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-2004, 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "dfm-read.h" -#include -#include -#include -#include -#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); -} - -/* 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; -} diff --git a/src/dfm-read.h b/src/dfm-read.h deleted file mode 100644 index 337acc35..00000000 --- a/src/dfm-read.h +++ /dev/null @@ -1,51 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -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 */ diff --git a/src/dfm-write.c b/src/dfm-write.c deleted file mode 100644 index 39aa7e38..00000000 --- a/src/dfm-write.c +++ /dev/null @@ -1,130 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-2004 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "dfm-write.h" -#include -#include -#include -#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); -} diff --git a/src/dfm-write.h b/src/dfm-write.h deleted file mode 100644 index de32e384..00000000 --- a/src/dfm-write.h +++ /dev/null @@ -1,32 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -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 */ diff --git a/src/dictionary.c b/src/dictionary.c deleted file mode 100644 index c11f6f41..00000000 --- a/src/dictionary.c +++ /dev/null @@ -1,1208 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "dictionary.h" -#include -#include -#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); -} - -/* 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); -} diff --git a/src/dictionary.h b/src/dictionary.h deleted file mode 100644 index d0287714..00000000 --- a/src/dictionary.h +++ /dev/null @@ -1,116 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include - -/* 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 */ diff --git a/src/do-if.c b/src/do-if.c deleted file mode 100644 index ad636f79..00000000 --- a/src/do-if.c +++ /dev/null @@ -1,274 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "ctl-stack.h" -#include "error.h" -#include -#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, - }; diff --git a/src/dummy-chart.c b/src/dummy-chart.c deleted file mode 100644 index 7dbc4b79..00000000 --- a/src/dummy-chart.c +++ /dev/null @@ -1,113 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2005 Free Software Foundation, Inc. - Written by 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. */ - - -/* 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) -{ -} diff --git a/src/echo.c b/src/echo.c deleted file mode 100644 index 2937bcb5..00000000 --- a/src/echo.c +++ /dev/null @@ -1,49 +0,0 @@ -/* 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 -#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; -} diff --git a/src/error.c b/src/error.c deleted file mode 100644 index 3a77c872..00000000 --- a/src/error.c +++ /dev/null @@ -1,498 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#include -#include -#include -#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; - - -/* 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 (); - } -} - -/* 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); -} - -/* 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 ); -} diff --git a/src/error.h b/src/error.h deleted file mode 100644 index e1016882..00000000 --- a/src/error.h +++ /dev/null @@ -1,103 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -/* 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 */ diff --git a/src/examine.q b/src/examine.q deleted file mode 100644 index 43ecc130..00000000 --- a/src/examine.q +++ /dev/null @@ -1,2202 +0,0 @@ -/* 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 -#include -#include "error.h" -#include -#include -#include -#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; -} diff --git a/src/factor_stats.c b/src/factor_stats.c deleted file mode 100644 index 29eebed2..00000000 --- a/src/factor_stats.c +++ /dev/null @@ -1,335 +0,0 @@ -/* 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 -#include "factor_stats.h" -#include "val.h" -#include "hash.h" -#include "algorithm.h" -#include "alloc.h" -#include "moments.h" -#include "percentiles.h" - -#include -#include -#include -#include -#include - - -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; - -} - diff --git a/src/factor_stats.h b/src/factor_stats.h deleted file mode 100644 index 02a69db3..00000000 --- a/src/factor_stats.h +++ /dev/null @@ -1,167 +0,0 @@ -/* 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 -#include -#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 diff --git a/src/file-handle-def.c b/src/file-handle-def.c deleted file mode 100644 index 3be48250..00000000 --- a/src/file-handle-def.c +++ /dev/null @@ -1,456 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "file-handle-def.h" -#include "error.h" -#include -#include -#include -#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; -} diff --git a/src/file-handle-def.h b/src/file-handle-def.h deleted file mode 100644 index c5c61ea8..00000000 --- a/src/file-handle-def.h +++ /dev/null @@ -1,96 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000, 2005, 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include - -/* 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 diff --git a/src/file-handle.h b/src/file-handle.h deleted file mode 100644 index 2e8de05a..00000000 --- a/src/file-handle.h +++ /dev/null @@ -1,31 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#include "file-handle-def.h" - -struct file_handle *fh_parse (enum fh_referent); - -#endif /* !file_handle.h */ diff --git a/src/file-handle.q b/src/file-handle.q deleted file mode 100644 index c13be76b..00000000 --- a/src/file-handle.q +++ /dev/null @@ -1,216 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "file-handle.h" -#include "error.h" -#include -#include -#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: -*/ diff --git a/src/file-type.c b/src/file-type.c deleted file mode 100644 index 4c7c4a03..00000000 --- a/src/file-type.c +++ /dev/null @@ -1,741 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#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); -} - -/* 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; -} - -/* 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; -} - -/* 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, - }; diff --git a/src/filename.c b/src/filename.c deleted file mode 100644 index 0c085776..00000000 --- a/src/filename.c +++ /dev/null @@ -1,954 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include "filename.h" -#include -#include -#include -#include -#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 -#if HAVE_UNISTD_H -#include -#endif -#include -#include "stat-macros.h" -#endif - -#ifdef __WIN32__ -#define NOGDI -#define NOUSER -#define NONLS -#include -#endif - -#if __DJGPP__ -#include -#endif - -/* Initialization. */ - -const char *config_path; - -void -fn_init (void) -{ - config_path = fn_getenv_default ("STAT_CONFIG_PATH", default_config_path); -} - -/* 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 . - 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); -} - -#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 - -/* 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); -} - -/* 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; -} - -/* 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); -} - -/* 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 */ diff --git a/src/filename.h b/src/filename.h deleted file mode 100644 index 46cdd7c5..00000000 --- a/src/filename.h +++ /dev/null @@ -1,79 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -/* 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 *); - -/* 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 */ diff --git a/src/flip.c b/src/flip.c deleted file mode 100644 index 20498235..00000000 --- a/src/flip.c +++ /dev/null @@ -1,543 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#include -#include -#include -#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 -#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 - }; diff --git a/src/font.h b/src/font.h deleted file mode 100644 index e4b32783..00000000 --- a/src/font.h +++ /dev/null @@ -1,135 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 */ diff --git a/src/format-prs.c b/src/format-prs.c deleted file mode 100644 index 988c05b5..00000000 --- a/src/format-prs.c +++ /dev/null @@ -1,157 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "format.h" -#include -#include "error.h" -#include -#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; -} - diff --git a/src/format.c b/src/format.c deleted file mode 100644 index cce8c46e..00000000 --- a/src/format.c +++ /dev/null @@ -1,374 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "format.h" -#include -#include "error.h" -#include -#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; -} diff --git a/src/format.h b/src/format.h deleted file mode 100644 index 1f6f3fb9..00000000 --- a/src/format.h +++ /dev/null @@ -1,128 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -/* 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 */ diff --git a/src/formats.c b/src/formats.c deleted file mode 100644 index 32d638ae..00000000 --- a/src/formats.c +++ /dev/null @@ -1,118 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#include -#include -#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; -} diff --git a/src/frequencies.q b/src/frequencies.q deleted file mode 100644 index 5754be7e..00000000 --- a/src/frequencies.q +++ /dev/null @@ -1,1640 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#include -#include - -#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); - - - -/* 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); -} - -/* 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); -} - -/* 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: -*/ diff --git a/src/get.c b/src/get.c deleted file mode 100644 index deda2d57..00000000 --- a/src/get.c +++ /dev/null @@ -1,1660 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#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 *); - -/* 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, - }; - -/* GET. */ -int -cmd_get (void) -{ - return parse_read_command (GET_CMD); -} - -/* IMPORT. */ -int -cmd_import (void) -{ - return parse_read_command (IMPORT_CMD); -} - -/* 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); -} - -/* 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); -} - -/* 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); -} - -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; -} - -/* 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; -} - - - -/* 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); - } -} diff --git a/src/getl.c b/src/getl.c deleted file mode 100644 index 2b689696..00000000 --- a/src/getl.c +++ /dev/null @@ -1,385 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "getl.h" -#include "error.h" -#include -#include -#include -#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; - -/* 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); -} - - diff --git a/src/getl.h b/src/getl.h deleted file mode 100644 index 71fca576..00000000 --- a/src/getl.h +++ /dev/null @@ -1,125 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include - -/* 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 */ diff --git a/src/glob.c b/src/glob.c deleted file mode 100644 index 12e173d1..00000000 --- a/src/glob.c +++ /dev/null @@ -1,62 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "glob.h" -#include -#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; - -/* 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; -} diff --git a/src/glob.h b/src/glob.h deleted file mode 100644 index 45ab3337..00000000 --- a/src/glob.h +++ /dev/null @@ -1,25 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 */ diff --git a/src/groff-font.c b/src/groff-font.c deleted file mode 100644 index 5df16f43..00000000 --- a/src/groff-font.c +++ /dev/null @@ -1,1030 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "font.h" -#include "error.h" -#include -#include -#include -#include -#include -#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 ? "" : 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 = ' '; - } - } -} - -/* 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); -} - -/* 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]; -} - -/* 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, _("<>")); - 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; -} diff --git a/src/group.c b/src/group.c deleted file mode 100644 index 25459eda..00000000 --- a/src/group.c +++ /dev/null @@ -1,68 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by 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 -#include -#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; -} diff --git a/src/group.h b/src/group.h deleted file mode 100644 index a0663486..00000000 --- a/src/group.h +++ /dev/null @@ -1,91 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by 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. */ - - -#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 diff --git a/src/group_proc.h b/src/group_proc.h deleted file mode 100644 index 9132ef95..00000000 --- a/src/group_proc.h +++ /dev/null @@ -1,51 +0,0 @@ -/* PSPP - computes sample statistics. - - Copyright (C) 2004 Free Software Foundation, Inc. - - Written by 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. */ - -#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 diff --git a/src/hash.c b/src/hash.c deleted file mode 100644 index bcf5244f..00000000 --- a/src/hash.c +++ /dev/null @@ -1,617 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "hash.h" -#include "error.h" -#include -#include -#include -#include -#include "algorithm.h" -#include "alloc.h" -#include -#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. */ - -/* 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; -} - -/* 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; -} - -/* 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; -} - -/* 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; -} - -/* Returns the number of items in H. */ -size_t -hsh_count (struct hsh_table *h) -{ - assert (h != NULL); - - return h->used; -} - -/* Debug helpers. */ - -#if GLOBAL_DEBUGGING -#undef NDEBUG -#include "error.h" -#include - -/* 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 diff --git a/src/hash.h b/src/hash.h deleted file mode 100644 index e426483a..00000000 --- a/src/hash.h +++ /dev/null @@ -1,83 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -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 */ diff --git a/src/histogram.c b/src/histogram.c deleted file mode 100644 index 997f7e38..00000000 --- a/src/histogram.c +++ /dev/null @@ -1,55 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by 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 -#include -#include -#include -#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; -} - diff --git a/src/histogram.h b/src/histogram.h deleted file mode 100644 index dd2d3cba..00000000 --- a/src/histogram.h +++ /dev/null @@ -1,28 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by 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. */ - -#ifndef HISTOGRAM_H -#define HISTOGRAM_H - -#include - - -gsl_histogram * histogram_create(double bins, double x_min, double x_max); - -#endif diff --git a/src/html.c b/src/html.c deleted file mode 100644 index 1b56ba1c..00000000 --- a/src/html.c +++ /dev/null @@ -1,657 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "htmlP.h" -#include "error.h" -#include -#include -#include -#include - -#if HAVE_UNISTD_H -#include -#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, - "", 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 = ""; - - 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, - "\n" - "\n" - "\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 ("

", x->file.file); - if (!ls_empty_p (t->cc)) - escape_string (x->file.file, ls_c_str (t->cc), ls_length (t->cc)); - fputs ("

\n", x->file.file); - - return; - } - - fputs ("\n", x->file.file); - - if (!ls_empty_p (&t->title)) - { - fprintf (x->file.file, " \n \n \n", x->file.file); - } - - { - int r; - unsigned char *ct = t->ct; - - for (r = 0; r < t->nr; r++) - { - int c; - - fputs (" \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, " 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, "\n", tag); - } - fputs (" \n", x->file.file); - } - } - - fputs ("
", t->nc); - escape_string (x->file.file, ls_c_str (&t->title), - ls_length (&t->title)); - fputs ("
\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 */ - diff --git a/src/htmlP.h b/src/htmlP.h deleted file mode 100644 index ee861414..00000000 --- a/src/htmlP.h +++ /dev/null @@ -1,38 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 */ diff --git a/src/include.c b/src/include.c deleted file mode 100644 index abce511a..00000000 --- a/src/include.c +++ /dev/null @@ -1,50 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#include -#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 (); -} diff --git a/src/inpt-pgm.c b/src/inpt-pgm.c deleted file mode 100644 index 855b4eca..00000000 --- a/src/inpt-pgm.c +++ /dev/null @@ -1,419 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#include -#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, - }; - -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; -} diff --git a/src/levene.c b/src/levene.c deleted file mode 100644 index 5de52205..00000000 --- a/src/levene.c +++ /dev/null @@ -1,378 +0,0 @@ -/* This file is part of GNU PSPP - Computes Levene test statistic. - - Copyright (C) 2004 Free Software Foundation, Inc. - Written by 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 -#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 -#include - - -/* 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); -} - diff --git a/src/levene.h b/src/levene.h deleted file mode 100644 index fd2aaf54..00000000 --- a/src/levene.h +++ /dev/null @@ -1,49 +0,0 @@ -/* This file is part of GNU PSPP - Computes Levene test statistic. - - Copyright (C) 2004 Free Software Foundation, Inc. - Written by 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. */ - -#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 */ diff --git a/src/lex-def.c b/src/lex-def.c deleted file mode 100644 index 15f06b1a..00000000 --- a/src/lex-def.c +++ /dev/null @@ -1,98 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000, 2005 Free Software Foundation, Inc. - Written by 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. */ - -/* - This file is concerned with the definition of the PSPP syntax, NOT the - action of scanning/parsing code . -*/ - -#include -#include "lex-def.h" - - -#include -#include - - -/* 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; -} - diff --git a/src/lex-def.h b/src/lex-def.h deleted file mode 100644 index 6146efc2..00000000 --- a/src/lex-def.h +++ /dev/null @@ -1,83 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#include - -/* 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 */ diff --git a/src/lexer.c b/src/lexer.c deleted file mode 100644 index cc2f8ca8..00000000 --- a/src/lexer.c +++ /dev/null @@ -1,1216 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "lexer.h" -#include "error.h" -#include -#include -#include -#include -#include -#include -#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 -*/ - - -/* 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; - -/* 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 - -/* 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); -} - - -/* 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; -} - -/* 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; -} - -/* 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; -} - -/* 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)); -} - -/* 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; -} - -/* 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); -} - -/* 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 _(""); -} - -/* 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); -} - -/* 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; - } -} - -/* 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; -} - -#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 */ diff --git a/src/lexer.h b/src/lexer.h deleted file mode 100644 index 08807733..00000000 --- a/src/lexer.h +++ /dev/null @@ -1,91 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include - -#include "lex-def.h" - - -extern int token; -extern double tokval; -extern char tokid[LONG_NAME_LEN + 1]; -extern struct string tokstr; - -#include - -/* 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 */ diff --git a/src/linked-list.c b/src/linked-list.c deleted file mode 100644 index e7631a43..00000000 --- a/src/linked-list.c +++ /dev/null @@ -1,102 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2005 Free Software Foundation, Inc. - Written by 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 -#include -#include - -#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; -} - diff --git a/src/linked-list.h b/src/linked-list.h deleted file mode 100644 index 56c8f411..00000000 --- a/src/linked-list.h +++ /dev/null @@ -1,48 +0,0 @@ -#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 diff --git a/src/list.q b/src/list.q deleted file mode 100644 index c2f3cd61..00000000 --- a/src/list.q +++ /dev/null @@ -1,723 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#include -#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 ("\n \n", x->file.file); - - { - size_t i; - - for (i = 0; i < cmd.n_variables; i++) - fprintf (x->file.file, " \n", - cmd.v_variables[i]->name); - } - - fputs (" \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 ("
%s
\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 (" \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, " %s\n", - &buf[strspn (buf, " ")]); - } - - fputs (" \n", x->file.file); - } - else - assert (0); - - return 1; -} - -/* - Local Variables: - mode: c - End: -*/ diff --git a/src/loop.c b/src/loop.c deleted file mode 100644 index f388d9e2..00000000 --- a/src/loop.c +++ /dev/null @@ -1,362 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#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 *); - -/* 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, - }; diff --git a/src/magic.c b/src/magic.c deleted file mode 100644 index 40164b21..00000000 --- a/src/magic.c +++ /dev/null @@ -1,32 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#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 diff --git a/src/magic.h b/src/magic.h deleted file mode 100644 index e6bc7edb..00000000 --- a/src/magic.h +++ /dev/null @@ -1,62 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include - -/* 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 */ diff --git a/src/main.c b/src/main.c deleted file mode 100644 index d52741d1..00000000 --- a/src/main.c +++ /dev/null @@ -1,280 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "main.h" -#include -#include -#include -#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 -#endif - -#if HAVE_LOCALE_H -#include -#endif - -#if HAVE_FENV_H -#include -#endif - -#include "gettext.h" -#define _(msgid) gettext (msgid) - -#include - -#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 (); - } -} - -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); -} diff --git a/src/main.h b/src/main.h deleted file mode 100644 index 38554a09..00000000 --- a/src/main.h +++ /dev/null @@ -1,30 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -extern int start_interactive; -extern int finished; - -void terminate (bool success); - -#endif /* main.h */ diff --git a/src/matrix-data.c b/src/matrix-data.c deleted file mode 100644 index 994285cd..00000000 --- a/src/matrix-data.c +++ /dev/null @@ -1,1999 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#include -#include -#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); -} - -/* 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; -} - -/* 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); - } -} - -/* 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; -} - -/* 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, - }; - diff --git a/src/means.q b/src/means.q deleted file mode 100644 index 887cbfd8..00000000 --- a/src/means.q +++ /dev/null @@ -1,176 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#include -#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: -*/ diff --git a/src/mis-val.c b/src/mis-val.c deleted file mode 100644 index 7aedc10b..00000000 --- a/src/mis-val.c +++ /dev/null @@ -1,155 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#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; -} - diff --git a/src/misc.c b/src/misc.c deleted file mode 100644 index 4bd64b60..00000000 --- a/src/misc.c +++ /dev/null @@ -1,38 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#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; -} - diff --git a/src/misc.h b/src/misc.h deleted file mode 100644 index a1be9f9f..00000000 --- a/src/misc.h +++ /dev/null @@ -1,95 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include - -#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 /* 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 */ diff --git a/src/missing-values.c b/src/missing-values.c deleted file mode 100644 index 6940c6cf..00000000 --- a/src/missing-values.c +++ /dev/null @@ -1,440 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2005 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "missing-values.h" -#include -#include -#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; -} diff --git a/src/missing-values.h b/src/missing-values.h deleted file mode 100644 index b2e004c7..00000000 --- a/src/missing-values.h +++ /dev/null @@ -1,93 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2005 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#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 */ diff --git a/src/mkfile.c b/src/mkfile.c deleted file mode 100644 index b8a8aa3b..00000000 --- a/src/mkfile.c +++ /dev/null @@ -1,107 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#include -#include -#include -#include -#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; -} - - - - diff --git a/src/mkfile.h b/src/mkfile.h deleted file mode 100644 index 3cfb3a18..00000000 --- a/src/mkfile.h +++ /dev/null @@ -1,35 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 */ diff --git a/src/modify-vars.c b/src/modify-vars.c deleted file mode 100644 index 4d01b6a9..00000000 --- a/src/modify-vars.c +++ /dev/null @@ -1,525 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#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; -} diff --git a/src/moments.c b/src/moments.c deleted file mode 100644 index 3c5e3840..00000000 --- a/src/moments.c +++ /dev/null @@ -1,611 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "moments.h" -#include -#include -#include -#include "alloc.h" -#include "misc.h" -#include "val.h" - -#include "gettext.h" -#define _(msgid) gettext (msgid) - -/* 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; - } - } - } -} - -/* 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); -} - -/* 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); -} - -/* 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.))); -} - -#include -#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; -} diff --git a/src/moments.h b/src/moments.h deleted file mode 100644 index 91ed40fa..00000000 --- a/src/moments.h +++ /dev/null @@ -1,75 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#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 */ diff --git a/src/numeric.c b/src/numeric.c deleted file mode 100644 index 2a7dbe57..00000000 --- a/src/numeric.c +++ /dev/null @@ -1,206 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#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 (); -} diff --git a/src/oneway.q b/src/oneway.q deleted file mode 100644 index f413cda1..00000000 --- a/src/oneway.q +++ /dev/null @@ -1,1058 +0,0 @@ -/* 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 -#include -#include "error.h" -#include -#include -#include -#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); - - } -} diff --git a/src/output.c b/src/output.c deleted file mode 100644 index c0b849a4..00000000 --- a/src/output.c +++ /dev/null @@ -1,1362 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "output.h" -#include "error.h" -#include -#include -#include -#include -#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; -} diff --git a/src/output.h b/src/output.h deleted file mode 100644 index 03867e9f..00000000 --- a/src/output.h +++ /dev/null @@ -1,271 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 */ diff --git a/src/percentiles.c b/src/percentiles.c deleted file mode 100644 index 2381f771..00000000 --- a/src/percentiles.c +++ /dev/null @@ -1,428 +0,0 @@ -/* 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 -#include "factor_stats.h" -#include "percentiles.h" -#include "misc.h" - -#include "gettext.h" -#define _(msgid) gettext (msgid) -#define N_(msgid) msgid - -#include - - -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); -} - - diff --git a/src/percentiles.h b/src/percentiles.h deleted file mode 100644 index 8f4271f5..00000000 --- a/src/percentiles.h +++ /dev/null @@ -1,83 +0,0 @@ -/* 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 diff --git a/src/permissions.c b/src/permissions.c deleted file mode 100644 index 0d236921..00000000 --- a/src/permissions.c +++ /dev/null @@ -1,128 +0,0 @@ -/* 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 -#include "error.h" -#include -#include -#include -#include -#include -#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; -} diff --git a/src/pfm-read.c b/src/pfm-read.c deleted file mode 100644 index f3987475..00000000 --- a/src/pfm-read.c +++ /dev/null @@ -1,724 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - 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 -#include "pfm-read.h" -#include "error.h" -#include -#include -#include -#include -#include -#include -#include -#include "alloc.h" -#include -#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; -} - -/* 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); -} - -/* 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; -} diff --git a/src/pfm-read.h b/src/pfm-read.h deleted file mode 100644 index 5639816a..00000000 --- a/src/pfm-read.h +++ /dev/null @@ -1,48 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include - -/* 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 */ diff --git a/src/pfm-write.c b/src/pfm-write.c deleted file mode 100644 index 132216d5..00000000 --- a/src/pfm-write.c +++ /dev/null @@ -1,860 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "pfm-write.h" -#include "error.h" -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#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; -} - -/* 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); -} - -/* 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); -} - -/* 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; -} diff --git a/src/pfm-write.h b/src/pfm-write.h deleted file mode 100644 index a1bb7ce9..00000000 --- a/src/pfm-write.h +++ /dev/null @@ -1,52 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -/* 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 */ diff --git a/src/piechart.c b/src/piechart.c deleted file mode 100644 index dd889c33..00000000 --- a/src/piechart.c +++ /dev/null @@ -1,209 +0,0 @@ -/* PSPP - draws pie charts of sample statistics - -Copyright (C) 2004 Free Software Foundation, Inc. -Written by 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 "chart.h" -#include -#include -#include -#include -#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); -} - diff --git a/src/plot-chart.c b/src/plot-chart.c deleted file mode 100644 index bfe38c81..00000000 --- a/src/plot-chart.c +++ /dev/null @@ -1,265 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by 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 -#include -#include -#include -#include -#include -#include -#include -#include - -#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); - } - -} - diff --git a/src/plot-hist.c b/src/plot-hist.c deleted file mode 100644 index fd1a88d8..00000000 --- a/src/plot-hist.c +++ /dev/null @@ -1,183 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2004 Free Software Foundation, Inc. - Written by 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. */ - -/* If you add/modify any public symbols in this file, don't forget to - change the stubs in dummy-chart.c */ - -#include - -#include -#include -#include -#include -#include -#include -#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); -} - diff --git a/src/pool.c b/src/pool.c deleted file mode 100644 index b8ca4ad1..00000000 --- a/src/pool.c +++ /dev/null @@ -1,962 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "pool.h" -#include -#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 *); - -/* 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); - } -} - -/* 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); -} - -/* 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); -} - -/* 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; -} - -/* 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; -} - -/* 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; - } -} - -/* 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)); - -} - -/* Self-test routine. */ - -#include -#include -#include -#include -#include - -#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; -} - diff --git a/src/pool.h b/src/pool.h deleted file mode 100644 index a5d91dd7..00000000 --- a/src/pool.h +++ /dev/null @@ -1,85 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -/* 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 */ diff --git a/src/postscript.c b/src/postscript.c deleted file mode 100644 index f2bb3400..00000000 --- a/src/postscript.c +++ /dev/null @@ -1,3053 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -/*this #if encloses the remainder of the file. */ -#if !NO_POSTSCRIPT - -#include -#include "error.h" -#include -#include -#include -#include - -#if HAVE_UNISTD_H -#include -#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); - -/* 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; -} - -/* 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 (_("<>")); - enc->index = x->next_encoding++; - } - return enc; -} - -/* 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 = ""; - - 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; - } -} - -/* 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; -} - - -/* 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); -} - -/* 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 */ diff --git a/src/print.c b/src/print.c deleted file mode 100644 index 966c4813..00000000 --- a/src/print.c +++ /dev/null @@ -1,1118 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#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); - -/* 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; -} - -/* 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); -} - -/* 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); -} - -/* 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); -} diff --git a/src/q2c.c b/src/q2c.c deleted file mode 100644 index c1b7e8d7..00000000 --- a/src/q2c.c +++ /dev/null @@ -1,2078 +0,0 @@ -/* q2c - parser generator for PSPP procedures. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#include -#include -#include -#include -#include -#include -#if HAVE_UNISTD_H -#include -#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; - -/* 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; -} - -/* 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 (); -} - -/* 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; - -/* 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; - } -} - -/* 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 "); - 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; -} diff --git a/src/random.c b/src/random.c deleted file mode 100644 index 7420a82e..00000000 --- a/src/random.c +++ /dev/null @@ -1,57 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000, 2005 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "random.h" -#include -#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); -} diff --git a/src/random.h b/src/random.h deleted file mode 100644 index 85959677..00000000 --- a/src/random.h +++ /dev/null @@ -1,31 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000, 2005 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -void random_init (void); -void random_done (void); - -gsl_rng *get_rng (void); -void set_rng (unsigned long seed); - -#endif /* random.h */ diff --git a/src/range-prs.c b/src/range-prs.c deleted file mode 100644 index b4e55b9b..00000000 --- a/src/range-prs.c +++ /dev/null @@ -1,111 +0,0 @@ -#include -#include "range-prs.h" -#include -#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; - } -} diff --git a/src/range-prs.h b/src/range-prs.h deleted file mode 100644 index f03a7e88..00000000 --- a/src/range-prs.h +++ /dev/null @@ -1,28 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2005 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -struct fmt_spec; -bool parse_num_range (double *x, double *y, const struct fmt_spec *fmt); - -#endif /* range-prs.h */ diff --git a/src/rank.q b/src/rank.q deleted file mode 100644 index 77a6dbe8..00000000 --- a/src/rank.q +++ /dev/null @@ -1,357 +0,0 @@ -/* 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 -#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); -} - - diff --git a/src/readln.c b/src/readln.c deleted file mode 100644 index 2327cec7..00000000 --- a/src/readln.c +++ /dev/null @@ -1,279 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -#include -#include -#include -#include - -#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 -#endif - -#if HAVE_LIBHISTORY -static char *history_file; - -#if HAVE_READLINE_HISTORY_H -#include -#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 -#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 */ - diff --git a/src/readln.h b/src/readln.h deleted file mode 100644 index 540776a1..00000000 --- a/src/readln.h +++ /dev/null @@ -1,32 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -/* Initialize getl. */ -void readln_initialize (void); - -/* Close getl. */ -void readln_uninitialize (void); - -#endif /* READLN_H */ - diff --git a/src/recode.c b/src/recode.c deleted file mode 100644 index b274ed02..00000000 --- a/src/recode.c +++ /dev/null @@ -1,660 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#include -#include -#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) - -/* 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; - -/* 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); - } -} - -/* 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); -} diff --git a/src/regression.q b/src/regression.q deleted file mode 100644 index 23ba49a6..00000000 --- a/src/regression.q +++ /dev/null @@ -1,941 +0,0 @@ -/* PSPP - linear regression. - Copyright (C) 2005 Free Software Foundation, Inc. - Written by Jason H Stover . - - 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 -#include -#include -#include -#include -#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 -#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: -*/ diff --git a/src/regression_export.h b/src/regression_export.h deleted file mode 100644 index 083064d1..00000000 --- a/src/regression_export.h +++ /dev/null @@ -1,148 +0,0 @@ -/* PSPP - Comments for C files generated by REGRESSION's EXPORT subcommand. - Copyright (C) 2005 Free Software Foundation, Inc. - Written by Jason H Stover . - - 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 \n#include \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 diff --git a/src/rename-vars.c b/src/rename-vars.c deleted file mode 100644 index 86250909..00000000 --- a/src/rename-vars.c +++ /dev/null @@ -1,116 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#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; -} diff --git a/src/repeat.c b/src/repeat.c deleted file mode 100644 index c0510c5d..00000000 --- a/src/repeat.c +++ /dev/null @@ -1,586 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "repeat.h" -#include "error.h" -#include -#include -#include -#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; -} - -int -cmd_end_repeat (void) -{ - msg (SE, _("No matching DO REPEAT.")); - return CMD_FAILURE; -} - -/* 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; -} diff --git a/src/repeat.h b/src/repeat.h deleted file mode 100644 index 33c0218f..00000000 --- a/src/repeat.h +++ /dev/null @@ -1,25 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 */ diff --git a/src/sample.c b/src/sample.c deleted file mode 100644 index 0255ae79..00000000 --- a/src/sample.c +++ /dev/null @@ -1,155 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#include -#include -#include -#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); -} diff --git a/src/scratch-handle.c b/src/scratch-handle.c deleted file mode 100644 index 5e3b74ad..00000000 --- a/src/scratch-handle.c +++ /dev/null @@ -1,36 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#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); - } -} diff --git a/src/scratch-handle.h b/src/scratch-handle.h deleted file mode 100644 index 34739cf2..00000000 --- a/src/scratch-handle.h +++ /dev/null @@ -1,34 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -/* 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 */ diff --git a/src/scratch-reader.c b/src/scratch-reader.c deleted file mode 100644 index 60355dc4..00000000 --- a/src/scratch-reader.c +++ /dev/null @@ -1,88 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "scratch-reader.h" -#include -#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); -} diff --git a/src/scratch-reader.h b/src/scratch-reader.h deleted file mode 100644 index 534ceb95..00000000 --- a/src/scratch-reader.h +++ /dev/null @@ -1,33 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -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 */ diff --git a/src/scratch-writer.c b/src/scratch-writer.c deleted file mode 100644 index e5ac0467..00000000 --- a/src/scratch-writer.c +++ /dev/null @@ -1,112 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "scratch-writer.h" -#include -#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); -} diff --git a/src/scratch-writer.h b/src/scratch-writer.h deleted file mode 100644 index 33e3e147..00000000 --- a/src/scratch-writer.h +++ /dev/null @@ -1,33 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -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 */ diff --git a/src/sel-if.c b/src/sel-if.c deleted file mode 100644 index 10d1030f..00000000 --- a/src/sel-if.c +++ /dev/null @@ -1,146 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#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; -} diff --git a/src/set.q b/src/set.q deleted file mode 100644 index 8df84654..00000000 --- a/src/set.q +++ /dev/null @@ -1,722 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "settings.h" -#include "error.h" -#include -#include -#include -#include -#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 -#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); -} - -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: -*/ diff --git a/src/settings.c b/src/settings.c deleted file mode 100644 index 3bd98c18..00000000 --- a/src/settings.c +++ /dev/null @@ -1,594 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "settings.h" -#include -#include -#include -#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; -} diff --git a/src/settings.h b/src/settings.h deleted file mode 100644 index 2eedbddb..00000000 --- a/src/settings.h +++ /dev/null @@ -1,137 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include - -/* 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 */ diff --git a/src/sfm-read.c b/src/sfm-read.c deleted file mode 100644 index 986dede9..00000000 --- a/src/sfm-read.c +++ /dev/null @@ -1,1542 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "sfm-read.h" -#include "sfmP.h" -#include "error.h" -#include -#include -#include -#include -#include -#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. */ - }; - -/* 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); -} - -/* 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; -} - -/* 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; - } -} - -/* 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; -} diff --git a/src/sfm-read.h b/src/sfm-read.h deleted file mode 100644 index d471ad7b..00000000 --- a/src/sfm-read.h +++ /dev/null @@ -1,49 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include - -/* 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 */ diff --git a/src/sfm-write.c b/src/sfm-write.c deleted file mode 100644 index dcdab0b4..00000000 --- a/src/sfm-write.c +++ /dev/null @@ -1,938 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "sfm-write.h" -#include "sfmP.h" -#include "error.h" -#include -#include -#include -#include -#include -#include -#if HAVE_UNISTD_H -#include /* 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); -} diff --git a/src/sfm-write.h b/src/sfm-write.h deleted file mode 100644 index f44d3ba1..00000000 --- a/src/sfm-write.h +++ /dev/null @@ -1,45 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -/* 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 */ diff --git a/src/sfmP.h b/src/sfmP.h deleted file mode 100644 index c127b85e..00000000 --- a/src/sfmP.h +++ /dev/null @@ -1,99 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 diff --git a/src/som.c b/src/som.c deleted file mode 100644 index 733fc3c8..00000000 --- a/src/som.c +++ /dev/null @@ -1,297 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "som.h" -#include "error.h" -#include -#include -#include "output.h" -#include "debug-print.h" - -/* Table. */ -int table_num = 1; -int subtable_num; - -/* 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; -} - -/* 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; - } - } - } -} diff --git a/src/som.h b/src/som.h deleted file mode 100644 index 1568dca3..00000000 --- a/src/som.h +++ /dev/null @@ -1,121 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -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 */ diff --git a/src/sort-prs.c b/src/sort-prs.c deleted file mode 100644 index 6ef6a6fa..00000000 --- a/src/sort-prs.c +++ /dev/null @@ -1,159 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#include -#include -#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); - } -} - diff --git a/src/sort-prs.h b/src/sort-prs.h deleted file mode 100644 index f2caf723..00000000 --- a/src/sort-prs.h +++ /dev/null @@ -1,38 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include - -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 */ diff --git a/src/sort.c b/src/sort.c deleted file mode 100644 index 8dad3566..00000000 --- a/src/sort.c +++ /dev/null @@ -1,724 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "sort.h" -#include "error.h" -#include -#include -#include -#include -#include "algorithm.h" -#include "alloc.h" -#include -#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; -} - -/* 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; -} - -/* 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); - } -} - -/* 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; -} - -/* 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; -} diff --git a/src/sort.h b/src/sort.h deleted file mode 100644 index af443edc..00000000 --- a/src/sort.h +++ /dev/null @@ -1,63 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include - -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 */ diff --git a/src/split-file.c b/src/split-file.c deleted file mode 100644 index c9e144f9..00000000 --- a/src/split-file.c +++ /dev/null @@ -1,52 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#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 (); -} diff --git a/src/str.c b/src/str.c deleted file mode 100644 index eaa9cdff..00000000 --- a/src/str.c +++ /dev/null @@ -1,705 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "str.h" -#include "error.h" -#include -#include -#include -#include "alloc.h" -#include "error.h" - -/* 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(). */ - -/* 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); -} - -/* 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; -} - -/* 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); -} diff --git a/src/str.h b/src/str.h deleted file mode 100644 index 19fe779a..00000000 --- a/src/str.h +++ /dev/null @@ -1,235 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#include - -#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 - -/* 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. */ - -/* 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 *); - -/* 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 - -/* 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 */ diff --git a/src/subclist.c b/src/subclist.c deleted file mode 100644 index 95ea455d..00000000 --- a/src/subclist.c +++ /dev/null @@ -1,75 +0,0 @@ -/* subclist - lists for PSPP subcommands - -Copyright (C) 2004 Free Software Foundation, Inc. - -Written by 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 "subclist.h" -#include -#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); -} diff --git a/src/subclist.h b/src/subclist.h deleted file mode 100644 index 5087cc1e..00000000 --- a/src/subclist.h +++ /dev/null @@ -1,72 +0,0 @@ -#ifndef SUBCLIST_H -#define SUBCLIST_H - -/* subclist - lists for PSPP subcommands - - Copyright (C) 2004 Free Software Foundation, Inc. - - Written by 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 - -/* 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 diff --git a/src/sysfile-info.c b/src/sysfile-info.c deleted file mode 100644 index c12bd100..00000000 --- a/src/sysfile-info.c +++ /dev/null @@ -1,608 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#include -#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 (); -} - -/* 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); -} - -/* 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); -} - - - - - - - - - - - diff --git a/src/t-test.q b/src/t-test.q deleted file mode 100644 index 5fdb802d..00000000 --- a/src/t-test.q +++ /dev/null @@ -1,1985 +0,0 @@ -/* PSPP - computes sample statistics. -*-c-*- - - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by John Williams . - 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 -#include -#include "error.h" -#include -#include -#include -#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; -} - diff --git a/src/tab.c b/src/tab.c deleted file mode 100644 index 4aa7f069..00000000 --- a/src/tab.c +++ /dev/null @@ -1,1438 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "tab.h" -#include -#include -#include -#include -#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" - -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; -} - -/* 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); -} - - -/* 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; -} - -/* 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); -} - -/* 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); -} - -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, - }; - -/* 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; -} - diff --git a/src/tab.h b/src/tab.h deleted file mode 100644 index 00d16897..00000000 --- a/src/tab.h +++ /dev/null @@ -1,195 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#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 */ - diff --git a/src/temporary.c b/src/temporary.c deleted file mode 100644 index 840e5d2b..00000000 --- a/src/temporary.c +++ /dev/null @@ -1,83 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#include -#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; - } -} diff --git a/src/title.c b/src/title.c deleted file mode 100644 index 7edd2dad..00000000 --- a/src/title.c +++ /dev/null @@ -1,182 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#include -#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 : _(""))); - 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 (); -} diff --git a/src/val-labs.c b/src/val-labs.c deleted file mode 100644 index 657bf5c7..00000000 --- a/src/val-labs.c +++ /dev/null @@ -1,193 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#include -#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) - -/* 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); - -/* Stubs. */ - -int -cmd_value_labels (void) -{ - return do_value_labels (1); -} - -int -cmd_add_value_labels (void) -{ - return do_value_labels (0); -} - -/* 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; -} diff --git a/src/val.h b/src/val.h deleted file mode 100644 index 927bd916..00000000 --- a/src/val.h +++ /dev/null @@ -1,78 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -#include - -/* 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 */ diff --git a/src/value-labels.c b/src/value-labels.c deleted file mode 100644 index 03eda933..00000000 --- a/src/value-labels.c +++ /dev/null @@ -1,518 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "value-labels.h" -#include "error.h" -#include -#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); -} - -/* 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; -} - -/* 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; -} - -/* 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); -} - -/* 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; -} diff --git a/src/value-labels.h b/src/value-labels.h deleted file mode 100644 index cb27fdfc..00000000 --- a/src/value-labels.h +++ /dev/null @@ -1,62 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#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 */ diff --git a/src/var-display.c b/src/var-display.c deleted file mode 100644 index 485fd3a1..00000000 --- a/src/var-display.c +++ /dev/null @@ -1,170 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by 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 -#include -#include -#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; -} diff --git a/src/var-labs.c b/src/var-labs.c deleted file mode 100644 index 3b5aa838..00000000 --- a/src/var-labs.c +++ /dev/null @@ -1,84 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include -#include -#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); -} diff --git a/src/var.h b/src/var.h deleted file mode 100644 index f4930eea..00000000 --- a/src/var.h +++ /dev/null @@ -1,235 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "config.h" -#include -#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); - -/* 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. */ - }; - -void discard_variables (void); - -/* This is the active file dictionary. */ -extern struct dictionary *default_dict; - -/* Transformation state. */ - -/* PROCESS IF expression. */ -extern struct expression *process_if_expr; - -/* 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); - -struct ccase; -void dump_split_vars (const struct ccase *); - -/* 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); - -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); - -/* 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 */ diff --git a/src/vars-atr.c b/src/vars-atr.c deleted file mode 100644 index 970ce567..00000000 --- a/src/vars-atr.c +++ /dev/null @@ -1,319 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "var.h" -#include "error.h" -#include -#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; -} - - - - -/* 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); -} - -/* 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 (); - } -} diff --git a/src/vars-prs.c b/src/vars-prs.c deleted file mode 100644 index 563ac2b2..00000000 --- a/src/vars-prs.c +++ /dev/null @@ -1,745 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "var.h" -#include -#include -#include -#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; -} - - -/* 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); -} - -/* 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; -} - -/* 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; -} diff --git a/src/vector.c b/src/vector.c deleted file mode 100644 index fc7a2dd3..00000000 --- a/src/vector.c +++ /dev/null @@ -1,205 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#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; -} diff --git a/src/version.h b/src/version.h deleted file mode 100644 index 35ba707b..00000000 --- a/src/version.h +++ /dev/null @@ -1,51 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 */ diff --git a/src/vfm.c b/src/vfm.c deleted file mode 100644 index 06cf67ec..00000000 --- a/src/vfm.c +++ /dev/null @@ -1,972 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "vfm.h" -#include "vfmP.h" -#include "error.h" -#include -#include -#include -#if HAVE_UNISTD_H -#include /* 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); - -/* 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 (); -} - -/* 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, - }; - -/* 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); -} - -/* 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, - }; - -/* 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; -} - -/* 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); - } -} - -/* 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); -} - -/* 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; -} diff --git a/src/vfm.h b/src/vfm.h deleted file mode 100644 index cfd639a9..00000000 --- a/src/vfm.h +++ /dev/null @@ -1,133 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 - -struct ccase; -typedef struct write_case_data *write_case_data; -typedef int write_case_func (write_case_data); - -/* 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 *); - -/* 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 *); - -/* 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); - -void multipass_procedure_with_splits (void (*) (const struct casefile *, - void *), - void *aux); - -time_t vfm_last_invocation (void); - -#endif /* !vfm_h */ diff --git a/src/vfmP.h b/src/vfmP.h deleted file mode 100644 index 38854c69..00000000 --- a/src/vfmP.h +++ /dev/null @@ -1,25 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 */ diff --git a/src/weight.c b/src/weight.c deleted file mode 100644 index f1326f09..00000000 --- a/src/weight.c +++ /dev/null @@ -1,61 +0,0 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000 Free Software Foundation, Inc. - Written by Ben Pfaff . - - 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 -#include "error.h" -#include -#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 (); -} -- 2.30.2