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
combinationsOf 0 _ = [[]]
combinationsOf _ [] = []
combinationsOf k (x:xs) = map (x:) (combinationsOf (k1) xs) ++ combinationsOf k xs
ptsAG 0 fq = [[]]
ptsAG n fq = [x:xs | x <- fq, xs <- ptsAG (n1) fq]
ptsPG 0 _ = [[1]]
ptsPG n fq = map (0:) (ptsPG (n1) fq) ++ map (1:) (ptsAG n fq)
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
closureAG ps =
let multipliers = [ (1 sum xs) : xs | xs <- ptsAG (k1) fq ]
in S.toList $ S.fromList [foldl1 (<+>) $ zipWith (*>) m ps | m <- multipliers]
where n = length $ head ps
k = length ps
fq = eltsFq undefined
closurePG ps = L.sort $ filter ispnf $ map (<*>> ps) $ ptsAG k fq where
k = length ps
fq = eltsFq undefined
qtorial n q | n >= 0 = product [(q^i 1) `div` (q1) | i <- [1..n]]
qnomial n k q = (n `qtorial` q) `div` ( (k `qtorial` q) * ((nk) `qtorial` q) )
numFlatsPG n q k = qnomial (n+1) (k+1) q
numFlatsAG n q k = q^(nk) * qnomial n k q
qtorials q = scanl (*) 1 [(q^i 1) `div` (q1) | 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)
data ZeroOneStar = Zero | One | Star deriving (Eq)
instance Show ZeroOneStar where
show Zero = "0"
show One = "1"
show Star = "*"
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+1c) Star)
oneColumn r = replicate (r1) Zero ++ One : replicate (kr) Zero
starColumn r = replicate (r1) Star ++ replicate (k+1r) Zero
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' [] = [[]]
flatsAG n fq k = [map tail (r : map (r <+>) rs) | r:rs <- flatsPG n fq k, head r == 1]