\documentclass{article}
\usepackage{open-axiom}
\begin{document}
\title{\$SPAD/src/algebra fnla.spad}
\author{Larry Lambe}
\maketitle
\begin{abstract}
\end{abstract}
\eject
\tableofcontents
\eject
\section{domain OSI OrdSetInts}
<<domain OSI OrdSetInts>>=
)abbrev domain OSI OrdSetInts
++  Author : Larry Lambe
++  Date created : 14 August 1988
++  Date Last Updated : 11 March 1991
++  Description : A domain used in order to take the free R-module on the
++  Integers I.  This is actually the forgetful functor from OrderedRings
++  to OrderedSets applied to I
OrdSetInts: Export == Implement where
   I  ==> Integer
   L  ==> List
   O  ==> OutputForm

   Export == OrderedSet with
     coerce : Integer -> %
	++ coerce(i) returns the element corresponding to i
     value  : % -> I
	++ value(x) returns the integer associated with x

   Implement == add
     Rep := Integer
     x,y: %

     x = y == x =$Rep y
     x < y == x <$Rep y

     coerce(i:Integer):% == i

     value(x) == x:Rep

     coerce(x):O ==
       sub(e::Symbol::O, coerce(x)$Rep)$O

@
\section{domain COMM Commutator}
<<domain COMM Commutator>>=
)abbrev domain COMM Commutator
++ Author : Larry Lambe
++ Date created: 30 June 1988.
++ Updated     : 10 March 1991
++ Description: A type for basic commutators
Commutator: Export == Implement where
   I   ==> Integer
   OSI ==> OrdSetInts
   O   ==> OutputForm

   Export == SetCategory with
     mkcomm : I -> %
	++ mkcomm(i) \undocumented{}
     mkcomm : (%,%) -> %
	++ mkcomm(i,j) \undocumented{}

   Implement == add
     import OSI
     P   :=  Record(left:%,right:%)
     Rep := Union(OSI,P)
     x,y: %
     i  : I

     x = y ==
        (x case OSI) and (y case OSI) => x::OSI = y::OSI
        (x case P) and (y case P) =>
           xx:P := x::P
           yy:P := y::P
           (xx.right = yy.right) and (xx.left = yy.left)
        false

     mkcomm(i) == i::OSI
     mkcomm(x,y) == construct(x,y)$P

     coerce(x: %): O ==
        x case OSI => x::OSI::O
        xx := x::P
        bracket([xx.left::O,xx.right::O])$O

@
\section{package HB HallBasis}
<<package HB HallBasis>>=
)abbrev package HB HallBasis
++ Author : Larry Lambe
++ Date Created : August  1988
++ Date Last Updated : March 9 1990
++ Related Constructors: OrderedSetInts, Commutator, FreeNilpotentLie
++ AMS Classification: Primary 17B05, 17B30; Secondary 17A50
++ Keywords: free Lie algebra, Hall basis, basic commutators
++ Description : Generate a basis for the free Lie algebra on n
++ generators over a ring R with identity up to basic commutators
++ of length c using the algorithm of P. Hall as given in Serre's
++ book Lie Groups -- Lie Algebras

HallBasis() : Export == Implement where
   B   ==> Boolean
   I   ==> Integer
   NNI ==> NonNegativeInteger
   VI  ==> Vector Integer
   VLI ==> Vector List Integer

   Export  ==> with
     lfunc : (I,I) -> I
       ++ lfunc(d,n) computes the rank of the nth factor in the
       ++ lower central series of the free d-generated free Lie
       ++ algebra;  This rank is d if n = 1 and binom(d,2) if
       ++ n = 2
     inHallBasis? : (I,I,I,I) -> B
       ++ inHallBasis?(numberOfGens, leftCandidate, rightCandidate, left)
       ++ tests to see if a new element should be added to the P. Hall
       ++ basis being constructed.
       ++ The list \spad{[leftCandidate,wt,rightCandidate]}
       ++ is included in the basis if in the unique factorization of
       ++ rightCandidate, we have left factor leftOfRight, and
       ++ leftOfRight <= leftCandidate
     generate : (NNI,NNI) -> VLI
       ++ generate(numberOfGens, maximalWeight) generates a vector of
       ++ elements of the form [left,weight,right] which represents a
       ++ P. Hall basis element for the free lie algebra on numberOfGens
       ++ generators.  We only generate those basis elements of weight
       ++ less than or equal to maximalWeight

   Implement ==> add

     lfunc(d,n) ==
        negative? n => 0
        n = 0 => 1
        n = 1 => d
        sum:I := 0
        for m in 1..(n-1) repeat
          if n rem m = 0 then
            sum := sum + m * lfunc(d,m)
        res := (d**(n::NNI) - sum) quo n

     inHallBasis?(n,i,j,l) ==
        i >= j => false
        j <= n => true
        l <= i => true
        false

     generate(n:NNI,c:NNI) ==
        gens:=n
        maxweight:=c
        siz:I := 0
        for i in 1 .. maxweight repeat siz := siz + lfunc(gens,i)
        v:VLI:= new(siz::NNI,[])
        for i in 1..gens repeat v(i) := [0, 1, i]
        firstindex:VI := new(maxweight::NNI,0)
        wt:I := 1
        firstindex(1) := 1
        numComms:I := gens
        newNumComms:I := numComms
        done:B := false
        while not done repeat
          wt := wt + 1
          if wt > maxweight then done := true
          else
            firstindex(wt) := newNumComms + 1
            leftIndex := 1
            -- cW == complimentaryWeight
            cW:I := wt - 1
            while (leftIndex <= numComms) and (v(leftIndex).2 <= cW) repeat
              for rightIndex in firstindex(cW)..(firstindex(cW+1) - 1) repeat
                if inHallBasis?(gens,leftIndex,rightIndex,v(rightIndex).1) then
                  newNumComms := newNumComms + 1
                  v(newNumComms) := [leftIndex,wt,rightIndex]
              leftIndex := leftIndex + 1
              cW := wt - v(leftIndex).2
            numComms := newNumComms
        v

