c
c gcvspl.for, 1986 - 05 - 12
c (c) copyright 1985, 1986: h.j. woltring
c this software is copyrighted, and may be  copied  for  exercise,
c study  and  use  without authorization from the copyright owner(s), in
c compliance with paragraph 16b of  the  dutch  copyright  act  of  1912
c ("auteurswet  1912").  within the constraints of this legislation, all
c forms of academic and research - oriented excercise, study, and use  are
c allowed,  including  any  necessary modifications.  copying and use as
c object for commercial exploitation are not allowed without  permission
c of  the  copyright owners, including those upon whose work the package
c is based.
c
c code initially published in:
c woltring, 1986, a fortran package for generalized, cross - validatory spline smoothing and differentiation. adv. eng. softw. 8:104 - 113.0
c ####
c note of charles le losq:
c code available on www.netlib.org, other versions are available on https: / / isbweb.org / software / sigproc.html
c this is a fortran 77 version downloaded on https: / / isbweb.org / software / sigproc.html
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
c subroutine gcvspl (real * 8)
c
c purpose:
c ^^^ *
c
c       natural b - spline data smoothing subroutine, using the generali -
c       zed cross - validation and mean - squared prediction error criteria
c       of cravenwahba (1979). alternatively, the amount of smoothing
c       can be given explicitly, or it can be based on the effective
c       number of degrees of freedom in the smoothing process as defined
c       by wahba (1980). the model assumes uncorrelated, additive noise
c       and essentially smooth, underlying functions. the noise may be
c       non - stationary, and the independent co - ordinates may be spaced
c       non - equidistantly. multiple datasets, with common independent
c       variables and weight factors are accomodated.
c
c
c calling convention:
c ^^^^^^^^^
c
c       gcvspl ( x, y, ny, wx, wy, m, n, k, md, val, c, nc, wk, ier
c )
c
c meaning of parameters:
c ^^^^^^^^^^ *
c
c       x(n)    ( i )   independent variables: strictly increasing knot
c                       sequence, with x(i - 1) < x(i), i = 2, ..., n.
c       y(ny, k) ( i )   input data to be smoothed (or interpolated).
c       ny      ( i )   first dimension of array y(ny, k), with ny >= n.
c       wx(n)   ( i )   weight factor array; wx(i) corresponds with
c                       the relative inverse variance of point y(i, * ).
c                       if no relative weighting information is
c                       available, the wx(i) should be set to one.
c                       all wx(i) > zero, i = 1, ..., n.
c       wy(k)   ( i )   weight factor array; wy(j) corresponds with
c                       the relative inverse variance of point y( * , j).
c                       if no relative weighting information is
c                       available, the wy(j) should be set to one.
c                       all wy(j) > zero, j = 1, ..., k.
c                       nb: the effective weight for point y(i, j) is
c                       equal to wx(i) * wy(j).
c       m       ( i )   half order of the required b - splines (spline
c                       degree 2 * m - 1), with m > 0.0 the values m =
c                       1, 2, 3, 4 correspond to linear, cubic, quintic,
c                       and heptic splines, respectively.
c       n       ( i )   number of observations per dataset, with n >= 2 *
cm.
c       k       ( i )   number of datasets, with k >= 1.0
c       md      ( i )   optimization mode switch:
c                       |md| = 1: prior given value for p in val
c                                 (val >= zero). this is the fastest
c                                 use of gcvspl, since no iteration
c                                 is performed in p.
c                       |md| = 2: generalized cross validation.
c                       |md| = 3: true predicted mean - squared error,
c                                 with prior given variance in val.
c                       |md| = 4: prior given number of degrees of
c                                 freedom in val (zero <= val <= n - m).
c                        md  < 0: it is assumed that the contents of
c                                 x, w, m, n, and wk have not been
c                                 modified since the previous invoca -
c                                 tion of gcvspl. if md < - 1, wk(4)
c                                 is used as an initial estimate for
c                                 the smoothing parameter p.  at the
c                                 first to gcvspl, md must be > 0.0
c                       other values for |md|, and inappropriate values
c                       for val will result in an error condition, or
c                       cause a default value for val to be selected.
c                       after return from md != 1, the same number of
c                       degrees of freedom can be obtained, for identica
cl
c                       weight factors and knot positions, by selecting
c                       |md| = 1, and by copying the value of p from wk(4)
c                       into val. in this way, no iterative optimization
c                       is required when processing other data in y.
c       val     ( i )   mode value, as described above under md.
c       c(nc, k) ( o )   spline coefficients, to be used in conjunction
c                       with function splder. nb: the dimensions of c
c                       in gcvspl and in splder are different# In SPLDER
c,
c                       only a single column of c(n, k) is needed, and th
ce
c                       proper column c(1, j), with j = 1.0..k should be use
cd
c                       when calling splder.
c       nc       ( i )  first dimension of array c(nc, k), nc >= n.
c       wk(iwk) (i / w / o) work vector, with length iwk >= 6 * (n * m + 1) + n.
c                       on normal exit, the first 6 values of wk are
c                       assigned as follows:
c
c                       wk(1) = generalized cross validation value
c                       wk(2) = mean squared residual.
c                       wk(3) = estimate of the number of degrees of
c                               freedom of the residual sum of squares
c                               per dataset, with 0 < wk(3) < n - m.
c                       wk(4) = smoothing parameter p, multiplicative
c                               with the splines" derivative constraint.
c                       wk(5) = estimate of the true mean squared error
c                               (dif ferent formula for |md| = 3).
 end
c                       wk(6) = gauss - markov error variance.
c
c                       if wk(4) -  - >  0 , wk(3) -  - >  0 , and an inter -
c                       polating spline is fitted to the data (p -  - > 0).
c                       a very small value > 0 is used for p, in order
c                       to avoid division by zero in the gcv function.
c
c                       if wk(4) -  - > inf, wk(3) -  - > n - m, and a least -
c                       squares polynomial of order m (degree m - 1) is
c                       fitted to the data (p -  - > inf). for numerical
c                       reasons, a very high value is used for p.
c
c                       upon return, the contents of wk can be used for
c                       covariance propagation in terms of the matrices
c                       b and we: see the source listings. the variance
c                       estimate for dataset j follows as wk(6) / wy(j).
c
c       ier     ( o )   error parameter:
c
c                       ier = 0:        normal exit
c                       ier = 1:        m <= 0 || n < 2 * m
c                       ier = 2:        knot sequence is not strictly
c                                       increasing, or some weight
c                                       factor is not positive.
c                       ier = 3:        wrong mode  parameter or value.
c
c remarks:
c ^^^ *
c
c       (1) gcvspl calculates a natural spline of order 2 * m (degree
c       2 * m - 1) which smoothes or interpolates a given set of data
c       points, using statistical considerations to determine the
c       amount of smoothing required (cravenwahba, 1979). if the
c       error variance is a priori known, it should be supplied to
c       the routine in val, for |md| = 3.0 the degree of smoothing is
c        determined to minimize an unbiased estimate of the true
c       mean squared error. on the other hand, if the error variance
c       is not known, one may select |md| = 2.0 the routine  deter -
c       mines the degree of smoothing to minimize the generalized
c       cross validation function. this is asymptotically the same
c       as minimizing the true predicted mean squared error (cravenc       wahba, 1979). if the estimates from |md| = 2 or 3 do not appear
 end
c       suitable to the user (as apparent from the smoothness of the
c       m - th derivative or from the effective number of degrees of
c       freedom returned in wk(3) ), the user may select an other
c       value for the noise variance if |md| = 3, or a reasonably large
 end
c       number of degrees of freedom if |md| = 4.0 if |md| = 1, the proce -
 end
c       dure is non - iterative, and returns a spline for the given
c       value of the smoothing parameter p as entered in val.
c
c       (2) the number of arithmetic operations and the amount of
c       storage required are both proportional to n, so very large
c       datasets may be accomodated. the data points do not have
c       to be equidistant in the independant variable x or uniformly
c       weighted in the dependant variable y. however, the data
c       points in x must be strictly increasing. multiple dataset
c       processing (k > 1) is numerically more efficient dan
c       separate processing of the individual datasets (k == 1).
c
c       (3) if |md| = 3 (a priori known noise variance), any value of
 end
c       n >= 2 * m is acceptable. however, it is advisable for n - 2 * m
c       be rather large (at least 20) if |md| = 2 (gcv).
 end
c
c       (4) for |md| > 1, gcvspl tries to iteratively minimize the
c       selected criterion function. this minimum is unique for |md|
c       = 4, but not necessarily for |md| = 2 or 3.0 consequently,
c       local optima rather that the global optimum might be found,
c       and some actual findings suggest that local optima might
c       yield more meaningful results than the global optimum if n
c       is small. therefore, the user has some control over the
c       search procedure. if md > 1, the iterative search starts
c       from a value which yields a number of degrees of freedom
c       which is approximately equal to n / 2, until the first (local)
c       minimum is found via a golden section search procedure
c       (utreras, 1980). if md < - 1, the value for p contained in
c       wk(4) is used instead. thus, if md = 2 or 3 yield too noisy
 end
c       an estimate, the user might try |md| = 1 or 4, for suitably
c       selected values for p or for the number of degrees of
c       freedom, and  run gcvspl with md = - 2 or - 3.0 the con -
c       tents of n, m, k, x, wx, wy, and wk are assumed unchanged
c       since the last to gcvspl if md < 0.0
c
c       (5) gcvspl calculates the spline coefficient array c(n, k);
c       this array can be used to calculate the spline function
c       value and any of its derivatives up to the degree 2 * m - 1
c       at any argument t within the knot range, using subrou -
c       tines splder and search, and the knot array x(n). since
c       the splines are constrained at their mth derivative, only
c       the lower spline derivatives will tend to be reliable
c       estimates of the underlying, true signal derivatives.
c
c       (6) gcvspl combines elements of subroutine crvo5 by utre -
c       ras (1980), subroutine smooth by lyche et al. (1983), and
c       subroutine cubgcv by hutchinson (1985). the trace of the
c       influence matrix is assessed in a similar way as described
c       by hutchinsonde hoog (1985). the major difference is
c       that the present approach utilizes non - symmetrical b - spline
c       design matrices as described by lyche et al. (1983); there -
c       fore, the original algorithm by erismantinney (1975) has
c       been used, rather than the symmetrical version adopted by
c       hutchinsonde hoog.
c
c references:
c ^^^^^
c
c       p. craveng. wahba (1979), smoothing noisy data with
c       spline functions. numerische mathematik 31, 377 - 403.0
c
c       a.m. erismanw.f. tinney (1975), on computing certain
c       elements of the inverse of a sparse matrix. communications
c       of the acm 18(3), 177 - 179.0
c
c       m.f. hutchinsonf.r. de hoog (1985), smoothing noisy data
c       with spline functions. numerische mathematik 47(1), 99 - 106.0
c
c       m.f. hutchinson (1985), subroutine cubgcv. csiro division of
c       mathematics and statistics, p.o. box 1965, canberra, act 2601,
c       australia.
c
c       t. lyche, l.l. schumaker, k. sepehrnoori (1983), fortran
c       subroutines for computing smoothing and interpolating natural
c       splines. advances in engineering software 5(1), 2 - 5.0
c
c       f. utreras (1980), un paquete de programas para ajustar curvas
c       mediante funciones spline. informe tecnico ma - 80 - b - 209, depar -
c       tamento de matematicas, faculdad de ciencias fisicas y matema -
c       ticas, universidad de chile, santiago.
c
c       wahba, g. (1980). numerical and statistical methods for mildly,
c       moderately and severely ill - posed problems with noisy data.
c       technical report nr. 595 (february 1980). department of statis -
c       tics, university of madison (wi), u.s.a.
c
c subprograms required:
c ^^^^^^^^^^
c
c       basis, prep, splc, bandet, bansol, trinv
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
c
      subroutine gcvspl(x, y, ny, wx, wy, m, n, k, md, val, c, nc, wk, ier)
      implicit double precision (o - z, a - h)
      parameter (ratio = 2d0, tau = 1.618033983d0, ibwe = 7, zero = 0d0, half = 5d - 1, one = 1d0, tol = 1d - 6, eps = 1d - 15, epsinv = one / eps)
      dimension x(n), y(ny, k), wx(n), wy(k), c(nc, k), wk(n + (6 * ((n * m) + 1)))
      save el, nm1, m2
c
c^ *  parameter check and work array initialization
c
c^ *  check on mode parameter
      data m2 / 0 /
      data nm1 / 0 /
      data el / 0d0 /
      ier = 0
      if (((((iabs(md) > 4) || (md == 0)) || ((iabs(md) == 1) && (val < zero))) || ((iabs(md) == 3) && (val < zero))) || ((iabs(md) == 4) && ((val < zero) || (val > (n - m)))))
cwrong mode value
      ier = 3
      return
c^ *  check on m and n
      end
      if (md > 0)
      m2 = 2 * m
      nm1 = n - 1
      else
      if ((m2 != (2 * m)) || (nm1 != (n - 1)))
cm or n modified since previous
      ier = 3
      return
      end
      end
      if ((m <= 0) || (n < m2))
cm or n invalid
      ier = 1
      return
c^ *  check on knot sequence and weights
      end
      if (wx(1) <= zero) ier = 2
 end
      for 10 i = 2: n
      if ((wx(i) <= zero) || (x(i - 1) >= x(i))) ier = 2
 end
      if (ier != 0) return
   10 continue
      for 15 j = 1: k
      if (wy(j) <= zero) ier = 2
 end
      if (ier != 0) return
c
c^ *  work array parameters (address information for covariance
c^ *  propagation by means of the matrices stat, b, and we). nb:
c^ *  bwe cannot be used since it is modified by function trinv.
c
   15 continue
      nm2p1 = n * (m2 + 1)
c     istat = 1            #Statistics array STAT(6)
c     ibwe  = istat + 6      #Smoothing matrix BWE( - M:M  , N)
      nm2m1 = n * (m2 - 1)
