day 7

aoc2022.cabal

@@ -196,4 +196,30 @@ test-suite day06aoctest
   build-depends:       base
                      , HUnit
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
+-- Day 7
+
+test-suite day07basictest
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      src/day07/test, src/day07
+  main-is:             Basic.hs
+  other-modules:       
+      Day7Lib
+  build-depends:       base
+                     , HUnit
+                     , parsec
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
+test-suite day07aoctest
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      src/day07/test, src/day07
+  main-is:             AoCTest.hs
+  other-modules:       
+      Day7Lib
+  build-depends:       base
+                     , HUnit
+                     , parsec
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010

data/input070.txt

@@ -0,0 +1,23 @@
+$ cd /
+$ ls
+dir a
+14848514 b.txt
+8504156 c.dat
+dir d
+$ cd a
+$ ls
+dir e
+29116 f
+2557 g
+62596 h.lst
+$ cd e
+$ ls
+584 i
+$ cd ..
+$ cd ..
+$ cd d
+$ ls
+4060174 j
+8033020 d.log
+5626152 d.ext
+7214296 k

src/day06/Day6Lib.hs

@@ -23,7 +23,7 @@ allUnique' (e1 : e2 : l) = e1 /= e2 && allUnique' (e2 : l)
 -- ####################
 
 processInput1 :: String -> Int
-processInput1 = (+ 4) . length . (takeWhile not) . map allUnique . createTiles 4
+processInput1 = (+ 4) . length . (takeWhile not) . (map allUnique) . createTiles 4
 
 processInput2 :: String -> Int
-processInput2 = (+ 14) . length . (takeWhile not) . map allUnique . createTiles 14
+processInput2 = (+ 14) . length . (takeWhile not) . (map allUnique) . createTiles 14

src/day06/test/Manual.hs

@@ -0,0 +1,5 @@
+import
+
+main = do
+
+    return ()

src/day07/Day7Lib.hs

