\documentclass{article}
\usepackage{axiom}
\begin{document}
\title{\$SPAD/src/algebra weier.spad}
\author{William H. Burge}
\maketitle
\begin{abstract}
\end{abstract}
\eject
\tableofcontents
\eject
\section{package WEIER WeierstrassPreparation}
<<package WEIER WeierstrassPreparation>>=
)abbrev package WEIER WeierstrassPreparation
++ Author:William H. Burge
++ Date Created:Sept 1988
++ Date Last Updated:Feb 15 1992
++ Basic Operations:
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ Examples:
++ References:
++ Description: This package implements the Weierstrass preparation
++ theorem f for multivariate power series.
++ weierstrass(v,p) where v is a variable, and p is a
++ TaylorSeries(R) in which there is term of form c*v^s where c is
++ a constant.  Let s be minimal as above.  The result
++ is a list of TaylorSeries coefficients A[i] of the
++ equivalent polynomial
++ A = A[0] + A[1]*v + A[2]*v^2 + ... + A[s-1]*v^(s-1) + v^s
++ such that p=A*B , B being a TaylorSeries of minimum degree 0
WeierstrassPreparation(R): Defn == Impl where
    R : Field
    VarSet==>Symbol
    SMP ==> Polynomial R
    PS  ==> InnerTaylorSeries SMP
    NNI ==> NonNegativeInteger
    ST  ==> Stream
    StS ==> Stream SMP
    STPS==>StreamTaylorSeriesOperations
    STTAYLOR==>StreamTaylorSeriesOperations
    SUP==> SparseUnivariatePolynomial(SMP)
    ST2==>StreamFunctions2
    SMPS==>  TaylorSeries(R)
    L==>List
    coef ==> coefficient$SUP


    Defn ==>  with

        weierstrass:(VarSet,SMPS)->L SMPS
          ++\spad{weierstrass(v,ts)} where v is a variable and ts is
          ++ a TaylorSeries, implements the Weierstrass Preparation
          ++ Theorem. The result is a list of TaylorSeries that
          ++ are the coefficients of the equivalent series.

    Impl ==>  add
        import TaylorSeries(R)
        import StreamTaylorSeriesOperations SMP
        import StreamTaylorSeriesOperations SMPS


        map1==>map$(ST2(SMP,SUP))
        map2==>map$(ST2(StS,SMP))
        map3==>map$(ST2(StS,StS))

        qqq : (NNI, SMPS, ST SMPS) -> ((ST SMPS) -> ST SMPS)

        transback(smps : ST SMPS) : L SMPS ==
            if empty?(smps)
            then empty()$(L SMPS)
            else
              if empty?(first (smps pretend (ST StS)))
              then empty()$(L SMPS)
              else
                cons(map2((ss : StS) : SMP +->
                                 if empty?(ss) then 0 else first ss,
                          smps pretend ST StS)pretend SMPS,
                     transback(map3((ss : StS) : StS +-> rest(ss, 1),
                               smps pretend ST StS) pretend (ST SMPS))
                    )$(L SMPS)

        streamlikeUniv(p : SUP, n : NNI) : StS ==
          if n=0
          then cons(coef (p,0), empty()$StS)
          else cons(coef (p,n),streamlikeUniv(p,(n-1)::NNI))

        transpose(s : ST StS) : ST StS ==delay(
           if empty?(s)
           then empty()$(ST StS)
           else cons(map2(first, s),transpose(map3(rest, rst s))))

        zp==>map$StreamFunctions3(SUP,NNI,StS)

        NO_COEFF ==> "can not find power of variable with constant coefficient"

        sts2stst(var : VarSet, sts : StS) : ST StS ==
           si0 : ST NNI := (integers 0) pretend ST NNI
           zp((x, y) +-> streamlikeUniv(x, y),
             map1((p : SMP) : SUP +-> univariate(p, var), sts),si0)

        tp(v : VarSet, sts : StS) : ST StS == transpose sts2stst(v, sts)

        map4==>map$(ST2 (StS,StS))

        maptake(n : NNI, p : ST StS) : ST SMPS ==
            map4((ss : StS) : StS +-> first(ss, n), p) pretend ST SMPS

        mapdrop(n : NNI, p : ST StS) : ST SMPS ==
            map4((ss : StS) : StS +-> rest(ss, n), p) pretend ST SMPS

        YSS==>Y$ParadoxicalCombinatorsForStreams(SMPS)

        weier(v : VarSet, sts : StS) : ST SMPS ==
            p := tp(v, sts) pretend (ST SMPS)
            b : StS := first p pretend StS
            a : NNI
            for a0 in 0.. repeat
                a0 = 1000 => error NO_COEFF
                empty?(b) => error NO_COEFF
                (b0 := first b) = 0 =>
                    b := rest b
                    "iterate"
                c := retractIfCan(b0)@Union(R, "failed")
                c case R =>
                    a := a0
                    break
                b := rest b
            e := recip b
            f := if e case "failed"
                     then error "no reciprocal"
                     else e::StS
            q := (YSS qqq(a,f pretend SMPS,rest p))
            maptake(a,(p*q) pretend ST StS)

        qq:(NNI,SMPS,ST SMPS,ST SMPS)->ST SMPS
        qq(a,e,p,c)==
            cons(e,(-e)*mapdrop(a,(p*c)pretend(ST StS)))

        qqq(a, e, p) ==  s +-> qq(a, e, p, s)

        wei(v : VarSet, s : SMPS) : ST SMPS == weier(v, s pretend StS)

        weierstrass(v, smps) ==
            coefficient(smps, 0) ~= 0 => empty()
            transback wei (v,smps)

@
\section{License}
<<license>>=
--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.
@
<<*>>=
<<license>>

<<package WEIER WeierstrassPreparation>>
@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}