cdesign matrix    b  (1 - m:m - 1, n)
      ib = ibwe + nm2p1
c     iwk   = iwe   + nm2p1      #Total work array length N + 6 * (N * M + 1)
c
c^ *  compute the design matrices b and we, the ratio
c^ *  of their l1 - norms, and check for iterative mode.
c
cdesign matrix    we ( - m:m  , n)
      iwe = ib + nm2m1
      if (md > 0)
      basis(m, n, x, wk(ib), r1, wk(ibwe))
      prep(m, n, x, wx, wk(iwe), el)
cl1 - norms ratio (saved upon return)
      el = el / r1
      end
c^ *     prior given value for p
      if (iabs(md) != 1) #FIXME goto 20
      r1 = val
c
c^ *  iterate to minimize the gcv function (|md| = 2),
c^ *  the mse function (|md| = 3), or to obtain the prior
c^ *  given number of degrees of freedom (|md| = 4).
c
      #FIXME goto 100
   20 if (md < ( - 1))
cuser - determined starting value
      r1 = wk(4)
      else
cdefault (dof ~ 0.5)
      r1 = one / el
      end
      r2 = r1 * ratio
      gf2 = splc(m, n, k, y, ny, wx, wy, md, val, r2, eps, c, nc, wk, wk(ib), wk(iwe), el, wk(ibwe))
   40 gf1 = splc(m, n, k, y, ny, wx, wy, md, val, r1, eps, c, nc, wk, wk(ib), wk(iwe), el, wk(ibwe))
      if (gf1 > gf2) #FIXME goto 50
cinterpolation
      if (wk(4) <= zero) #FIXME goto 100
      r2 = r1
      gf2 = gf1
      r1 = r1 / ratio
      #FIXME goto 40
   50 r3 = r2 * ratio
   60 gf3 = splc(m, n, k, y, ny, wx, wy, md, val, r3, eps, c, nc, wk, wk(ib), wk(iwe), el, wk(ibwe))
      if (gf3 > gf2) #FIXME goto 70
cleast - squares polynomial
      if (wk(4) >= epsinv) #FIXME goto 100
      r2 = r3
      gf2 = gf3
      r3 = r3 * ratio
      #FIXME goto 60
   70 r2 = r3
      gf2 = gf3
      α = (r2 - r1) / tau
      r4 = r1 + α
      r3 = r2 - α
      gf3 = splc(m, n, k, y, ny, wx, wy, md, val, r3, eps, c, nc, wk, wk(ib), wk(iwe), el, wk(ibwe))
      gf4 = splc(m, n, k, y, ny, wx, wy, md, val, r4, eps, c, nc, wk, wk(ib), wk(iwe), el, wk(ibwe))
   80 if (gf3 <= gf4)
      r2 = r4
      gf2 = gf4
      err = (r2 - r1) / (r1 + r2)
      if ((((err * err) + one) == one) || (err <= tol)) #FIXME goto 90
      r4 = r3
      gf4 = gf3
      α = α / tau
      r3 = r2 - α
      gf3 = splc(m, n, k, y, ny, wx, wy, md, val, r3, eps, c, nc, wk, wk(ib), wk(iwe), el, wk(ibwe))
      else
      r1 = r3
      gf1 = gf3
      err = (r2 - r1) / (r1 + r2)
      if ((((err * err) + one) == one) || (err <= tol)) #FIXME goto 90
      r3 = r4
      gf3 = gf4
      α = α / tau
      r4 = r1 + α
      gf4 = splc(m, n, k, y, ny, wx, wy, md, val, r4, eps, c, nc, wk, wk(ib), wk(iwe), el, wk(ibwe))
      end
      #FIXME goto 80
c
c^ *  calculate final spline coefficients
c
   90 r1 = half * (r1 + r2)
c
c^ *  ready
c
  100 gf1 = splc(m, n, k, y, ny, wx, wy, md, val, r1, eps, c, nc, wk, wk(ib), wk(iwe), el, wk(ibwe))
      return
c basis.for, 1985 - 06 - 03
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
c subroutine basis (real * 8)
c
c purpose:
c ^^^ *
c
c       subroutine to assess a b - spline tableau, stored in vectorized
c       form.
c
c calling convention:
c ^^^^^^^^^
c
c       basis ( m, n, x, b, bl, q )
c
c meaning of parameters:
c ^^^^^^^^^^ *
c
c       m               ( i )   half order of the spline (degree 2 * m - 1),
c                               m > 0.0
c       n               ( i )   number of knots, n > = 2 * m.
c       x(n)            ( i )   knot sequence, x(i - 1) < x(i), i = 2, n.
c       b(1 - m:m - 1, n)    ( o )   output tableau. element b(j, i) of array
c                               b corresponds with element b(i, i + j) of
c                               the tableau matrix b.
c       bl              ( o )   l1 - norm of b.
c       q(1 - m:m)        ( w )   internal work array.
c
c remark:
c ^^^
c
c       this subroutine is an adaptation of subroutine basis from the
c       paper by lyche et al. (1983). no checking is performed on the
c       validity of m and n. if the knot sequence is not strictly in -
c       creasing, division by zero may occur.
c
c reference:
c ^^^^ *
c
c       t. lyche, l.l. schumaker, k. sepehrnoori, fortran subroutines
c       for computing smoothing and interpolating natural splines.
c       advances in engineering software 5(1983)1, pp. 2 - 5.0
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
      end
c
      subroutine basis(m, n, x, b, bl, q)
      implicit double precision (o - z, a - h)
      parameter (zero = 0d0, one = 1d0)
c
      dimension x(n), b(1 - m:m - 1, n), q(1 - m:m)
c^ *         linear spline
      if (m == 1)
      for 3 i = 1: n
      b(0, i) = one
    3 continue
      bl = one
      return
c
c^ *  general splines
c
      end
      mm1 = m - 1
      mp1 = m + 1
      m2 = 2 * m
c^ *     1st row
      for 15 l = 1: n
      for 5 j = - mm1: m
      q(j) = zero
    5 continue
      q(mm1) = one
c^ *     successive rows
      if ((l != 1) && (l != n)) q(mm1) = one / (x(l + 1) - x(l - 1))
 end
      arg = x(l)
      for 13 i = 3: m2
      ir = mp1 - i
      v = q(ir)
c^ *               left - hand b - splines
      if (l < i)
      for 6 j = l + 1: i
      u = v
      v = q(ir + 1)
      q(ir) = u + ((x(j) - arg) * v)
      ir = ir + 1
    6 continue
      end
      j1 = max0((l - i) + 1, 1)
      j2 = min0(l - 1, n - i)
c^ *               ordinary b - splines
      if (j1 <= j2)
      if (i < m2)
      for 8 j = j1: j2
      y = x(i + j)
      u = v
      v = q(ir + 1)
      q(ir) = u + (((v - u) * (y - arg)) / (y - x(j)))
      ir = ir + 1
    8 continue
      else
      for 10 j = j1: j2
      u = v
      v = q(ir + 1)
      q(ir) = ((arg - x(j)) * u) + ((x(i + j) - arg) * v)
      ir = ir + 1
   10 continue
      end
      end
      nmip1 = (n - i) + 1
c^ *           right - hand b - splines
      if (nmip1 < l)
      for 12 j = nmip1: l - 1
      u = v
      v = q(ir + 1)
      q(ir) = ((arg - x(j)) * u) + v
      ir = ir + 1
   12 continue
      end
   13 continue
      for 14 j = - mm1: mm1
      b(j, l) = q(j)
   14 continue
c
c^ *  zero unused parts of b
c
   15 continue
      for 17 i = 1: mm1
      for 16 k = i: mm1
      b( - k, i) = zero
      b(k, (n + 1) - i) = zero
   16 continue
c
c^ *  assess l1 - norm of b
c
   17 continue
      bl = 0d0
      for 19 i = 1: n
      for 18 k = - mm1: mm1
      bl = bl + abs(b(k, i))
   18 continue
   19 continue
c
c^ *  ready
c
      bl = bl / n
      return
c prep.for, 1985 - 07 - 04
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
c subroutine prep (real * 8)
c
c purpose:
c ^^^ *
c
c       to compute the matrix we of weighted divided difference coeffi -
c       cients needed to set up a linear system of equations for sol -
c       ving b - spline smoothing problems, and its l1 - norm el. the matrix
c       we is stored in vectorized form.
c
c calling convention:
c ^^^^^^^^^
c
c       prep ( m, n, x, w, we, el )
c
c meaning of parameters:
c ^^^^^^^^^^ *
c
c       m               ( i )   half order of the b - spline (degree
c                               2 * m - 1), with m > 0.0
c       n               ( i )   number of knots, with n > = 2 * m.
c       x(n)            ( i )   strictly increasing knot array, with
c                               x(i - 1) < x(i), i = 2, n.
c       w(n)            ( i )   weight matrix (diagonal), with
c                               w(i) > 0.0, i = 1, n.
c       we( - m:m, n)      ( o )   array containing the weighted divided
c                               difference terms in vectorized format.
c                               element we(j, i) of array e corresponds
c                               with element e(i, i + j) of the matrix
c                               w^ - 1 * e.
c       el              ( o )   l1 - norm of we.
c
c remark:
c ^^^
c
c       this subroutine is an adaptation of subroutine prep from the pap
cer
c       by lyche et al. (1983). no checking is performed on the validity
c       of m and n. division by zero may occur if the knot sequence is
c       not strictly increasing.
c
c reference:
c ^^^^ *
c
c       t. lyche, l.l. schumaker, k. sepehrnoori, fortran subroutines
c       for computing smoothing and interpolating natural splines.
c       advances in engineering software 5(1983)1, pp. 2 - 5.0
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
      end
c
      subroutine prep(m, n, x, w, we, el)
      implicit double precision (o - z, a - h)
      parameter (zero = 0d0, one = 1d0)
c
c^ *  calculate the factor f1
c
cwe( - m:m, n)
      dimension x(n), w(n), we(((2 * m) + 1) * n)
      m2 = 2 * m
      mp1 = m + 1
      m2m1 = m2 - 1
      m2p1 = m2 + 1
      nm = n - m
      f1 = - one
      if (m != 1)
      for 5 i = 2: m
      f1 = - (f1 * i)
    5 continue
      for 6 i = mp1: m2m1
      f1 = f1 * i
    6 continue
c
c^ *  columnwise evaluation of the unweighted design matrix e
c
      end
      i1 = 1
      i2 = m
      jm = mp1
      for 17 j = 1: n
      inc = m2p1
      if (j > nm)
      f1 = - f1
      f = f1
      else
      if (j < mp1)
      inc = 1
      f = f1
      else
      f = f1 * (x(j + m) - x(j - m))
      end
      end
      if (j > mp1) i1 = i1 + 1
 end
      if (i2 < n) i2 = i2 + 1
 end
c^ *     loop for divided difference coefficients
      jj = jm
      ff = f
      y = x(i1)
      i1p1 = i1 + 1
      for 11 i = i1p1: i2
      ff = ff / (y - x(i))
   11 continue
      we(jj) = ff
      jj = jj + m2
      i2m1 = i2 - 1
      if (i1p1 <= i2m1)
      for 14 l = i1p1: i2m1
      ff = f
      y = x(l)
      for 12 i = i1: l - 1
      ff = ff / (y - x(i))
   12 continue
      for 13 i = l + 1: i2
      ff = ff / (y - x(i))
   13 continue
      we(jj) = ff
      jj = jj + m2
   14 continue
      end
      ff = f
      y = x(i2)
      for 16 i = i1: i2m1
      ff = ff / (y - x(i))
   16 continue
      we(jj) = ff
      jj = jj + m2
      jm = jm + inc
c
c^ *  zero the upper left and lower right corners of e
c
   17 continue
      kl = 1
      n2m = (m2p1 * n) + 1
      for 19 i = 1: m
      ku = (kl + m) - i
      for 18 k = kl: ku
      we(k) = zero
      we(n2m - k) = zero
   18 continue
      kl = kl + m2p1
c
c^ *  weighted matrix we = w^ - 1 * e and its l1 - norm
c
   19 continue
   20 jj = 0
      el = 0d0
      for 22 i = 1: n
      wi = w(i)
      for 21 j = 1: m2p1
      jj = jj + 1
      we(jj) = we(jj) / wi
      el = el + abs(we(jj))
   21 continue
   22 continue
c
c^ *  ready
c
      el = el / n
      return
