adventofcode1622/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