rcas 0.2.0

data/lib/rcas/special.rb

@@ -0,0 +1,163 @@
+# frozen_string_literal: true
+
+module RCAS
+  # The incomplete gamma and beta functions, numerically. They are what the
+  # chi-square, Student t and F distributions need for their CDFs; everything
+  # here returns Floats and is labelled as numeric where it surfaces.
+  #
+  #   Special.gamma_p(2.0, 1.5)    # regularized lower incomplete gamma P(a, x)
+  #   Special.beta_i(0.3, 2.0, 5)  # regularized incomplete beta I_x(a, b)
+  #
+  # P(a, x) by the series for x < a + 1 and by the continued fraction for
+  # Q(a, x) beyond; I_x(a, b) by the continued fraction with the symmetry
+  # I_x(a, b) = 1 - I_(1-x)(b, a) picking the fast side. Both are evaluated
+  # with the modified Lentz algorithm.
+  #
+  # Sources (keys: MANUAL.md, Sources): [AS64, §6.5, §26.5]; [PTVF07, §6.2,
+  # §6.4]; Lentz's method [Len76].
+  module Special
+    EPSILON = 1e-16
+    TINY = 1e-300
+    MAX_ITERATIONS = 300
+
+    module_function
+
+    def float(x, name)
+      v = x.is_a?(Numeric) ? x : Expression.lift(x).evalf
+      raise ArgumentError, "#{name}: a real number is needed, got #{x}" unless v.is_a?(Numeric) && !v.is_a?(Complex)
+      v.to_f
+    end
+
+    def log_gamma(x) = Math.lgamma(x).first
+
+    # Regularized lower incomplete gamma P(a, x) = gamma(a, x) / Gamma(a).
+    def gamma_p(a, x)
+      a = float(a, "gamma_p")
+      x = float(x, "gamma_p")
+      raise ArgumentError, "gamma_p: a must be positive" unless a.positive?
+      return 0.0 if x <= 0
+      x < a + 1.0 ? gamma_series(a, x) : 1.0 - gamma_cf(a, x)
+    end
+
+    # Regularized upper incomplete gamma Q(a, x) = 1 - P(a, x).
+    def gamma_q(a, x)
+      a = float(a, "gamma_q")
+      x = float(x, "gamma_q")
+      return 1.0 if x <= 0
+      x < a + 1.0 ? 1.0 - gamma_series(a, x) : gamma_cf(a, x)
+    end
+
+    # The series needs about sqrt(a) terms near x = a, and stopping at a
+    # fixed 300 without a word gave ChiSquare(10**6 + 1).cdf(10**6 + 1) as
+    # 0.16 instead of 0.5 (third review, P-5): the budget grows with a, and
+    # running out of it is a refusal.
+    def budget(a) = MAX_ITERATIONS + (40 * Math.sqrt(a.abs)).ceil
+
+    def gamma_series(a, x)
+      ap = a
+      term = 1.0 / a
+      sum = term
+      converged = false
+      budget(a).times do
+        ap += 1
+        term *= x / ap
+        sum += term
+        if term.abs < sum.abs * EPSILON
+          converged = true
+          break
+        end
+      end
+      raise ArgumentError, "gamma_p: the series did not converge for a = #{a}, x = #{x}" unless converged
+      sum * Math.exp(log_prefactor(a, x))
+    end
+
+    # log(x**a * exp(-x) / Gamma(a)). For a large a the three terms are each
+    # of size a*log(a) and their sum is of size log(a): computed directly it
+    # loses nine digits at a = 10**6. Stirling's series for log Gamma(a)
+    # [AS64, 6.1.41] lets the large parts cancel on paper instead:
+    # a*(log1p(t) - t) - log(2*pi*a)/2 + ... with t = (x - a)/a.
+    def log_prefactor(a, x)
+      return -x + a * Math.log(x) - log_gamma(a) if a < 100
+      t = (x - a) / a
+      core = if t.abs < 0.1
+               # log1p(t) - t by its series, without the cancellation
+               (2..60).reduce(0.0) { |acc, k| acc + ((k.even? ? -1 : 1) * t**k / k) }
+             else
+               Math.log(1 + t) - t
+             end
+      stirling = 1.0 / (12 * a) - 1.0 / (360 * a**3) + 1.0 / (1260 * a**5)
+      a * core + 0.5 * Math.log(a) - 0.5 * Math.log(2 * Math::PI) - stirling
+    end
+
+    # Q(a, x) as a continued fraction (Lentz), for x >= a + 1.
+    def gamma_cf(a, x)
+      b = x + 1.0 - a
+      c = 1.0 / TINY
+      d = 1.0 / b
+      h = d
+      converged = false
+      (1..budget(a)).each do |i|
+        an = -i * (i - a)
+        b += 2.0
+        d = an * d + b
+        d = TINY if d.abs < TINY
+        c = b + an / c
+        c = TINY if c.abs < TINY
+        d = 1.0 / d
+        delta = d * c
+        h *= delta
+        if (delta - 1.0).abs < EPSILON
+          converged = true
+          break
+        end
+      end
+      raise ArgumentError, "gamma_q: the continued fraction did not converge for a = #{a}, x = #{x}" unless converged
+      Math.exp(log_prefactor(a, x)) * h
+    end
+
+    # Regularized incomplete beta I_x(a, b).
+    def beta_i(x, a, b)
+      x = float(x, "beta_i")
+      a = float(a, "beta_i")
+      b = float(b, "beta_i")
+      raise ArgumentError, "beta_i: a and b must be positive" unless a.positive? && b.positive?
+      return 0.0 if x <= 0
+      return 1.0 if x >= 1
+      front = Math.exp(log_gamma(a + b) - log_gamma(a) - log_gamma(b) + a * Math.log(x) + b * Math.log(1.0 - x))
+      x < (a + 1.0) / (a + b + 2.0) ? front * beta_cf(x, a, b) / a : 1.0 - front * beta_cf(1.0 - x, b, a) / b
+    end
+
+    def beta_cf(x, a, b)
+      qab = a + b
+      qap = a + 1.0
+      qam = a - 1.0
+      c = 1.0
+      d = 1.0 - qab * x / qap
+      d = TINY if d.abs < TINY
+      d = 1.0 / d
+      h = d
+      (1..budget([a, b].max)).each do |m|
+        m2 = 2 * m
+        an = m * (b - m) * x / ((qam + m2) * (a + m2))
+        d = 1.0 + an * d
+        d = TINY if d.abs < TINY
+        c = 1.0 + an / c
+        c = TINY if c.abs < TINY
+        d = 1.0 / d
+        h *= d * c
+        an = -(a + m) * (qab + m) * x / ((a + m2) * (qap + m2))
+        d = 1.0 + an * d
+        d = TINY if d.abs < TINY
+        c = 1.0 + an / c
+        c = TINY if c.abs < TINY
+        d = 1.0 / d
+        delta = d * c
+        h *= delta
+        return h if (delta - 1.0).abs < EPSILON
+      end
+      # a continued fraction that has not settled is no value: StudentT with
+      # 10**12 degrees of freedom printed 0.84128 for 0.84134 (fourth review)
+      raise ArgumentError, "beta_i: the continued fraction did not converge for a = #{a}, b = #{b}, x = #{x}"
+    end
+  end
+end

