adventofcode1622/app/advent22library.hs

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