Tidying

[advent-of-code-22.git] / advent07 / Main.hs

diff --git a/advent07/Main.hs b/advent07/Main.hs
new file mode 100644 (file)
index 0000000..dcc076c
--- /dev/null
+++ b/advent07/Main.hs
@@ -0,0 +1,138 @@
+-- Writeup at https://work.njae.me.uk/2022/12/07/advent-of-code-2022-day-7/
+
+import AoC
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text hiding (take)
+import Control.Applicative
+import Data.Char
+import Data.Maybe
+import Data.Tree
+import Data.Tree.Zipper hiding (tree)
+import qualified Data.Map.Strict as M
+-- import Data.Map.Strict ((!), (!?))
+import Data.List (foldl', sort)
+
+data ParsedObject = CD String 
+                  | LS 
+                  | PDirectory String 
+                  | PFile Int String 
+                  deriving Show
+
+data Directory = Dir String (M.Map String Int)
+  deriving (Show, Eq)
+
+data ContainedSize = CSize String Integer
+  deriving (Show, Eq)
+
+type DTree = Tree Directory
+type ZDTree = TreePos Full Directory
+type STree = Tree ContainedSize
+
+reportingThreshold, spaceAvailable, spaceRequired :: Integer
+reportingThreshold =   100000
+spaceAvailable     = 70000000
+spaceRequired      = 30000000
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let trace = successfulParse text
+      let tree = mkTree trace emptyTree
+      let sizedTree = transitiveSizes $ containingSizes tree
+      print $ part1 sizedTree
+      print $ part2 sizedTree
+
+part1, part2 :: STree -> Integer
+part1 = foldTree (\x xs -> sum (x:xs)) . fmap cancelLarge 
+
+part2 tree = spaceFreed
+  where nodes = fmap extractCSize $ flatten tree
+        spaceUsed = extractCSize $ rootLabel tree
+        spaceUnused = spaceAvailable - spaceUsed
+        spaceToFree = spaceRequired - spaceUnused
+        viableNodes = filter (>= spaceToFree) nodes
+        spaceFreed = head $ sort viableNodes
+
+emptyTree :: DTree
+emptyTree = Node {rootLabel = (Dir "/" M.empty), subForest = []}
+
+mkTree :: [ParsedObject] -> DTree -> DTree
+mkTree trace tree = toTree $ root $ makeTree trace $ fromTree tree
+
+makeTree :: [ParsedObject] -> ZDTree -> ZDTree
+makeTree trace tree = foldl' processCommand tree trace
+
+processCommand :: ZDTree -> ParsedObject -> ZDTree
+processCommand tree (CD name)
+  | name == "/" = root tree
+  | name == ".." = fromJust $ parent tree
+  | otherwise = fromJust $ childWithName name tree
+processCommand tree LS = tree
+processCommand tree (PFile size name) = 
+  modifyLabel (\ (Dir n fs) -> Dir n (M.insert name size fs)) tree
+processCommand tree (PDirectory name) = 
+  if (isJust $ childWithName name tree)
+  then tree
+  else fromJust $ parent $ insert (Node { rootLabel = (Dir name M.empty)
+                                        , subForest = []
+                                        }) $ children tree
+
+
+childWithName :: String -> ZDTree -> Maybe ZDTree
+childWithName name tree = searchForChild name (firstChild tree)
+
+searchForChild :: String -> Maybe ZDTree -> Maybe ZDTree
+searchForChild _name Nothing = Nothing
+searchForChild name (Just tree)
+  | name == labelName = Just tree
+  | otherwise = searchForChild name (next tree)
+  where (Dir labelName _) = label tree
+
+containingSizes :: DTree -> STree
+containingSizes (Node {rootLabel = (Dir name files), subForest = sf}) = 
+  (Node {rootLabel = (CSize name sizeHere), subForest = sizedTrees})
+  where sizeHere = M.foldl (+) 0 $ M.map fromIntegral files
+        sizedTrees = fmap containingSizes sf
+
+transitiveSizes :: STree -> STree
+transitiveSizes (Node {rootLabel = (CSize name sizeHere), subForest = sf}) =
+  (Node {rootLabel = (CSize name (sizeHere + subSizes)), subForest = sizedTrees })
+  where sizedTrees = fmap transitiveSizes sf
+        subSizes = sum $ fmap (extractCSize . rootLabel) sizedTrees
+
+extractCSize, cancelLarge :: ContainedSize -> Integer
+extractCSize (CSize _ s) = s
+
+cancelLarge (CSize _ s) 
+  | s <= reportingThreshold = s
+  | otherwise = 0
+
+-- Parse the input file
+
+traceP :: Parser [ParsedObject]
+lineP :: Parser ParsedObject
+cdP :: Parser ParsedObject
+lsP :: Parser ParsedObject
+fileP :: Parser ParsedObject
+directoryP :: Parser ParsedObject
+letterP :: Parser Char
+nameP :: Parser String
+
+traceP = lineP `sepBy` endOfLine
+
+lineP = cdP <|> lsP <|> directoryP <|> fileP
+cdP = CD <$> ("$ cd " *> nameP)
+lsP = LS <$ "$ ls"
+fileP = PFile <$> (decimal <* " ") <*> nameP
+directoryP = PDirectory <$> ("dir " *> nameP)
+
+nameP = many1 letterP
+letterP = satisfy (not . isSpace)
+
+successfulParse :: Text -> [ParsedObject]
+successfulParse input = 
+  case parseOnly traceP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right commands -> commands