X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=src%2Flanguage%2Fexpressions%2Foperations.def;h=eb05661678277fb8cc25233d91beda496bd063bf;hb=63387e3d127359bab6c4f53c27a9131ab4a9c348;hp=5f0b938a0974a1a1e92a948d961ce7bd9cd1f523;hpb=888d0f91d57e0c3c5a4206c30ac71eb87bf44227;p=pspp diff --git a/src/language/expressions/operations.def b/src/language/expressions/operations.def index 5f0b938a09..eb05661678 100644 --- a/src/language/expressions/operations.def +++ b/src/language/expressions/operations.def @@ -1,23 +1,20 @@ // -*- c -*- // -// PSPP - computes sample statistics. -// Copyright (C) 2005, 2006 Free Software Foundation, Inc. -// Written by Ben Pfaff . +// PSPP - a program for statistical analysis. +// Copyright (C) 2005, 2006, 2009, 2010, 2011, 2012, 2015, 2016 Free Software Foundation, Inc. // -// This program is free software; you can redistribute it and/or -// modify it under the terms of the GNU General Public License as -// published by the Free Software Foundation; either version 2 of the -// License, or (at your option) any later version. +// This program is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. // -// This program is distributed in the hope that it will be useful, but -// WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -// General Public License for more details. +// This program is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. // // You should have received a copy of the GNU General Public License -// along with this program; if not, write to the Free Software -// Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -// 02110-1301, USA. */ +// along with this program. If not, see . operator NEG (x) = -x; @@ -66,12 +63,12 @@ boolean operator LT (a, b) = a < b; boolean operator NE (a, b) = a != b; // String relational operators. -boolean operator EQ_STRING (string a, string b) = compare_string (&a, &b) == 0; -boolean operator GE_STRING (string a, string b) = compare_string (&a, &b) >= 0; -boolean operator GT_STRING (string a, string b) = compare_string (&a, &b) > 0; -boolean operator LE_STRING (string a, string b) = compare_string (&a, &b) <= 0; -boolean operator LT_STRING (string a, string b) = compare_string (&a, &b) < 0; -boolean operator NE_STRING (string a, string b) = compare_string (&a, &b) != 0; +boolean operator EQ_STRING (string a, string b) = compare_string_3way (&a, &b) == 0; +boolean operator GE_STRING (string a, string b) = compare_string_3way (&a, &b) >= 0; +boolean operator GT_STRING (string a, string b) = compare_string_3way (&a, &b) > 0; +boolean operator LE_STRING (string a, string b) = compare_string_3way (&a, &b) <= 0; +boolean operator LT_STRING (string a, string b) = compare_string_3way (&a, &b) < 0; +boolean operator NE_STRING (string a, string b) = compare_string_3way (&a, &b) != 0; // Unary functions. function ABS (x) = fabs (x); @@ -87,7 +84,9 @@ function LG10(x) = check_errno (log10 (x)); function LN (x) = check_errno (log (x)); function LNGAMMA (x >= 0) = gsl_sf_lngamma (x); function MOD10 (x) = fmod (x, 10); -function RND (x) = x >= 0. ? floor (x + .5) : -floor (-x + .5); +function RND (x) = round_nearest (x, 1, 0); +function RND (x, mult != 0) = round_nearest (x, mult, 0); +function RND (x, mult != 0, fuzzbits >= 0) = round_nearest (x, mult, fuzzbits); function SIN (x) = sin (x); function SQRT (x >= 0) = sqrt (x); function TAN (x) = check_errno (tan (x)); @@ -121,7 +120,7 @@ boolean function ANY (string x, string a[n]) size_t i; for (i = 0; i < n; i++) - if (!compare_string (&x, &a[i])) + if (!compare_string_3way (&x, &a[i])) return 1.; return 0.; } @@ -157,7 +156,7 @@ string function MAX (string a[n]) max = &a[0]; for (i = 1; i < n; i++) - if (compare_string (&a[i], max) > 0) + if (compare_string_3way (&a[i], max) > 0) max = &a[i]; return *max; } @@ -169,6 +168,11 @@ function MEAN.1 (a[n]) return mean; } +function MEDIAN.1 (a[n]) +{ + return median (a, n); +} + function MIN.1 (a[n]) { double min; @@ -188,7 +192,7 @@ string function MIN (string a[n]) min = &a[0]; for (i = 1; i < n; i++) - if (compare_string (&a[i], min) < 0) + if (compare_string_3way (&a[i], min) < 0) min = &a[i]; return *min; } @@ -241,7 +245,7 @@ boolean function RANGE (string x, string a[n*2]) { struct substring *w = &a[2 * i]; struct substring *y = &a[2 * i + 1]; - if (compare_string (w, &x) <= 0 && compare_string (&x, y) <= 0) + if (compare_string_3way (w, &x) <= 0 && compare_string_3way (&x, y) <= 0) return 1.; } return 0.; @@ -294,7 +298,15 @@ function CTIME.SECONDS (time) = time; function DATE.DMY (d, m, y) = expr_ymd_to_date (y, m, d); function DATE.MDY (m, d, y) = expr_ymd_to_date (y, m, d); function DATE.MOYR (m, y) = expr_ymd_to_date (y, m, 1); -function DATE.QYR (q, y) = expr_ymd_to_date (y, q * 3 - 2, 1); +function DATE.QYR (q, y) +{ + if (q < 1.0 || q > 4.0 || q != (int) q) + { + msg (SW, _("The first argument to DATE.QYR must be 1, 2, 3, or 4.")); + return SYSMIS; + } + return expr_ymd_to_date (y, q * 3 - 2, 1); +} function DATE.WKYR (w, y) = expr_wkyr_to_date (w, y); function DATE.YRDAY (y, yday) = expr_yrday_to_date (y, yday); function YRMODA (y, m, d) = expr_yrmoda (y, m, d); @@ -318,6 +330,15 @@ function XDATE.WEEK (date >= DAY_S) function XDATE.WKDAY (date >= DAY_S) = calendar_offset_to_wday (date / DAY_S); function XDATE.YEAR (date >= DAY_S) = calendar_offset_to_year (date / DAY_S); +// Date arithmetic functions. +no_abbrev function DATEDIFF (date2 >= DAY_S, date1 >= DAY_S, string unit) + = expr_date_difference (date1, date2, unit); +no_abbrev function DATESUM (date, quantity, string unit) + = expr_date_sum (date, quantity, unit, ss_cstr ("closest")); +no_abbrev function DATESUM (date, quantity, string unit, string method) + = expr_date_sum (date, quantity, unit, method); + + // String functions. string function CONCAT (string a[n]) expression e; @@ -383,7 +404,6 @@ function INDEX (string haystack, string needles, needle_len_d) } } - function RINDEX (string haystack, string needle) { if (needle.length == 0) @@ -401,7 +421,7 @@ function RINDEX (string haystack, string needle) function RINDEX (string haystack, string needles, needle_len_d) { - if (needle_len_d <= INT_MIN || needle_len_d >= INT_MAX + if (needle_len_d <= 0 || needle_len_d >= INT_MAX || (int) needle_len_d != needle_len_d || needles.length == 0) return SYSMIS; @@ -488,6 +508,15 @@ absorb_miss string function LPAD (string s, n, string c) } } +string function REPLACE (string haystack, string needle, string replacement) + expression e; + = replace_string (e, haystack, needle, replacement, DBL_MAX); + +absorb_miss string function REPLACE (string haystack, string needle, + string replacement, n) + expression e; + = replace_string (e, haystack, needle, replacement, n); + absorb_miss string function RPAD (string s, n) expression e; { @@ -567,7 +596,19 @@ string function RTRIM (string s, string c) function NUMBER (string s, ni_format f) { union value out; - data_in (ss_head (s, f->w), f->type, f->d, 0, &out, 0); + char *error; + + if (s.length > f->w) + s.length = f->w; + error = data_in (s, C_ENCODING, f->type, &out, 0, NULL); + if (error == NULL) + data_in_imply_decimals (s, C_ENCODING, f->type, f->d, &out); + else + { + msg (SE, "Cannot parse `%.*s' as format %s: %s", + (int) s.length, s.string, fmt_name (f->type), error); + free (error); + } return out.f; } @@ -576,14 +617,30 @@ absorb_miss string function STRING (x, no_format f) { union value v; struct substring dst; + char *s; v.f = x; - dst = alloc_string (e, f->w); + assert (!fmt_is_string (f->type)); - data_out (&v, f, dst.string); + s = data_out (&v, C_ENCODING, f); + dst = alloc_string (e, strlen (s)); + strcpy (dst.string, s); + free (s); return dst; } +absorb_miss string function STRUNC (string s, n) +{ + if (n < 1 || n == SYSMIS) + return empty_string; + + if (n < s.length) + s.length = n; + while (s.length > 0 && s.string[s.length - 1] == ' ') + s.length--; + return s; +} + absorb_miss string function SUBSTR (string s, ofs) expression e; { @@ -607,20 +664,34 @@ absorb_miss string function SUBSTR (string s, ofs, cnt) return empty_string; } +absorb_miss no_opt no_abbrev string function VALUELABEL (var v) + expression e; + case c; +{ + const char *label = var_lookup_value_label (v, case_data (c, v)); + if (label != NULL) + return copy_string (e, label, strlen (label)); + else + return empty_string; +} + // Artificial. operator SQUARE (x) = x * x; -boolean operator NUM_TO_BOOLEAN (x) +boolean operator NUM_TO_BOOLEAN (x, string op_name) { if (x == 0. || x == 1. || x == SYSMIS) return x; + + if (!ss_is_empty (op_name)) + msg (SE, _("An operand of the %.*s operator was found to have a value " + "other than 0 (false), 1 (true), or the system-missing " + "value. The result was forced to 0."), + (int) op_name.length, op_name.string); else - { - msg (SE, _("A number being treated as a Boolean in an " - "expression was found to have a value other than " - "0 (false), 1 (true), or the system-missing value. " - "The result was forced to 0.")); - return 0.; - } + msg (SE, _("A logical expression was found to have a value other than 0 " + "(false), 1 (true), or the system-missing value. The result " + "was forced to 0.")); + return 0.; } operator BOOLEAN_TO_NUM (boolean x) = x; @@ -630,7 +701,7 @@ function PDF.BETA (x >= 0 && x <= 1, a > 0, b > 0) = gsl_ran_beta_pdf (x, a, b); function CDF.BETA (x >= 0 && x <= 1, a > 0, b > 0) = gsl_cdf_beta_P (x, a, b); function IDF.BETA (P >= 0 && P <= 1, a > 0, b > 0) - = gslextras_cdf_beta_Pinv (P, a, b); + = gsl_cdf_beta_Pinv (P, a, b); no_opt function RV.BETA (a > 0, b > 0) = gsl_ran_beta (get_rng (), a, b); function NCDF.BETA (x >= 0, a > 0, b > 0, lambda > 0) = ncdf_beta (x, a, b, lambda); @@ -833,7 +904,7 @@ no_opt function RV.BERNOULLI (p >= 0 && p <= 1) // Binomial distribution. function CDF.BINOM (k, n > 0 && n == floor (n), p >= 0 && p <= 1) - = gslextras_cdf_binomial_P (k, p, n); + = gsl_cdf_binomial_P (k, p, n); function PDF.BINOM (k >= 0 && k == floor (k) && k <= n, n > 0 && n == floor (n), p >= 0 && p <= 1) @@ -843,7 +914,7 @@ no_opt function RV.BINOM (p > 0 && p == floor (p), n >= 0 && n <= 1) // Geometric distribution. function CDF.GEOM (k >= 1 && k == floor (k), p >= 0 && p <= 1) - = gslextras_cdf_geometric_P (k, p); + = gsl_cdf_geometric_P (k, p); function PDF.GEOM (k >= 1 && k == floor (k), p >= 0 && p <= 1) = gsl_ran_geometric_pdf (k, p); @@ -854,7 +925,7 @@ function CDF.HYPER (k >= 0 && k == floor (k) && k <= c, a > 0 && a == floor (a), b > 0 && b == floor (b) && b <= a, c > 0 && c == floor (c) && c <= a) - = gslextras_cdf_hypergeometric_P (k, c, a - c, b); + = gsl_cdf_hypergeometric_P (k, c, a - c, b); function PDF.HYPER (k >= 0 && k == floor (k) && k <= c, a > 0 && a == floor (a), b > 0 && b == floor (b) && b <= a, @@ -873,7 +944,7 @@ no_opt extension function RV.LOG (p > 0 && p <= 1) // Negative binomial distribution. function CDF.NEGBIN (k >= 1, n == floor (n), p > 0 && p <= 1) - = gslextras_cdf_negative_binomial_P (k, p, n); + = gsl_cdf_negative_binomial_P (k, p, n); function PDF.NEGBIN (k >= 1, n == floor (n), p > 0 && p <= 1) = gsl_ran_negative_binomial_pdf (k, p, n); no_opt function RV.NEGBIN (n == floor (n), p > 0 && p <= 1) @@ -881,7 +952,7 @@ no_opt function RV.NEGBIN (n == floor (n), p > 0 && p <= 1) // Poisson distribution. function CDF.POISSON (k >= 0 && k == floor (k), mu > 0) - = gslextras_cdf_poisson_P (k, mu); + = gsl_cdf_poisson_P (k, mu); function PDF.POISSON (k >= 0 && k == floor (k), mu > 0) = gsl_ran_poisson_pdf (k, mu); no_opt function RV.POISSON (mu > 0) = gsl_ran_poisson (get_rng (), mu); @@ -892,34 +963,34 @@ absorb_miss boolean function SYSMIS (x) = x == SYSMIS || !finite (x); no_opt boolean function SYSMIS (num_var v) case c; { - return case_num (c, v->fv) == SYSMIS; + return case_num (c, v) == SYSMIS; } no_opt boolean function VALUE (num_var v) case c; { - return case_num (c, v->fv); + return case_num (c, v); } no_opt operator VEC_ELEM_NUM (idx) vector v; case c; { - if (idx >= 1 && idx <= v->cnt) + if (idx >= 1 && idx <= vector_get_var_cnt (v)) { - const struct variable *var = v->var[(int) idx - 1]; - double value = case_num (c, var->fv); - return !var_is_num_user_missing (var, value) ? value : SYSMIS; + const struct variable *var = vector_get_var (v, (size_t) idx - 1); + double value = case_num (c, var); + return !var_is_num_missing (var, value, MV_USER) ? value : SYSMIS; } else { if (idx == SYSMIS) msg (SE, _("SYSMIS is not a valid index value for vector " "%s. The result will be set to SYSMIS."), - v->name); + vector_get_name (v)); else msg (SE, _("%g is not a valid index value for vector %s. " "The result will be set to SYSMIS."), - idx, v->name); + idx, vector_get_name (v)); return SYSMIS; } } @@ -929,21 +1000,22 @@ absorb_miss no_opt string operator VEC_ELEM_STR (idx) vector v; case c; { - if (idx >= 1 && idx <= v->cnt) + if (idx >= 1 && idx <= vector_get_var_cnt (v)) { - struct variable *var = v->var[(int) idx - 1]; - return copy_string (e, case_str (c, var->fv), var_get_width (var)); + struct variable *var = vector_get_var (v, (size_t) idx - 1); + return copy_string (e, CHAR_CAST_BUG (char *, case_str (c, var)), + var_get_width (var)); } else { if (idx == SYSMIS) msg (SE, _("SYSMIS is not a valid index value for vector " "%s. The result will be set to the empty string."), - v->name); + vector_get_name (v)); else msg (SE, _("%g is not a valid index value for vector %s. " "The result will be set to the empty string."), - idx, v->name); + idx, vector_get_name (v)); return empty_string; } } @@ -954,8 +1026,8 @@ no_opt operator NUM_VAR () case c; num_var v; { - double d = case_num (c, v->fv); - return !var_is_num_user_missing (v, d) ? d : SYSMIS; + double d = case_num (c, v); + return !var_is_num_missing (v, d, MV_USER) ? d : SYSMIS; } no_opt string operator STR_VAR () @@ -964,18 +1036,18 @@ no_opt string operator STR_VAR () str_var v; { struct substring s = alloc_string (e, var_get_width (v)); - memcpy (s.string, case_str (c, v->fv), var_get_width (v)); + memcpy (s.string, case_str (c, v), var_get_width (v)); return s; } no_opt perm_only function LAG (num_var v, pos_int n_before) dataset ds; { - struct ccase *c = lagged_case (ds, n_before); + const struct ccase *c = lagged_case (ds, n_before); if (c != NULL) { - double x = case_num (c, v->fv); - return !var_is_num_user_missing (v, x) ? x : SYSMIS; + double x = case_num (c, v); + return !var_is_num_missing (v, x, MV_USER) ? x : SYSMIS; } else return SYSMIS; @@ -984,11 +1056,11 @@ no_opt perm_only function LAG (num_var v, pos_int n_before) no_opt perm_only function LAG (num_var v) dataset ds; { - struct ccase *c = lagged_case (ds, 1); + const struct ccase *c = lagged_case (ds, 1); if (c != NULL) { - double x = case_num (c, v->fv); - return !var_is_num_user_missing (v, x) ? x : SYSMIS; + double x = case_num (c, v); + return !var_is_num_missing (v, x, MV_USER) ? x : SYSMIS; } else return SYSMIS; @@ -998,9 +1070,10 @@ no_opt perm_only string function LAG (str_var v, pos_int n_before) expression e; dataset ds; { - struct ccase *c = lagged_case (ds, n_before); + const struct ccase *c = lagged_case (ds, n_before); if (c != NULL) - return copy_string (e, case_str (c, v->fv), var_get_width (v)); + return copy_string (e, CHAR_CAST_BUG (char *, case_str (c, v)), + var_get_width (v)); else return empty_string; } @@ -1009,9 +1082,10 @@ no_opt perm_only string function LAG (str_var v) expression e; dataset ds; { - struct ccase *c = lagged_case (ds, 1); + const struct ccase *c = lagged_case (ds, 1); if (c != NULL) - return copy_string (e, case_str (c, v->fv), var_get_width (v)); + return copy_string (e, CHAR_CAST_BUG (char *, case_str (c, v)), + var_get_width (v)); else return empty_string; } @@ -1020,14 +1094,14 @@ no_opt operator NUM_SYS () case c; num_var v; { - return case_num (c, v->fv) == SYSMIS; + return case_num (c, v) == SYSMIS; } no_opt operator NUM_VAL () case c; num_var v; { - return case_num (c, v->fv); + return case_num (c, v); } no_opt operator CASENUM ()