X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=src%2Flanguage%2Fexpressions%2Foperations.def;h=df2887044fd377995d378009d9ea75df5d2c7555;hb=012b9e4ecf47d844aea352b2c0b7dda80a7194bd;hp=52d4226dff60ceec92657364a2b6f227d108e11b;hpb=2764b3157e26955a31af5f4aa7d14e27098ddf19;p=pspp diff --git a/src/language/expressions/operations.def b/src/language/expressions/operations.def index 52d4226dff..df2887044f 100644 --- a/src/language/expressions/operations.def +++ b/src/language/expressions/operations.def @@ -1,18 +1,18 @@ // -*- c -*- // // PSPP - a program for statistical analysis. -// Copyright (C) 2005, 2006, 2009 Free Software Foundation, Inc. -// +// 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 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. -// +// // You should have received a copy of the GNU General Public License // along with this program. If not, see . @@ -63,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); @@ -84,11 +84,15 @@ 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)); -function TRUNC (x) = x >= 0. ? floor (x) : -floor (-x); +function TRUNC (x) = round_zero (x, 1, 0); +function TRUNC (x, mult != 0) = round_zero (x, mult, 0); +function TRUNC (x, mult != 0, fuzzbits >= 0) = round_zero (x, mult, fuzzbits); absorb_miss function MOD (n, d) { @@ -118,7 +122,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.; } @@ -154,7 +158,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; } @@ -166,6 +170,11 @@ function MEAN.1 (a[n]) return mean; } +function MEDIAN.1 (a[n]) +{ + return median (a, n); +} + function MIN.1 (a[n]) { double min; @@ -185,7 +194,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; } @@ -238,7 +247,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.; @@ -291,7 +300,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); @@ -389,7 +406,6 @@ function INDEX (string haystack, string needles, needle_len_d) } } - function RINDEX (string haystack, string needle) { if (needle.length == 0) @@ -407,7 +423,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; @@ -494,6 +510,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; { @@ -528,7 +553,7 @@ absorb_miss string function RPAD (string s, n, string c) string function LTRIM (string s) { - while (s.length > 0 && s.string[0] == ' ') + while (s.length > 0 && s.string[0] == ' ') { s.length--; s.string++; @@ -540,7 +565,7 @@ string function LTRIM (string s, string c) { if (c.length == 1) { - while (s.length > 0 && s.string[0] == c.string[0]) + while (s.length > 0 && s.string[0] == c.string[0]) { s.length--; s.string++; @@ -573,7 +598,21 @@ string function RTRIM (string s, string c) function NUMBER (string s, ni_format f) { union value out; - data_in (ss_head (s, f->w), LEGACY_NATIVE, f->type, f->d, 0, 0, &out, 0); + char *error; + + if (s.length > f->w) + s.length = f->w; + error = data_in (s, C_ENCODING, f->type, settings_get_fmt_settings (), + &out, 0, NULL); + if (error == NULL) + data_in_imply_decimals (s, C_ENCODING, f->type, f->d, + settings_get_fmt_settings (), &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; } @@ -587,13 +626,25 @@ absorb_miss string function STRING (x, no_format f) v.f = x; assert (!fmt_is_string (f->type)); - s = data_out (&v, LEGACY_NATIVE, f); + s = data_out (&v, C_ENCODING, f, settings_get_fmt_settings ()); 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; { @@ -630,18 +681,21 @@ absorb_miss no_opt no_abbrev string function VALUELABEL (var v) // 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; @@ -706,7 +760,7 @@ function CDF.GAMMA (x >= 0, a > 0, b > 0) = gsl_cdf_gamma_P (x, a, 1. / b); function IDF.GAMMA (P >= 0 && P <= 1, a > 0, b > 0) = gsl_cdf_gamma_Pinv (P, a, 1. / b); function PDF.GAMMA (x >= 0, a > 0, b > 0) = gsl_ran_gamma_pdf (x, a, 1. / b); -no_opt function RV.GAMMA (a > 0, b > 0) +no_opt function RV.GAMMA (a > 0, b > 0) = gsl_ran_gamma (get_rng (), a, 1. / b); // Half-normal distribution. @@ -730,16 +784,16 @@ function CDF.LAPLACE (x, a, b > 0) = gsl_cdf_laplace_P ((x - a) / b, 1); function IDF.LAPLACE (P > 0 && P < 1, a, b > 0) = a + b * gsl_cdf_laplace_Pinv (P, 1); function PDF.LAPLACE (x, a, b > 0) = gsl_ran_laplace_pdf ((x - a) / b, 1) / b; -no_opt function RV.LAPLACE (a, b > 0) +no_opt function RV.LAPLACE (a, b > 0) = a + b * gsl_ran_laplace (get_rng (), 1); // Levy alpha-stable distribution. -no_opt extension function RV.LEVY (c, alpha > 0 && alpha <= 2) +no_opt extension function RV.LEVY (c, alpha > 0 && alpha <= 2) = gsl_ran_levy (get_rng (), c, alpha); // Levy skew alpha-stable distribution. no_opt extension function RV.LVSKEW (c, alpha > 0 && alpha <= 2, - beta >= -1 && beta <= 1) + beta >= -1 && beta <= 1) = gsl_ran_levy_skew (get_rng (), c, alpha, beta); // Logistic distribution. @@ -748,7 +802,7 @@ function IDF.LOGISTIC (P > 0 && P < 1, a, b > 0) = a + b * gsl_cdf_logistic_Pinv (P, 1); function PDF.LOGISTIC (x, a, b > 0) = gsl_ran_logistic_pdf ((x - a) / b, 1) / b; -no_opt function RV.LOGISTIC (a, b > 0) +no_opt function RV.LOGISTIC (a, b > 0) = a + b * gsl_ran_logistic (get_rng (), 1); // Lognormal distribution. @@ -758,7 +812,7 @@ function IDF.LNORMAL (P >= 0 && P < 1, m > 0, s > 0) = gsl_cdf_lognormal_Pinv (P, log (m), s); function PDF.LNORMAL (x >= 0, m > 0, s > 0) = gsl_ran_lognormal_pdf (x, log (m), s); -no_opt function RV.LNORMAL (m > 0, s > 0) +no_opt function RV.LNORMAL (m > 0, s > 0) = gsl_ran_lognormal (get_rng (), log (m), s); // Normal distribution. @@ -774,7 +828,7 @@ no_opt function NORMAL (s > 0) = gsl_ran_gaussian (get_rng (), s); // Normal tail distribution. function PDF.NTAIL (x, a > 0, sigma > 0) = gsl_ran_gaussian_tail_pdf (x, a, sigma); -no_opt function RV.NTAIL (a > 0, sigma > 0) +no_opt function RV.NTAIL (a > 0, sigma > 0) = gsl_ran_gaussian_tail (get_rng (), a, sigma); // Pareto distribution. @@ -790,13 +844,13 @@ extension function IDF.RAYLEIGH (P >= 0 && P <= 1, sigma > 0) = gsl_cdf_rayleigh_Pinv (P, sigma); extension function PDF.RAYLEIGH (x, sigma > 0) = gsl_ran_rayleigh_pdf (x, sigma); -no_opt extension function RV.RAYLEIGH (sigma > 0) +no_opt extension function RV.RAYLEIGH (sigma > 0) = gsl_ran_rayleigh (get_rng (), sigma); // Rayleigh tail distribution. extension function PDF.RTAIL (x, a, sigma) = gsl_ran_rayleigh_tail_pdf (x, a, sigma); -no_opt extension function RV.RTAIL (a, sigma) +no_opt extension function RV.RTAIL (a, sigma) = gsl_ran_rayleigh_tail (get_rng (), a, sigma); // Studentized maximum modulus distribution. @@ -845,11 +899,11 @@ function PDF.WEIBULL (x >= 0, a > 0, b > 0) = gsl_ran_weibull_pdf (x, a, b); no_opt function RV.WEIBULL (a > 0, b > 0) = gsl_ran_weibull (get_rng (), a, b); // Bernoulli distribution. -function CDF.BERNOULLI (k == 0 || k == 1, p >= 0 && p <= 1) +function CDF.BERNOULLI (k == 0 || k == 1, p >= 0 && p <= 1) = k ? 1 : 1 - p; function PDF.BERNOULLI (k == 0 || k == 1, p >= 0 && p <= 1) = gsl_ran_bernoulli_pdf (k, p); -no_opt function RV.BERNOULLI (p >= 0 && p <= 1) +no_opt function RV.BERNOULLI (p >= 0 && p <= 1) = gsl_ran_bernoulli (get_rng (), p); // Binomial distribution. @@ -859,7 +913,7 @@ function PDF.BINOM (k >= 0 && k == floor (k) && k <= n, n > 0 && n == floor (n), p >= 0 && p <= 1) = gsl_ran_binomial_pdf (k, p, n); -no_opt function RV.BINOM (p > 0 && p == floor (p), n >= 0 && n <= 1) +no_opt function RV.BINOM (p > 0 && p == floor (p), n >= 0 && n <= 1) = gsl_ran_binomial (get_rng (), p, n); // Geometric distribution. @@ -889,7 +943,7 @@ no_opt function RV.HYPER (a > 0 && a == floor (a), // Logarithmic distribution. extension function PDF.LOG (k >= 1, p > 0 && p <= 1) = gsl_ran_logarithmic_pdf (k, p); -no_opt extension function RV.LOG (p > 0 && p <= 1) +no_opt extension function RV.LOG (p > 0 && p <= 1) = gsl_ran_logarithmic (get_rng (), p); // Negative binomial distribution. @@ -897,7 +951,7 @@ function CDF.NEGBIN (k >= 1, n == floor (n), p > 0 && p <= 1) = 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) +no_opt function RV.NEGBIN (n == floor (n), p > 0 && p <= 1) = gsl_ran_negative_binomial (get_rng (), p, n); // Poisson distribution. @@ -908,8 +962,8 @@ function PDF.POISSON (k >= 0 && k == floor (k), mu > 0) no_opt function RV.POISSON (mu > 0) = gsl_ran_poisson (get_rng (), mu); // Weirdness. -absorb_miss boolean function MISSING (x) = x == SYSMIS || !finite (x); -absorb_miss boolean function SYSMIS (x) = x == SYSMIS || !finite (x); +absorb_miss boolean function MISSING (x) = x == SYSMIS || !isfinite (x); +absorb_miss boolean function SYSMIS (x) = x == SYSMIS || !isfinite (x); no_opt boolean function SYSMIS (num_var v) case c; { @@ -925,11 +979,11 @@ no_opt operator VEC_ELEM_NUM (idx) vector v; case c; { - if (idx >= 1 && idx <= vector_get_var_cnt (v)) + if (idx >= 1 && idx <= vector_get_var_cnt (v)) { 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; + return !var_is_num_missing (var, value, MV_USER) ? value : SYSMIS; } else { @@ -953,7 +1007,8 @@ absorb_miss no_opt string operator VEC_ELEM_STR (idx) if (idx >= 1 && idx <= vector_get_var_cnt (v)) { struct variable *var = vector_get_var (v, (size_t) idx - 1); - return copy_string (e, case_str (c, var), var_get_width (var)); + return copy_string (e, CHAR_CAST_BUG (char *, case_str (c, var)), + var_get_width (var)); } else { @@ -1021,7 +1076,8 @@ no_opt perm_only string function LAG (str_var v, pos_int n_before) { const struct ccase *c = lagged_case (ds, n_before); if (c != NULL) - return copy_string (e, case_str (c, v), var_get_width (v)); + return copy_string (e, CHAR_CAST_BUG (char *, case_str (c, v)), + var_get_width (v)); else return empty_string; } @@ -1032,7 +1088,8 @@ no_opt perm_only string function LAG (str_var v) { const struct ccase *c = lagged_case (ds, 1); if (c != NULL) - return copy_string (e, case_str (c, v), var_get_width (v)); + return copy_string (e, CHAR_CAST_BUG (char *, case_str (c, v)), + var_get_width (v)); else return empty_string; }