import Data.Foldable as Fold import Data.Maybe as Maybe import Data.List.Split import Data.List as List main = do content <- getContents let ops = map parse $ lines content --let result = foldl toMap [("COM",0)] (sorted ops "COM") let result = toTree2 "YOU" ops 0 mapM putStrLn (map show result) putStrLn $ show $ sum (map (\x-> snd x) result) putStrLn("Hello World") toMap :: [(String,Int)] -> (String,String) -> [(String,Int)] toMap state (p1,p2) = state ++ [(p2, (snd value) + 1)] where value = (fromMaybe (p1,-1) ((Fold.find (\x -> fst x == p1) state))) sorted :: [(String, String)] -> String -> [(String, String)] sorted input base = baseOps ++ (concat $ map (sorted input) subelems) where baseOps = filter (\(x, _) -> x == base) input subelems = map snd baseOps toTree :: [(String,Int)] -> [(String,String)] -> [(String,Int)] toTree dist ops = do let visits = map fst dist let newop = (Fold.find (\x-> (elem (fst x) visits)) ops) if Maybe.isNothing newop then dist else do let newdist = toMap dist (Maybe.fromJust newop) let newops = List.delete (Maybe.fromJust newop) ops toTree newdist newops toTree2 :: String -> [(String,String)] -> Int -> [(String,Int)] toTree2 base ops counter = do let rightnewop = (filter (\x-> base == fst x) ops) let leftnewop = (filter (\x-> base == snd x) ops) let newstops = (map snd rightnewop) ++ ( map fst leftnewop) if null rightnewop && null leftnewop then [] else do let newcounter = counter + 1 let newdist = (map (\x-> (x,newcounter)) newstops) let newops = filter(\x->notElem x (leftnewop ++ rightnewop)) ops newdist ++ (concat $ map (\x -> toTree2 x newops newcounter) newstops) parse :: String -> (String, String) parse input = do let split = splitOn ")" input (split !! 0, split !! 1)