module Exercise_5 where
import           Test.QuickCheck
import           Data.List
import           Data.Array
import           Data.Function                  ( on )

{- H5.3 -}
{-WETT-}
type Vertex = Int
type Edge = (Vertex, Vertex)
type Graph = ([Vertex], [Edge])

prepArray (vs, es) = accumArray (\currentFroms from -> from : currentFroms) [] (foldr1 min vs, foldr1 max vs) (map (\(a, b) -> (b, a)) es)
{-prepArray (vs, es) = array (foldr1 min vs, foldr1 max vs) (([(i, []) | i <- vs] ++ (map (\arr -> (snd $ head arr, map fst arr)) (groupBy (\(afrom, ato) (bfrom, bto) -> ato == bto) (sortBy (compare `on` snd) es)))))-}

aux_longestPath :: Vertex -> Array Vertex [Vertex] -> Int
aux_longestPath posn es = foldr max 0 [ 1 + (aux_longestPath from es) | from <- es ! posn ]

longestPath :: Graph -> Vertex -> Int
longestPath (vs, es) t = aux_longestPath t (prepArray (vs, es))

{-TTEW-}

aux_longestPath_fast :: Vertex -> [(Vertex {-to-}, [Vertex] {-from-})] -> Int
aux_longestPath_fast posn es = foldr max 0 nexts
 where
  nexts = [ 1 + (aux_longestPath_fast from es) | from <- localGroup ]
  localGroup = case find (\(to, _) -> to == posn) es of
    Just (to, froms) -> froms
    Nothing -> []

longestPath_fast :: Graph -> Vertex -> Int
longestPath_fast (vs, es) t = aux_longestPath_fast t (map (\arr -> (snd $ head arr, map fst arr)) (groupBy (\(afrom, ato) (bfrom, bto) -> ato == bto) (sortBy (compare `on` snd)
 es)))

aux_longestPath_vanilla :: Vertex -> [Edge] -> Int
aux_longestPath_vanilla posn es = foldr max 0 nexts
 where
  nexts =
    [ 1 + (aux_longestPath_vanilla from es) | (from, to) <- es, to == posn ]

longestPath_vanilla :: Graph -> Vertex -> Int
longestPath_vanilla (vs, es) t = aux_longestPath_vanilla t es

-- generates a DAG with u vertices and only one node without incoming edges
-- you can use this function to test your implementation using QuickCheck
genDag :: Int -> Gen Graph
genDag n =
  let v = [1 .. n]
  in  do
        b <- mapM (\i -> choose (1, n - i)) [1 .. n - 1]
        t <- mapM (\(c, i) -> vectorOf c (choose (i + 1, n))) (zip b [1 .. n])
        let e = nub $ ([ (1, i) | i <- [2 .. n] ] ++ edges t 1 [])
        return $ (v, e)
 where
  edges []        _ acc = acc
  edges (ts : xs) i acc = edges xs (i + 1) (acc ++ [ (i, t) | t <- ts ])


prop_testGen :: Int -> Property
prop_testGen size = size > 0 && size <= 32 ==> do
  g@(vs, _) <- genDag size
  v         <- elements vs
  return $ longestPath g v === longestPath_vanilla g v

prop_testGen10 :: Property
prop_testGen10 =
  property $
    do g@(vs, _) <- genDag 256
       v <- elements vs
       return $ prepArray g === prepArray g

prop_testGen10_fast :: Property
prop_testGen10_fast =
  property $
    do g@(vs, _) <- genDag 32
       v <- elements vs
       return $ longestPath_fast g v === longestPath_fast g v

prop_testGen10_vanilla :: Property
prop_testGen10_vanilla =
  property $
    do g@(vs, _) <- genDag 32
       v <- elements vs
       return $ longestPath_vanilla g v === longestPath_vanilla g v