Day 17

data/bits.txt

+220D69802BE00A0803711E1441B1006E39C318A12730C200DCE66D2CCE360FA0055652CD32966E3004677EDF600B0803B1361741510076254138D8A00E4FFF3E3393ABE4FC7AC10410010799D2A4430003764DBE281802F3102CA00D4840198430EE0E00021D04E3F41F84AE0154DFDE65A17CCBFAFA14ADA56854FE5E3FD5BCC53B0D2598027A00848C63F2B918C7E513DEC3290051B3867E009CCC5FE46BD520007FE5E8AD344B37583D0803E40085475887144C01A8C10FE2B9803B0720D45A3004652FD8FA05F80122CAF91E5F50E66BEF8AB000BB0F4802039C20917B920B9221200ABF0017B9C92CCDC76BD3A8C4012CCB13CB22CDB243E9C3D2002067440400D9BE62DAC4D2DC0249BF76B6F72BE459B279F759AE7BE42E0058801CC059B08018A0070012CEC045BA01006C03A8000D46C02FA000A8EA007200800E00618018E00410034220061801D36BF178C01796FC52B4017100763547E86000084C7E8910AC0027E9B029FE2F4952F96D81B34C8400C24AA8CDAF4F1E98027C00FACDE3BA86982570D13AA640195CD67B046F004662711E989C468C01F1007A10C4C8320008742287117C401A8C715A3FC2C8EB3777540048272DFE7DE1C0149AC8BC9E79D63200B674013978E8BE5E3A2E9AA3CCDD538C01193CFAB0A146006AA00087C3E88B130401D8E304A239802F39FAC922C0169EA3248DF2D600247C89BCDFE9CA7FFD8BB49686236C9FF9795D80C0139BEC4D6C017978CF78C5EB981FCE7D4D801FA9FB63B14789534584010B5802F3467346D2C1D1E080355B00424FC99290C7E5D729586504803A2D005E677F868C271AA479CEEB131592EE5450043A932697E6A92C6E164991EFC4268F25A294600B5002A3393B31CC834B972804D2F3A4FD72B928E59219C9C771EC3DC89D1802135C9806802729694A6E723FD6134C0129A019E600
\ No newline at end of file

data/probe.txt

+target area: x=57..116, y=-198..-148
\ No newline at end of file

src/AOC-16a.hs

 module Main where
 
-import Control.Monad.State
+import Control.Monad ( guard, replicateM )
+import Data.Char ( isSpace )
+import Text.ParserCombinators.ReadP
+    ( ReadP, eof, many, munch, pfail, readP_to_S, satisfy )
 
 type HexString = String
 type BitString = String
 
 hex2bin :: HexString -> BitString
+
 hex2bin = concatMap c where
   c '0' = "0000"
   c '1' = "0001"
@@ -23,70 +27,70 @@ hex2bin = concatMap c where
   c 'D' = "1101"
   c 'E' = "1110"
   c 'F' = "1111"
-  c ch  = error $ "hex2bin -- unexpected character: " ++ [ch]
-
+  c ch  = error $ "hex2bin.c -- unexpected character: " ++ [ch]
+ 
 data PacketContents
-  = Literal Integer
-  | List [PacketContents]
+  = Literal Int
+  | List [Packet]
   deriving Show
 
-data Packet = Packet { version :: Integer, typeID :: Integer, contents :: PacketContents  }
+data Packet = Packet { version :: Int, typeID :: Int, contents :: PacketContents  }
   deriving Show
 
-type BitState = State BitString
+instance Read Packet where
+  readsPrec _ = readP_to_S (parsePacket <* parseZeros)
+
+parseBits :: Int -> ReadP String
+parseBits n = replicateM n (satisfy (const True))
+
+parseLiteralInt :: ReadP String
+parseLiteralInt = do
+  (sel:v) <- parseBits 5
+  case sel of
+    '0' -> pure v
+    '1' -> (v++) <$> parseLiteralInt
+    _ -> pfail
 