c splc.for, 1985 - 12 - 12
c
c author: h.j. woltring
c
c organizations: university of nijmegen, and
c                philips medical systems, eindhoven
c                (the netherlands)
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
c function splc (real * 8)
c
c purpose:
c ^^^ *
c
c       to assess the coefficients of a b - spline and various statistical
c       parameters, for a given value of the regularization parameter p.
c
c calling convention:
c ^^^^^^^^^
c
c       fv = splc ( m, n, k, y, ny, wx, wy, mode, val, p, eps, c, nc,
c       1           stat, b, we, el, bwe)
c
c meaning of parameters:
c ^^^^^^^^^^ *
c
c       splc            ( o )   gcv function value if |mode| == 2,
c                               mse value if |mode| == 3, and absolute
c                               difference with the prior given number o
cf
c                               degrees of freedom if |mode| == 4.0
c       m               ( i )   half order of the b - spline (degree 2 * m - 1
c),
c                               with m > 0.0
c       n               ( i )   number of observations, with n > = 2 * m.
c       k               ( i )   number of datasets, with k > = 1.0
c       y(ny, k)         ( i )   observed measurements.
c       ny              ( i )   first dimension of y(ny, k), with ny >= n
c.
c       wx(n)           ( i )   weight factors, corresponding to the
c                               relative inverse variance of each measur
ce -
c                               ment, with wx(i) > 0.0.0
c       wy(k)           ( i )   weight factors, corresponding to the
c                               relative inverse variance of each datase
ct,
c                               with wy(j) > 0.0.0
c       mode            ( i )   mode switch, as described in gcvspl.
c       val             ( i )   prior variance if |mode| == 3, and
c                               prior number of degrees of freedom if
c                               |mode| == 4.0 for other values of mode,
c                               val is not used.
c       p               ( i )   smoothing parameter, with p > = 0.0.0 if
c                               p == 0.0, an interpolating spline is
c                               calculated.
c       eps             ( i )   relative rounding tolerance * 10.0.0 eps is
c                               the smallest positive number such that
c                               eps / 10.0 + 1.0 != 1.0.0
c       c(nc, k)         ( o )   calculated spline coefficient arrays. nb
c:
c                               the dimensions of in gcvspl and in splde
cr
c                               are different# In SPLDER, only a single
c                               column of c(n, k) is needed, and the prop
cer
c                               column c(1, j), with j = 1.0..k, should be u
csed
c                               when calling splder.
c       nc              ( i )   first dimension of c(nc, k), with nc >= n
c.
c       stat(6)         ( o )   statistics array. see the description in
c                               subroutine gcvspl.
c       b (1 - m:m - 1, n)   ( i )   b - spline tableau as evaluated by subrout
cine
c                               basis.
c       we( - m:m  , n)   ( i )   weighted b - spline tableau (w^ - 1 * e) as
c                               evaluated by subroutine prep.
c       el              ( i )   l1 - norm of the matrix we as evaluated by
c                               subroutine prep.
c       bwe( - m:m, n)     ( o )   central 2 * m + 1 bands of the inverted
c                               matrix ( b  +  p * w^ - 1 * e )^ - 1
c
c remarks:
c ^^^ *
c
c       this subroutine combines elements of subroutine splc0 from the
c       paper by lyche et al. (1983), and of subroutine spfit1 by
c       hutchinson (1985).
c
c references:
c ^^^^^
c
c       m.f. hutchinson (1985), subroutine cubgcv. csiro division of
c       mathematics and statistics, p.o. box 1965, canberra, act 2601,
c       australia.
c
c       t. lyche, l.l. schumaker, k. sepehrnoori, fortran subroutines
c       for computing smoothing and interpolating natural splines.
c       advances in engineering software 5(1983)1, pp. 2 - 5.0
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
      end
c
      function splc(m, n, k, y, ny, wx, wy, mode, val, p, eps, c, nc, stat, b, we, el, bwe)
      implicit double precision (o - z, a - h)
      parameter (zero = 0d0, one = 1d0, two = 2d0)
c
c^ *  check on p - value
c
      dimension y(ny, k), wx(n), wy(k), c(nc, k), stat(6), b(1 - m:m - 1, n), we( - m:m, n), bwe( - m:m, n)
      dp = p
      stat(4) = p
c^ *  pseudo - interpolation if p is too small
      pel = p * el
      if (pel < eps)
      dp = eps / el
      stat(4) = zero
c^ *  pseudo least - squares polynomial if p is too large
      end
      if ((pel * eps) > one)
      dp = one / (el * eps)
      stat(4) = dp
c
c^ *  calculate  bwe  =  b  +  p * w^ - 1 * e
c
      end
      for 40 i = 1: n
      km = - min0(m, i - 1)
      kp = min0(m, n - i)
      for 30 l = km: kp
      if (iabs(l) == m)
      bwe(l, i) = dp * we(l, i)
      else
      bwe(l, i) = b(l, i) + (dp * we(l, i))
      end
   30 continue
c
c^ *  solve bwe * c = y, and assess trace [ b * bwe^ - 1 ]
c
   40 continue
      bandet(bwe, m, n)
      bansol(bwe, y, ny, c, nc, m, n, k)
ctrace * p = res. d.o.
      stat(3) = trinv(we, bwe, m, n) * dp
c
c^ *  compute mean - squared weighted residual
c
      trn = stat(3) / n
      esn = zero
      for 70 j = 1: k
      for 60 i = 1: n
      dt = - y(i, j)
      km = - min0(m - 1, i - 1)
      kp = min0(m - 1, n - i)
      for 50 l = km: kp
      dt = dt + (b(l, i) * c(i + l, j))
   50 continue
      esn = esn + (((dt * dt) * wx(i)) * wy(j))
   60 continue
   70 continue
c
c^ *  calculate statistics and function value
c
      esn = esn / (n * k)
cestimated variance
      stat(6) = esn / trn
cgcv function value
      stat(1) = stat(6) / trn
c     stat(3) = trace [p * b * bwe^ - 1] #Estimated residuals" d.o.f.
c     stat(4) = p                     #Normalized smoothing factor
cmean squared residual
      stat(2) = esn
c^ *     unknown variance: gcv
      if (iabs(mode) != 3)
      stat(5) = stat(6) - esn
      if (iabs(mode) == 1) splc = zero
 end
      if (iabs(mode) == 2) splc = stat(1)
 end
      if (iabs(mode) == 4) splc = dabs(stat(3) - val)
 end
c^ *     known variance: estimated mean squared error
      else
      stat(5) = esn - (val * ((two * trn) - one))
      splc = stat(5)
c
      end
      return
c bandet.for, 1985 - 06 - 03
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
c subroutine bandet (real * 8)
c
c purpose:
c ^^^ *
c
c       this subroutine computes the lu decomposition of an n * n matrix
c       e. it is assumed that e has m bands above and m bands below the
c       diagonal. the decomposition is returned in e. it is assumed that
c       e can be decomposed without pivoting. the matrix e is stored in
c       vectorized form in the array e( - m:m, n), where element e(j, i) of
c       the array e corresponds with element e(i, i + j) of the matrix e.
c
c calling convention:
c ^^^^^^^^^
c
c       bandet ( e, m, n )
c
c meaning of parameters:
c ^^^^^^^^^^ *
c
c       e( - m:m, n)       (i / o)   matrix to be decomposed.
c       m, n            ( i )   matrix dimensioning parameters,
c                               m > = 0, n > = 2 * m.
c
c remark:
c ^^^
c
c       no checking on the validity of the input data is performed.
c       if (m <= 0), no action is taken.
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
      end
c
      subroutine bandet(e, m, n)
      implicit double precision (o - z, a - h)
c
      dimension e( - m:m, n)
      if (m <= 0) return
      for 40 i = 1: n
      di = e(0, i)
      mi = min0(m, i - 1)
      if (mi >= 1)
      for 10 k = 1: mi
      di = di - (e( - k, i) * e(k, i - k))
   10 continue
      e(0, i) = di
      end
      lm = min0(m, n - i)
      if (lm >= 1)
      for 30 l = 1: lm
      dl = e( - l, i + l)
      km = min0(m - l, i - 1)
      if (km >= 1)
      du = e(l, i)
      for 20 k = 1: km
      du = du - (e( - k, i) * e(l + k, i - k))
      dl = dl - (e(( - l) - k, l + i) * e(k, i - k))
   20 continue
      e(l, i) = du
      end
      e( - l, i + l) = dl / di
   30 continue
      end
c
c^ *  ready
c
   40 continue
      return
c bansol.for, 1985 - 12 - 12
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
c subroutine bansol (real * 8)
c
c purpose:
c ^^^ *
c
c       this subroutine solves systems of linear equations given an lu
c       decomposition of the design matrix. such a decomposition is pro -
c       vided by subroutine bandet, in vectorized form. it is assumed
c       that the design matrix is not singular.
c
c calling convention:
c ^^^^^^^^^
c
c       bansol ( e, y, ny, c, nc, m, n, k )
c
c meaning of parameters:
c ^^^^^^^^^^ *
c
c       e( - m:m, n)       ( i )   input design matrix, in lu - decomposed,
c                               vectorized form. element e(j, i) of the
c                               array e corresponds with element
c                               e(i, i + j) of the n * n design matrix e.
c       y(ny, k)         ( i )   right hand side vectors.
c       c(nc, k)         ( o )   solution vectors.
c       ny, nc, m, n, k ( i )   dimensioning parameters, with m > = 0,
c                               n > 2 * m, and k > = 1.0
c
c remark:
c ^^^
c
c       this subroutine is an adaptation of subroutine bansol from the
c       paper by lyche et al. (1983). no checking is performed on the
c       validity of the input parameters and data. division by zero may
c       occur if the system is singular.
c
c reference:
c ^^^^ *
c
c       t. lyche, l.l. schumaker, k. sepehrnoori, fortran subroutines
c       for computing smoothing and interpolating natural splines.
c       advances in engineering software 5(1983)1, pp. 2 - 5.0
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
      end
c
      subroutine bansol(e, y, ny, c, nc, m, n, k)
      implicit double precision (o - z, a - h)
c
c^ *  check on special cases: m = 0, m = 1, m>1
c
      dimension e( - m:m, n), y(ny, k), c(nc, k)
      nm1 = n - 1
c
c^ *  m = 0: diagonal system
c
      if (m - 1) 10, 40, 80
   10 for 30 i = 1: n
      for 20 j = 1: k
      c(i, j) = y(i, j) / e(0, i)
   20 continue
   30 continue
c
c^ *  m = 1: tridiagonal system
c
      return
   40 for 70 j = 1: k
      c(1, j) = y(1, j)
cforward sweep
      for 50 i = 2: n
      c(i, j) = y(i, j) - (e( - 1, i) * c(i - 1, j))
   50 continue
      c(n, j) = c(n, j) / e(0, n)
cbackward sweep
      for 60 i = nm1, 1: - 1
      c(i, j) = (c(i, j) - (e(1, i) * c(i + 1, j))) / e(0, i)
   60 continue
   70 continue
c
c^ *  m > 1: general system
c
      return
   80 for 130 j = 1: k
      c(1, j) = y(1, j)
cforward sweep
      for 100 i = 2: n
      mi = min0(m, i - 1)
      d = y(i, j)
      for 90 l = 1: mi
      d = d - (e( - l, i) * c(i - l, j))
   90 continue
      c(i, j) = d
  100 continue
      c(n, j) = c(n, j) / e(0, n)
cbackward sweep
      for 120 i = nm1, 1: - 1
      mi = min0(m, n - i)
      d = c(i, j)
      for 110 l = 1: mi
      d = d - (e(l, i) * c(i + l, j))
  110 continue
      c(i, j) = d / e(0, i)
  120 continue
  130 continue
c
      return
c trinv.for, 1985 - 06 - 03
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
c function trinv (real * 8)
c
c purpose:
c ^^^ *
c
c       to calculate trace [ b * e^ - 1 ], where b and e are n * n
c       matrices with bandwidth 2 * m + 1, and where e is a regular matrix
c       in lu - decomposed form. b and e are stored in vectorized form,
c       compatible with subroutines bandet and bansol.
c
c calling convention:
c ^^^^^^^^^
c
c       trace = trinv ( b, e, m, n )
c
c meaning of parameters:
c ^^^^^^^^^^ *
c
c       b( - m:m, n)       ( i ) input array for matrix b. element b(j, i)
c                             corresponds with element b(i, i + j) of the
c                             matrix b.
c       e( - m:m, n)       (i / o) input array for matrix e. element e(j, i)
c                             corresponds with element e(i, i + j) of the
c                             matrix e. this matrix is stored in lu -
c                             decomposed form, with l unit lower tri -
c                             angular, and u upper triangular. the unit
c                             diagonal of l is not stored. upon return,
c                             the array e holds the central 2 * m + 1 bands
c                             of the inverse e^ - 1, in similar ordering.
c       m, n            ( i ) array and matrix dimensioning parameters
c                             (m > 0, n >= 2 * m + 1).
c       trinv           ( o ) output function value trace [ b * e^ - 1 ]
c
c reference:
c ^^^^ *
c
c       a.m. erismanw.f. tinney, on computing certain elements of the
c       inverse of a sparse matrix. communications of the acm 18(1975),
c       nr. 3, pp. 177 - 179.0
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
      end
c
      double precision function trinv(b, e, m, n)
      implicit double precision (o - z, a - h)
      parameter (zero = 0d0, one = 1d0)
c
c^ *  assess central 2 * m + 1 bands of e^ - 1 and store in array e
c
      dimension b( - m:m, n), e( - m:m, n)
cnth pivot
      e(0, n) = one / e(0, n)
      for 40 i = n - 1, 1: - 1
      mi = min0(m, n - i)
c^ *     save ith column of l and ith row of u, and normalize u row
cith pivot
      dd = one / e(0, i)
      for 10 k = 1: mi
cith row of u (normalized)
      e(k, n) = e(k, i) * dd
cith column of l
      e( - k, 1) = e( - k, k + i)
   10 continue
c^ *     invert around ith pivot
      dd = dd + dd
      for 30 j = mi, 1: - 1
      du = zero
      dl = zero
      for 20 k = 1: mi
      du = du - (e(k, n) * e(j - k, i + k))
      dl = dl - (e( - k, 1) * e(k - j, i + j))
   20 continue
      e(j, i) = du
      e( - j, j + i) = dl
      dd = dd - ((e(j, n) * dl) + (e( - j, 1) * du))
   30 continue
      e(0, i) = 5d - 1 * dd
c
c^ *  assess trace [ b * e^ - 1 ] and clear working storage
c
   40 continue
      dd = zero
      for 60 i = 1: n
      mn = - min0(m, i - 1)
      mp = min0(m, n - i)
      for 50 k = mn: mp
      dd = dd + (b(k, i) * e( - k, k + i))
   50 continue
   60 continue
      trinv = dd
      for 70 k = 1: m
      e(k, n) = zero
      e( - k, 1) = zero
c
c^ *  ready
c
   70 continue
      return
