-- Copyright (c) David Amos, 2008-2009. All rights reserved. module Math.Combinatorics.FiniteGeometry where import Data.List as L import qualified Data.Set as S import Math.Algebra.Field.Base import Math.Algebra.Field.Extension hiding ( (<+>) ) import Math.Algebra.LinearAlgebra -- hiding ( det ) import Math.Combinatorics.Graph -- |ptsAG n fq returns the points of the affine geometry AG(n,Fq), where fq are the elements of Fq ptsAG :: (FiniteField a) => Int -> [a] -> [[a]] ptsAG 0 fq = [[]] ptsAG n fq = [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 Fq ptsPG :: (FiniteField a) => Int -> [a] -> [[a]] ptsPG 0 _ = [[1]] ptsPG n fq = map (0:) (ptsPG (n-1) fq) ++ map (1:) (ptsAG n fq) -- "projective normal form" pnf (0:xs) = 0 : pnf xs pnf (1:xs) = 1 : xs pnf (x:xs) = 1 : map (* x') xs where x' = recip x ispnf (0:xs) = ispnf xs ispnf (1:xs) = True ispnf _ = False -- closure of points in AG(n,Fq) -- result is sorted closureAG ps = let multipliers = [ (1 - sum xs) : xs | xs <- ptsAG (k-1) fq ] -- k-vectors over fq whose sum is 1 in S.toList $ S.fromList [foldl1 (<+>) $ zipWith (*>) m ps | m <- multipliers] where n = length $ head ps -- the dimension of the space we're working in k = length ps -- the dimension of the flat fq = eltsFq undefined -- 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)) closurePG ps = L.sort $ filter ispnf $ map (<*>> ps) $ ptsAG k fq where k = length ps fq = eltsFq undefined -- van Lint & Wilson, p325, 332 qtorial n q | n >= 0 = product [(q^i - 1) `div` (q-1) | i <- [1..n]] -- van Lint & Wilson, p326 qnomial n k q = (n `qtorial` q) `div` ( (k `qtorial` q) * ((n-k) `qtorial` q) ) -- Cameron, p129 numFlatsPG n q k = qnomial (n+1) (k+1) q -- because it's the number of subspaces in AG n+1 -- Cameron, p137 numFlatsAG n q k = q^(n-k) * qnomial n k q qtorials q = scanl (*) 1 [(q^i - 1) `div` (q-1) | i <- [1..]] qnomials q = iterate succ [1] where succ xs = L.zipWith3 (\l r c -> 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 p125 data ZeroOneStar = Zero | One | Star deriving (Eq) instance Show ZeroOneStar where show Zero = "0" show One = "1" show Star = "*" -- reduced row echelon forms rrefs n k = map (rref 1 1) (combinationsOf k [1..n]) where rref r c (x:xs) = if c == x then zipWith (:) (oneColumn r) (rref (r+1) (c+1) xs) else zipWith (:) (starColumn r) (rref r (c+1) (x:xs)) rref _ c [] = replicate k (replicate (n+1-c) Star) oneColumn r = replicate (r-1) Zero ++ One : replicate (k-r) Zero starColumn r = replicate (r-1) Star ++ replicate (k+1-r) Zero -- |flatsPG n fq k returns the k-flats in PG(n,Fq), where fq are the elements of Fq flatsPG :: (FiniteField a) => Int -> [a] -> Int -> [[[a]]] flatsPG n fq k = concatMap substStars $ rrefs (n+1) (k+1) where substStars (r:rs) = [r':rs' | r' <- substStars' r, rs' <- substStars rs] substStars [] = [[]] substStars' (Star:xs) = [x':xs' | x' <- fq, xs' <- substStars' xs] substStars' (Zero:xs) = map (0:) $ substStars' xs substStars' (One:xs) = map (1:) $ substStars' xs substStars' [] = [[]] -- Flats in AG(n,Fq) are just the flats in PG(n,Fq) which are not "at infinity" -- |flatsAG n fq k returns the k-flats in AG(n,Fq), where fq are the elements of Fq flatsAG :: (FiniteField a) => Int -> [a] -> Int -> [[[a]]] flatsAG n fq k = [map tail (r : map (r <+>) rs) | r:rs <- flatsPG n fq k, head r == 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) -- |The lines (1-flats) in PG(n,fq) linesPG :: (FiniteField a) => Int -> [a] -> [[[a]]] linesPG n fq = flatsPG n fq 1 -- |The lines (1-flats) in AG(n,fq) linesAG :: (FiniteField a) => Int -> [a] -> [[[a]]] linesAG n fq = flatsAG n fq 1 -- less efficient but perhaps more intuitive -- a line in AG(n,fq) is a translation (x) of a line through the origin (y) linesAG1 n fq = [ [x,z] | x <- ptsAG n fq, y <- ptsPG (n-1) fq, z <- [x <+> y], [x,z] == take 2 (closureAG [x,z]) ] -- the point of the condition at the end is to avoid listing the same line more than once -- INCIDENCE GRAPH -- |Incidence graph of PG(n,fq), considered as an incidence structure between points and lines incidenceGraphPG :: (Ord a, FiniteField a) => Int -> [a] -> Graph (Either [a] [[a]]) incidenceGraphPG n fq = G vs es where points = ptsPG n fq lines = linesPG n fq vs = L.sort $ map Left points ++ map Right lines es = L.sort [ [Left x, Right b] | b <- lines, x <- closurePG b] -- 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 lines incidenceGraphAG :: (Ord a, FiniteField a) => Int -> [a] -> Graph (Either [a] [[a]]) incidenceGraphAG n fq = G vs es where points = ptsAG n fq lines = linesAG n fq vs = L.sort $ map Left points ++ map Right lines es = L.sort [ [Left x, Right b] | b <- lines, x <- closureAG b] -- 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)+ orderGL n q = 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 -- etc orderAff n q = q^n * orderGL n q -- 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 as aut group S(2^n)