module Special where


import           E8 (gen,posRoots,inp,Vector,showVector)

import           Control.Applicative ((<$>),(<*>))
import           Data.List           (genericLength)
import qualified Number.Peano         as Peano
import           System.Environment  (getArgs)


main :: IO ()
main = do
  d : rest <- map read <$> getArgs
  putStr $ "d = " ++ show d ++ ": "
  if null rest
    then do
      let
        special = filter (apt peano7) (gen d)
        verySpecial = filter (apt peano6) special
      case (special,verySpecial) of
        ([]   ,_    ) -> putStrLn $ "No special vectors found."
        (x : _,[]   ) -> putStrLn $ "No very special vectors, but found special vector:" ++ showVector x
        (_    ,x : _) -> putStrLn $ "Found very special vector:" ++ showVector x
    else
      putStrLn $ "Generated: " ++ show (length $ gen d)

-- Verify whether a given vector is orthogonal to at most 2*r roots.
apt :: Peano.T -> Vector -> Bool
apt r = ((&&) <$> (<= r) <*> (>= peano1)) . genericLength . filter (== 0) . flip map posRoots . inp

-- These are "Peano integers" with the special property that one may compare
-- them, while evaluating them only up to the size needed to decide the
-- comparison.
peano1,peano6,peano7 :: Peano.T
[peano1,peano6,peano7] = [1,6,7]