data/lib/rcas/statistics.rb

@@ -0,0 +1,175 @@
+# frozen_string_literal: true
+
+module RCAS
+  # Descriptive statistics and least squares on lists of data, exact.
+  #
+  #   mean([1, 2, 3, 4])                 # => 5/2
+  #   variance([2, 4, 4, 4, 5, 5, 7, 9]) # => 32/7   (sample variance, n - 1)
+  #   quantile([1, 2, 3, 4], 1/4r)       # => 7/4
+  #   mean([a, b, c])                    # => a/3 + b/3 + c/3
+  #   linreg([1, 2, 3], [2, 4, 7], x)    # => -2/3 + 5*x/2
+  #
+  # Conventions follow Maple, Mathematica and MuPAD: variance, standard
+  # deviation and covariance divide by n - 1 unless sample: false; skewness
+  # and kurtosis are the standardized third and fourth central moments
+  # (kurtosis 3 for a normal sample, not the excess); quantiles interpolate
+  # linearly between order statistics (definition 7 of [HF96], the default of
+  # R and Excel). Data may be symbolic wherever no ordering is needed.
+  #
+  # Sources (keys: MANUAL.md, Sources): [HF96]; least squares and the moment
+  # statistics are textbook [Ros14, ch. 7].
+  module Statistics
+    module_function
+
+    def data(list, name)
+      list = list.to_a if list.is_a?(Range)
+      raise ArgumentError, "#{name}: a non-empty list of values is needed, got #{list.inspect}" unless list.is_a?(Array) && !list.empty?
+      list.map { |v| Expression.lift(v) }
+    end
+
+    # Sorted ascending by numeric value; symbolic data has no order.
+    def sorted(list, name)
+      values = data(list, name)
+      keyed = values.map do |v|
+        f = v.evalf
+        raise ArgumentError, "#{name}: #{v} is not a real number" unless f.is_a?(Numeric) && !f.is_a?(Complex)
+        [f, v]
+      end
+      # exact numbers compare exactly, anything else by Inequalities.compare
+      # where the Floats cannot tell: 1 and 1 + 10**-20 are one Float
+      # (third review, P-10)
+      keyed.sort do |(fa, a), (fb, b)|
+        if a.is_a?(Num) && b.is_a?(Num) && a.value.real? && b.value.real?
+          a.value <=> b.value
+        elsif (fa - fb).abs > 1e-9 * [1.0, fa.abs, fb.abs].max
+          fa <=> fb
+        else
+          Inequalities.compare(a, b) || (fa <=> fb)
+        end
+      end.map(&:last)
+    end
+
+    def size(list) = Num.new(list.size)
+
+    def mean(list)
+      values = data(list, "mean")
+      (values.reduce(:+) / size(values)).simplify
+    end
+
+    def median(list)
+      values = sorted(list, "median")
+      n = values.size
+      return values[n / 2] if n.odd?
+      ((values[n / 2 - 1] + values[n / 2]) / 2).simplify
+    end
+
+    # The most frequent value; a list when several tie.
+    def mode(list)
+      counts = frequencies(list)
+      top = counts.values.max
+      modes = counts.select { |_, c| c == top }.keys
+      modes.size == 1 ? modes.first : modes
+    end
+
+    # { value => count }, ordered by value where the data is numeric.
+    def frequencies(list)
+      values = data(list, "frequencies").map(&:simplify)
+      counts = {}
+      values.each { |v| counts[v] = (counts[v] || 0) + 1 }
+      numeric = counts.keys.all? { |v| (f = v.evalf).is_a?(Numeric) && !f.is_a?(Complex) }
+      numeric ? counts.sort_by { |v, _| v.evalf }.to_h : counts
+    end
+
+    def variance(list, sample: true)
+      values = data(list, "variance")
+      raise ArgumentError, "variance: at least two values are needed for a sample variance" if sample && values.size < 2
+      m = mean(values)
+      squares = values.map { |v| ((v - m)**2).expand }.reduce(:+)
+      (squares / Num.new(sample ? values.size - 1 : values.size)).simplify
+    end
+
+    def stdev(list, sample: true) = RCAS.sqrt(variance(list, sample: sample)).simplify
+
+    # k-th central (or raw) moment, divided by n.
+    def moment(list, k, central: true)
+      values = data(list, "moment")
+      shift = central ? mean(values) : Num.new(0)
+      (values.map { |v| ((v - shift)**k).expand }.reduce(:+) / size(values)).simplify
+    end
+
+    def skewness(list)
+      m2 = moment(list, 2)
+      (moment(list, 3) / m2**Rational(3, 2)).simplify
+    end
+
+    def kurtosis(list)
+      m2 = moment(list, 2)
+      (moment(list, 4) / m2**2).simplify
+    end
+
+    # Definition 7 of [HF96]: h = (n - 1) p, linear interpolation between the
+    # order statistics x[floor h] and x[floor h + 1].
+    def quantile(list, p)
+      values = sorted(list, "quantile")
+      p = Expression.lift(p)
+      raise ArgumentError, "quantile: p must be a number in [0, 1], got #{p}" unless p.is_a?(Num) && p.value.real? && p.value.between?(0, 1)
+      h = (values.size - 1) * p.value
+      i = h.floor
+      return values[i] if i == h || i + 1 >= values.size
+      (values[i] + (values[i + 1] - values[i]) * Num.new(Simplify.normalize_number(h - i))).simplify
+    end
+
+    def quartiles(list) = [quantile(list, Rational(1, 4)), median(list), quantile(list, Rational(3, 4))]
+    def iqr(list) = (quantile(list, Rational(3, 4)) - quantile(list, Rational(1, 4))).simplify
+
+    def geometric_mean(list)
+      values = data(list, "geometric_mean")
+      (values.reduce(:*)**Rational(1, values.size)).simplify
+    end
+
+    def harmonic_mean(list)
+      values = data(list, "harmonic_mean")
+      (size(values) / values.map { |v| 1 / v }.reduce(:+)).simplify
+    end
+
+    # ---- two variables ----------------------------------------------------------
+
+    def pairs(xs, ys, name)
+      xs = data(xs, name)
+      ys = data(ys, name)
+      raise ArgumentError, "#{name}: the lists must have the same length (#{xs.size} and #{ys.size})" unless xs.size == ys.size
+      raise ArgumentError, "#{name}: at least two pairs are needed" if xs.size < 2
+      [xs, ys]
+    end
+
+    def covariance(xs, ys, sample: true)
+      xs, ys = pairs(xs, ys, "covariance")
+      mx = mean(xs)
+      my = mean(ys)
+      total = xs.zip(ys).map { |x, y| ((x - mx) * (y - my)).expand }.reduce(:+)
+      (total / Num.new(sample ? xs.size - 1 : xs.size)).simplify
+    end
+
+    def correlation(xs, ys)
+      xs, ys = pairs(xs, ys, "correlation")
+      sx = stdev(xs)
+      sy = stdev(ys)
+      if Scalar.zero?(sx) || Scalar.zero?(sy)
+        raise ArgumentError, "correlation: undefined when one of the two series is constant"
+      end
+      (covariance(xs, ys) / (sx * sy)).simplify
+    end
+
+    # Least squares line as an expression in var: a + b*var.
+    def linreg(xs, ys, var = :x)
+      xs, ys = pairs(xs, ys, "linreg")
+      x = Expression.lift(var)
+      raise ArgumentError, "linreg: the third argument names the indeterminate, got #{x}" unless x.is_a?(Var)
+      vx = variance(xs)
+      raise ArgumentError, "linreg: all x values are equal" if Scalar.zero?(vx)
+      b = (covariance(xs, ys) / vx).simplify
+      a = (mean(ys) - b * mean(xs)).simplify
+      (a + b * x).simplify
+    end
+  end
+end