c splder.for, 1985 - 06 - 11
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
c function splder (real * 8)
c
c purpose:
c ^^^ *
c
c       to produce the value of the function (ider == 0) or of the
c       iderth derivative (ider > 0) of a 2m - th order b - spline at
c       the point t. the spline is described in terms of the half
c       order m, the knot sequence x(n), n >= 2 * m, and the spline
c       coefficients c(n).
c
c calling convention:
c ^^^^^^^^^
c
c       svider = splder ( ider, m, n, t, x, c, l, q )
c
c meaning of parameters:
c ^^^^^^^^^^ *
c
c       splder  ( o )   function or derivative value.
c       ider    ( i )   derivative order required, with 0 <= ider
c                       and ider <= 2 * m. if ider == 0, the function
c                       value is returned; otherwise, the ider - th
c                       derivative of the spline is returned.
c       m       ( i )   half order of the spline, with m > 0.0
c       n       ( i )   number of knots and spline coefficients,
c                       with n >= 2 * m.
c       t       ( i )   argument at which the spline or its deri -
c                       vative is to be evaluated, with x(1) <= t
c                       and t <= x(n).
c       x(n)    ( i )   strictly increasing knot sequence array,
c                       x(i - 1) < x(i), i = 2, ..., n.
c       c(n)    ( i )   spline coefficients, as evaluated by
c                       subroutine gvcspl.
c       l       (i / o)   l contains an integer such that:
c                       x(l) <= t and t < x(l + 1) if t is within
c                       the range x(1) <= t and t < x(n). if
c                       t < x(1), l is set to 0, and if t >= x(n),
c                       l is set to n. the search for l is facili -
c                       tated if l has approximately the right
c                       value on entry.
c       q(2 * m)  ( w )   internal work array.
c
c remark:
c ^^^
c
c       this subroutine is an adaptation of subroutine splder of
c       the paper by lyche et al. (1983). no checking is performed
c       on the validity of the input parameters.
c
c reference:
c ^^^^ *
c
c       t. lyche, l.l. schumaker, k. sepehrnoori, fortran subroutines
c       for computing smoothing and interpolating natural splines.
c       advances in engineering software 5(1983)1, pp. 2 - 5.0
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
      end
c
      double precision function splder(ider, m, n, t, x, c, l, q)
      implicit double precision (o - z, a - h)
      parameter (zero = 0d0, one = 1d0)
cf2py intent(out) :: splder
cf2py intent(hide) :: q
c
c^ *  derivatives of ider >= 2 * m are alway zero
c
      dimension x(n), c(n), q(2 * m)
      m2 = 2 * m
      k = m2 - ider
      if (k < 1)
      splder = zero
      return
c
c^ *  search for the interval value l
c
      end
c
c^ *  initialize parameters and the 1st row of the b - spline
c^ *  coefficients tableau
c
      search(n, x, t, l)
      tt = t
      mp1 = m + 1
      npm = n + m
      m2m1 = m2 - 1
      k1 = k - 1
      nk = n - k
      lk = l - k
      lk1 = lk + 1
      lm = l - m
      jl = l + 1
      ju = l + m2
      ii = n - m2
      ml = - l
      for 2 j = jl: ju
      if ((j >= mp1) && (j <= npm))
      q(j + ml) = c(j - m)
      else
      q(j + ml) = zero
      end
c
c^ *  the following loop computes differences of the b - spline
c^ *  coefficients. if the value of the spline is required,
c^ *  differencing is not necessary.
c
    2 continue
      if (ider > 0)
      jl = jl - m2
      ml = ml + m2
      for 6 i = 1: ider
      jl = jl + 1
      ii = ii + 1
      j1 = max0(1, jl)
      j2 = min0(l, ii)
      mi = m2 - i
      j = j2 + 1
      if (j1 <= j2)
      for 3 jin = j1: j2
      j = j - 1
      jm = ml + j
      q(jm) = (q(jm) - q(jm - 1)) / (x(j + mi) - x(j))
    3 continue
      end
      if (jl >= 1) #FIXME goto 6
      i1 = i + 1
      j = ml + 1
      if (i1 <= ml)
      for 5 jin = i1: ml
      j = j - 1
      q(j) = - q(j - 1)
    5 continue
      end
    6 continue
      for 7 j = 1: k
      q(j) = q(j + ider)
    7 continue
c
c^ *  compute lower half of the evaluation tableau
c
      end
ctableau ready if ider == 2 * m - 1
      if (k1 >= 1)
      for 14 i = 1: k1
      nki = nk + i
      ir = k
      jj = l
      ki = k - i
c^ *        right - hand b - splines
      nki1 = nki + 1
      if (l >= nki1)
      for 9 j = nki1: l
      q(ir) = q(ir - 1) + ((tt - x(jj)) * q(ir))
      jj = jj - 1
      ir = ir - 1
    9 continue
c^ *        middle b - splines
      end
      lk1i = lk1 + i
      j1 = max0(1, lk1i)
      j2 = min0(l, nki)
      if (j1 <= j2)
      for 11 j = j1: j2
      xjki = x(jj + ki)
      z = q(ir)
      q(ir) = z + (((xjki - tt) * (q(ir - 1) - z)) / (xjki - x(jj)))
      ir = ir - 1
      jj = jj - 1
   11 continue
c^ *        left - hand b - splines
      end
      if (lk1i <= 0)
      jj = ki
      lk1i1 = 1 - lk1i
      for 13 j = 1: lk1i1
      q(ir) = q(ir) + ((x(jj) - tt) * q(ir - 1))
      jj = jj - 1
      ir = ir - 1
   13 continue
      end
   14 continue
c
c^ *  compute the return value
c
      end
c^ *  multiply with factorial if ider > 0
      z = q(k)
      if (ider > 0)
      for 16 j = k: m2m1
      z = z * j
   16 continue
      end
c
c^ *  ready
c
      splder = z
      return
c search.for, 1985 - 06 - 03
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
c subroutine search (real * 8)
c
c purpose:
c ^^^ *
c
c       given a strictly increasing knot sequence x(1) < ... < x(n),
c       where n > = 1, and a real number t, this subroutine finds the
c       value l such that x(l) < = t < x(l + 1).  if t < x(1), l = 0;
 end
c       if x(n) < = t, l = n.
 end
c
c calling convention:
c ^^^^^^^^^
c
c       search ( n, x, t, l )
c
c meaning of parameters:
c ^^^^^^^^^^ *
c
c       n       ( i )   knot array dimensioning parameter.
c       x(n)    ( i )   stricly increasing knot array.
c       t       ( i )   input argument whose knot interval is to
c                       be found.
c       l       (i / o)   knot interval parameter. the search procedure
c                       is facilitated if l has approximately the
c                       right value on entry.
c
c remark:
c ^^^
c
c       this subroutine is an adaptation of subroutine search from
c       the paper by lyche et al. (1983). no checking is performed
c       on the input parameters and data; the algorithm may fail if
c       the input sequence is not strictly increasing.
c
c reference:
c ^^^^ *
c
c       t. lyche, l.l. schumaker, k. sepehrnoori, fortran subroutines
c       for computing smoothing and interpolating natural splines.
c       advances in engineering software 5(1983)1, pp. 2 - 5.0
c
c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *
c
      end
c
      subroutine search(n, x, t, l)
      implicit double precision (o - z, a - h)
c
      dimension x(n)
c^ *     out of range to the left
      if (t < x(1))
      l = 0
      return
      end
c^ *     out of range to the right
      if (t >= x(n))
      l = n
      return
c^ *  validate input value of l
      end
      l = max0(l, 1)
c
c^ *  often l will be in an interval adjoining the interval found
c^ *  in a previous to search
c
      if (l >= n) l = n - 1
 end
      if (t >= x(l)) #FIXME goto 5
      l = l - 1
c
c^ *  perform bisection
c
      if (t >= x(l)) return
      il = 1
    3 iu = l
    4 l = (il + iu) / 2
      if ((iu - il) <= 1) return
      if (t < x(l)) #FIXME goto 3
      il = l
      #FIXME goto 4
    5 if (t < x(l + 1)) return
      l = l + 1
      if (t < x(l + 1)) return
      il = l + 1
      iu = n
c
      #FIXME goto 4
      end


function nlp_cvx_105_013(
    optimizer,
    objective_tol,
    primal_tol,
    dual_tol,
    termination_target = TERMINATION_TARGET_LOCAL,
    primal_target = PRIMAL_TARGET_LOCAL,
)
    model = Model(optimizer)

    @variable(model, x, start = 0.1)
    @variable(model, y)

    @objective(model, Min, -x + y)
    @NLconstraint(model, exp(x - 2.0) - 0.5 <= y)
    @NLconstraint(model, log(x) + 0.5 >= y)

    optimize!(model)

    check_status(model, FEASIBLE_PROBLEM, termination_target, primal_target)
    check_objective(model, -3 / 2, tol = objective_tol)
    return check_solution([x, y], [2, 1 / 2], tol = primal_tol)
end


export Random

"""
    Random(;args)

Randomly generated initial data, based on provided (optional arguments) :
- `L` is the typical wavelength (default is `L=1`)
- `s` is the (real) Sobolev index regularity (default is `s=∞`)
- `λ` is the length of spatial localization (default is none)

The initial data `(η,v)` are generated through randomly chosen Fourier coefficients,
multiplied with weigth `w=10^(-|k|L/(2π))` if `s=∞`, or `w=1/(1+9(|k|L/(2π))^(s+1/2))` otherwise.
If `λ` is provided, the function in spatial variables is multiplied by `exp(-|x/λ|^2)`,
and in any case normalized to have maximum absolute value 1.

"""
struct Random <: InitialData

    η
    v

    function Random(;L=1,s=Inf,λ=nothing)

        function generate( x )

            k = Mesh( x ).k
            if s == Inf
                w = 10 .^(-abs.(k*L/(2*π)))
            else
                w = 1 ./( 1 .+ 9*abs.(k*L/(2*π)).^(s+1/2) )
            end
            if λ == nothing
                φ = zero(x).+1
            else
                φ = exp.(-abs.((x/λ).^2))
            end

            θ = 2*π*rand(Float64,length(x))
            r = rand(Float64,length(x))
            Fourier = r.*exp.(-1im.*θ).*w
            Physic = real.(ifft(Fourier)).*φ
            return Physic./maximum(abs.(Physic))
        end
        η( x ) = generate( x )
        v( x ) = generate( x )

    	new( η,v )

    end

end


####### Routines related to Chebyshev interpolation or polynomials that are not about
#   evaluation nor interpolation set up.

# scale x ∈ [a,b] to [-1,1].
function scaletoChebyinterval(x::T, a::T, b::T)::T where T
    @assert a <= x <= b
    @assert b > a # disallow empty interval.

    Δ::T = b-a
    return (x-a)/Δ*convert(T,2) - one(T)
end

# scale y ∈ [-1,1] to [a,b].
function scalefromChebyinterval(y::T, a::T, b::T)::T where T
    @assert -one(T) <= y <= one(T)

    Δ::T = b-a
    return (y+1)/2*Δ + a
end

function Chebyshev2nd(x::T, L::Int)::T where T
    two = one(T) + one(T)

    out = zero(T)
    for l = 0:div(L,2)
        out += (-one(Int))^l*binomial(L-l,l)*(two*x)^(L-2*l)
    end

    return out
end

function Chebyshev1stall(x::T, L::Int)::Vector{T} where T
    @assert L >= 2

    # setup.
    two = one(T)+one(T)

    out = Vector{T}(undef,L+1)
    out[1] = one(T)
    out[2] = x
    for i = 3:length(out)
        out[i] = two*x*out[i-1] - out[i-2]
    end

    return out
end

function Chebyshev1st(x::T, L::Int)::T where T
    @assert L >= 0

    @assert isnumericallyin(x,-one(T),one(T))
    clamp(x,-one(T),one(T))

    return cos(convert(T,L)*acos(x))
end

# fill array with function
# equivalent to: collect( 𝝋[j](y[i]) for j = 1:n+1 for i = 1:m+1 ), but transposed.
function getunivariateChebyVmatrix(𝓧::Vector{T}, L::Int) where T
    p = length(𝓧)
    V = Matrix{T}(undef,L+1,p)

    for j = 1:p
        V[:,j] = Chebyshev1stall(𝓧[j],L)
    end

    return V
end

function Chebyshev1stnodes(Lp1::Int)::Vector{BigFloat}
    L = Lp1 - 1
    half = BigFloat("0.5")
    return collect( cos( (BigFloat(L-i)+half)*BigFloat(π)/BigFloat(L+1) ) for i = 0:L+1 )
end

function Chebyshev2ndnodes(L::Int)::Vector{BigFloat}
    return collect( cos( (L-i)*BigFloat(π)/BigFloat(L) ) for i = 0:L+1 )
end

function Chebyshev2ndnode(i::Int, L::Int)::BigFloat
    return cos( (L-i)*BigFloat(π)/BigFloat(L) )
end

# Colleague matrix for a L-degree Chebyshev polynomial of the mth kind.
function constructcolleaguematrix(c::Vector{T}, m::Int) where T
    @assert m == 1 || m == 2

    L = length(c) - 1

    while isnumericallyclose(c[L+1], zero(T), 1e-9) && L > 2
        L -= 1
    end

    # pre-compute.
    two = convert(T,2)
    half = one(T)/two

    C = zeros(T,L,L)
    C[2,1] = half

    # fill out the band.
    for l = 2:L-1
        C[l-1,l] = half
        C[l+1,l] = half
    end
    C[L-1,L] = half

    if m == 1
        C[1,2] = one(T)
    end

    # fill out bottom row.
    for l = 1:L
        C[L,l] = -c[l]/(two*c[L+1])
    end

    C[L,L-1] += half

    return C
end

# polynomial basis is Chebyshev polynomials of the m-th kind.
# coeffs are a_k for m = 1
# coeffs are c_k-1 = k*a_k for m = 2
function findChebyitproots(a::Vector{T}, m::Int)::Vector{T} where T
    if count(!isnumericallyclose(a[i],zero(T)) for i = 1:length(a)) < 2
        # case, a is the zero vector or a has less than 2 non-zero entries.
        #   The latter case means constant term and linear term. No local extrema.
        return Vector{T}(undef,0)
    end

    C = constructcolleaguematrix(a,m)

    return findChebyitproots(C)
end

function findChebyitproots(C::Matrix{T})::Vector{T} where T
    C_eig = LinearAlgebra.eigen(convert(Matrix{Float64},C))
    𝑧 = convert(Vector{T}, real.(C_eig.values))
    unique!(𝑧)
    filter!(xx->isnumericallyin(xx,-one(T),one(T)), 𝑧)
    clamp!(𝑧,-one(T),one(T))

    return 𝑧
