Tidying, especially the parser
[advent-of-code-16.git] / adventofcode16 / app / advent22.hs
1 module Main(main) where
2
3 import GHC.Generics (Generic)
4 import Text.Parsec
5 import Text.ParserCombinators.Parsec.Number
6 import Data.Maybe (catMaybes, fromJust)
7 import Data.List (find, delete, sort, sortOn, reverse)
8
9 data Node = Node { x :: Int
10 , y :: Int
11 , size :: Int
12 , used :: Int
13 , available :: Int
14 , use_pc :: Int
15 } deriving (Show, Eq, Ord)
16
17 data SearchState = SearchState { cx :: Int
18 , cy :: Int
19 , grid :: [Node]
20 } deriving (Show)
21 instance Ord SearchState where
22 s1 `compare` s2 = (heuristic s1) `compare` (heuristic s2)
23 instance Eq SearchState where
24 s1 == s2 = equivalentState s1 s2
25
26 equivalentState :: SearchState -> SearchState -> Bool
27 equivalentState s1 s2 =
28 let h1 = fromJust $ find (\n -> used n == 0) $ grid s1
29 h2 = fromJust $ find (\n -> used n == 0) $ grid s2
30 in
31 cx s1 == cx s2 && cy s1 == cy s2 &&
32 x h1 == x h2 && y h1 == y h2
33
34
35 testGrid = "\
36 \Filesystem Size Used Avail Use%\n\
37 \/dev/grid/node-x0-y0 10T 8T 2T 80%\n\
38 \/dev/grid/node-x0-y1 11T 6T 5T 54%\n\
39 \/dev/grid/node-x0-y2 32T 28T 4T 87%\n\
40 \/dev/grid/node-x1-y0 9T 7T 2T 77%\n\
41 \/dev/grid/node-x1-y1 8T 0T 8T 0%\n\
42 \/dev/grid/node-x1-y2 11T 7T 4T 63%\n\
43 \/dev/grid/node-x2-y0 10T 6T 4T 60%\n\
44 \/dev/grid/node-x2-y1 9T 8T 1T 88%\n\
45 \/dev/grid/node-x2-y2 9T 6T 3T 66%\n\
46 \"
47
48 main :: IO ()
49 main = do
50 text <- readFile "data/advent22.txt"
51 let sizes = successfulParse $ parseFile text
52 part1 sizes
53 part2 sizes
54
55 part1 :: [Node] -> IO ()
56 part1 sizes = print $ length viable
57 where viable = [(a, b) | a <- sizes,
58 b <- sizes,
59 a /= b,
60 (used a) > 0,
61 (used a) <= (available b)]
62
63
64 part2 :: [Node] -> IO ()
65 part2 sizes =
66 -- do let testSizes = successfulParse $ parseFile testGrid
67 -- putStrLn $ searchTraceH $ reverse $ aStar [[startSt testSizes]] []
68 print (26 + 26 + 29 + 5 * 36)
69
70
71 aStar :: [[SearchState]] -> [SearchState] -> [SearchState]
72 aStar [] _ = []
73 aStar (currentPath:agenda) closed =
74 if isGoal reached then currentPath
75 else if reached `elem` closed
76 then aStar agenda closed
77 else aStar newAgenda (reached:closed)
78 where
79 reached = head currentPath
80 successorPaths = map (:currentPath) $ successors reached
81 newAgenda = sortOn (cost) $ successorPaths ++ agenda
82
83
84 searchTrace :: [SearchState] -> String
85 searchTrace ss = unlines $ map (sst) ss
86 where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ")"
87
88 searchTraceH :: [SearchState] -> String
89 searchTraceH ss = unlines $ map (sst) ss
90 where sst s = "(" ++ show (cx s) ++ ", " ++ show (cy s) ++ ") :: " ++ holeS s
91 hole sk = fromJust $ find (\n -> used n == 0) $ grid sk
92 holeS sk = "(" ++ show (x $ hole sk) ++ ", " ++ show (y $ hole sk) ++ ")"
93
94 startSt :: [Node] -> SearchState
95 startSt nodes = SearchState {cx = maximum xs, cy = 0, grid = nodes}
96 where xs = map (\n -> x n) nodes
97
98 isGoal :: SearchState -> Bool
99 isGoal st = cx st == 0 && cy st == 0
100
101 adjacent :: Node -> Node -> Bool
102 adjacent n1 n2 = abs ((x n1) - (x n2)) + abs ((y n1) - (y n2)) == 1
103
104 -- A move of data from n1 to n2 is legal.
105 legal :: Node -> Node -> Bool
106 legal n1 n2 = adjacent n1 n2 && used n1 > 0 && used n1 <= available n2
107
108 heuristic :: SearchState -> Int
109 heuristic st = (cx st) + (cy st)
110
111 successors :: SearchState -> [SearchState]
112 successors st = map (newState st current) possibleMoves
113 where nodes = grid st
114 current = fromJust $ find (\n -> (x n) == (cx st) && (y n) == (cy st)) nodes
115 possibleMoves = [(n1, n2) | n1 <- nodes, n2 <- nodes, legal n1 n2]
116
117
118 -- Moving data from n1 to n2
119 newState :: SearchState -> Node -> (Node, Node) -> SearchState
120 newState st current (n1, n2) = st {cx = cx', cy = cy', grid = grid'}
121 where cx' = if current == n1 then x n2 else x current
122 cy' = if current == n1 then y n2 else y current
123 grid' = sort $ (n2 {used = (used n2 + used n1), available = (available n2 - used n1)}):
124 (n1 {used = 0, available = (size n1)}):
125 (delete n1 $ delete n2 (grid st))
126
127 cost :: [SearchState] -> Int
128 cost p = (heuristic $ head p) + (length p)
129
130
131
132 duFile = duLine `sepEndBy` newline
133 -- duLine = (optionMaybe nodeL)
134
135 duLine = (nodeL >>= return . Just) <|> (headerL >> return Nothing)
136
137 headerL = (many (noneOf "\r\n"))
138
139 nodeL = nodeify <$> (string "/dev/grid/node-x" *> int)
140 <*> (string "-y" *> int)
141 <*> (spaces *> int <* string "T")
142 <*> (spaces *> int <* string "T")
143 <*> (spaces *> int <* string "T")
144 <*> (spaces *> int <* string "%")
145 where nodeify x y size used available use_pc =
146 Node {x=x, y=y, size=size, used=used, available=available, use_pc=use_pc}
147
148 parseFile :: String -> Either ParseError [Maybe Node]
149 parseFile input = parse duFile "(unknown)" input
150
151 parseLine :: String -> Either ParseError (Maybe Node)
152 parseLine input = parse duLine "(unknown)" input
153
154 successfulParse :: Either ParseError [Maybe a] -> [a]
155 successfulParse (Left _) = []
156 successfulParse (Right a) = catMaybes a