axiom-source 20170501-3 / usr / share / axiom-20170501 / src / algebra / SCPKG.spad

)abbrev package SCPKG StructuralConstantsPackage
++ Authors: J. Grabmeier
++ Date Created: 02 April 1992
++ Date Last Updated: 14 April 1992
++ Description:
++ StructuralConstantsPackage provides functions creating
++ structural constants from a multiplication tables or a basis
++ of a matrix algebra and other useful functions in this context.

StructuralConstantsPackage(R) : SIG == CODE where
  R : Field

  L  ==> List
  S  ==> Symbol
  FRAC ==> Fraction
  POLY ==> Polynomial
  V  ==> Vector
  M  ==> Matrix
  REC  ==> Record(particular: Union(V R,"failed"),basis: List V R)
  LSMP ==> LinearSystemMatrixPackage(R,V R,V R, M R)

  SIG ==>  with

      -- what we really want to have here is a matrix over
      -- linear polynomials in the list of symbols, having arbitrary
      -- coefficients from a ring extension of R, for example FRAC POLY R.

    structuralConstants : (L S, M FRAC POLY R) -> V M FRAC POLY R
      ++ structuralConstants(ls,mt) determines the structural constants
      ++ of an algebra with generators ls and multiplication table mt, the
      ++ entries of which must be given as linear polynomials in the
      ++ indeterminates given by ls. The result is in particular useful
      ++  as fourth argument for \spadtype{AlgebraGivenByStructuralConstants}
      ++  and \spadtype{GenericNonAssociativeAlgebra}.

    structuralConstants : (L S, M POLY R) -> V M POLY R
      ++ structuralConstants(ls,mt) determines the structural constants
      ++ of an algebra with generators ls and multiplication table mt, the
      ++ entries of which must be given as linear polynomials in the
      ++ indeterminates given by ls. The result is in particular useful
      ++  as fourth argument for \spadtype{AlgebraGivenByStructuralConstants}
      ++  and \spadtype{GenericNonAssociativeAlgebra}.

    structuralConstants : L M R -> V M R
      ++ structuralConstants(basis)  takes the basis of a matrix
      ++ algebra, for example the result of \spadfun{basisOfCentroid} and 
      ++ calculates the structural constants.
      ++ Note, that the it is not checked, whether basis really is a
      ++ basis of a matrix algebra.

    coordinates : (M R, L M R) -> V R
      ++ coordinates(a,[v1,...,vn]) returns the coordinates of \spad{a}
      ++ with respect to the \spad{R}-module basis \spad{v1},...,\spad{vn}.

  CODE ==> add

      matrix2Vector: M R -> V R
      matrix2Vector m ==
        lili : L L R := listOfLists m
        --li : L R  := reduce(concat, listOfLists m)
        li : L R  := reduce(concat, lili)
        construct(li)$(V R)

      coordinates(x,b) ==
        m : NonNegativeInteger := (maxIndex b) :: NonNegativeInteger
        n : NonNegativeInteger := nrows(b.1) * ncols(b.1)
        transitionMatrix   : Matrix R := new(n,m,0$R)$Matrix(R)
        for i in 1..m repeat
          setColumn_!(transitionMatrix,i,matrix2Vector(b.i))
        res : REC := solve(transitionMatrix,matrix2Vector(x))$LSMP
        if (not every?(zero?$R,first res.basis)) then
          error("coordinates: the second argument is linearly dependent")
        (res.particular  case "failed") =>
          error("coordinates: first argument is not in linear span of _
                second argument")
        (res.particular) :: (Vector R)

      structuralConstants b ==
        --n := rank()
        -- be careful with the possibility that b is not a basis
        m : NonNegativeInteger := (maxIndex b) :: NonNegativeInteger
        sC : Vector Matrix R := [new(m,m,0$R) for k in 1..m]
        for i in 1..m repeat
          for j in 1..m repeat
            covec : Vector R := coordinates(b.i * b.j, b)$%
            for k in 1..m repeat
               setelt( sC.k, i, j, covec.k )
        sC

      structuralConstants(ls:L S, mt: M POLY R)  ==
        nn := #(ls)
        nrows(mt) ^= nn or ncols(mt) ^= nn =>
          error "structuralConstants: size of second argument does not _
                 agree with number of generators"
        gamma : L M POLY R := []
        lscopy : L S := copy ls
        while not null lscopy repeat
          mat : M POLY R := new(nn,nn,0)
          s : S := first lscopy
          for i in 1..nn repeat
            for j in 1..nn repeat
              p := qelt(mt,i,j)
              totalDegree(p,ls) > 1 =>
                error "structuralConstants: entries of second argument _
                       must be linear polynomials in the generators"
              if (c := coefficient(p, s, 1) ) ^= 0 then qsetelt_!(mat,i,j,c)
          gamma := cons(mat, gamma)
          lscopy := rest lscopy
        vector reverse gamma

      structuralConstants(ls:L S, mt: M FRAC POLY R)  ==
        nn := #(ls)
        nrows(mt) ^= nn or ncols(mt) ^= nn =>
          error "structuralConstants: size of second argument does not _
                 agree with number of generators"
        gamma : L M FRAC(POLY R) := []
        lscopy : L S := copy ls
        while not null lscopy repeat
          mat : M FRAC(POLY R) := new(nn,nn,0)
          s : S := first lscopy
          for i in 1..nn repeat
            for j in 1..nn repeat
              r := qelt(mt,i,j)
              q := denom(r)
              totalDegree(q,ls) ^= 0 =>
                error "structuralConstants: entries of second argument _
                       must be (linear) polynomials in the generators"
              p := numer(r)
              totalDegree(p,ls) > 1 =>
                error "structuralConstants: entries of second argument _
                       must be linear polynomials in the generators"
              if (c := coefficient(p, s, 1) ) ^= 0 then qsetelt_!(mat,i,j,c/q)
          gamma := cons(mat, gamma)
          lscopy := rest lscopy
        vector reverse gamma