trunk
HeNine 2 years ago
parent 6fe209eac9
commit 07ade6f13d

@ -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

@ -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

File diff suppressed because it is too large Load Diff

@ -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

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

@ -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)

@ -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 ()

@ -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 ()
Loading…
Cancel
Save