-bits :: Int -> BitState String
-bits n = do
-  s <- get
-  let r = take n s
-  if length r /= n
-  then error "bits -- not enough bits"
-  else do
-    put (drop n s)
-    pure r
+parsePacket :: ReadP Packet
+parsePacket = do
+  v <- bitsToInt <$> parseBits 3
+  t <- bitsToInt <$> parseBits 3
+  case t of
+    4 -> do
+      n <- bitsToInt <$> parseLiteralInt
+      pure $ Packet v t (Literal n)
+    _ -> do
+      i <- satisfy (const True)
+      case i of
+        '0' -> do
+          l <- bitsToInt <$> parseBits 15
+          bs <- parseBits l
+          let packets = do {- [] -}
+                (ps,rest) <- readP_to_S (many parsePacket <* eof) bs
+                guard $ all isSpace rest
+                ps
+          pure $ Packet v t (List packets)
+        '1' -> do
+          l <- bitsToInt <$> parseBits 11
+          ps <- replicateM l parsePacket
+          pure $ Packet v t (List ps)
+        _ -> pfail
 
-decode :: HexString -> (Packet,Int)
-decode s =  evalState process . hex2bin $ s where
-  process :: BitState (Packet,Int)
-  process = do
-    v <- bitsToInt <$> bits 3
-    t <- bitsToInt <$> bits 3
-    case t of
-      4 -> do
-        (n,nc) <- nibbles
-        pure $ (Packet v t (Literal (bitsToInt n)),nc+6)
-      _ -> do
-        lengthType <- bitsToInt <$> bits 1
-        case lengthType of
-          0 -> undefined
-          1 -> undefined
-          _ -> error "decode.process -- impossible lengthType"
-      
-nibbles :: BitState (BitString,Int)
-nibbles = iter 6 where
-  iter n = do
-    ns <- bits 5
-    case ns of
-      '0' : bs -> do
-        let npad = 4 - (n+5) `mod` 4
-        pad <- bits npad
-        if all (== '0') pad
-        then pure (bs,5+npad)
-        else error "decode -- invalid padding"
-      '1' : bs -> do
-        (rest,nrest) <- iter (n+5)
-        pure $ (bs ++ rest,nrest + 5)
-      c : _ -> error $ "nibbles.iter -- nonbinary character: " ++ [c]
-      "" -> error $ "nibbles.iter -- out of bits"
+parseZeros :: ReadP ()
+parseZeros = munch (== '0') *> eof
 
-bitsToInt :: BitString -> Integer
-bitsToInt = sum . zipWith (*) (iterate (*2) 1) . map bitValue . reverse
+score :: String -> Int
+score = versionSum . read @Packet . hex2bin where
+  versionSum (Packet v _ (Literal _)) = v
+  versionSum (Packet v _ (List ps)) = v + sum (map versionSum ps)
 
-bitValue :: Char -> Integer
-bitValue '0' = 0
-bitValue '1' = 1
-bitValue c = error $ "decode -- nonbinary character in bitValue: " ++ [c]
+bitsToInt :: BitString -> Int
+bitsToInt = sum . zipWith f (iterate (*2) 1) . reverse where
+  f _ '0' = 0
+  f n '1' = n
+  f _ ch  = error $ "bitsToInt -- unrecognized character: " ++ [ch]
 
 main :: IO ()
-main = 
-  print . decode $ "D2FE28"
+main = do
+  result <- score <$> readFile "data/bits.txt"
+  print result

src/AOC-16b.hs

 module Main where
 
