-- Gustav Kirchoff -- Invoke with: ghci GustavProb.hs -hide-package mtl-1.1.0.2 -- Or in ghci: :set -hide-package mtl module GustavProb where --For nickie's read import Char import Data.List --For IOArray import Data.Array.IO --For State handling import Control.Monad.State --Sugartzis import Control.Monad(when) {- -- Example for IOArray main = do arr <- newArray (1,10) 37 :: IO (IOArray Int Int) a <- readArray arr 1 writeArray arr 1 64 b <- readArray arr 1 print (a,b) -} -- Repeat n times Monad m action --count n m = sequence $ take n $ repeat m -- Tree datatype is an IOArray of Weigts and List of children --data Tree a = T IOArray Int (a, [Int]) -- deriving Show -- Proper read of input (by nickie) getWord :: IO String getWord = do c <- getChar if isSpace c then return "" else do s <- getWord return (c : s) readOne :: Read a => IO a readOne = do w <- getWord return (read w) readGraph :: Int -> Int -> IOArray Int (Int, [Int]) -> IO () readGraph i n arr = do when (i <= n) $ do bi <- readOne pi <- readOne -- Insert node i writeArray arr i (bi, []) -- Update children of pi (if not root) if pi > 0 then do (w, childs) <- readArray arr pi :: IO (Int, [Int]) writeArray arr pi (w, i : childs) else return () readGraph (i+1) n arr -- State is Center index and Center value type MyState = (Int, Int) type MyMonadState = State MyState -- Gustav function -- Gets node index and Tree and returns weight of subtree with root index. gustav :: IOArray Int (Int, [Int]) -> Int -> MyMonadstate Int gustav t i = do (w,childs) <- readArray t i :: IO (Int, [Int]) child_weights <- sequence $ map (gustav t) childs let max = foldr max 0 child_weights res = foldr (+) w child_weights (min_i, min) <- get if max < min then put (i, max) else put (min_i, min) return res main = do n <- readOne arr <- newArray (1,n) (0,[]) :: IO (IOArray Int (Int,[Int])) readGraph 1 n arr print $ evalState (gustav arr 4) (0, 100) {- --Hardcoded testcase writeArray arr 1 (10, []) writeArray arr 2 (10, [3]) writeArray arr 3 (10, [1,4]) writeArray arr 4 (20, [5]) writeArray arr 5 (20, []) gustav arr 4 -}