)abbrev package GENUPS GenerateUnivariatePowerSeries
++ Author: Clifton J. Williamson
++ Date Created: 29 April 1990
++ 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.
GenerateUnivariatePowerSeries(R, FE) : Exports == Implementation where
  R  : Join(IntegralDomain, Comparable, RetractableTo Integer, _
            LinearlyExplicitOver Integer)
  FE : Join(AlgebraicallyClosedField, TranscendentalFunctionCategory, _
            FunctionSpace R)
  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 : (FE, SY, EQ FE) -> Any
      ++ \spad{taylor(a(n), 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)}.
    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 : (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)}.
    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)}.

    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)}.
    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 : (I -> FE, EQ FE) -> Any
      ++ \spad{series(n +-> a(n), x = a)} returns
      ++ \spad{sum(n = 0.., 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 : (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 : (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 : (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)}.
    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

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

    genFiniteStream : (I -> FE, I, I) -> ST FE
    genFiniteStream0 : (I -> FE, I, I) -> ST FE
    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, 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
      coerce(series(genStream(f, 0))$UTS(FE, x, a))$ANY1(UTS(FE, x, a))

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

    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
      hasHi seg =>
        n0 := low(seg); n1 := high(seg)
        if n1 < n0 then (n0, n1) := (n1, n0)
        uts := series(genFiniteStream(f, n0, n1))$UTS(FE, x, a)
        uts := uts * monomial(1, n0)$UTS(FE, x, a)
        coerce(uts)$ANY1(UTS(FE, x, a))
      n0 := low(seg)
      uts := series(genStream(f, n0))$UTS(FE, x, a)
      uts := uts * monomial(1, n0)$UTS(FE, x, a)
      coerce(uts)$ANY1(UTS(FE, x, a))

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

    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
      hasHi seg =>
        n0 := low(seg); n1 := high(seg)
        if n1 < n0 then (n0, n1) := (n1, n0)
        uts := series(genFiniteStream(f, n0, n1))$UTS(FE, x, a)
        coerce(laurent(n0, uts)$ULS(FE, x, a))$ANY1(ULS(FE, x, a))
      n0 := low(seg)
      uts := series(genStream(f, n0))$UTS(FE, x, a)
      coerce(laurent(n0, uts)$ULS(FE, x, a))$ANY1(ULS(FE, x, a))

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

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

    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
      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) : FE +-> modifyFcn(f, n0, nn, q, i), eq, segment(n0, n1))
        uls := retract(ulsUnion)$ANY1(ULS(FE, x, a))
        coerce(puiseux(1/q, uls)$UPXS(FE, x, a))$ANY1(UPXS(FE, 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) : FE +-> modifyFcn(f, n0, nn, q, i), eq, segment n0)
      uls := retract(ulsUnion)$ANY1(ULS(FE, x, a))
      coerce(puiseux(1/q, uls)$UPXS(FE, x, a))$ANY1(UPXS(FE, x, a))

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

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

--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.