@@ -0,0 +1,169 @@
+module Day7Lib
+  ( Node (..),
+    Session (..),
+    newSession,
+    cd,
+    -- mkdir,
+    touch,
+    --
+    processInput1,
+    processInput2,
+  )
+where
+
+import Control.Monad
+import Data.List
+import Debug.Trace
+import Text.Parsec
+import Text.Parsec.Combinator
+
+data Node = File {name :: String, size :: Maybe Int} | Dir {name :: String, size :: Maybe Int, children :: [Node]} deriving (Show, Eq)
+
+newDir :: String -> Node
+newDir name = Dir name Nothing []
+
+newFile :: String -> Int -> Node
+newFile name size = File name (Just size)
+
+data Session = Session
+  { pwd :: [String],
+    filesystem :: Node
+  }
+  deriving (Show, Eq)
+
+newSession :: Session
+newSession = Session {pwd = ["/"], filesystem = Dir "/" Nothing []}
+
+mkdir :: Session -> String -> Session
+mkdir session dname = modifyNode session (\n -> n {children = newDir dname : children n})
+
+touch :: Session -> String -> Int -> Session
+touch session name size = modifyNode session (\n -> n {children = newFile name size : children n})
+
+getNode :: Node -> [String] -> Node
+getNode fs [] = fs
+getNode fs (p : wd) =
+  let (cd, rest) = partition (\d -> (name d) == p) (children fs)
+   in if null cd then error ("Directory not found" ++ show wd) else getNode (head cd) wd
+
+modifyNode :: Session -> (Node -> Node) -> Session
+modifyNode session@(Session {pwd = wd, filesystem = fs}) f = session {filesystem = modifyNode' (tail wd) fs f}
+
+modifyNode' :: [String] -> Node -> (Node -> Node) -> Node
+modifyNode' [] node f = f node
+modifyNode' (p : wd) node f =
+  let (chd, rest) = case partition (\d -> (name d) == p) (children node) of
+        ([chd], rest) -> (chd, rest)
+        (_, _) -> error ("Directory not found: " ++ show p)
+   in node {children = (modifyNode' wd chd f) : rest}
+
+cd :: Session -> String -> Session
+cd session@(Session {pwd = wd}) ".." = session {pwd = init wd}
+cd session@(Session {pwd = wd}) "/" = session {pwd = ["/"]}
+cd session@(Session {pwd = p : wd, filesystem = fs}) dname = case find (\x -> name x == dname) (children $ getNode fs wd) of
+  Just _ -> session {pwd = (p : wd) ++ [dname]}
+  Nothing -> error "directory not found"
+cd _ _ = error "invalid cd"
+
+applyCommand :: Session -> Command -> Session
+applyCommand session (CD name) = cd session name
+applyCommand session (LS children) =
+  foldl
+    ( \session child -> case child of
+        (Nothing, name) -> mkdir session name
+        (Just size, name) -> touch session name size
+    )
+    session
+    children
+
+showNode :: String -> Node -> String
+showNode pf (Dir {size = Just s, name = n, children = ch}) =
+  pf
+    ++ "dir "
+    ++ (show s)
+    ++ " "
+    ++ n
+    ++ "\n"
+    ++ concatMap (showNode (' ' : pf)) ch
+showNode pf (File {size = Just s, name = n}) = pf ++ show s ++ " " ++ n ++ "\n"
+showNode _ _ = error "show node error"
+
+----------------------------
+
+computeSizes :: Node -> Node
+computeSizes node@(Dir {children = ch}) =
+  let newCh = map computeSizes ch
+      newSize = fmap sum . sequence $ map size newCh
+   in node {size = newSize, children = newCh}
+computeSizes file@(File {}) = file
+
+---------------------------
+
+data Command = CD String | LS [(Maybe Int, String)] deriving (Show, Eq)
+
+history = command `sepBy1` (optional (char '\n'))
+
+command = do
+  string "$ "
+  cdCommand <|> lsCommand
+
+dirName = many (oneOf ['a' .. 'z'])
+
+cdCommand :: Parsec String () Command
+cdCommand = do
+  string "cd "
+  dirname <- string "/" <|> string ".." <|> dirName
+  return $ CD dirname
+
+lsCommand :: Parsec String () Command
+lsCommand = do
+  string "ls\n"
+  children <- many1 (dirLine <|> fileLine)
+  return $ LS children
+
+dirLine :: Parsec String () (Maybe Int, String)
+dirLine = do
+  string "dir "
+  name <- dirName
+  try (char '\n')
+  return (Nothing, name)
+
+fileLine :: Parsec String () (Maybe Int, String)
+fileLine = do
+  size <- many (oneOf ['0' .. '9'])
+  char ' '
+  name <- many (oneOf ('.' : ['a' .. 'z']))
+  try (char '\n')
+  return (Just (read size), name)
+
+-- ####################
+
+processInput1 :: String -> Int
+processInput1 input =
+  let h = case parse history "" input of
+        Right h -> h
+        Left e -> error (show e)
+      session = foldl applyCommand newSession h
+      sized = computeSizes . filesystem $ session
+   in sumTooSmall sized
+
+-- gintm = maybe 0 id
+
+sumTooSmall :: Node -> Int
+sumTooSmall dir@(Dir {size = Just s, children = ch}) = (if s <= 100000 then s else 0) + (sum . (map sumTooSmall) $ ch)
+sumTooSmall f@(File {size = Just s}) = 0
+sumTooSmall _ = error "sum error"
+
+processInput2 :: String -> Int
+processInput2 input =
+  let h = case parse history "" input of
+        Right h -> h
+        Left e -> error (show e)
+      session = foldl applyCommand newSession h
+      sized = computeSizes . filesystem $ session
+      sizes = sort . getAllDirSizes $ sized
+   in head . dropWhile (< 30000000 - (70000000 - last sizes)) $ sizes
+
+getAllDirSizes node@(Dir {size = Just s, children = ch}) = s : (concatMap getAllDirSizes ch)
+getAllDirSizes File {} = []
+getAllDirSizes n = error ("allDirSizes error" ++ show n)

src/day07/test/AoCTest.hs

@@ -0,0 +1,41 @@
+import Day7Lib (processInput1, processInput2)
+import System.IO
+import Test.HUnit
+
+testCases1 =
+  [ ("data/input070.txt", 95437),
+    ("data/input071.txt", 1084134)
+  ]
+
+testCase1 (file, result) = do
+  withFile
+    file
+    ReadMode
+    ( \handle -> do
+        contents <- hGetContents handle
+        assertEqual "input test" result $ processInput1 contents
+    )
+
+testCases2 =
+  [ ("data/input070.txt", 24933642),
+    ("data/input071.txt", 6183184)
+  ]
+
+testCase2 (file, result) = do
+  withFile
+    file
+    ReadMode
+    ( \handle -> do
+        contents <- hGetContents handle
+        assertEqual ("input test: " ++ file) result $ processInput2 contents
+    )
+
+tests =
+  TestList $
+    [TestCase (testCase1 c) | c <- testCases1]
+      ++ [TestCase (testCase2 c) | c <- testCases2]
+
+main :: IO ()
+main = do
+  runTestTT tests
+  return ()

src/day07/test/Basic.hs

@@ -0,0 +1,37 @@
+import Day7Lib
+import Test.HUnit
+
+tNewSession =
+  TestCase $
+    assertEqual
+      "new session"
+      (Session {pwd = ["/"], filesystem  = Dir "/" Nothing []})
+      (newSession)
+
+tNewDir1 = 
+  TestCase $
+    assertEqual
+      "new dir 1"
+      (Session {pwd = ["/", "a"], filesystem  = Dir "/" Nothing [Dir "a" Nothing []]})
+      (let s = newSession in cd s "a")
+
+tNewFile1 =
+  TestCase $
+    assertEqual
+      "new dir 1"
+      (Session {pwd = ["/"], filesystem  = Dir "/" Nothing [File "b" (Just 100)]})
+      (let s = newSession in touch s "b" 100)
+
+
+tests =
+  TestList $
+    [
+      tNewSession,
+      tNewDir1,
+      tNewFile1
+    ]
+
+main :: IO ()
+main = do
+  runTestTT tests
+  return ()