{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}
module CanonicalOrbits where


import qualified E8
import qualified Weyl
import           Weyl (G(G))

import qualified Algebra.Module
import           Control.Applicative ((<$>))
import           Data.List           (sort,foldl',genericLength)
import qualified Data.Set       as Set
import           Data.Traversable    (for)
import qualified Data.Vector    as V
import qualified MathObj.Matrix as Matrix
import qualified Number.Peano   as Peano
import qualified Number.Ratio   as Ratio
import           NumericPrelude      ((*>))
import           System.Environment  (getArgs)
import           System.IO           (hSetBuffering,BufferMode(LineBuffering),stdout)


normalise :: [G] -> E8.Vector -> E8.Vector
normalise representatives x = minimum $ map (\ r -> n $ r ^*^ x) representatives where
  n :: E8.Vector -> E8.Vector
  n = V.fromList . changeSigns . sort' . V.toList where
    sort' = map snd . sort . map (\ x -> (signum x *> x,x))
    changeSigns (c1 : cs) = case unzip . map (\ c -> let s = signum c in (s *> c,s)) $ cs of
      (cs',signs) -> foldl' (*) 1 signs *> c1 : cs'

instance Algebra.Module.C E8.Coordinate E8.Coordinate where
  x *> y = x * y

(^*^) :: G -> E8.Vector -> E8.Vector
(G m) ^*^ v = V.fromList . map (E8.inp v . V.fromList . map Ratio.toRational98) . Matrix.rows $ m

-- Verify whether a given vector is orthogonal to 2*7 roots.
canonical :: E8.Vector -> Bool
canonical = (== peano7) . genericLength . filter (== 0) . flip map E8.posRoots . E8.inp

peano7 :: Peano.T
peano7 = 7


main :: IO ()
main = do
  hSetBuffering stdout LineBuffering
  d1 : d2 : _ <- map read <$> getArgs
  rs <- Weyl.representatives
  for [d1 .. d2] $ \ d -> do
    putStr $ "Number of orbits of canonical vectors of length d = " ++ show d ++ ": "
    let orbits = Set.size . Set.fromList . map (normalise rs) . filter canonical $ E8.gen d
    print orbits
  return ()