Done day 5

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

diff --git a/advent05/Main.hs b/advent05/Main.hs
new file mode 100644 (file)
index 0000000..9ec1d25
--- /dev/null
+++ b/advent05/Main.hs
@@ -0,0 +1,124 @@
+-- Writeup at https://work.njae.me.uk/2022/12/04/advent-of-code-2022-day-4/
+
+import System.Environment
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text hiding (take)
+import Control.Applicative
+import Data.List
+import Data.Maybe
+import qualified Data.IntMap.Strict as M
+import Data.IntMap.Strict ((!), (!?))
+
+data Crate = Crate Char deriving (Show, Eq)
+type Wharf = M.IntMap [Crate]
+
+data Move = Move Int Int Int -- quantity, from, to
+  deriving (Show, Eq)
+
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let ((wharfLines, colNames), moves) = successfulParse text
+      -- print wharfLines
+      -- print colNames
+      -- print moves
+      let wharf = makeWharf wharfLines colNames
+      -- print wharf
+      -- print $ applyMove wharf (head moves)
+      putStrLn $ part1 wharf moves
+      putStrLn $ part2 wharf moves
+
+
+getDataFileName :: IO String
+getDataFileName =
+  do args <- getArgs
+     progName <- getProgName
+     let baseDataName =  if null args
+                         then progName
+                         else head args 
+     let dataFileName = "data/" ++ baseDataName ++ ".txt"
+     return dataFileName
+
+
+part1 :: Wharf -> [Move] -> String
+part1 wharf moves = showTops $ applyMoves1 wharf moves
+
+part2 :: Wharf -> [Move] -> String
+part2 wharf moves = showTops $ applyMoves2 wharf moves
+
+showTops :: Wharf -> String
+showTops wharf = fmap extractName $ fmap (head . snd) $ M.toAscList wharf
+
+extractName :: Crate -> Char
+extractName (Crate c) = c        
+
+makeWharf :: [[Maybe Crate]] -> [Int] -> Wharf
+makeWharf wharfLines colNames = M.fromList $ zip colNames wharfCols
+  where wharfCols = fmap (fmap fromJust)
+                  $ fmap (dropWhile isNothing) 
+                  $ transpose wharfLines
+
+applyMoves1 :: Wharf -> [Move] -> Wharf
+applyMoves1 wharf moves = foldl' applyMove1 wharf moves
+
+applyMove1 :: Wharf -> Move -> Wharf
+applyMove1 wharf m@(Move n _ _) = foldl' makeMove1 wharf (replicate n m)
+
+makeMove1 :: Wharf -> Move -> Wharf
+makeMove1 wharf (Move _ from to) = M.insert from origin 
+                                 $ M.insert to destination wharf
+  where (c:origin) = wharf!from
+        destination = c:(fromMaybe [] $ wharf!?to)
+
+applyMoves2 :: Wharf -> [Move] -> Wharf
+applyMoves2 wharf moves = foldl' applyMove2 wharf moves
+
+applyMove2 :: Wharf -> Move -> Wharf
+applyMove2 wharf (Move n from to) = M.insert from origin' 
+                                  $ M.insert to destination wharf
+  where origin = wharf!from
+        moving = take n origin
+        origin' = drop n origin
+        destination = moving ++ (fromMaybe [] $ wharf!?to)
+
+
+-- Parse the input file
+
+problemP :: Parser (([[Maybe Crate]], [Int]), [Move])
+wharfP :: Parser ([[Maybe Crate]], [Int])
+wharfLineP :: Parser [Maybe Crate]
+wharfCellP, blankP, crateP :: Parser (Maybe Crate)
+stackLabelsP :: Parser [Int]
+movesP :: Parser [Move]
+moveP :: Parser Move
+
+-- problemP = (,) <$> wharfP <* endOfLine <* endOfLine <*> movesP
+problemP = (,) <$> wharfP <*> movesP
+
+wharfP = (,) <$> (wharfLineP `sepBy` endOfLine) <*> stackLabelsP
+
+wharfLineP = wharfCellP `sepBy1` (char ' ')
+
+wharfCellP = crateP <|> blankP
+blankP = Nothing <$ (count 3 space)
+crateP = (Just . Crate) <$> ("[" *> letter) <* "]"
+
+-- stackLabelsP = ((many1 space) *> (decimal `sepBy` (many1 space))) <* (takeWhile1 isHorizontalSpace)
+stackLabelsP = (many1 space) 
+            *> (decimal `sepBy` (many1 space)) 
+            <* (many1 space)
+
+movesP = moveP `sepBy` endOfLine
+moveP = Move <$> ("move " *> decimal) 
+             <*> (" from " *> decimal) 
+             <*> (" to " *> decimal)
+
+
+successfulParse :: Text -> (([[Maybe Crate]], [Int]), [Move])
+successfulParse input = 
+  case parseOnly problemP input of
+    Left  _err -> (([], []), []) -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right problem -> problem