blob: 843729291c5c18ca11c36b57838fd5c6e71b6dd5 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
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
|