gustav kirchoff

-- 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
-}