5-1

1 files changed, 30 insertions, 0 deletions

diff --git a/5-1.hs b/5-1.hs
new file mode 100644
index 0000000..c84d1f6
--- /dev/null
+++ b/5-1.hs
@@ -0,0 +1,30 @@
+pairs' :: [a] -> [(a,a)] -> [(a,a)]
+pairs' [] ys = ys
+pairs' (x:xs) ys = pairs' xs (ys ++ map (x,) xs)
+
+pairs :: [a] -> [(a,a)]
+pairs xs = pairs' xs []
+
+ordered :: Eq a => [(a,a)] -> [a] -> Bool
+ordered ps xs = all (`elem` pairs xs) $ filter f ps
+  where
+    f (p,q) = p `elem` xs && q `elem` xs
+
+parse :: String -> ([(Int,Int)], [[Int]])
+parse s = (map pair ls, map list ks)
+  where
+    (ls,_:ks) = span (/= "") (lines s)
+    pair r  = let (p,_:q) = span (/= '|') r in (read p, read q)
+    list r  = read ("[" ++ r ++ "]") :: [Int]
+
+corrects :: String -> [[Int]]
+corrects s = let (ps,xss) = parse s in filter (ordered ps) xss
+
+middle :: [a] -> a
+middle xs = xs !! (length xs `div` 2)
+
+doThing :: String -> Int
+doThing = sum . map middle . corrects
+
+main :: IO ()
+main = getContents >>= print . doThing