end

function findChebyitpextrema(a::Vector{T}) where T
    L = length(a)-1

    c = collect( k*a[k+1] for k = 1:L)

    extrema_positions = findChebyitproots(c,2)

    return extrema_positions
end

# remove roots that do not have a zero derivative.
function findChebyitpextremawithchk(a::Vector{T}, tol::T = convert(T,0.2)) where T
    X = findChebyitpextrema(a)

    𝑑itp_X = evalunivariateChebyshevpolynomialderivative(a,X)

    remove_list = Vector{Int}(undef,0)
    for i = 1:length(X)
        if !isnumericallyclose(𝑑itp_X[i],zero(T),tol)
            push!(remove_list,i)
        end
    end

    deleteat!(X,remove_list)

    return X
end

# N is the number of samples to take between each reference position.
# 𝓧 is the set of reference positions.
function findChebyitpextremainterval(  𝑒::Function,
                                    L::Int,
                                    𝓟_in::Vector{T},
                                    tol_𝓧_spacing, # was defaulted to convert(T,1e-6/length(𝓟_in)
                                    tol_derivative_zero) where T

    ### get roots.
    sample_position_template = collect( Chebyshev2ndnode(k,L) for k = 0:L )
    out, d_set, X_set = getextremafromroots(𝑒, L, 𝓟_in,
                                            sample_position_template,
                                            tol_𝓧_spacing, tol_derivative_zero)

    # check each point in out to see if its a stationary point.
    chkfunc = xx->numericalchkextrema(𝑒, xx, tol_derivative_zero)
    filter!(chkfunc,out)

    sort!(out)
    unique!(out)

    return out, d_set, X_set
end

function discreteinnerprod(f::Function, g::Function, L::Int)

    ν = collect( Chebyshev2ndnode(k,L) for k = 0:L )

    term1 = 1/2 * f(ν[1]) * g(ν[1])

    term2 = BigFloat("0")
    for l = 1:L-1
        term2 += f(ν[l+1]) * g(ν[l+1])
    end

    term3 = 1/2 * f(ν[L+1]) * g(ν[L+1])

    return term1 + term2 + term3
end


# export  fit_cubic_spline,
#       sample_spline,
#       sample_spline_derivative,
#       sample_spline_derivative2,
#       sample_spline_speed,
#       sample_spline_theta,
#       sample_spline_curvature,
#       sample_spline_derivative_of_curvature,
#       calc_curve_length,
#       arclength,
#       calc_curve_param_given_arclen

function _integrate_simpsons(f::Function, a::Real, b::Real, n::Int)
    # integrate using Composite Simpson's rule
    # reference: https://en.wikipedia.org/wiki/Simpson%27s_rule

    @assert(n > 0) # number of intervals
    @assert(mod(n,2) == 0) # n must be even

    h = (b-a)/n
    retval = f(a) + f(b)
    flip = true
    for i = 1 : n-1
        retval += f(a+i*h) * (flip ? 4 : 2)
        flip = !flip
    end
    return h/3*retval
end

function _fit_open(pts::AbstractVector{Float64} )
    # fits the 1-D spline such that:
    #   spline goes through each point
    #   first and second derivatives match at each inner point
    #   the second derivative at the ends is zero
    # see: http://mathworld.wolfram.com/CubicSpline.html

    # this function returns a 4×(n-1) spline coefficient matrix, where n = |pts|

    n = length(pts)-1
    @assert(n > 0)

    M = spzeros(n+1,n+1)
    for i = 1 : n
        M[i,i] = 4
        M[i,i+1] = 1
        M[i+1,i] = 1
    end
    M[n+1,n+1] = 2
    M[1,1] = 2

    Y = Array{Float64}(n+1)
    for i = 1 : n+1
        ind_hi = min(i+1,n)
        ind_lo = max(1,i-1)
        Y[i] = 3*(pts[ind_hi] - pts[ind_lo])
    end

    D = M\Y

    spline_coeffs = Array{Float64}(4, n) # col is <a,b,c,d>
    spline_coeffs[1,:] = pts[1:n]
    spline_coeffs[2,:] = D[1:n]
    spline_coeffs[3,:] = 3*(pts[2:n+1] - pts[1:n]) -2*D[1:n]-D[2:n+1]
    spline_coeffs[4,:] = 2*(pts[1:n] - pts[2:n+1]) + D[1:n] + D[2:n+1]

    spline_coeffs
end
function _fit_closed(pts::AbstractVector{Float64} )
    # fits the 1-D spline such that:
    #   spline goes through each point
    #   first and second derivatives match at each inner point
    #   first the second derivative at the ends match
    # see: http://mathworld.wolfram.com/CubicSpline.html

    # this function returns a 4×n spline coefficient matrix, where n = |pts|

    n = length(pts)-1
    @assert(n > 0)

    M = spzeros(n+1,n+1)
    for i = 1 : n
        M[i,i] = 4
        M[i,i+1] = 1
        M[i+1,i] = 1
    end
    M[n+1,n+1] = 4
    M[1,n+1] = 1
    M[n+1,1] = 1

    Y = Array{Float64}(n+1)
    Y[1] = 3*(pts[2] - pts[n+1])
    for i = 2 : n
        Y[i] = 3*(pts[i+1] - pts[i-1])
    end
    Y[end] = 3*(pts[1] - pts[n])

    D = M\Y

    spline_coeffs = Array{Float64}(4, n+1) # col is <a,b,c,d>
    spline_coeffs[1,:] = pts
    spline_coeffs[2,:] = D
    spline_coeffs[3,1:n] = 3*(pts[2:n+1] - pts[1:n]) -2*D[1:n]-D[2:n+1]
    spline_coeffs[4,1:n] = 2*(pts[1:n] - pts[2:n+1]) + D[1:n] + D[2:n+1]
    spline_coeffs[3,n+1] = 3*(pts[1] - pts[n+1]) -2*D[n+1]-D[1]
    spline_coeffs[4,n+1] = 2*(pts[n+1] - pts[1]) + D[n+1] + D[1]

    spline_coeffs
end
function _fit_open(pts::Matrix{Float64}) # 2×n {x,y}

    # see http://mathworld.wolfram.com/CubicSpline.html

    d,n = size(pts)
    n -= 1

    Y = Array{Float64}(n+1)

    M = sparse(Int[], Int[], Float64[], n+1,n+1)
    for i in 1 : n
        M[i,i] = 4.0
        M[i,i+1] = 1.0
        M[i+1,i] = 1.0
    end
    M[n+1,n+1] = 2.0
    M[1,1] = 2.0

    retval = Array{Matrix{Float64}}(d)
    for k in 1 : d

        for i in 1 : n+1
            ind_hi = min(i+1,n)
            ind_lo = max(1,i-1)
            Y[i] = 3*(pts[k,ind_hi] - pts[k,ind_lo])
        end

        D = M \ Y

        spline_coeffs = Array{Float64}(4, n) # col is <a,b,c,d> for a + b⋅t + c⋅t² + d⋅t³
        spline_coeffs[1,:] = pts[k,1:n] # x₀
        spline_coeffs[2,:] = D[1:n]     # x'₀
        spline_coeffs[3,:] = 3*(pts[k,2:n+1]' - pts[k,1:n]') -2*D[1:n] - D[2:n+1] # -3x₀ + 3x₁ - 2x'₀ - x'₁
        spline_coeffs[4,:] = 2*(pts[k,1:n]' - pts[k,2:n+1]') +  D[1:n] + D[2:n+1] #  2x₀ - 2x₁ +  x'₀ + x'₁

        retval[k] = spline_coeffs
    end
    retval
end
function _fit_closed(pts::AbstractMatrix{Float64})
    d = size(pts,1)
    retval = Array{Matrix{Float64}}(d)
    for i = 1 : d
        retval[i] = _fit_closed(vec(pts[i,:]))
    end
    retval
end

function fit_cubic_spline(pts::AbstractArray{Float64}; open::Bool=true)
    if open
        return _fit_open(pts)
    else
        return _fit_closed(pts)
    end
end

function sample_spline(spline_coeffs::AbstractVector{Float64}, t::Float64)
    # here t is generally expected to be t ∈ [0,1]
    return spline_coeffs[1] + t*(spline_coeffs[2] + t*(spline_coeffs[3] + t*spline_coeffs[4]))
end
function sample_spline(spline_coeffs::AbstractMatrix{Float64}, t::Float64)
    # for t ∈ (-∞,1] we use spline_coeffs[:,1]
    # for t ∈ [1,2] we use spline_coeffs[:,2]
    # etc.
    @assert(size(spline_coeffs, 1) == 4)
    col_ind = clamp(ceil(Int, t), 1, size(spline_coeffs,2))
    sample_spline(spline_coeffs[:,col_ind], t-col_ind+1)
end
function sample_spline(spline_coeffs::AbstractVector{Float64}, t_arr::AbstractVector{Float64})
    # here t is generally expected to be t ∈ [0,1]

    a = spline_coeffs[1]
    b = spline_coeffs[2]
    c = spline_coeffs[3]
    d = spline_coeffs[4]

    retval = Array{Float64}(length(t_arr))
    for (i,t) in enumerate(t_arr)
        retval[i] = a + t*(b + t*(c + t*d))
    end
    retval
end
function sample_spline(spline_coeffs::AbstractMatrix{Float64}, t_arr::AbstractVector{Float64})
    # for t ∈ (-∞,1] we use spline_coeffs[:,1]
    # for t ∈ [1,2] we use spline_coeffs[:,2]
    # etc.
    @assert(size(spline_coeffs, 1) == 4)
    retval = Array{Float64}(length(t_arr))
    for (i,t) in enumerate(t_arr)
        col_ind = clamp(ceil(Int, t), 1, size(spline_coeffs,2))
        retval[i] = sample_spline(spline_coeffs[:,col_ind], t-col_ind+1)
    end
    retval
end

function sample_spline_derivative(spline_coeffs::AbstractVector{Float64}, t::Float64)
    # here t is generally expected to be t ∈ [0,1]
    return spline_coeffs[2] + t*(2spline_coeffs[3] + t*3spline_coeffs[4])
end
function sample_spline_derivative(spline_coeffs::AbstractMatrix{Float64}, t::Float64)
    # for t ∈ (-∞,1] we use spline_coeffs[:,1]
    # for t ∈ [1,2] we use spline_coeffs[:,2]
    # etc.
    @assert(size(spline_coeffs, 1) == 4)
    col_ind = clamp(ceil(Int, t), 1, size(spline_coeffs,2))
    sample_spline_derivative(spline_coeffs[:,col_ind], t-col_ind+1)
end
function sample_spline_derivative(spline_coeffs::AbstractVector{Float64}, t_arr::AbstractVector{Float64})
    # here t is generally expected to be t ∈ [0,1]

    b = spline_coeffs[2]
    c = spline_coeffs[3]
    d = spline_coeffs[4]

    retval = Array{Float64}(length(t_arr))
    for (i,t) in enumerate(t_arr)
        retval[i] = b + t*(2c + t*3d)
    end
    retval
end
function sample_spline_derivative(spline_coeffs::AbstractMatrix{Float64}, t_arr::AbstractVector{Float64})
    # for t ∈ (-∞,1] we use spline_coeffs[:,1]
    # for t ∈ [1,2] we use spline_coeffs[:,2]
    # etc.
    @assert(size(spline_coeffs, 1) == 4)
    retval = Array{Float64}(length(t_arr))
    for (i,t) in enumerate(t_arr)
        col_ind = clamp(ceil(Int, t), 1, size(spline_coeffs,2))
        retval[i] = sample_spline_derivative(spline_coeffs[:,col_ind], t-col_ind+1)
    end
    retval
end

function sample_spline_derivative2(spline_coeffs::AbstractVector{Float64}, t::Float64)
    # here t is generally expected to be t ∈ [0,1]
    return 2spline_coeffs[3] + t*6spline_coeffs[4]
end
function sample_spline_derivative2(spline_coeffs::AbstractMatrix{Float64}, t::Float64)
    # for t ∈ (-∞,1] we use spline_coeffs[:,1]
    # for t ∈ [1,2] we use spline_coeffs[:,2]
    # etc.
    @assert(size(spline_coeffs, 1) == 4)
    col_ind = clamp(ceil(Int, t), 1, size(spline_coeffs,2))
    sample_spline_derivative2(spline_coeffs[:,col_ind], t-col_ind+1)
end
function sample_spline_derivative2(spline_coeffs::AbstractVector{Float64}, t_arr::AbstractVector{Float64})
    # here t is generally expected to be t ∈ [0,1]

    b = spline_coeffs[2]
    c = spline_coeffs[3]
    d = spline_coeffs[4]

    retval = Array{Float64}(length(t_arr))
    for (i,t) in enumerate(t_arr)
        retval[i] = 2c + t*6d
    end
    retval
end
function sample_spline_derivative2(spline_coeffs::AbstractMatrix{Float64}, t_arr::AbstractVector{Float64})
    # for t ∈ (-∞,1] we use spline_coeffs[:,1]
    # for t ∈ [1,2] we use spline_coeffs[:,2]
    # etc.
    @assert(size(spline_coeffs, 1) == 4)
    retval = Array{Float64}(length(t_arr))
    for (i,t) in enumerate(t_arr)
        col_ind = clamp(ceil(Int, t), 1, size(spline_coeffs,2))
        retval[i] = sample_spline_derivative2(spline_coeffs[:,col_ind], t-col_ind+1)
    end
    retval
end

function sample_spline_speed(spline_coeffs_x::AbstractVector{Float64}, spline_coeffs_y::AbstractVector{Float64}, t::Float64)
    dxdt = sample_spline_derivative(spline_coeffs_x, t)
    dydt = sample_spline_derivative(spline_coeffs_y, t)
    hypot(dxdt, dydt)
