Day 16

3 files changed, 122 insertions, 0 deletions

diff --git a/day16/input.txt b/day16/input.txt
new file mode 100644
index 0000000..d21aeba
--- /dev/null
+++ b/day16/input.txt
@@ -0,0 +1 @@
+A20D6CE8F00033925A95338B6549C0149E3398DE75817200992531E25F005A18C8C8C0001849FDD43629C293004B001059363936796973BF3699CFF4C6C0068C9D72A1231C339802519F001029C2B9C29700B2573962930298B6B524893ABCCEC2BCD681CC010D005E104EFC7246F5EE7328C22C8400424C2538039239F720E3339940263A98029600A80021B1FE34C69100760B41C86D290A8E180256009C9639896A66533E459148200D5AC0149D4E9AACEF0F66B42696194031F000BCE7002D80A8D60277DC00B20227C807E8001CE0C00A7002DC00F300208044E000E69C00B000974C00C1003DC0089B90C1006F5E009CFC87E7E43F3FBADE77BE14C8032C9350D005662754F9BDFA32D881004B12B1964D7000B689B03254564414C016B004A6D3A6BD0DC61E2C95C6E798EA8A4600B5006EC0008542D8690B80010D89F1461B4F535296B6B305A7A4264029580021D1122146900043A0EC7884200085C598CF064C0129CFD8868024592FEE9D7692FEE9D735009E6BBECE0826842730CD250EEA49AA00C4F4B9C9D36D925195A52C4C362EB8043359AE221733DB4B14D9DCE6636ECE48132E040182D802F30AF22F131087EDD9A20804D27BEFF3FD16C8F53A5B599F4866A78D7898C0139418D00424EBB459915200C0BC01098B527C99F4EB54CF0450014A95863BDD3508038600F44C8B90A0801098F91463D1803D07634433200AB68015299EBF4CF5F27F05C600DCEBCCE3A48BC1008B1801AA0803F0CA1AC6200043A2C4558A710E364CC2D14920041E7C9A7040402E987492DE5327CF66A6A93F8CFB4BE60096006E20008543A8330780010E8931C20DCF4BFF13000A424711C4FB32999EE33351500A66E8492F185AB32091F1841C91BE2FDC53C4E80120C8C67EA7734D2448891804B2819245334372CBB0F080480E00D4C0010E82F102360803B1FA2146D963C300BA696A694A501E589A6C80
diff --git a/day16/main.hs b/day16/main.hs
new file mode 100644
index 0000000..76b3db1
--- /dev/null
+++ b/day16/main.hs
@@ -0,0 +1,120 @@
+module Main where
+
+import Control.Monad (foldM)
+import Data.Bifunctor (bimap, first, second)
+import Data.Char (digitToInt)
+import Data.Function (on)
+import qualified Data.List as L
+import Data.Map.Strict (Map, (!))
+import qualified Data.Map.Strict as M
+import qualified Data.Text as T
+import Debug.Trace (traceShow, traceShowId)
+import Utils
+
+convertHex '0' = "0000"
+convertHex '1' = "0001"
+convertHex '2' = "0010"
+convertHex '3' = "0011"
+convertHex '4' = "0100"
+convertHex '5' = "0101"
+convertHex '6' = "0110"
+convertHex '7' = "0111"
+convertHex '8' = "1000"
+convertHex '9' = "1001"
+convertHex 'A' = "1010"
+convertHex 'B' = "1011"
+convertHex 'C' = "1100"
+convertHex 'D' = "1101"
+convertHex 'E' = "1110"
+convertHex 'F' = "1111"
+convertHex other = error $ "invalid hex: " ++ [other]
+
+hexToBinaryString "" = ""
+hexToBinaryString (hex : rest) = convertHex hex ++ hexToBinaryString rest
+
+-- | Convert binary (list of zeros and ones) to decimal
+binaryToInt :: String -> Int
+binaryToInt = reverse .> binaryToInt'
+
+binaryToInt' [] = 0
+binaryToInt' (x : xs) = digitToInt x + 2 * binaryToInt' xs
+
+takeUntil :: (a -> Bool) -> [a] -> [a]
+takeUntil _ [] = []
+takeUntil p (x : xs) = x : if p x then takeUntil p xs else []
+
+applyOperator opTypeId subValues = case opTypeId of
+  0 -> sum subValues
+  1 -> product subValues
+  2 -> minimum subValues
+  3 -> maximum subValues
+  5 ->
+    let [a, b] = subValues
+     in if a > b then 1 else 0
+  6 ->
+    let [a, b] = subValues
+     in if a < b then 1 else 0
+  7 ->
+    let [a, b] = subValues
+     in if a == b then 1 else 0
+  other -> error $ "invalid operator type id " ++ show opTypeId
+
+parseTypeOperator :: Int -> String -> (Int, Int, String)
+parseTypeOperator opTypeId binary =
+  let (lengthTypeID, binary') = splitAt 1 binary $> first binaryToInt
+      (versionSum, subValues, rest) = case lengthTypeID of
+        0 -> parseOpLengthId0 binary'
+        1 -> parseOpLengthId1 binary'
+        other -> error $ "invalid length type id " ++ show other
+      computedResult = applyOperator opTypeId subValues
+   in (versionSum, computedResult, rest)
+
+parseOpLengthId0 :: String -> (Int, [Int], String)
+parseOpLengthId0 binary =
+  let (subPacketsLength, binary') = splitAt 15 binary $> first binaryToInt
+      (subPackets, binary'') = splitAt subPacketsLength binary'
+      iter = iterate (\(_, _, sub) -> parse sub) (minBound, minBound, subPackets) $> tail .> takeUntil (\(_, _, rest) -> (not . null) rest)
+      (subVersions, results, rests) = iter $> unzip3
+   in (sum subVersions, results, binary'')
+
+parseOpLengthId1 :: String -> (Int, [Int], String)
+parseOpLengthId1 binary =
+  let (subPacketsCount, binary') = splitAt 11 binary $> first binaryToInt
+      iter = iterate (\(_, _, sub) -> parse sub) (minBound, minBound, binary') $> tail .> take subPacketsCount
+      (subVersions, results, rests) = iter $> unzip3
+   in (sum subVersions, results, last rests)
+
+parseType4 :: [Char] -> (Int, String)
+parseType4 binary =
+  let (result, rest) = parseType4' binary
+   in (binaryToInt result, rest)
+
+parseType4' :: String -> (String, String)
+parseType4' ('0' : rest) = splitAt 4 rest
+parseType4' ('1' : rest) =
+  let (binary, rest') = splitAt 4 rest
+      (result, rest'') = parseType4' rest'
+   in (binary ++ result, rest'')
+parseType4' other = error $ "invalid type 4: " ++ other
+
+parse :: String -> (Int, Int, String)
+parse "" = (0, minBound, "")
+parse binary =
+  let (packetVersion, binary') = splitAt 3 binary $> first binaryToInt
+      (packetTypeID, binary'') = splitAt 3 binary' $> first binaryToInt
+   in case packetTypeID of
+        4 ->
+          let (result, rest) = parseType4 binary''
+           in (packetVersion, result, rest)
+        opTypeId ->
+          let (typeOpVersionSum, result, rest) = parseTypeOperator opTypeId binary''
+           in (packetVersion + typeOpVersionSum, result, rest)
+
+main :: IO ()
+main =
+  do
+    contents <- getContents
+
+    let binary = contents $> T.pack .> T.strip .> T.unpack .> hexToBinaryString
+
+    parse binary $> print
diff --git a/day16/simple.txt b/day16/simple.txt
new file mode 100644
index 0000000..726b25a
--- /dev/null
+++ b/day16/simple.txt
@@ -0,0 +1 @@
+04005AC33890
\ No newline at end of file