@
\section{domain FNLA FreeNilpotentLie}
<<domain FNLA FreeNilpotentLie>>=
)abbrev domain FNLA FreeNilpotentLie
++ Author: Larry Lambe
++ Date Created: July 1988
++ Date Last Updated: March 13 1991
++ Related Constructors: OrderedSetInts, Commutator
++ AMS Classification: Primary 17B05, 17B30; Secondary 17A50
++ Keywords: free Lie algebra, Hall basis, basic commutators
++ Related Constructors:  HallBasis, FreeMod, Commutator, OrdSetInts
++ Description: Generate the Free Lie Algebra over a ring R with identity;
++ A P. Hall basis is generated by a package call to HallBasis.

FreeNilpotentLie(n:NNI,class:NNI,R: CommutativeRing): Export == Implement where
   B   ==> Boolean
   Com ==> Commutator
   HB  ==> HallBasis
   I   ==> Integer
   NNI ==> NonNegativeInteger
   O   ==> OutputForm
   OSI ==> OrdSetInts
   FM  ==> FreeModule(R,OSI)
   VI  ==> Vector Integer
   VLI ==> Vector List Integer
   lC  ==> leadingCoefficient
   lS  ==> leadingSupport

   Export ==> NonAssociativeAlgebra(R) with
     dimension : () -> NNI
       ++ dimension() is the rank of this Lie algebra
     deepExpand    : %   -> O
	++ deepExpand(x) \undocumented{}
     shallowExpand    : %   -> O
	++ shallowExpand(x) \undocumented{}
     generator : NNI -> %
       ++ generator(i) is the ith Hall Basis element

   Implement ==> FM add
     Rep := FM
     f,g : %

     coms:VLI
     coms := generate(n,class)$HB

     dimension() == #coms

     have : (I,I) -> %
       -- have(left,right) is a lookup function for basic commutators
       -- already generated; if the nth basic commutator is
       -- [left,wt,right], then have(left,right) = n
     have(i,j) ==
        wt:I := coms(i).2 + coms(j).2
        wt > class => 0
        lo:I := 1
        hi:I := dimension()
        while hi-lo > 1 repeat
          mid:I := (hi+lo) quo 2
          if coms(mid).2 < wt then lo := mid else hi := mid
        while coms(hi).1 < i repeat hi := hi + 1
        while coms(hi).3 < j repeat hi := hi + 1
        monomial(1,hi::OSI)$FM

     generator(i) ==
       i > dimension() => 0$Rep
       monomial(1,i::OSI)$FM

     putIn : I -> %
     putIn(i) ==
       monomial(1$R,i::OSI)$FM

     brkt : (I,%) -> %
     brkt(k,f) ==
       f = 0 => 0
       dg:I := value lS f
       reductum(f) = 0 =>
         k = dg  => 0
         k > dg  => -lC(f)*brkt(dg, putIn(k))
         inHallBasis?(n,k,dg,coms(dg).1) => lC(f)*have(k, dg)
         lC(f)*( brkt(coms(dg).1, _
          brkt(k,putIn coms(dg).3)) - brkt(coms(dg).3, _
           brkt(k,putIn coms(dg).1) ))
       brkt(k,monomial(lC f,lS f)$FM)+brkt(k,reductum f)

     f*g ==
       reductum(f) = 0 =>
         lC(f)*brkt(value(lS f),g)
       monomial(lC f,lS f)$FM*g + reductum(f)*g

     Fac : I -> Com
       -- an auxilliary function used for output of Free Lie algebra
       -- elements (see expand)
     Fac(m) ==
       coms(m).1 = 0 => mkcomm(m)$Com
       mkcomm(Fac coms(m).1, Fac coms(m).3)

     shallowE : (R,OSI) -> O
     shallowE(r,s) ==
       k := value s
       r = 1 =>
         k <= n => s::O
         mkcomm(mkcomm(coms(k).1)$Com,mkcomm(coms(k).3)$Com)$Com::O
       k <= n => r::O * s::O
       r::O * mkcomm(mkcomm(coms(k).1)$Com,mkcomm(coms(k).3)$Com)$Com::O

     shallowExpand(f) ==
       f = 0           => 0@R::O
       reductum(f) = 0 => shallowE(lC f,lS f)
       shallowE(lC f,lS f) + shallowExpand(reductum f)

     deepExpand(f) ==
       f = 0          => 0@R::O
       reductum(f) = 0 =>
         lC(f)=1 => Fac(value(lS f))::O
         lC(f)::O * Fac(value(lS f))::O
       lC(f)=1 => Fac(value(lS f))::O + deepExpand(reductum f)
       lC(f)::O * Fac(value(lS f))::O + deepExpand(reductum f)

@
\section{License}
<<license>>=
--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--All rights reserved.
--Copyright (c) 2007-2010, Gabriel Dos Reis.
--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>>

<<domain OSI OrdSetInts>>
<<domain COMM Commutator>>
<<package HB HallBasis>>
<<domain FNLA FreeNilpotentLie>>
@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}