end
function sample_spline_speed(spline_coeffs_x::AbstractMatrix{Float64}, spline_coeffs_y::AbstractMatrix{Float64}, t::Float64)
    # for t ∈ (-∞,1] we use spline_coeffs[:,1]
    # for t ∈ [1,2] we use spline_coeffs[:,2]
    # etc.
    n = size(spline_coeffs_x, 2)
    @assert(size(spline_coeffs_x, 1) == 4)
    @assert(size(spline_coeffs_y, 1) == 4)
    @assert(n == size(spline_coeffs_y, 2))
    col_ind = clamp(ceil(Int, t), 1, n)::Int
    sample_spline_speed(spline_coeffs_x[:,col_ind], spline_coeffs_y[:,col_ind], t-col_ind+1)
end
function sample_spline_speed(spline_coeffs_x::AbstractVector{Float64}, spline_coeffs_y::AbstractVector{Float64}, t_arr::AbstractVector{Float64})
    # here t is generally expected to be t ∈ [0,1]

    bx = spline_coeffs_x[2]
    cx = spline_coeffs_x[3]
    dx = spline_coeffs_x[4]

    by = spline_coeffs_y[2]
    cy = spline_coeffs_y[3]
    dy = spline_coeffs_y[4]

    retval = Array{Float64}(length(t_arr))
    for (i,t) in enumerate(t_arr)
        dxdt = bx + t*(2cx + t*3dx)
        dydt = by + t*(2cy + t*3dy)
        retval[i] = hypot(dxdt, dydt)
    end
    retval
end
function sample_spline_speed(spline_coeffs_x::AbstractMatrix{Float64}, spline_coeffs_y::AbstractMatrix{Float64}, t_arr::AbstractVector{Float64})
    # for t ∈ (-∞,1] we use spline_coeffs[:,1]
    # for t ∈ [1,2] we use spline_coeffs[:,2]
    # etc.

    n = size(spline_coeffs_x, 2)
    @assert(size(spline_coeffs_x, 1) == 4)
    @assert(size(spline_coeffs_y, 1) == 4)
    @assert(n == size(spline_coeffs_y, 2))
    retval = Array{Float64}(length(t_arr))
    for (i,t) in enumerate(t_arr)
        col_ind = clamp(ceil(Int, t), 1, n)
        retval[i] = sample_spline_speed(spline_coeffs_x[:,col_ind], spline_coeffs_y[:,col_ind], t-col_ind+1)
    end
    retval
end

function sample_spline_theta(spline_coeffs_x::AbstractVector{Float64}, spline_coeffs_y::AbstractVector{Float64}, t::Float64;
    stepsize=1e-4
    )

    # compute the angle from positive x-axis (counter-clockwise positive) of the curve in the positive t direction at t
    # uses an approximation via small step size instead of derivative due to zero-derivative issues
    # uses the forward derivative approximation unless it would put it out of range
    # result returned is in radians

    t_lo, t_hi = t, t+stepsize
    if t_hi > 1.0
        t_lo, t_hi = t-min(1000stepsize,0.1), t
    end

    x1 = sample_spline(spline_coeffs_x, t_lo)
    x2 = sample_spline(spline_coeffs_x, t_hi)
    y1 = sample_spline(spline_coeffs_y, t_lo)
    y2 = sample_spline(spline_coeffs_y, t_hi)

    # println("(t, lo, hi)  $t   $t_lo   $t_hi, ($(atan2(y2-y1, x2-x1)))")

    atan2(y2-y1, x2-x1)
end
function sample_spline_theta(spline_coeffs_x::AbstractMatrix{Float64}, spline_coeffs_y::AbstractMatrix{Float64}, t::Float64)
    # for t ∈ (-∞,1] we use spline_coeffs[:,1]
    # for t ∈ [1,2] we use spline_coeffs[:,2]
    # etc.
    n = size(spline_coeffs_x, 2)
    @assert(size(spline_coeffs_x, 1) == 4)
    @assert(size(spline_coeffs_y, 1) == 4)
    @assert(n == size(spline_coeffs_y, 2))
    col_ind = clamp(ceil(Int, t), 1, n)
    sample_spline_theta(spline_coeffs_x[:,col_ind], spline_coeffs_y[:,col_ind], t-col_ind+1)
end
function sample_spline_theta(spline_coeffs_x::AbstractVector{Float64}, spline_coeffs_y::AbstractVector{Float64}, t_arr::AbstractVector{Float64})
    # here t is generally expected to be t ∈ [0,1]

    retval = Array{Float64}(length(t_arr))
    for (i,t) in enumerate(t_arr)
        retval[i] = sample_spline_theta(spline_coeffs_x, spline_coeffs_y, t)
    end
    retval
end
function sample_spline_theta(spline_coeffs_x::AbstractMatrix{Float64}, spline_coeffs_y::AbstractMatrix{Float64}, t_arr::AbstractVector{Float64})
    # for t ∈ (-∞,1] we use spline_coeffs[:,1]
    # for t ∈ [1,2] we use spline_coeffs[:,2]
    # etc.

    n = size(spline_coeffs_x, 2)
    @assert(size(spline_coeffs_x, 1) == 4)
    @assert(size(spline_coeffs_y, 1) == 4)
    @assert(n == size(spline_coeffs_y, 2))
    retval = Array{Float64}(length(t_arr))
    for (i,t) in enumerate(t_arr)
        col_ind = clamp(ceil(Int, t), 1, n)
        retval[i] = sample_spline_theta(spline_coeffs_x[:,col_ind], spline_coeffs_y[:,col_ind], t-col_ind+1)
    end
    retval
end

function sample_spline_curvature(spline_coeffs_x::AbstractVector{Float64}, spline_coeffs_y::AbstractVector{Float64}, t::Float64)
    # computes the signed curvature

    dx  = sample_spline_derivative( spline_coeffs_x, t)
    dy  = sample_spline_derivative( spline_coeffs_y, t)
    ddx = sample_spline_derivative2(spline_coeffs_x, t)
    ddy = sample_spline_derivative2(spline_coeffs_y, t)

    (dx*ddy - dy*ddx)/(dx*dx + dy*dy)^1.5
end
function sample_spline_curvature(spline_coeffs_x::AbstractMatrix{Float64}, spline_coeffs_y::AbstractMatrix{Float64}, t::Float64)
    # for t ∈ (-∞,1] we use spline_coeffs[:,1]
    # for t ∈ [1,2] we use spline_coeffs[:,2]
    # etc.
    n = size(spline_coeffs_x, 2)
    @assert(size(spline_coeffs_x, 1) == 4)
    @assert(size(spline_coeffs_y, 1) == 4)
    @assert(n == size(spline_coeffs_y, 2))
    col_ind = clamp(ceil(Int, t), 1, n)
    sample_spline_curvature(spline_coeffs_x[:,col_ind], spline_coeffs_y[:,col_ind], t-col_ind+1)
end
function sample_spline_curvature(spline_coeffs_x::AbstractVector{Float64}, spline_coeffs_y::AbstractVector{Float64}, t_arr::AbstractVector{Float64})
    # here t is generally expected to be t ∈ [0,1]

    retval = Array{Float64}(length(t_arr))
    for (i,t) in enumerate(t_arr)
        retval[i] = sample_spline_curvature(spline_coeffs_x, spline_coeffs_y, t)
    end
    retval
end
function sample_spline_curvature(spline_coeffs_x::AbstractMatrix{Float64}, spline_coeffs_y::AbstractMatrix{Float64}, t_arr::AbstractVector{Float64})
    # for t ∈ (-∞,1] we use spline_coeffs[:,1]
    # for t ∈ [1,2] we use spline_coeffs[:,2]
    # etc.

    n = size(spline_coeffs_x, 2)
    @assert(size(spline_coeffs_x, 1) == 4)
    @assert(size(spline_coeffs_y, 1) == 4)
    @assert(n == size(spline_coeffs_y, 2))
    retval = Array{Float64}(length(t_arr))
    for (i,t) in enumerate(t_arr)
        col_ind = clamp(ceil(Int, t), 1, n)
        retval[i] = sample_spline_curvature(spline_coeffs_x[:,col_ind], spline_coeffs_y[:,col_ind], t-col_ind+1)
    end
    retval
end

function sample_spline_derivative_of_curvature(spline_coeffs_x::AbstractVector{Float64}, spline_coeffs_y::AbstractVector{Float64}, t::Float64;
    stepsize=1e-4
    )

    # computes the derivative of the signed curvature

    t_lo, t_hi = t, t+stepsize
    if t_hi > 1.0
        t_lo, t_hi = t-stepsize, t
    end

    κ_hi = sample_spline_curvature(spline_coeffs_x, spline_coeffs_y, t_hi)
    κ_lo = sample_spline_curvature(spline_coeffs_x, spline_coeffs_y, t_lo)

    (κ_hi - κ_lo) / stepsize
end
function sample_spline_derivative_of_curvature(spline_coeffs_x::AbstractMatrix{Float64}, spline_coeffs_y::AbstractMatrix{Float64}, t::Float64;
    stepsize=1e-4
    )

    # for t ∈ (-∞,1] we use spline_coeffs[:,1]
    # for t ∈ [1,2] we use spline_coeffs[:,2]
    # etc.
    n = size(spline_coeffs_x, 2)
    @assert(size(spline_coeffs_x, 1) == 4)
    @assert(size(spline_coeffs_y, 1) == 4)
    @assert(n == size(spline_coeffs_y, 2))
    col_ind = clamp(ceil(Int, t), 1, n)
    sample_spline_derivative_of_curvature(spline_coeffs_x[:,col_ind], spline_coeffs_y[:,col_ind], t-col_ind+1, stepsize=stepsize)
end
function sample_spline_derivative_of_curvature(spline_coeffs_x::AbstractVector{Float64}, spline_coeffs_y::AbstractVector{Float64}, t_arr::AbstractVector{Float64};
    stepsize=1e-4
    )

    # here t is generally expected to be t ∈ [0,1]

    retval = Array{Float64}(length(t_arr))
    for (i,t) in enumerate(t_arr)
        retval[i] = sample_spline_derivative_of_curvature(spline_coeffs_x, spline_coeffs_y, t, stepsize=stepsize)
    end
    retval
end
function sample_spline_derivative_of_curvature(spline_coeffs_x::AbstractMatrix{Float64}, spline_coeffs_y::AbstractMatrix{Float64}, t_arr::AbstractVector{Float64};
    stepsize=1e-4
    )

    # for t ∈ (-∞,1] we use spline_coeffs[:,1]
    # for t ∈ [1,2] we use spline_coeffs[:,2]
    # etc.

    n = size(spline_coeffs_x, 2)
    @assert(size(spline_coeffs_x, 1) == 4)
    @assert(size(spline_coeffs_y, 1) == 4)
    @assert(n == size(spline_coeffs_y, 2))
    retval = Array{Float64}(length(t_arr))
    for (i,t) in enumerate(t_arr)
        col_ind = clamp(ceil(Int, t), 1, n)
        retval[i] = sample_spline_derivative_of_curvature(spline_coeffs_x[:,col_ind], spline_coeffs_y[:,col_ind], t-col_ind+1, stepsize=stepsize)
    end
    retval
end

function calc_curve_length(spline_coeffs_x::AbstractVector{Float64}, spline_coeffs_y::AbstractVector{Float64};
    n_intervals::Int = 100
    )

    # integrate using Simpson's rule
    # _integrate_simpsons(t->sample_spline_speed(spline_coeffs_x, spline_coeffs_y, t), 0.0, 1.0, n_intervals)

    a = 0.0
    b = 1.0
    n = n_intervals

    h = (b-a)/n
    retval = sample_spline_speed(spline_coeffs_x, spline_coeffs_y, a) + sample_spline_speed(spline_coeffs_x, spline_coeffs_y, b)
    flip = true
    for i = 1 : n-1
        retval += sample_spline_speed(spline_coeffs_x, spline_coeffs_y, a+i*h) * (flip ? 4 : 2)
        flip = !flip
    end
    return h/3*retval
end
function calc_curve_length(
    spline_coeffs_x::AbstractMatrix{Float64},
    spline_coeffs_y::AbstractMatrix{Float64};
    n_intervals_per_segment::Int = 100
    )

    n = size(spline_coeffs_x, 2)
    @assert(size(spline_coeffs_y, 2) == n)
    @assert(size(spline_coeffs_x, 1) == size(spline_coeffs_y, 1) == 4)

    len = 0.0
    for i = 1 : n
        len += calc_curve_length(spline_coeffs_x[:,i], spline_coeffs_y[:,i], n_intervals = n_intervals_per_segment)
    end
    len
end

function arclength(
    spline_coeffs_x::AbstractVector{Float64},
    spline_coeffs_y::AbstractVector{Float64},
    t_min::Real = 0.0,
    t_max::Real = 1.0,
    n_intervals::Int = 100
    )

    if isapprox(t_min, t_max)
        return 0.0
    end

    # _integrate_simpsons(t->sample_spline_speed(spline_coeffs_x, spline_coeffs_y, t), t_min, t_max, n_intervals)

    a = t_min
    b = t_max
    n = n_intervals

    h = (b-a)/n
    retval = sample_spline_speed(spline_coeffs_x, spline_coeffs_y, a) + sample_spline_speed(spline_coeffs_x, spline_coeffs_y, b)
    flip = true
    for i = 1 : n-1
        retval += sample_spline_speed(spline_coeffs_x, spline_coeffs_y, a+i*h) * (flip ? 4 : 2)
        flip = !flip
    end
    return h/3*retval
