)abbrev domain OSI OrdSetInts
++  Author : Larry Lambe
++  Date created : 14 August 1988
++  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::O, coerce(x)$Rep)$O

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

)abbrev package HB HallBasis
++ Author : Larry Lambe
++ Date Created : August  1988
++ 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
     basis : (NNI, NNI) -> VLI
       ++ basis(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) ==
        n < 0 => 0
        n = 0 => 1
        n = 1 => d
        sum : I := 0
        m : I
        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

     basis(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

)abbrev domain FNLA FreeNilpotentLie
++ Author: Larry Lambe
++ Date Created: July 1988
++ 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) rewrites all terms of x as commutators
        ++ of generators.
     shallowExpand    : %   -> O
        ++ shallowExpand(x) replaces elements of basis
        ++ by commutators of other basis elements if
        ++ possible.
     generator : NNI -> %
       ++ generator(i) is the ith Hall Basis element

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

     coms : VLI
     coms := basis(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::O
       reductum(f) = 0 => shallowE(lC f, lS f)
       shallowE(lC f, lS f) + shallowExpand(reductum f)

     deepExpand(f) ==
       f = 0          => 0::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)

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