import System.Exit
import qualified Exercise02 as Sub
import qualified Solution as Sol
import Text.Printf
import System.CPUTime
import System.IO
import Control.Monad
import Data.List
import Test.QuickCheck
import Test.QuickCheck.Gen
import Test.QuickCheck.Random

import qualified Data.IntSet as S
{-
Stage 1: size (1,10), n = 250, timeout 5s
Stage 2: size 30, n = 1, timeout 20s
Stage 3: size 50, n = 1, timeout 1s
Stage 4: size (1,20), n = 10^5, timeout 600s
Stage 5: all tournaments of size up to 7 + 10^5 of size 8
-}

-- (size, nTests) = ((1,10), 250) -- Stage 1: timeout 5s
-- (size, nTests) = ((30,30), 1) -- Stage 2: timeout 20s
(size, nTests) = ((50,50), 1) -- Stage 3: timeout 1s
-- (size, nTests) = ((1,20), 10^5) -- Stage 4: timeout 600s
-- Stage 5: all tournaments of size up to 7 + 10^5 of size 8


-- Generate all tournaments of a given size
allTournaments :: Int -> [[[Int]]]
allTournaments 0 = [[]]
allTournaments n =
  do bs <- replicateM (n - 1) [True, False]
     t <- ts
     let x = map snd (filter fst (zip bs [1..]))
     let t' = [if b then xs else insert n xs | (xs, b) <- zip t bs]
     return (t' ++ [x])
  where ts = allTournaments (n - 1)


-- QUICKCHECK GENERATORS
players :: [[Int]] -> [Int]
players t = [1..length t]

dominion :: [[Int]] -> Int -> [Int]
dominion t i = t !! (i - 1)


deleteElem :: Int -> [[Int]] -> [[Int]]
deleteElem i tournament = map reindex rel'
  where rel' = case splitAt (i - 1) tournament of
                 (xs, ys) -> xs ++ drop 1 ys
        reindex xs = [if j < i then j else j - 1 | j <- xs, j /= i]

shrinkTournament:: [[Int]] -> [[[Int]]]
shrinkTournament tournament = if length tournament <= 1 then [] else [deleteElem i tournament | i <- players tournament]
  where n = length tournament

genTournament1 :: Int -> Gen [[Int]]
genTournament1 n = fmap (map S.toList) (aux [] n)
  where aux ss 0 = return ss
        aux ss i = do dominion1 <- sublistOf [1..i-1]
                      let dominion2 = [j | (j, s) <- zip [i+1..] ss, i `S.notMember` s]
                      let s = S.fromList dominion1 `S.union` S.fromList dominion2
                      aux (s : ss) (i - 1)

sublistOf' :: Eq a => Int -> [a] -> Gen [a]
sublistOf' n xs = aux n xs []
  where aux 0 as bs = return bs
        aux n as bs =
          do x <- elements as
             aux (n - 1) (delete x as) (x : bs)

genTournament2 :: Int -> Gen [[Int]]
genTournament2 n = fmap (map S.toList) (aux [] n)
  where aux ss 0 = return ss
        aux ss i = do m <- choose (0, i - 1)
                      dominion1 <- sublistOf' m [1..i-1]
                      let dominion2 = [j | (j, s) <- zip [i+1..] ss, i `S.notMember` s]
                      let s = S.fromList dominion1 `S.union` S.fromList dominion2
                      aux (s : ss) (i - 1)

genBiasedTournamentAux :: Int -> Double -> Double -> Gen [[Int]]
genBiasedTournamentAux n exp m =
  do biases <- replicateM n (choose (1, m)) :: Gen [Double]
     fmap (map S.toList) (aux [] n biases)
  where fight :: Double -> Double -> Gen Bool
        fight b1 b2 = liftM2 (>) (choose (0, exp ** (b1 ** 0.5))) (choose (0, exp ** (b2 ** 0.5)))
        aux :: [S.IntSet] -> Int -> [Double] -> Gen [S.IntSet]
        aux ss 0 _ = return ss
        aux ss i (b : bs) =
          do let bs' = reverse bs
             dominion1 <- fmap concat (zipWithM (\i b' -> fmap (\b -> if b then [i] else []) (fight b b')) [1..] bs')
             let dominion2 = [j | (j, s) <- zip [i+1..] ss, i `S.notMember` s]
             let s = S.fromList dominion1 `S.union` S.fromList dominion2
             aux (s : ss) (i - 1) bs

interpolate :: [(Double, Double)] -> Double -> Double
interpolate [(_, x)] t = x
interpolate ((a, x) : (b, y) : xs) t
  | t < a = x
  | t > b = interpolate ((b, y) : xs) t
  | otherwise = ((t - a) * y + (b - t) * x) / (b - a)

genTournament3 n = genBiasedTournamentAux n exp 10000
  where exp = interpolate [(3, 1.01), (20, 1.09), (50, 1.25), (100, 1.55), (200, 2.5)] (fromIntegral n)
-- END GENERATORS





(==?) :: (Show a, Eq a) => a -> a -> Property
act ==? exp = counterexample msg $ act == exp
  where msg = printf "Expected: \"%s\"\nActual: \"%s\"" (show exp) (abbrev 1000 (show act))

normalize :: [Int] -> [Int]
normalize = map head . group . sort

propAllEq :: (Show a, Eq a, Show b) => Gen b -> (b -> [b]) -> (b -> a) -> (b -> a) -> Property
propAllEq gen shrink sub sol = forAllShrink gen shrink (\x -> counterexample ("Input: " ++ show x) (sub x ==? sol x))


propAllEq' = propAllEq (choose size >>= genTournament3) shrinkTournament

mkTest sub sol =
  do res <- quickCheckWithResult (stdArgs {replay = Just (mkQCGen 42, 0), maxSuccess = nTests, chatty = False}) (propAllEq' sub sol)
     if isSuccess res then
       return True
     else do
       hPutStrLn stderr (showRes res)
       return False
       
isFailure :: Test.QuickCheck.Result -> Bool
isFailure (Failure _ _ _ _ _ _ _ _ _ _ _ _ _) = True
isFailure _ = False
       
showRes :: Test.QuickCheck.Result -> String
showRes res
  | isFailure res =
      case theException res of
        Just e -> "Exception thrown:\n" ++ show (theException res)
        Nothing -> output res
  | otherwise = show res

runTests :: [IO Bool] -> IO Bool
runTests [] = return True
runTests (x : xs) =
  do b <- x
     if b then runTests xs else return False

tests = runTests [mkTest (normalize . sub) (normalize . sol) | (sub, sol) <- [(Sub.copeland, Sol.copeland), (Sub.uncoveredSet, Sol.uncoveredSet), (Sub.topCycle, Sol.topCycle)]]

longerThan :: Int -> [a] -> Bool
longerThan _ [] = False
longerThan 0 _ = True
longerThan n (x : xs) = longerThan (n - 1) xs

abbrev n xs = if longerThan n xs then take n xs ++ "…" else xs

main =
  do start <- getCPUTime
     b <- tests
     if b then do
       end <- getCPUTime
       let diff = (fromIntegral (end - start)) / (10^12)
       printf "%8.2f s\n" (diff :: Double)
     else
       exitWith (ExitFailure 1)