end
function arclength(
    spline_coeffs_x::AbstractMatrix{Float64},
    spline_coeffs_y::AbstractMatrix{Float64},
    t_min::Real = 0.0,
    t_max::Real = size(spline_coeffs_x, 2),
    n_intervals_per_segment::Int = 100
    )

    n = size(spline_coeffs_x, 2)
    @assert(size(spline_coeffs_y, 2) == n)
    @assert(size(spline_coeffs_x, 1) == size(spline_coeffs_y, 1) == 4)

    if isapprox(t_min, t_max)
        return 0.0
    end

    # println("tmin/tmax: $t_min / $t_max")

    len = 0.0
    for i = floor(Int, t_min) : min(floor(Int, t_max), n-1)
        t_lo, t_hi = float(i), i+1.0

        spline_ind = i+1
        t_in_min = max(t_lo, t_min) - t_lo
        t_in_max = min(t_hi, t_max) - t_lo
        # println("($i) t_lo: $t_lo, t_hi: $t_hi, : $t_in_min → $t_in_max")
        len += arclength(spline_coeffs_x[:,spline_ind], spline_coeffs_y[:,spline_ind], t_in_min, t_in_max, n_intervals_per_segment)
    end
    # println("len: ", len)
    len
end

function calc_curve_param_given_arclen(
    spline_coeffs_x :: AbstractVector{Float64},
    spline_coeffs_y :: AbstractVector{Float64},
    s :: Float64;
    max_iterations :: Int=100,
    curve_length :: Float64 = calc_curve_length(spline_coeffs_x, spline_coeffs_y),
    epsilon::Float64 = 1e-4 # tolerance required before termination
    )

    # finds t such that p(t) is a distance s from start of curve
    # returns t=0 if s ≤ 0.0 and t=1 if s > L
    if s ≤ 0.0
        return 0.0
    elseif s ≥ curve_length
        return 1.0
    end

    t = s/curve_length
    lo, hi = 0.0, 1.0

    # @printf("%10s %10s %10s %10s %10s %10s\n", "iter", "lo", "hi", "t", "s", "F")
    # println("-"^65)

    for iter = 1 : max_iterations
        F = arclength(spline_coeffs_x, spline_coeffs_y, 0.0, t) - s

        # @printf("%10d %10.5f %10.5f %10.5f %10.5f %10.5f\n", iter-1, lo, hi, t, s, F)

        if abs(F) < epsilon
            # |F(t)| is close enough to zero, report it
            return t
        end

        DF = sample_spline_speed(spline_coeffs_x, spline_coeffs_y, t)
        tCandidate = t - F/DF
        if F > 0
            hi = t
            t = tCandidate ≤ lo ? 0.5*(lo+hi) : tCandidate
        else
            lo = t
            t = tCandidate ≥ hi ? 0.5*(lo+hi) : tCandidate
        end
    end

    # @printf("%10d %10.5f %10.5f %10.5f %10.5f %10s\n", max_iterations, lo, hi, t, s, "-")

    t
end
function calc_curve_param_given_arclen(
    spline_coeffs_x :: AbstractMatrix{Float64},
    spline_coeffs_y :: AbstractMatrix{Float64},
    s :: Float64;
    max_iterations :: Int=100,
    n_integration_intervals :: Int=100, # must be multiple of 2
    curve_length :: Float64 = calc_curve_length(spline_coeffs_x, spline_coeffs_y),
    epsilon::Float64 = 1e-4 # tolerance required before termination
    )

    # finds t such that p(t) is a distance s from start of curve
    # returns t=0 if s ≤ 0.0 and t=t_max if s > L

    n_segments = size(spline_coeffs_x, 2)
    @assert(size(spline_coeffs_x,1) == size(spline_coeffs_y,1) == 4)
    @assert(size(spline_coeffs_y,2) == n_segments)

    if s ≤ 0.0
        return 0.0
    elseif s ≥ curve_length
        return float(n_segments)
    end

    t = s/curve_length
    lo, hi = 0.0, float(n_segments)

    # @printf("%10s %10s %10s %10s %10s %10s\n", "iter", "lo", "hi", "t", "s", "F")
    # println("-"^65)

    for iter = 1 : max_iterations
        F = arclength(spline_coeffs_x, spline_coeffs_y, 0.0, t, n_integration_intervals) - s

        # @printf("%10d %10.5f %10.5f %10.5f %10.5f %10.5f\n", iter-1, lo, hi, t, s, F)

        if abs(F) < epsilon
            return t
        end

        DF = sample_spline_speed(spline_coeffs_x, spline_coeffs_y, t)
        tCandidate = t - F/DF
        if F > 0
            hi = t
            t = tCandidate ≤ lo ? 0.5*(lo+hi) : tCandidate
        else
            lo = t
            t = tCandidate ≥ hi ? 0.5*(lo+hi) : tCandidate
        end
    end

    # @printf("%10d %10.5f %10.5f %10.5f %10.5f %10s\n", max_iterations, lo, hi, t, s, "-")

    t
end
function calc_curve_param_given_arclen(
    spline_coeffs_x :: AbstractVector{Float64},
    spline_coeffs_y :: AbstractVector{Float64},
    s_arr :: AbstractVector{Float64}; # assumes s_arr is sorted
    max_iterations :: Int=100,
    curve_length :: Float64 = calc_curve_length(spline_coeffs_x, spline_coeffs_y),
    epsilon::Float64 = 1e-4 # tolerance required before termination
    )

    n = length(s_arr)
    t_arr = Array{Float64}(n)

    s = s_arr[1]
    t = s/curve_length
    if s ≤ 0.0
        t = 0.0
    elseif s ≥ curve_length
        t = 1.0
    end

    lo =  0.0

    for (i,s) in enumerate(s_arr)

        if s ≤ 0.0
            t = 0.0
            t_arr[i], lo = t, t
            continue
        elseif s ≥ curve_length
            t = 1.0
            t_arr[i], lo = t, t
            continue
        end

        hi = 1.0
        for iter = 1 : max_iterations
            F = arclength(spline_coeffs_x, spline_coeffs_y, 0.0, t) - s

            if abs(F) < epsilon
                t_arr[i], lo = t, t
                continue
            end

            DF = sample_spline_speed(spline_coeffs_x, spline_coeffs_y, t)
            tCandidate = t - F/DF
            if F > 0
                hi = t
                t = tCandidate ≤ lo ? 0.5*(lo+hi) : tCandidate
            else
                lo = t
                t = tCandidate ≥ hi ? 0.5*(lo+hi) : tCandidate
            end
        end

        t_arr[i], lo = t, t
    end

    t_arr
end
function calc_curve_param_given_arclen(
    spline_coeffs_x :: AbstractMatrix{Float64},
    spline_coeffs_y :: AbstractMatrix{Float64},
    s_arr :: AbstractVector{Float64}; # assumes s_arr is sorted
    max_iterations :: Int = 50,
    curve_length :: Float64 = calc_curve_length(spline_coeffs_x, spline_coeffs_y),
    epsilon::Float64 = 1e-4, # tolerance required before termination
    n_intervals_in_arclen::Int = 100
    )

    n_segments = size(spline_coeffs_x, 2)
    @assert(size(spline_coeffs_x,1) == size(spline_coeffs_y,1) == 4)
    @assert(size(spline_coeffs_y,2) == n_segments)

    n = length(s_arr)
    t_arr = Array{Float64}(n)

    s = s_arr[1]
    t = s/curve_length
    if s ≤ 0.0
        t = 0.0
    elseif s ≥ curve_length
        return float(n_segments)
    end

    lo =  0.0
    # println("L: ", curve_length)
    # println("s_max: ", s_arr[end])
    for (i,s) in enumerate(s_arr)

        # println("\ns: ", s)

        if s ≤ 0.0
            t = 0.0
            t_arr[i] = lo = t
            continue
        elseif s ≥ curve_length
            t = float(n_segments)
            t_arr[i] = lo = t
            continue
        end

        hi = float(n_segments)
        for iter = 1 : max_iterations
            F = arclength(spline_coeffs_x, spline_coeffs_y, 0.0, t, n_intervals_in_arclen) - s

            if abs(F) < epsilon
                break
            end

            DF = sample_spline_speed(spline_coeffs_x, spline_coeffs_y, t)
            tCandidate = t - F/DF
            if F > 0
                hi = t
                t = tCandidate ≤ lo ? 0.5*(lo+hi) : tCandidate
            else
                lo = t
                t = tCandidate ≥ hi ? 0.5*(lo+hi) : tCandidate
            end
        end

        t_arr[i] = lo = t
    end

    t_arr
end


n = rand(1:10)

A = rand(n, n)

r = polarfact(A, alg = :halley);

# Test unitary matrix U

U = r.U
H = r.H

@test_approx_eq_eps U'*U eye(n) 1e-7

# Test Hermitian positive semifefinite matrix H

@test issym(H)

for i in eigvals(H)
    @test i >= 0.
end

@test_approx_eq A U*H

println("Halley method passed test...")

##########################################################

m = rand(1:10)

B = rand(m, m)

r2 = polarfact(B, alg = :qdwh);

# Test unitary matrix U

U2 = r2.U
H2 = r2.H

@test_approx_eq_eps U2'*U2 eye(m) 1e-7

# Test Hermitian positive semifefinite matrix H

@test issym(H2)

for i in eigvals(H2)
    @test i >= 0.
end

@test_approx_eq B U2*H2

println("QDWH method passed test...")


list = readlines("day1_input.txt")

function get_two(list)
    years = parse.(Int, list)
    for i in years
        for j in years
            if i+j == 2020
                return i*j
            end
        end
    end
    return "Not found"
end

function get_two_ind(list)
    years = parse.(Int, list)
    for i in 1:length(years)
        for j in (i+1):length(years)
            if years[i]+years[j] == 2020
                return years[i]*years[j]
            end
        end
    end
    return "Not found"
end

function get_two_comprehension(list)
    years = parse.(Int, list)
    prod = [a*b for a in years for b in years if a+b==2020]
    if length(prod) > 1
        return prod[1]
    else
        return "Not found"
    end
end

function get_two_sorting(list)
    years = parse.(Int, list)
    list_inc = sort(years)
    list_dec = sort(years, rev = true)
    for a in list_inc
        for b in list_dec
            if a + b == 2020
                return a*b
            end
        end
    end
    return "Not found"
end

function findsol(list)
    years = parse.(Int, list)
    sorted=sort(years)
    sm,la=1,length(sorted)
    while sm<la
        cur=sorted[sm]+sorted[la]
        if cur<2020
            sm+=1
        elseif cur>2020
            la-=1
        else
            return sorted[sm]*sorted[la]
        end
    end
    error("dead end")
end

function get_three(list)
    years = parse.(Int, list)
    for i in years
        for j in years
            for k in years
                if i+j+k == 2020
                    return i*j*k
                end
            end
        end
    end
    return "Not found"
end

@show get_two(list) == 355875
@show get_two_ind(list) == 355875
@show get_two_comprehension(list) == 355875
@show get_two_sorting(list) == 355875
@show findsol(list) == 355875
@show get_three(list) == 140379120

#=
```julia
julia> @btime get_two(list)
  19.653 μs (2 allocations: 1.78 KiB)

julia> @btime get_two_ind(list);
  18.567 μs (2 allocations: 1.78 KiB)

julia> @btime get_two_comprehension(list);
  42.493 μs (5 allocations: 1.98 KiB)

julia> @btime get_two_sorting(list);
  14.270 μs (4 allocations: 5.31 KiB)

julia> @btime findsol(list);
  12.201 μs (3 allocations: 3.55 KiB)

julia> @btime get_three(list);
  437.935 μs (2 allocations: 1.78 KiB)
```
 =#

nothing


using CayleyDickson
using Base.Test: @test, @test_throws

@test begin
    a = CayleyDickson.randomBigFloat()
    isreal(Sedenion(Octonion(a)))
end

@test begin
    a = 1
    !isreal(Sedenion(Octonion(a, a, a, a)))
end

@test begin
    z = random(Sedenion{Int})
    z == +(z)
end

@test begin
    a = CayleyDickson.randomBigFloat()
    real(Sedenion(Octonion(a))) == a
end

@test begin
    io = IOBuffer()
    show(io, Sedenion(Octonion(1.0, 2, 3, 4, 5, 6, 7, 8)))
    l = String(take!(io))
    r = "[1: 1.0, i: 2.0, j: 3.0, ij: 4.0, k: 5.0, ik: 6.0, jk: 7.0, (ij)k: 8.0, m: 0.0, im: 0.0, jm: 0.0, (ij)m: 0.0, km: 0.0, (ik)m: 0.0, (jk)m: 0.0, ((ij)k)m: 0.0]"
    l == r
end

@test begin
    a = CayleyDickson.randomBigInt()
    b = CayleyDickson.randomBigInt()
    c = CayleyDickson.randomBigInt()
    d = CayleyDickson.randomBigInt()
    l = Sedenion(Octonion(a, b, c, d))
    r = Sedenion(Quaternion(a, b, c, d))
    l == r
end

@test begin
    a = CayleyDickson.randomBigInt()
    b = CayleyDickson.randomBigInt()
    l = Sedenion(Binion(a, b))
    r = Sedenion(Octonion(a, b))
    l == r
end

@test begin
    x = random(Sedenion{BigFloat})
    y = random(Sedenion{BigFloat})
    x != y
end

@test begin
    a = CayleyDickson.randomBigInt()
    z = random(Sedenion{BigInt})
    l = a + z
    r = z + a
    l == r
end

@test begin
    a = random(Octonion{BigInt})
    z = random(Sedenion{BigInt})
    l = a + z
    r = z + a
    l == r
end

@test begin
    a = CayleyDickson.randomBigInt()
    z = random(Sedenion{BigInt})
    l = a - z
    r = -(z - a)
    l == r
end

@test begin
    a = random(Octonion{BigInt})
    z = random(Sedenion{BigInt})
    l = a - z
    r = -(z - a)
    l == r
end

@test begin
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    l = x + y
    r = y + x
    l == r
end

@test begin
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    l = x * y
    r = y * x
    l != r
end

@test begin
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    l = x - y
    r = -(y - x)
    l == r
end

@test begin
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    z = random(Sedenion{BigInt})
    l = (x + y) + z
    r = x + (y + z)
    l == r
end

@test begin
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    z = random(Sedenion{BigInt})
    l = (x * y) * z
    r = x * (y * z)
    l != r
end