+import Control.Monad ( guard, replicateM )
+import Data.Char ( isSpace )
+import System.IO ()
+import Text.ParserCombinators.ReadP
+    ( ReadP, eof, many, munch, pfail, readP_to_S, satisfy )
+
+type HexString = String
+type BitString = String
+
+hex2bin :: HexString -> BitString
+
+hex2bin = concatMap c where
+  c '0' = "0000"
+  c '1' = "0001"
+  c '2' = "0010"
+  c '3' = "0011"
+  c '4' = "0100"
+  c '5' = "0101"
+  c '6' = "0110"
+  c '7' = "0111"
+  c '8' = "1000"
+  c '9' = "1001"
+  c 'A' = "1010"
+  c 'B' = "1011"
+  c 'C' = "1100"
+  c 'D' = "1101"
+  c 'E' = "1110"
+  c 'F' = "1111"
+  c ch  = error $ "hex2bin.c -- unexpected character: " ++ [ch]
+ 
+data PacketContents
+  = Literal Int
+  | List [Packet]
+  deriving Show
+
+data Packet = Packet { version :: Int, typeID :: Int, contents :: PacketContents  }
+  deriving Show
+
+instance Read Packet where
+  readsPrec _ = readP_to_S (parsePacket <* parseZeros)
+
+parseBits :: Int -> ReadP String
+parseBits n = replicateM n (satisfy (const True))
+
+parseLiteralInt :: ReadP String
+parseLiteralInt = do
+  (sel:v) <- parseBits 5
+  case sel of
+    '0' -> pure v
+    '1' -> (v++) <$> parseLiteralInt
+    _ -> pfail
+
+parsePacket :: ReadP Packet
+parsePacket = do
+  v <- bitsToInt <$> parseBits 3
+  t <- bitsToInt <$> parseBits 3
+  case t of
+    4 -> do
+      n <- bitsToInt <$> parseLiteralInt
+      pure $ Packet v t (Literal n)
+    _ -> do
+      i <- satisfy (const True)
+      case i of
+        '0' -> do
+          l <- bitsToInt <$> parseBits 15
+          bs <- parseBits l
+          let packets = do {- [] -}
+                (ps,rest) <- readP_to_S (many parsePacket <* eof) bs
+                guard $ all isSpace rest
+                ps
+          pure $ Packet v t (List packets)
+        '1' -> do
+          l <- bitsToInt <$> parseBits 11
+          ps <- replicateM l parsePacket
+          pure $ Packet v t (List ps)
+        _ -> pfail
+
+score :: String -> Int
+score = versionSum . read @Packet . hex2bin where
+  versionSum (Packet v _ (Literal _)) = v
+  versionSum (Packet v _ (List ps)) = v + sum (map versionSum ps)
+
+bitsToInt :: BitString -> Int
+bitsToInt = sum . zipWith f (iterate (*2) 1) . reverse where
+  f _ '0' = 0
+  f n '1' = n
+  f _ ch  = error $ "bitsToInt -- unrecognized character: " ++ [ch]
+
+parseZeros :: ReadP ()
+parseZeros = munch (=='0') *> eof 
+
+eval :: Packet -> Int
+eval (Packet _ 4 (Literal n)) = n
+eval (Packet _ n (List ps)) = case n of
+  0 -> sum . map eval $ ps
+  1 -> product . map eval $ ps
+  2 -> minimum . map eval $ ps
+  3 -> maximum . map eval $ ps
+  5 -> op (>) . map eval $ ps
+  6 -> op (<) . map eval $ ps
+  7 -> op (==) . map eval $ ps
+  _ -> error "eval -- impossible typeID"
+  where
+  op rel [a,b]
+    | a `rel` b = 1
+    | otherwise = 0
+  op _ _ = error "eval.op -- wrong # of operands"
+eval _ = error "eval -- invalid packet"
+
 main :: IO ()
-main = pure ()
+main = do
+  packet <- read @Packet . hex2bin <$> readFile "data/bits.txt"
+  print . eval $ packet

src/AOC-17a.hs

 module Main where
 
