-- Copyright (c) David Amos, 2008-2011. All rights reserved.-- |Constructions of the finite geometries AG(n,Fq) and PG(n,Fq), their points, lines and flats,-- together with the incidence graphs between points and lines.moduleMath.Combinatorics.FiniteGeometrywhereimportData.ListasLimportqualifiedData.SetasSimportMath.Common.ListSet(toListSet)importMath.Core.UtilsimportMath.Core.FieldimportMath.Algebra.LinearAlgebra-- hiding ( det )importMath.Combinatorics.GraphimportMath.Combinatorics.GraphAuts-- for use in GHCiimportMath.Algebra.Group.PermutationGrouphiding(elts)-- for use in GHCiimportMath.Algebra.Group.SchreierSimsasSShiding(elts)-- for use in GHCi-- !! The following two functions previously required (FiniteField a) as context-- but this has been temporarily removed to enable them to work with Math.Core.Field-- |ptsAG n fq returns the points of the affine geometry AG(n,Fq), where fq are the elements of FqptsAG::Int->[a]->[[a]]ptsAG0fq=[[]]ptsAGnfq=[x:xs|x<-fq,xs<-ptsAG(n-1)fq]-- |ptsPG n fq returns the points of the projective geometry PG(n,Fq), where fq are the elements of FqptsPG::Numa=>Int->[a]->[[a]]ptsPG0_=[[1]]ptsPGnfq=map(0:)(ptsPG(n-1)fq)++map(1:)(ptsAGnfq)-- "projective normal form"pnf(0:xs)=0:pnfxspnf(1:xs)=1:xspnf(x:xs)=1:map(*x')xswherex'=recipxispnf(0:xs)=ispnfxsispnf(1:xs)=Trueispnf_=False-- closure of points in AG(n,Fq)-- given p1, .., pk, we're looking for all a1 p1 + ... + ak pk, s.t. a1 + ... + ak = 1-- if m is the matrix with p1, .., pk as rows, and vs are the vectors [a1, .., ak]-- then this is the same as [v <*>> m | v <- vs] == [m' <<*> v | v <- vs]-- |Given a list of points in AG(n,Fq), return their closure, the smallest flat containing themclosureAG::(Numa,Orda,FinSeta)=>[[a]]->[[a]]closureAGps=letvs=[(1-sumxs):xs|xs<-ptsAG(k-1)fq]-- k-vectors over fq whose sum is 1intoListSet[m'<<*>v|v<-vs]wherek=lengthps-- the dimension of the flat (assuming ps are independent)m'=L.transposepsfq=elts-- toListSet call sorts the result, and also removes duplicates in case the points weren't independent{-
closureAG ps =
let vs = [ (1 - sum xs) : xs | xs <- ptsAG (k-1) fq ] -- k-vectors over fq whose sum is 1
in toListSet [foldl1 (<+>) $ zipWith (*>) v ps | v <- vs]
where k = length ps -- the dimension of the flat
fq = eltsFq undefined
-}lineAG[p1,p2]=L.sort[p1<+>(c*>dp)|c<-fq]wheredp=p2<->p1fq=elts-- closure of points in PG(n,Fq)-- take all linear combinations of the points (ie the subspace generated by the points, considered as points in Fq ^(n+1) )-- then discard all which aren't in PNF (thus dropping back into PG(n,Fq))-- |Given a set of points in PG(n,Fq), return their closure, the smallest flat containing themclosurePG::(Numa,Orda,FinSeta)=>[[a]]->[[a]]closurePGps=toListSet$filterispnf$map(<*>>ps)$ptsAGkfqwherek=lengthpsfq=elts-- toListSet call sorts the result, and also removes duplicates in case the points weren't independentlinePG[p1,p2]=toListSet$filterispnf[(a*>p1)<+>(b*>p2)|a<-fq,b<-fq]wherefq=elts-- van Lint & Wilson, p325, 332qtorialnq|n>=0=product[(q^i-1)`div`(q-1)|i<-[1..n]]-- van Lint & Wilson, p326qnomialnkq=(n`qtorial`q)`div`((k`qtorial`q)*((n-k)`qtorial`q))-- Cameron, p129numFlatsPGnqk=qnomial(n+1)(k+1)q-- because it's the number of subspaces in AG n+1 -- Cameron, p137numFlatsAGnqk=q^(n-k)*qnomialnkqqtorialsq=scanl(*)1[(q^i-1)`div`(q-1)|i<-[1..]]qnomialsq=iteratesucc[1]wheresuccxs=L.zipWith3(\lrc->l+c*r)(0:xs)(xs++[0])(iterate(*q)1)-- succ xs = zipWith (+) (0:xs) $ zipWith (*) (xs++[0]) $ iterate (*q) 1 -- This amounts to saying-- [n+1,k]_q = [n,k-1]_q + q^k [n,k]_q-- Cameron, Combinatorics, p126-- FLATS VIA REDUCED ROW ECHELON FORMS-- Suggested by Cameron p125dataZeroOneStar=Zero|One|Starderiving(Eq)instanceShowZeroOneStarwhereshowZero="0"showOne="1"showStar="*"-- reduced row echelon formsrrefsnk=map(rref11)(combinationsOfk[1..n])whererrefrc(x:xs)=ifc==xthenzipWith(:)(oneColumnr)(rref(r+1)(c+1)xs)elsezipWith(:)(starColumnr)(rrefr(c+1)(x:xs))rref_c[]=replicatek(replicate(n+1-c)Star)oneColumnr=replicate(r-1)Zero++One:replicate(k-r)ZerostarColumnr=replicate(r-1)Star++replicate(k+1-r)Zero-- flatsPG :: (FiniteField a) => Int -> [a] -> Int -> [[[a]]]-- |@flatsPG n fq k@ returns the k-flats in PG(n,Fq), where fq are the elements of Fq.-- The returned flats are represented as matrices in reduced row echelon form,-- the rows of which are the points that generate the flat.-- The full set of points in the flat can be recovered by calling 'closurePG'flatsPG::(Eqa,Numa)=>Int->[a]->Int->[[[a]]]flatsPGnfqk=concatMapsubstStars$rrefs(n+1)(k+1)wheresubstStars(r:rs)=[r':rs'|r'<-substStars'r,rs'<-substStarsrs]substStars[]=[[]]substStars'(Star:xs)=[x':xs'|x'<-fq,xs'<-substStars'xs]substStars'(Zero:xs)=map(0:)$substStars'xssubstStars'(One:xs)=map(1:)$substStars'xssubstStars'[]=[[]]-- Flats in AG(n,Fq) are just the flats in PG(n,Fq) which are not "at infinity"-- flatsAG :: (FiniteField a) => Int -> [a] -> Int -> [[[a]]]-- |flatsAG n fq k returns the k-flats in AG(n,Fq), where fq are the elements of Fq.flatsAG::(Eqa,Numa)=>Int->[a]->Int->[[[a]]]flatsAGnfqk=[maptail(r:map(r<+>)rs)|r:rs<-flatsPGnfqk,headr==1]-- The head r == 1 condition is saying that we want points which are in the "finite" part of PG(n,Fq), not points at infinity-- The reason we add r to each of the rs is to bring them into the "finite" part-- (If you don't do this, it can lead to incorrect results, for example some of the flats having the same closure)-- linesPG :: (FiniteField a) => Int -> [a] -> [[[a]]]-- |The lines (1-flats) in PG(n,fq)linesPG::(Eqa,Numa)=>Int->[a]->[[[a]]]linesPGnfq=flatsPGnfq1-- linesAG :: (FiniteField a) => Int -> [a] -> [[[a]]]-- |The lines (1-flats) in AG(n,fq)linesAG::(Eqa,Numa)=>Int->[a]->[[[a]]]linesAGnfq=flatsAGnfq1-- almost certainly not as efficient as linesAG, because requires lineAG/closureAG call-- among all pairs of distinct points, select those which are the first two in the line they generatelinesAG1nfq=[[x,y]|[x,y]<-combinationsOf2(ptsAGnfq),[x,y]==take2(lineAG[x,y])]-- the point of the condition at the end is to avoid listing the same line more than once-- almost certainly not as efficient as linesAG, because requires lineAG/closureAG call-- a line in AG(n,fq) is a translation (x) of a line through the origin (y)linesAG2nfq=[[x,z]|x<-ptsAGnfq,y<-ptsPG(n-1)fq,z<-[x<+>y],[x,z]==take2(closureAG[x,z])]-- INCIDENCE GRAPH-- |Incidence graph of PG(n,fq), considered as an incidence structure between points and linesincidenceGraphPG::(Numa,Orda,FinSeta)=>Int->[a]->Graph(Either[a][[a]])incidenceGraphPGnfq=Gvseswherepoints=ptsPGnfqlines=linesPGnfqvs=L.sort$mapLeftpoints++mapRightlineses=L.sort[[Leftx,Rightb]|b<-lines,x<-closurePGb]-- Could also consider incidence structure between points and planes, etc-- incidenceAuts (incidenceGraphPG n fq) == PGL(n,fq) * auts fq-- For example, incidenceAuts (incidenceGraphPG 2 f4) =-- PGL(3,f4) * auts f4-- where PGL(3,f4)/PSL(3,f4) == f4* (multiplicative group of f4),-- and auts f4 == { 1, x -> x^2 } (the Frobenius aut)-- The full group is called PGammaL(3,f4)-- |Incidence graph of AG(n,fq), considered as an incidence structure between points and linesincidenceGraphAG::(Numa,Orda,FinSeta)=>Int->[a]->Graph(Either[a][[a]])incidenceGraphAGnfq=Gvseswherepoints=ptsAGnfqlines=linesAGnfqvs=L.sort$mapLeftpoints++mapRightlineses=L.sort[[Leftx,Rightb]|b<-lines,x<-closureAGb]-- incidenceAuts (incidenceGraphAG n fq) == Aff(n,fq) * auts fq-- where Aff(n,fq), the affine group, is the semi-direct product GL(n,fq) * (fq^n)+-- where (fq^n)+ is the additive group of translations-- Each elt of Aff(n,fq) is of the form x -> ax + b, where a <- GL(n,fq), b <- (fq^n)+orderGLnq=product[q^n-q^i|i<-[0..n-1]]-- for the first row, we can choose any vector except zero, hence q^n-1-- for the second row, we can choose any vector except a multiple of the first, hence q^n-q-- etcorderAffnq=q^n*orderGLnqorderPGLnq=orderGLnq`div`(q-1)-- NOTE:-- AG(n,F2) is degenerate:-- Every pair of points is a line, so it is the complete graph on 2^n points-- And as such has aut group S(2^n)-- Heawood graph = incidence graph of Fano planeheawood=to1n$incidenceGraphPG2f2