module Exercise_5 where
import Test.QuickCheck
import Data.List 
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as Map


{- H5.3 -}
{-WETT-}
type Vertex = Int
type Edge = (Vertex, Vertex)
type Graph = ([Vertex], [Edge])
--
-- pretty much a wrapper for tsKahn and lpFromMap
longestPath :: Graph -> Vertex -> Int
longestPath g t = let edges = snd g
                      initMap = Map.fromList (map (\a -> (a,[])) (fst g))
                      (tsort, paths) = tsKahn t edges ([], initMap) in
                      lpFromMap paths t tsort

-- Kahns algorithm for topological sorting, also 
-- saves only the required paths for computing distance dynamically.
-- Stops when the desired vertice is sorted, which can lead to dramatic speedups
-- when that vertice is sorted early on.
-- Not really an optimal solution (atleast some preprocessing could help...)
-- but hey, 'dabeisein ist Alles'.
-- Also sorry to anyone who tries to decipher the code below (or just the
-- freaking type-signatures)
tsKahn :: Int -> [(Int, Int)] -> ([Int], Map Int [Int]) -> ([Int], Map Int [Int])
tsKahn t edgs res = tsKahn' edgs [1] res
        where tsKahn' _ []      (s,m)          = ((reverse s),m)
              tsKahn' es (x:xs) (s,m) 
                  | x == t = ((reverse (x:s)), m)
                  | otherwise = tsKahn' es' (xs++noIncs) ((x:s),m')
                      where children  = map (snd) $ filter (\(a,_) -> a == x) es
                            es'       = es \\ [(x,c) | c <- children]
                            noIncs    = filter (\a -> 
                                         isNothing(find (\(_,b) -> b == a) es')) 
                                         children
                            m'        = updateMap noIncs x m

-- Updates the path. Inlining this is akin to thinking that putting spoilers
-- on your car adds horsepower, but now it looks a little more as if
-- I knew what I was doing
{-# INLINE updateMap #-}  
updateMap :: [Int] -> Int -> Map Int [Int] -> Map Int [Int]
updateMap []     _   res = res
updateMap (x:xs) par res = updateMap xs par (Map.adjust (adF par) x res)
        where adF x k = x:k

-- If vertices were guaranteed to be a list of type [1..n] an array would be
-- faster here, but I don't think that constructing a bijection is worth it.
-- Simply fill a HashMap by dynamically computing 
-- dist(v) = max dist({w | (w,v) in g}) .
-- The topological sort linearizes the graph, so previus distances have 
-- always already been evaluated. Also, tsKahn only produces this 
-- topological sort until the desired vertice has been reached, so
-- no need to check for that.
lpFromMap :: Map Int [Int] -> Int -> [Int] -> Int
lpFromMap m t ts = fromJust $ Map.lookup t m'   
        where m' = Map.fromList $ map (f) ts
              f x
                  | x == 1    = (1, 0)
                  | otherwise = (x , maximum vals)
                      where pars = fromJust $ Map.lookup x m
                            vals  = map 
                                     (\v -> (1+) $ fromJust $ Map.lookup v m') pars

{-TTEW-}

-- 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])