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=bdb6ed2b911c70af0915e3e689c3308c9dadc67d;hpb=18e0d701a5e9a288604a408100efcf1463b6da9c;p=pspp

diff --git a/src/language/expressions/operations.def b/src/language/expressions/operations.def
index bdb6ed2b91..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, 2010, 2011 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 <http://www.gnu.org/licenses/>.
 
@@ -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)
 {
@@ -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;
@@ -397,7 +406,6 @@ function INDEX (string haystack, string needles, needle_len_d)
     }
 }
 
-
 function RINDEX (string haystack, string needle)
 {
   if (needle.length == 0)
@@ -415,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;
@@ -502,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;
 {
@@ -536,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++;
@@ -548,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++;
@@ -585,9 +602,11 @@ function NUMBER (string s, ni_format f)
 
   if (s.length > f->w)
     s.length = f->w;
-  error = data_in (s, LEGACY_NATIVE, f->type, &out, 0, NULL);
+  error = data_in (s, C_ENCODING, f->type, settings_get_fmt_settings (),
+                   &out, 0, NULL);
   if (error == NULL)
-    data_in_imply_decimals (s, LEGACY_NATIVE, f->type, f->d, &out);
+    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",
@@ -607,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;
 {
@@ -654,14 +685,17 @@ 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, _("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);
-      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;
@@ -726,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.
@@ -750,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.
@@ -768,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.
@@ -778,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.
@@ -794,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.
@@ -810,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.
@@ -865,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.
@@ -879,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.
@@ -909,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.
@@ -917,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.
@@ -928,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;
 {
@@ -945,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
     {