@test begin
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    l = alternatorL(x, y)
    r = zero(Sedenion{BigInt})
    l != r
end

@test begin
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    l = alternatorR(x, y)
    r = zero(Sedenion{BigInt})
    l != r
end

@test begin
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    l = flexator(x, y)
    r = zero(Sedenion{BigInt})
    l == r
end

@test begin
    x = random(Sedenion{BigInt})
    conj(conj(x)) == x
end

@test begin
    x = random(Sedenion{Rational{BigInt}})
    inv(inv(x)) == x
end

@test begin
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    l = conj(x * y)
    r = conj(y) * conj(x)
    l == r
end

@test begin
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    l = conj(x + y)
    r = conj(x) + conj(y)
    l == r
end

@test begin
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    l = conj(x - y)
    r = conj(x) - conj(y)
    l == r
end

# @test begin
#     x = random(Sedenion{Rational{BigInt}})
#     y = random(Sedenion{Rational{BigInt}})
#     z = x * y
#     z / y == x
# end

# @test begin
#     x = random(Sedenion{Rational{BigInt}})
#     y = random(Sedenion{Rational{BigInt}})
#     z = x * y
#     x \ z == y
# end

# @test begin
#     x = random(Sedenion{Rational{BigInt}})
#     y = random(Sedenion{Rational{BigInt}})
#     l = inv(x * y)
#     r = inv(y) * inv(x)
#     l == r
# end

# @test begin
#     x = random(Sedenion{Rational{BigInt}})
#     y = random(Sedenion{Rational{BigInt}})
#     l = inv(x / y)
#     r = y / x
#     l == r
# end

# @test begin
#     x = random(Sedenion{Rational{BigInt}})
#     y = random(Sedenion{Rational{BigInt}})
#     l = inv(x \ y)
#     r = y \ x
#     l == r
# end

@test begin
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    z = random(Sedenion{BigInt})
    l = x * (y + z)
    r = (x * y) + (x * z)
    l == r
end

@test begin
    a = CayleyDickson.randomBigInt()
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    l = a * (x + y)
    r = (a * x) + (a * y)
    l == r
end

@test begin
    a = CayleyDickson.randomBigInt()
    x = random(Sedenion{BigInt})
    l = a * x
    r = x * a
    l == r
end

@test begin
    a = random(Octonion{BigInt})
    x = random(Sedenion{BigInt})
    l = commutator(a, x)
    r = zero(Sedenion{BigInt})
    l != r
end

@test begin
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    z = random(Sedenion{BigInt})
    l = (x + y) * z
    r = (x * z) + (y * z)
    l == r
end

@test begin
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    z = random(Sedenion{BigInt})
    l = x * (y - z)
    r = (x * y) - (x * z)
    l == r
end

@test begin
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    z = random(Sedenion{BigInt})
    l = (x - y) * z
    r = (x * z) - (y * z)
    l == r
end

@test begin
    x = random(Sedenion{BigInt})
    quadrance(x) > big(0) || quadrance(x) == big(0)
end

@test begin
    x = random(Sedenion{BigInt})
    y = random(Sedenion{BigInt})
    l = quadrance(x * y)
    r = quadrance(x) * quadrance(y)
    l != r
end

@test_throws ErrorException begin
    inv(Sedenion(Octonion(0)))
end

@test_throws ErrorException begin
    random(Sedenion{Int}) / 0
end

@test_throws ErrorException begin
    0 \ random(Sedenion{Int})
end

@test begin
    a = CayleyDickson.randomBigRational()
    z = random(Sedenion{Rational{BigInt}})
    l = z / a
    r = a \ z
    l == r
end

@test begin
    a = CayleyDickson.randomBigRational()
    z = random(Sedenion{Rational{BigInt}})
    l = a / z
    r = z \ a
    l == r
end

@test begin
    z = random(Sedenion{BigInt})
    z == z + zero(Sedenion{BigInt})
end

@test begin
    z = random(Sedenion{BigInt})
    z == z * one(Sedenion{BigInt})
end

@test begin
    z = random(Sedenion{BigInt})
    z == z + zero(z)
end

@test begin
    z = random(Sedenion{BigInt})
    z == z * one(z)
end

@test begin
    i = Sedenion{Int}(Octonion(0,1), zero(Octonion{Int}))
    m = Sedenion{Int}(zero(Octonion{Int}), one(Octonion{Int}))
    anti_alternatorL(i, m) != zero(Sedenion{Int})
end

@test begin
    i = Sedenion{Int}(Octonion(0,1), zero(Octonion{Int}))
    m = Sedenion{Int}(zero(Octonion{Int}), one(Octonion{Int}))
    anti_alternatorR(i, m) != zero(Sedenion{Int})
end

@test begin
    i = Sedenion{Int}(Octonion(0,1), zero(Octonion{Int}))
    m = Sedenion{Int}(zero(Octonion{Int}), one(Octonion{Int}))
    anti_flexator(i, m) != zero(Sedenion{Int})
end

@test begin
    l = Sedenion(1,2,3,4)
    r = Sedenion(Quaternion(1,2,3,4))
    l == r
end

@test begin
    l = Sedenion(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17)
    r = Sedenion(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16)
    l == r
end


## Exercise 4-8
## Enter the code in this chapter in a notebook.

## 1. Draw a stack diagram that shows the state of the program while executing circle(🐢, radius).
## You can do the arithmetic by hand or add print statements to the code.
println("Ans 1: ")

println(" turtle --> Turtle")
println("     turtle --> Turtle")
println("     radius --> 100")
println("     circumference --> 628.318...")
println("     n --> 212")
println("     len --> 2")
println("         turtle --> Turtle")
println("         nsides --> 212")
println("         len --> 2")
println("         i --> 1:212")
println(" return")

## 2. The version of arc in Refactoring is not very accurate because the linear approximation of the circle
## is always outside the true circle. As a result, the turtle ends up a few pixels away from the correct destination.
## My solution shows a way to reduce the effect of this error. Read the code and see if it makes sense to you.
## If you draw a diagram, you might see how it works.
using ThinkJulia

function polyline(t, n, len, angle)
    for i in 1:n
        forward(t, len)
        turn(t, -angle)
    end
end

"""
arc(t, r, angle)

Draws an arc with the given radius and angle:

    t: turtle
    r: radius
    angle: angle subtended by the arc, in degrees
"""
function arc(t, r, angle)
    arc_len = 2 * π * r * abs(angle) / 360
    n = trunc(arc_len / 4) + 3
    step_len = arc_len / n
    step_angle = angle / n

    # making a slight left turn before starting reduces
    # the error caused by the linear approximation of the arc
    turn(t, -step_angle/2)
    polyline(t, n, step_len, step_angle)
    turn(t, step_angle/2)
end

println("Ans 2: ")

@svg begin
    turtle = Turtle()
    # forward(turtle, 30)  # for checking the position of the turtle
    arc(turtle, 100, 125)
end

##

println("End.")


using ModelingToolkit
using DifferentialEquations

@parameters t α
@variables x(t) y(t)
D = Differential(t)

eqs = [D(x) ~ y * x,
       D(y) ~ -α * x]

@named sys = ODESystem(eqs)

u0 = [ x => 1.0, y => 2.0]
tspan = (0.0, 1.0)
p = [α => 1.0]
prob = ODEProblem(sys, u0, tspan, p)
sol = solve(prob)

#=
using SymbolicUtils
r1 = @rule (~y)*(~x) => (~y)^2
r1(eqs[1].rhs)
=#


using Distributions
using SpecialFunctions
import Base.convert
# this is a file defining the half-Cauchy Distribution

struct HalfCauchy{T <: Real} <: Distributions.ContinuousDistribution
    a :: T # Beta(a, b) shape₁
    b :: T # Beta(a, b) shape₂

    function HalfCauchy{T}(a :: T, b :: T) where T
        Distributions.@check_args(HalfCauchy, a > zero(a), b > zero(b))
        new{T}(a, b)
    end
end

HalfCauchy(a :: T, b :: T) where{T <: Real} = HalfCauchy{T}(a, b)
HalfCauchy(a :: Real, b :: Real) =  HalfCauchy(promote(a, b)...)
HalfCauchy(a :: Integer, b :: Integer) = HalfCauchy(Float64(a), Float64(b))
HalfCauchy() = HalfCauchy(0.5, 0.5)

Distributions.@distr_support HalfCauchy 0 Inf

#### Conversions

function convert(:: Type{HalfCauchy{T}}, a :: Real, b :: Real) where T<: Real
    HalfCauchy(T(a), T(b))
end
function convert(:: Type{HalfCauchy{T}}, d :: HalfCauchy{S}) where {T <: Real, S <: Real}
    HalfCauchy(T(d.a), T(d.b))
end

#### Parameters
params(d :: HalfCauchy) = (d.a, d.b)

#### Statistics
# I skipped this part

#### Functions
pdf(d :: HalfCauchy, x :: Real) = (x ^(b - 1) /(1 + x)^(d.a + d.b)) / beta(d.a, d.b)


#
# Computes the density function of a list of values
#

function density(v;nbins=nothing,step=nothing,steptype="absolute",vmin=nothing,vmax=nothing)

  ndata = length(v)

  if vmin == nothing
    vmin = minimum(v)
  end
  if vmax == nothing
    vmax = maximum(v)
  end
  if nbins == nothing
    nbins = 100
  end
  if step == nothing
    step = (vmax - vmin)/nbins
  else
    # By default, the step size is absolute
    if steptype == "relative"
      step = step*(vmax-vmin)/nbins
    elseif steptype != "absolute"
      error(" steptype must be \"relative\" or \"absolute\"")
    end
  end

  x = Vector{Float64}(undef,nbins)
  df = Vector{Float64}(undef,nbins)

  binstep = (vmax - vmin)/nbins
  for i in 1:nbins
    x[i] = vmin + (i-1)*binstep + binstep/2
    nv = 0
    for j in 1:ndata
      if ( v[j] > x[i] - step/2 ) && ( v[j] <= x[i] + step/2 )
        nv = nv + 1
      end
    end
    binsize = min(vmax,x[i]+step/2) - max(vmin,x[i]-step/2)
    df[i] = nv/(binsize*ndata)
  end

  return x, df

end


cd(@__DIR__); runapprox = true; allNGWPs = false; include("setups/sunflower.jl")
gr(dpi = 200)

##
VM_NGWP = vm_ngwp(𝚽, GP_dual)
f = matread("../datasets/sunflower_barbara_voronoi.mat")["f_trouser_voronoi"]
G_Sig.f = reshape(f, (N, 1))
dmatrix_VM = ngwp_analysis(G_Sig, VM_NGWP)
dvec_vm_ngwp, BS_vm_ngwp = ngwp_bestbasis(dmatrix_VM, GP_dual)
important_idx = sortperm(dvec_vm_ngwp[:].^2; rev = true)
println("================ftrouser-VM-NGWP-top-basis-vectors=================")
for i in 2:17
    dr, dc = BS_vm_ngwp.levlist[important_idx[i]]
    w = VM_NGWP[dr, dc, :]
    j, k, l = NGWP_jkl(GP_dual, dr, dc)
    print("(j, k, l) = ($(j), $(k), $(l))  ")
    if j == jmax
        print("φ_{$(GP_dual.ind[dr]-1)}")
    end
    println()
    scatter_gplot(X; marker = w, ms = LinRange(4.0, 14.0, N), c = :greys)
    plt = plot!(xlim = [-1.2, 1.2], ylim = [-1.2, 1.2], frame = :none,
                cbar = false, clims = (-0.15, 0.15))
    savefig(plt,
        "../figs/SunFlower_ftrouser_DAG_VM_NGWP_ibv$(lpad(i,2,"0"))_j$(j)_k$(k)_l$(l).png")
end


# Miscellaneous functions

# Logarithm of multivariate gamma function
#
# See: https://en.wikipedia.org/wiki/Multivariate_gamma_function
#
function logmvgamma(p::Int, a::Real)
    # NOTE: one(a) factors are here to prevent unnecessary promotion of Float32
    res = p * (p - 1) * log(pi * one(a)) / 4
    for ii in 1:p
        res += lgamma(a + (1 - ii) * one(a)/ 2)
    end
    return res
end

# Remainder term after Stirling's approximation to the log-gamma function
# lstirling(x) = lgamma(x) + x - (x-0.5)*log(x) - 0.5*log2π
#              = 1/(12x) - 1/(360x^3) + 1/(1260x^5) + ...
#
# Asymptotic expansion from:
#
#   Temme, N. (1996) Special functions: An introduction to the classical
#   functions of mathematical physics, Wiley, New York, ISBN: 0-471-11313-1,
#   Chapter 3.6, pp 61-65.
#
# Relative error of approximation is bounded by
#   (174611/125400 x^-19) / (1/12 x^-1 - 1/360 x^-3)
# which is < 1/2 ulp for x >= 10.0
# total numeric error appears to be < 2 ulps
#
function lstirling_asym(x::Float64)
    t = 1.0/(x*x)
    @horner(t,
             8.33333333333333333e-2, #  1/12 x^-1
            -2.77777777777777778e-3, # -1/360 x^-3
             7.93650793650793651e-4, #  1/1260 x^-5
            -5.95238095238095238e-4, # -1/1680 x^-7
             8.41750841750841751e-4, #  1/1188 x^-9
            -1.91752691752691753e-3, # -691/360360 x^-11
             6.41025641025641026e-3, #  1/156 x^-13
            -2.95506535947712418e-2, # -3617/122400 x^-15
             1.79644372368830573e-1)/x #  43867/244188 x^-17
end

function lstirling_asym(x::Float32)
    t = 1f0/(x*x)
    @horner(t,
             8.333333333333f-2, #  1/12 x^-1
            -2.777777777777f-3, # -1/360 x^-3
             7.936507936508f-4, #  1/1260 x^-5
            -5.952380952381f-4, # -1/1680 x^-7
             8.417508417508f-4)/x #  1/1188 x^-9
end

lstirling_asym(x::Integer) = lstirling_asym(float(x))