-- Copyright (c) David Amos, 2008. All rights reserved.moduleMath.Algebra.NonCommutative.GSBasiswhereimportData.ListasLimportMath.Algebra.NonCommutative.NCPoly-- given two monomials f g, find if possible a,b,c with f=ab g=bcfindOverlap(Mxs)(Mys)=findOverlap'[]xsyswherefindOverlap'as[]cs=Nothing-- (reverse as, [], cs)findOverlap'as(b:bs)cs=if(b:bs)`L.isPrefixOf`csthenJust(M$reverseas,M$b:bs,M$drop(length(b:bs))cs)elsefindOverlap'(b:as)bscs-- given two monomials f g, find if possible l,r with g = lfr-- findInclusion (M xs) (M ys) = findInclusion' sPolyf@(NP((xs,c):_))g@(NP((ys,d):_))=casefindOverlapxsysofJust(l,m,r)->f*NP[(r,d)]-NP[(l,c)]*gNothing->0sPoly__=0-- !! shouldn't reach this-- The point about the s-poly is that it cancels out the leading terms of the two polys, exposing their second termsgb1fs=gb'fs[sPolyfifj|fi<-fs,fj<-fs,fi/=fj]where-- unlike the commutative case, we take sPolys both ways roundgb'gs(h:hs)=leth'=h%%gsinifh'==0thengb'gshselsegb'(h':gs)(hs++[sPolyh'g|g<-gs]++[sPolygh'|g<-gs])gb'gs[]=gsreducegs=reduce'[]gswherereduce'gs'(g:gs)|g'==0=reduce'gs'gs|otherwise=reduce'(g':gs')gswhereg'=g%%(gs'++gs)reduce'gs'[]=reverse$sort$gs'gbfs=maptoMonic$reduce$gb1fsgb'fs=reduce$gb1fsgb2fs=gb'fs[(fi,fj)|fi<-fs,fj<-fs,fi/=fj]where-- unlike the commutative case, we take sPolys both ways roundgb'gs((fi,fj):pairs)=leth=sPolyfifj%%gsinifh==0thengb'gspairselsegb'(h:gs)(pairs++[(h,g)|g<-gs]++[(g,h)|g<-gs])gb'gs[]=gsgb2'fs=gb'fs[(fi,fj)|fi<-fs,fj<-fs,fi/=fj]where-- unlike the commutative case, we take sPolys both ways roundgb'gs((fi,fj):pairs)=leth=sPolyfifj%%gsinifh==0thengb'gspairselse(fi,fj,sPolyfifj,h):gb'(h:gs)(pairs++[(h,g)|g<-gs]++[(g,h)|g<-gs])gb'gs[]=[]-- gs-- Monomial basis for the quotient algebra, where gs are the generators, rs the relationsmbasisQAgsrs=mbasisQA'[1]wherembasisQA'[]=[]-- the quotient ring has a finite monomial basismbasisQA'ms=letms'=[g*m|g<-gs,m<-ms,g*m%%rs==g*m]-- ie, not reducibleinms++mbasisQA'ms'{-
isGB fs = all (\h -> h %% fs == 0) (pairWith sPoly fs)
-}