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

)abbrev domain PACOFF PseudoAlgebraicClosureOfFiniteField
++ Authors: Gaetan Hache
++ Date Created: june 1996 
++ Date Last Updated: May 2010 by Tim Daly
++ Description: 
++ This domain implement  dynamic extension using the simple notion of 
++ tower extensions. A tower extension T  of the ground  field K is any 
++ sequence of field extension (T : K_0, K_1, ..., K_i...,K_n) where K_0 = K 
++ and for i =1,2,...,n, K_i is an extension of K_{i-1} of degree > 1 and 
++ defined by an irreducible polynomial p(Z) in K_{i-1}.
++ Two towers (T_1: K_01, K_11,...,K_i1,...,K_n1)  
++ and (T_2: K_02, K_12,...,K_i2,...,K_n2) are said to be related 
++ if T_1 <= T_2 (or T_1 >= T_2), that is if K_i1 = K_i2 for i=1,2,...,n1 
++ (or i=1,2,...,n2). Any algebraic operations defined for several elements 
++ are only defined if all of the concerned elements are comming from 
++ a set of related tour extensions. 

PseudoAlgebraicClosureOfFiniteField(K) : SIG == CODE where
  K : FiniteFieldCategory
  
  INT      ==> Integer
  NNI      ==> NonNegativeInteger
  SUP      ==> SparseUnivariatePolynomial
  BOOLEAN  ==> Boolean
  PI       ==> PositiveInteger
  FFFACTSE ==> FiniteFieldFactorizationWithSizeParseBySideEffect

  recRep ==> Record(recEl:SUP(%),_
                    recTower:SUP(%),_
                    recDeg:PI,_
                    recPrevTower:%,_
                    recName:Symbol) 
    
  SIG ==> Join(PseudoAlgebraicClosureOfFiniteFieldCategory,_
                  ExtensionField(K)) with 
  
    fullOutput : % -> OutputForm
  
  CODE ==> add

    Rep := Union(recRep,K)
    
    -- signature of local function  
    replaceRecEl: (%,SUP(%)) -> %
    down: % -> %
    localRandom: % -> %
    repPolynomial : % -> SUP(%)
    
    replaceRecEl(a,el)==
      a case K => a
      aa:=copy a
      aa.recEl := el
      aa

    -- local variable    
    localTower :% := 1$K
        
    localSize :NNI := size()$K
    -- implemetation of exported function

    degree(a)==
      da:PositiveInteger:= extDegree a
      coerce(da@PositiveInteger)$OnePointCompletion(PositiveInteger)

    repPolynomial(a)==
      a case K => error "Is in ground field"
      (a pretend recRep).recEl

    inv(a)==
      a case K => inv(a)$K
      aRecEl:= repPolynomial a
      aDefPoly:= definingPolynomial a 
      aInv := extendedEuclidean( aRecEl , aDefPoly, 1 )
      aInv  case "failed" => error "PACOFF : division by zero"
      down replaceRecEl( a , aInv.coef1 )
      
    a:% ** n:PositiveInteger == 
      zero?(a) => 0
      expt( a , n )$RepeatedSquaring(%)

    a:% ** n:NonNegativeInteger == 
      zero?(a) and zero?(n) => error " --- 0^0 not defined "
      zero?(n) => 1$%
      a ** ( n pretend PositiveInteger )

    a:% ** n:Integer ==
      n < 0 => inv( a ** ( (-n)  pretend PositiveInteger) )
      a ** ( n pretend NonNegativeInteger )

    unitNormal(a)==
      zero? a => [1,0,1]
      [a,1,inv a]

    ground?(a)== a case K

    vectorise(a,lev)==
      da:=extDegree a
      dlev:=extDegree lev
      dlev < da => _
       error "Cannot vectorise at a lower level than the element to vectorise"
      lev case K => [a]
      pa:SUP(%)
      na:%
      ^(da = dlev) =>
        pa:=  monomial(a,0)$SUP(%)
        na:=  replaceRecEl(lev,pa)
        vectorise(na,lev)$%
      prevLev:=previousTower(lev)
      a case K => _
       error "At this point a is not suppose to be in K, big error"
      aEl:=(a pretend recRep).recEl
      daEl:=degree(definingPolynomial a)$SUP(%)
      lv:=[vectorise(c,prevLev)$% for c in entries(vectorise(aEl,daEl)$SUP(%))]
      concat lv        
          
    size == localSize

    setTower!(a) ==
      localTower:=a
      localSize:=(size()$K)**extDegree(a)
      void()
      
    localRandom(a) ==
        --return a random element at the extension of a
      a case K => random()$K
      subF:=previousTower(a)
      d:=degree(a.recTower)-1
      pol:=reduce("+",[monomial(localRandom(subF),i)$SUP(%) for i in 0..d])
      down replaceRecEl(a,pol)
         
    a:% + b:% ==
      (a case K) and (b case K) => a +$K b
      extDegree(a) > extDegree(b) => b + a
      res1:SUP(%)
      res2:%
      if extDegree(a) = extDegree(b) then
        res1:=   b.recEl +$SUP(%) a.recEl
        res2:=   replaceRecEl(b,res1)
      else
        res1:=   b.recEl +$SUP(%) monomial(a,0)$SUP(%)
        res2:= replaceRecEl(b,res1)
      down(res2)
         
    a:% * b:% ==
      (a case K) and (b case K) => a *$K b
      extDegree(a) > extDegree(b) => b * a
      res1:SUP(%)
      res2:%
      if extDegree(a) = extDegree(b) then
        res1:=   b.recEl *$SUP(%) a.recEl rem b.recTower
        res2:=   replaceRecEl(b,res1)
      else
        res1:=   b.recEl *$SUP(%) monomial(a,0)$SUP(%)
        res2:=  replaceRecEl(b,res1)
      down(res2)
      
    distinguishedRootsOf(polyZero,ee) ==
        setTower!(ee)
        zero?(polyZero) => error "to lazy to give you all the roots of 0 !!!"
        factorf: Factored SUP % :=  factor(polyZero)$FFFACTSE(%,SUP(%))
        listFact:List SUP %  := [pol.fctr for pol in factorList(factorf)]
        listOfZeros:List(%):=empty()
        for p in listFact repeat
          root:=newElement(p, new(D::Symbol)$Symbol)
          listOfZeros:List(%):=concat([ root ], listOfZeros)
        listOfZeros
    
    random==
      localRandom(localTower)

    extDegOfGrdField:PI := 
      i: PI := 1
      while characteristic()$K ** i < size()$K repeat
        i:= i + 1
      i

    charthRoot(a : %): % ==
      --return a**(1/chararcteristic )
      a case K => charthRoot(retract a)$K
      b:NNI := extDegree(a) * extDegOfGrdField
      j := subtractIfCan(b,1)
      if (j case "failed") then b:= 0
      else b:= j
      c:= (characteristic()$K) ** b
      a**c

    conjugate(a)==
      a ** size()$K 

    1 == 1$K

    0 == 0$K

    newElement(pol:SUP(%),subF:%,inName:Symbol): % ==
        -- pol is an irreducible polynomial over the field extension
        -- given by subF. 
        -- The output of this function is a root of pol.
      dp:=degree pol
      one?(dp) =>
        listCoef:=coefficients(pol)
        one?(#listCoef) => 0
        - last(listCoef) / first(listCoef)
      ground?(pol) => error "Cannot create a new element with a constant"
      d:PI := (dp pretend PI) * extDegree(subF)
      [monomial(1$%,1),pol,d,subF,inName] :: Rep
      
    newElement(poll:SUP(%),inName:Symbol)==
      newElement(poll,localTower,inName)
       
    maxTower(la)==
        --return an element from the list la which is in the largest
        --extension of the ground field
        --PRECONDITION: all elements in same tower, else no meaning?
      m:=reduce("max",[extDegree(a) for a in la])
      first [b for b in la | extDegree(b)=m]

    --Field operations 

    a:% / b:% == a * inv(b)
    
    a:K * b:%==
      (a :: %) * b
      
    b:% * a:K == a*b

    a:% - b:% ==
      a + (-b)
    
    a:% * b:Fraction(Integer) ==
      bn:=numer b
      bd:=denom b
      ebn:%:= bn * 1$%
      ebd:%:= bd * 1$%
      a * ebn * inv(ebd)

    -a:% ==
       a case K => -$K a 
       [-$SUP(%) (a pretend recRep).recEl,_
        (a pretend recRep).recTower,_
        (a pretend recRep).recDeg,_
        (a pretend recRep).recPrevTower,_
        (a pretend recRep).recName ]
       
    n:INT * a:% ==
      one?(n) => a
      zero?(a) or zero?(n) => 0
      (n < 0) => - ((-n)*a)
      mm:PositiveInteger:=(n pretend PositiveInteger)
      double(mm,a)$RepeatedDoubling(%)
        
    bb:% = aa:% ==
      b:=down bb
      a:=down aa
      ^( extDegree(b) =$NNI extDegree(a) ) => false
      (b case K)  =>  ( (retract a)  =$K (retract b) )
      rda := a :: recRep
      rdb := b :: recRep
      not (rda.recTower =$SUP(%) rdb.recTower) => false
      rdb.recEl =$SUP(%) rda.recEl
        
    zero?(a:%) == 
      da:=down a  -- just to be sure !!!
      ^(da case K) => false
      zero?(da)$K
    
    one?(a:%) ==
      da:= down a  -- just to be sure !!!
      ^(da case K) => false
      one?(da)$K
    
    --Coerce Functions
      
    coerce(a:K) == a       

    retractIfCan(a)==
      a case K => a
      "failed"
               
    coerce(a:%):OutputForm ==
      a case K => (retract a)::OutputForm
      outputForm((a pretend recRep).recEl,_
                ((a pretend recRep).recName)::OutputForm) $SUP(%)

    fullOutput(a:%):OutputForm==
      a case K => (retract a)::OutputForm
      (a pretend recRep)::OutputForm
      
    definingPolynomial(a:%): SUP % ==
      a case K => 1
      (a pretend recRep).recTower

    extDegree(a:%): PI ==
      a case K => 1
      (a pretend recRep).recDeg
      
    previousTower(a:%):% ==
      a case K => error "No previous extension for ground field element"
      (a pretend recRep).recPrevTower
 
    name(a:%):Symbol ==
      a case K => error "No name for ground field element"
      (a pretend recRep).recName

    -- function related to the ground field 
    
    lookup(a:%)==
      aa:=down a
      ^(aa case K) => _
        error "From NonGlobalDynamicExtensionOfFiniteField fnc Lookup: Cannot take i-dex"
      lookup(retract aa)$K

    index(i)==(index(i)$K) 

    fromPrimeField? == characteristic()$K = size()$K
    
    representationType == representationType()$K
   
    characteristic == characteristic()$K

    -- implementation of local functions
    
    down(a:%) == 
      a case K => a
      aa:=(a pretend recRep)
      elel := aa.recEl
      ^ground?(elel) => a
      gel:%:=ground(elel)
      down(gel)