+import Control.Monad ( void )
+import Data.Char ( isDigit )
+import Data.Maybe ( catMaybes )
+import Text.ParserCombinators.ReadP
+    ( ReadP, char, munch1, option, readP_to_S, string )
+
+data Target = Target { xrange :: (Int,Int), yrange :: (Int,Int) }
+  deriving Show
+
+parseInt :: ReadP Int
+parseInt = do
+  sign <- option 1 (char '-' *> pure (-1))
+  val <- read <$> munch1 isDigit
+  pure $ sign * val
+
+parseTarget :: ReadP Target
+parseTarget = do
+  void $ string "target area: x="
+  xmin <- parseInt
+  void $ string ".."
+  xmax <- parseInt
+  void $ string ", y="
+  ymin <- parseInt
+  void $ string ".."
+  ymax <- parseInt
+  pure $ Target (xmin,xmax) (ymin,ymax)
+
+instance Read Target where
+  readsPrec _ = readP_to_S parseTarget
+
+probe :: Target -> (Int,Int) -> (Int,Int) -> Maybe [(Int,Int)]
+probe t@(Target (xmin,xmax) (ymin,ymax)) (x,y) (dx,dy)
+  | x > xmax || y < ymin = Nothing
+  | x >= xmin && y <= ymax = Just [(x,y)]
+  | otherwise = ((x,y) :) <$> probe t (x+dx,y+dy) (ndx,dy-1)
+  where
+    ndx = case compare dx 0 of
+      LT -> dx+1
+      EQ -> dx
+      GT -> dx-1
+
+viablePaths :: Target -> [[(Int,Int)]]
+viablePaths t@(Target (_,xmax) (ymin,_)) = catMaybes
+  [ probe t (0,0) (dx,dy)
+  | dx <- [0..xmax]
+  , dy <- [ymin..abs ymin]
+  ]
+
 main :: IO ()
-main = pure ()
+main = do
+  target <- read @Target <$> readFile "data/probe.txt"
+  print target
+  print . maximum . map (maximum . map snd) . viablePaths $ target

src/AOC-17b.hs

 module Main where
 
+import Control.Monad ( void )
+import Data.Char ( isDigit )
+import Data.Maybe ( catMaybes )
+import Text.ParserCombinators.ReadP
+    ( ReadP, char, munch1, option, readP_to_S, string )
+
+data Target = Target { xrange :: (Int,Int), yrange :: (Int,Int) }
+  deriving Show
+
+parseInt :: ReadP Int
+parseInt = do
+  sign <- option 1 (char '-' *> pure (-1))
+  val <- read <$> munch1 isDigit
+  pure $ sign * val
+
+parseTarget :: ReadP Target
+parseTarget = do
+  void $ string "target area: x="
+  xmin <- parseInt
+  void $ string ".."
+  xmax <- parseInt
+  void $ string ", y="
+  ymin <- parseInt
+  void $ string ".."
+  ymax <- parseInt
+  pure $ Target (xmin,xmax) (ymin,ymax)
+
+instance Read Target where
+  readsPrec _ = readP_to_S parseTarget
+
+probe :: Target -> (Int,Int) -> (Int,Int) -> Maybe [(Int,Int)]
+probe t@(Target (xmin,xmax) (ymin,ymax)) (x,y) (dx,dy)
+  | x > xmax || y < ymin = Nothing
+  | x >= xmin && y <= ymax = Just [(x,y)]
+  | otherwise = ((x,y) :) <$> probe t (x+dx,y+dy) (ndx,dy-1)
+  where
+    ndx = case compare dx 0 of
+      LT -> dx+1
+      EQ -> dx
+      GT -> dx-1
+
+viablePaths :: Target -> [[(Int,Int)]]
+viablePaths t@(Target (_,xmax) (ymin,_)) = catMaybes
+  [ probe t (0,0) (dx,dy)
+  | dx <- [0..xmax]
+  , dy <- [ymin..abs ymin]
+  ]
+
 main :: IO ()
-main = pure ()
+main = do
+  target <- read @Target <$> readFile "data/probe.txt"
+  print target
+  print . length . viablePaths $ target

test/probe.txt

+target area: x=20..30, y=-10..-5
\ No newline at end of file