)abbrev package GENUPS1 GenerateUnivariatePowerSeries1
++ Author: Clifton J. Williamson, Waldek Hebisch
++ Basic Operations:
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords: series, Taylor, Laurent, Puiseux
++ Examples:
++ References:
++ Description:
++   \spadtype{GenerateUnivariatePowerSeries} provides functions that create
++   power series from explicit formulas for their \spad{n}th coefficient.
GenerateUnivariatePowerSeries1(R) : Exports == Implementation where
  R : Ring
  ANY1 ==> AnyFunctions1
  EQ   ==> Equation
  I    ==> Integer
  NNI  ==> NonNegativeInteger
  RN   ==> Fraction Integer
  SEG  ==> UniversalSegment
  ST   ==> Stream
  SY   ==> Symbol
  UTS  ==> UnivariateTaylorSeries
  ULS  ==> UnivariateLaurentSeries
  UPXS ==> UnivariatePuiseuxSeries

  Exports ==> with
    taylor : (I -> R, SY, R) -> Any
      ++ \spad{taylor(n +-> a(n), x, a)} returns
      ++ \spad{sum(n = 0.., a(n)*(x-a)^n)}.
    taylor : (I -> R, SY, R, SEG NNI) -> Any
      ++ \spad{taylor(n +-> a(n), x, a, n0..)} returns
      ++ \spad{sum(n=n0.., a(n)*(x-a)^n)};
      ++ \spad{taylor(n +-> a(n), x, a, n0..n1)} returns
      ++ \spad{sum(n = n0.., a(n)*(x-a)^n)}.

    laurent : (I -> R, SY, R, SEG I) -> Any
      ++ \spad{laurent(n +-> a(n), x, a, n0..)} returns
      ++ \spad{sum(n = n0.., a(n) * (x - a)^n)};
      ++ \spad{laurent(n +-> a(n), x, a, n0..n1)} returns
      ++ \spad{sum(n = n0..n1, a(n) * (x - a)^n)}.

    puiseux : (RN -> R, SY, R, SEG RN, RN) -> Any
      ++ \spad{puiseux(n +-> a(n), x, a, r0.., r)} returns
      ++ \spad{sum(n = r0, r0 + r, r0 + 2*r..., a(n) * (x - a)^n)};
      ++ \spad{puiseux(n +-> a(n), x = a, r0..r1, r)} returns
      ++ \spad{sum(n = r0 + k*r while n <= r1, a(n) * (x - a)^n)}.

  Implementation ==> add

    genStream : (I -> R, I) -> ST(R)
    genStream(f, n) == delay concat(f(n), genStream(f, n + 1))

    genFiniteStream : (I -> R, I, I) -> ST(R)
    genFiniteStream0 : (I -> R, I, I) -> ST(R)
    genFiniteStream(f, n, m) ==
        n > m => empty()
        genFiniteStream0(f, n, m)
    genFiniteStream0(f, n, m) == delay
        -- make sure tail is explicitly empty
        n = m => concat(f(n), empty())
        concat(f(n), genFiniteStream0(f, n + 1, m))

    taylor(f, x, a) ==
      coerce(series(genStream(f, 0))$UTS(R, x, a))$ANY1(UTS(R, x, a))

    taylor(f : I -> R, x, a, seg : SEG NNI) ==
      hasHi seg =>
        n0 := low(seg); n1 := high(seg)
        if n1 < n0 then (n0, n1) := (n1, n0)
        uts := series(genFiniteStream(f, n0, n1))$UTS(R, x, a)
        uts := uts * monomial(1, n0)$UTS(R, x, a)
        coerce(uts)$ANY1(UTS(R, x, a))
      n0 := low(seg)
      uts := series(genStream(f, n0))$UTS(R, x, a)
      uts := uts * monomial(1, n0)$UTS(R, x, a)
      coerce(uts)$ANY1(UTS(R, x, a))

    laurent(f, x, a, seg) ==
      hasHi seg =>
        n0 := low(seg); n1 := high(seg)
        if n1 < n0 then (n0, n1) := (n1, n0)
        uts := series(genFiniteStream(f, n0, n1))$UTS(R, x, a)
        coerce(laurent(n0, uts)$ULS(R, x, a))$ANY1(ULS(R, x, a))
      n0 := low(seg)
      uts := series(genStream(f, n0))$UTS(R, x, a)
      coerce(laurent(n0, uts)$ULS(R, x, a))$ANY1(ULS(R, x, a))

    modifyFcn : (RN -> R, I, I, I, I) -> R
    modifyFcn(f, n0, nn, q, m) == (zero?((m - n0) rem nn) => f(m/q); 0)

    puiseux(f, x, a, seg, r) ==
      not positive? r => error "puiseux: last argument must be positive"
      hasHi seg =>
        r0 := low(seg); r1 := high(seg)
        if r1 < r0 then (r0, r1) := (r1, r0)
        p0 := numer r0; q0 := denom r0
        p1 := numer r1; q1 := denom r1
        p2 := numer r; q2 := denom r
        q := lcm(lcm(q0, q1), q2)
        n0 := p0 * (q quo q0); n1 := p1 * (q quo q1)
        nn := p2 * (q quo q2)
        ulsUnion := laurent((i : I) : R +-> modifyFcn(f, n0, nn, q, i),
                            x, a, segment(n0, n1))
        uls := retract(ulsUnion)$ANY1(ULS(R, x, a))
        coerce(puiseux(1/q, uls)$UPXS(R, x, a))$ANY1(UPXS(R, x, a))
      p0 := numer(r0 := low(seg)); q0 := denom r0
      p2 := numer r; q2 := denom r
      q := lcm(q0, q2)
      n0 := p0 * (q quo q0); nn := p2 * (q quo q2)
      ulsUnion := laurent((i : I) : R +->
                            modifyFcn(f, n0, nn, q, i), x, a, segment n0)
      uls := retract(ulsUnion)$ANY1(ULS(R, x, a))
      coerce(puiseux(1/q, uls)$UPXS(R, x, a))$ANY1(UPXS(R, x, a))


)abbrev package GENUPS2 GenerateUnivariatePowerSeries2
++ Author: Clifton J. Williamson, Waldek Hebisch
++ Basic Operations:
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords: series, Taylor, Laurent, Puiseux
++ Examples:
++ References:
++ Description:
++   \spadtype{GenerateUnivariatePowerSeries} provides functions that create
++   power series from explicit formulas for their \spad{n}th coefficient.
GenerateUnivariatePowerSeries2(FE) : Exports == Implementation where
  FE : Join(Ring, RetractableTo SY)
  ANY1 ==> AnyFunctions1
  EQ   ==> Equation
  I    ==> Integer
  NNI  ==> NonNegativeInteger
  RN   ==> Fraction Integer
  SEG  ==> UniversalSegment
  ST   ==> Stream
  SY   ==> Symbol
  UTS  ==> UnivariateTaylorSeries
  ULS  ==> UnivariateLaurentSeries
  UPXS ==> UnivariatePuiseuxSeries

  Exports ==> with
    taylor : (I -> FE, EQ FE) -> Any
      ++ \spad{taylor(n +-> a(n), x = a)} returns
      ++ \spad{sum(n = 0.., a(n)*(x-a)^n)}.
    taylor : (I -> FE, EQ FE, SEG NNI) -> Any
      ++ \spad{taylor(n +-> a(n), x = a, n0..)} returns
      ++ \spad{sum(n=n0.., a(n)*(x-a)^n)};
      ++ \spad{taylor(n +-> a(n), x = a, n0..n1)} returns
      ++ \spad{sum(n = n0.., a(n)*(x-a)^n)}.
    laurent : (I -> FE, EQ FE, SEG I) -> Any
      ++ \spad{laurent(n +-> a(n), x = a, n0..)} returns
      ++ \spad{sum(n = n0.., a(n) * (x - a)^n)};
      ++ \spad{laurent(n +-> a(n), x = a, n0..n1)} returns
      ++ \spad{sum(n = n0..n1, a(n) * (x - a)^n)}.

    puiseux : (RN -> FE, EQ FE, SEG RN, RN) -> Any
      ++ \spad{puiseux(n +-> a(n), x = a, r0.., r)} returns
      ++ \spad{sum(n = r0, r0 + r, r0 + 2*r..., a(n) * (x - a)^n)};
      ++ \spad{puiseux(n +-> a(n), x = a, r0..r1, r)} returns
      ++ \spad{sum(n = r0 + k*r while n <= r1, a(n) * (x - a)^n)}.

    series : (I -> FE, EQ FE) -> Any
      ++ \spad{series(n +-> a(n), x = a)} returns
      ++ \spad{sum(n = 0.., a(n)*(x-a)^n)}.
    series : (I -> FE, EQ FE, SEG I) -> Any
      ++ \spad{series(n +-> a(n), x = a, n0..)} returns
      ++ \spad{sum(n = n0.., a(n) * (x - a)^n)};
      ++ \spad{series(n +-> a(n), x = a, n0..n1)} returns
      ++ \spad{sum(n = n0..n1, a(n) * (x - a)^n)}.
    series : (RN -> FE, EQ FE, SEG RN, RN) -> Any
      ++ \spad{series(n +-> a(n), x = a, r0.., r)} returns
      ++ \spad{sum(n = r0, r0 + r, r0 + 2*r..., a(n) * (x - a)^n)};
      ++ \spad{series(n +-> a(n), x = a, r0..r1, r)} returns
      ++ \spad{sum(n = r0 + k*r while n <= r1, a(n) * (x - a)^n)}.

    if FE has RetractableTo(I) and FE has Evalable(FE) then

      taylor : (FE, SY, EQ FE) -> Any
        ++ \spad{taylor(a(n), n, x = a)} returns
        ++ \spad{sum(n = 0.., a(n)*(x-a)^n)}.
      taylor : (FE, SY, EQ FE, SEG NNI) -> Any
        ++ \spad{taylor(a(n), n, x = a, n0..)} returns
        ++ \spad{sum(n = n0.., a(n)*(x-a)^n)};
        ++ \spad{taylor(a(n), n, x = a, n0..n1)} returns
        ++ \spad{sum(n = n0.., a(n)*(x-a)^n)}.

      laurent : (FE, SY, EQ FE, SEG I) -> Any
        ++ \spad{laurent(a(n), n, x=a, n0..)} returns
        ++ \spad{sum(n = n0.., a(n) * (x - a)^n)};
        ++ \spad{laurent(a(n), n, x=a, n0..n1)} returns
        ++ \spad{sum(n = n0..n1, a(n) * (x - a)^n)}.

    if FE has RetractableTo(RN) and FE has Evalable(FE) then

      puiseux : (FE, SY, EQ FE, SEG RN, RN) -> Any
        ++ \spad{puiseux(a(n), n, x = a, r0.., r)} returns
        ++ \spad{sum(n = r0, r0 + r, r0 + 2*r..., a(n) * (x - a)^n)};
        ++ \spad{puiseux(a(n), n, x = a, r0..r1, r)} returns
        ++ \spad{sum(n = r0 + k*r while n <= r1, a(n) * (x - a)^n)}.

      series : (FE, SY, EQ FE) -> Any
        ++ \spad{series(a(n), n, x = a)} returns
        ++ \spad{sum(n = 0.., a(n)*(x-a)^n)}.
      series : (FE, SY, EQ FE, SEG I) -> Any
        ++ \spad{series(a(n), n, x=a, n0..)} returns
        ++ \spad{sum(n = n0.., a(n) * (x - a)^n)};
        ++ \spad{series(a(n), n, x=a, n0..n1)} returns
        ++ \spad{sum(n = n0..n1, a(n) * (x - a)^n)}.
      series : (FE, SY, EQ FE, SEG RN, RN) -> Any
        ++ \spad{series(a(n), n, x = a, r0.., r)} returns
        ++ \spad{sum(n = r0, r0 + r, r0 + 2*r..., a(n) * (x - a)^n)};
        ++ \spad{series(a(n), n, x = a, r0..r1, r)} returns
        ++ \spad{sum(n = r0 + k*r while n <= r1, a(n) * (x - a)^n)}.

  Implementation ==> add

    GENUPS1 ==> GenerateUnivariatePowerSeries1(FE)

    taylor(f, eq) ==
      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
        error "taylor: left hand side must be a variable"
      x := xx@SY; a := rhs eq
      taylor(f, x, a)$GENUPS1

    taylor(f : I -> FE, eq : EQ FE, seg : SEG NNI) ==
      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
        error "taylor: left hand side must be a variable"
      x := xx@SY; a := rhs eq
      taylor(f, x, a, seg)$GENUPS1

    laurent(f, eq, seg) ==
      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
        error "taylor: left hand side must be a variable"
      x := xx@SY; a := rhs eq
      laurent(f, x, a, seg)$GENUPS1

    puiseux(f, eq, seg, r) ==
      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
        error "puiseux: left hand side must be a variable"
      x := xx@SY; a := rhs eq
      puiseux(f, x, a, seg, r)$GENUPS1

    series(f : I -> FE, eq : EQ FE) ==
        puiseux(r +-> f(numer r), eq, segment 0, 1)

    series(f : I -> FE, eq : EQ FE, seg : SEG I) ==
      ratSeg := map(x +-> x::RN, seg)$UniversalSegmentFunctions2(I, RN)
      puiseux((r : RN) : FE +-> f(numer r), eq, ratSeg, 1)

    series(f : RN -> FE, eq : EQ FE, seg : SEG RN, r : RN) ==
        puiseux(f, eq, seg, r)

    if FE has RetractableTo(I) and FE has Evalable(FE) then

      taylor(an : FE, n : SY, eq : EQ FE) : Any ==
          taylor((i : I) : FE +-> eval(an, (n :: FE) = (i :: FE)), eq)

      taylor(an, n, eq, seg) ==
          taylor((i : I) : FE +-> eval(an, (n :: FE) = (i :: FE)), eq, seg)

      laurent(an, n, eq, seg) ==
          laurent((i : I) : FE +-> eval(an, (n :: FE) = (i :: FE)), eq, seg)

    if FE has RetractableTo(RN) and FE has Evalable(FE) then

      puiseux(an, n, eq, r0, m) ==
          puiseux((r : RN) : FE +-> eval(an, (n :: FE) = (r :: FE)), eq, r0, m)

      series(an : FE, n : SY, eq : EQ FE) == puiseux(an, n, eq, segment 0, 1)
      series(an : FE, n : SY, eq : EQ FE, seg : SEG I) ==
          ratSeg := map(i+->i::RN, seg)$UniversalSegmentFunctions2(I, RN)
          puiseux(an, n, eq, ratSeg, 1)
      series(an : FE, n : SY, eq : EQ FE, seg : SEG RN, r : RN) ==
          puiseux(an, n, eq, seg, r)

)abbrev package GENUPS GenerateUnivariatePowerSeries
++ Description:
++  This package is to restrict interpreter choice of signatures,
++  and force Expression when no types are declared
GenerateUnivariatePowerSeries(
  R : Join(IntegralDomain, Comparable, RetractableTo Integer,
           LinearlyExplicitOver Integer),
    FE : Join(RetractableTo Symbol, TranscendentalFunctionCategory,
              FunctionSpace R)) ==
      GenerateUnivariatePowerSeries2(FE)


--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--All rights reserved.
--
--Redistribution and use in source and binary forms, with or without
--modification, are permitted provided that the following conditions are
--met:
--
--    - Redistributions of source code must retain the above copyright
--      notice, this list of conditions and the following disclaimer.
--
--    - Redistributions in binary form must reproduce the above copyright
--      notice, this list of conditions and the following disclaimer in
--      the documentation and/or other materials provided with the
--      distribution.
--
--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--      names of its contributors may be used to endorse or promote products
--      derived from this software without specific prior written permission.
--
--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
