1 files changed, 73 insertions, 0 deletions
diff --git a/2015/day09.hs b/2015/day09.hs
new file mode 100644
index 0000000..8437292
--- /dev/null
+++ b/2015/day09.hs
@@ -0,0 +1,73 @@
+module Main where
+
+import Data.Char
+import Data.List
+import Control.Monad
+import qualified Data.Set as Set
+
+import Debug.Trace
+
+indexof :: (Eq a) => [a] -> a -> Int
+indexof l x = indexof' l x 0
+
+indexof' :: (Eq a) => [a] -> a -> Int -> Int
+indexof' (x:xs) v n | x == v = n
+indexof' (_:xs) v n = indexof' xs v (n+1)
+
+contains :: (Eq a) => [a] -> a -> Bool
+contains [] _ = False
+contains (x:xs) v = if x == v then True else contains xs v
+
+collectnames :: [[String]] -> [String]
+collectnames l = Set.toList $ collectnames' l
+
+collectnames' :: [[String]] -> Set.Set String
+collectnames' [] = Set.empty
+collectnames' ((a:_:b:_):xs) = Set.insert a $ Set.insert b $ collectnames' xs
+
+setinarr :: [a] -> Int -> a -> [a]
+setinarr a i v = pre ++ v : post
+    where spl = splitAt i a
+          pre = fst spl
+          post = tail $ snd spl
+
+setinarr2 :: [[a]] -> (Int,Int) -> a -> [[a]]
+setinarr2 a (i,j) v = pre ++ setinarr line j v : post
+    where spl = splitAt i a
+          pre = fst spl
+          ([line],post) = splitAt 1 $ snd spl
+
+parse :: [[String]] -> [[Int]]
+parse ll = parse' ll names $ replicate numn (replicate numn 0)
+    where names = collectnames ll
+          numn = length names
+
+parse' :: [[String]] -> [String] -> [[Int]] -> [[Int]]
+parse' [] _ adj = adj
+parse' ([as,_,bs,_,ds]:ls) ns adj = parse' ls ns $ setinarr2 (setinarr2 adj (b,a) d) (a,b) d
+    where a = indexof ns as
+          b = indexof ns bs
+          d = read ds :: Int
+
+pathlen :: [Int] -> Int
+pathlen = sum
+
+genpaths :: [[Int]] -> [[Int]]
+genpaths adj = map todists $ concat [genpaths' adj [from] | from <- [0..(length adj - 1)]]
+    where todists (a:b:cs) = adj!!a!!b : todists (b:cs)
+          todists _ = []
+
+genpaths' :: [[Int]] -> [Int] -> [[Int]]
+genpaths' adj pat  -- = -- subl syntax
+    | length pat == length adj = [pat]
+    | otherwise = {-traceShow pat $-} concat [genpaths' adj (from:pat) | from <- [0..(length adj - 1)], adj!!(head pat)!!from /= 0 && not (contains pat from)]
+
+day9 :: IO ()
+day9 = do
+    input <- liftM (map words . lines) $ readFile "day09.txt"
+    print $ collectnames input
+    --print $ parse input
+    --print $ genpaths $ parse input
+    print $ minimum [pathlen $ path | path <- genpaths $ parse input]
+
+main = day9