Days 1-3 + stub for day 4

.gitignore

@@ -0,0 +1,2 @@
+dist-newstyle
+inputs/

README.org

@@ -0,0 +1,31 @@
+#+title: aoc2021
+
+My solutions to the 2021 edition of Advent of Code
+
+| Day | Part 1 | Part 2 |
+|-----+--------+--------|
+|   1 | X      | X      |
+|   2 | X      | X      |
+|   3 | X      |        |
+|   4 |        |        |
+|   5 |        |        |
+|   6 |        |        |
+|   7 |        |        |
+|   8 |        |        |
+|   9 |        |        |
+|  10 |        |        |
+|  11 |        |        |
+|  12 |        |        |
+|  13 |        |        |
+|  14 |        |        |
+|  15 |        |        |
+|  16 |        |        |
+|  17 |        |        |
+|  18 |        |        |
+|  19 |        |        |
+|  20 |        |        |
+|  21 |        |        |
+|  22 |        |        |
+|  23 |        |        |
+|  24 |        |        |
+|  25 |        |        |

aoc2021.cabal

@@ -0,0 +1,62 @@
+cabal-version:      2.4
+name:               aoc2021
+version:            0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- A URL where users can report bugs.
+-- bug-reports:
+
+-- The license under which the package is released.
+-- license:
+author:             Annwan
+maintainer:         annwan@outlook.fr
+
+extra-source-files:
+    README.org
+
+executable d1p1
+    main-is:          D1P1.hs
+    build-depends:    base ^>=4.15.0.0
+    hs-source-dirs:   app
+    default-language: Haskell2010
+
+executable d1p2
+    main-is: D1P2.hs
+    build-depends: base ^>=4.15.0.0
+    hs-source-dirs: app
+    default-language: Haskell2010
+
+executable d2p1
+    main-is: D2P1.hs
+    build-depends: base ^>=4.15.0.0
+    hs-source-dirs: app
+    default-language: Haskell2010
+
+executable d2p2
+    main-is: D2P2.hs
+    build-depends: base ^>=4.15.0.0
+    hs-source-dirs: app
+    default-language: Haskell2010
+
+executable d3p1
+    main-is: D3P1.hs
+    build-depends: base ^>=4.15.0.0
+    hs-source-dirs: app
+    default-language: Haskell2010
+
+executable d3p2
+    main-is: D3P2.hs
+    build-depends: base ^>=4.15.0.0
+    hs-source-dirs: app
+    default-language: Haskell2010
+
+executable d4p1
+    main-is: D4P1.hs
+    build-depends: base ^>=4.15.0.0
+    hs-source-dirs: app
+    default-language: Haskell2010

app/D1P1.hs

@@ -0,0 +1,17 @@
+module Main where
+
+main :: IO ()
+main = interact solution
+
+windows :: Int -> [a] -> [[a]]
+windows _ [] = []
+windows n (a:r) = take n (a:r) : windows n r
+
+solution :: String -> String 
+solution = show
+         . sum
+         . map (fromEnum . \(a:b:_) -> a < b)
+         . init
+         . windows 2
+         . map (read :: String -> Int)
+         . lines

app/D1P2.hs

@@ -0,0 +1,21 @@
+module Main where
+
+main :: IO ()
+main = interact solution
+
+windows :: Int -> [a] -> [[a]]
+windows _ [] = []
+windows n (a:r) = take n (a:r) : windows n r
+
+solution :: String -> String
+solution =
+  show
+  . sum
+  . map (fromEnum . (\(a:b:_) -> a < b) )
+  . init
+  . windows 2
+  . map sum
+  . init . init
+  . windows 3
+  . map (read :: String -> Int)
+  . lines

app/D2P1.hs

@@ -0,0 +1,21 @@
+module Main where
+
+main :: IO()
+main =  interact solution
+
+solution :: String -> String
+solution = show
+         . multhem
+         . foldl applymove (0, 0)
+         . map ((\[a, b] -> (head a, read b :: Int)) . words)
+         . lines
+    where
+      applymove :: (Int, Int) -> (Char, Int) -> (Int, Int)
+      applymove (x, y) (d, v) = case d of
+        'f' -> (x + v, y)
+        'd' -> (x, y + v)
+        'u' -> (x, y - v)
+        _   -> undefined -- unreachable
+      multhem :: (Int, Int) -> Int
+      multhem (a, b) = a * b
+        

app/D2P2.hs

@@ -0,0 +1,20 @@
+module Main where
+
+main :: IO ()
+main = interact solution
+
+solution :: String -> String
+solution = show
+         . multhem
+         . foldl applymove (0, 0, 0)
+         . map ((\[a, b] -> (head a, read b :: Int)) . words)
+         . lines
+    where
+      applymove :: (Int, Int, Int) -> (Char, Int) -> (Int, Int, Int)
+      applymove (x, y, a) (d, v) = case d of
+        'f' -> (x + v, y + v * a, a)
+        'd' -> (x, y, a + v)
+        'u' -> (x, y, a - v)
+        _   -> undefined -- unreachable
+      multhem :: (Int, Int, Int) -> Int
+      multhem (a, b, _) = a * b

app/D3P1.hs

@@ -0,0 +1,30 @@
+module Main where
+
+import Data.List (transpose)
+import Data.Bits (shift, complement, (.&.))
+
+main :: IO ()
+main = interact solution
+
+solution :: String -> String
+solution = show
+         . (\x -> x * (complement x .&. 4095))
+         . bits_to_number
+         . map mostcommon
+         . transpose
+         . map (map ((read :: String -> Int) . (pure :: a -> [a])))
+         . lines
+  where
+    mostcommon :: [Int] -> Int
+    mostcommon a = if count 0 a > count 1 a then 0 else 1;
+
+    count :: Eq a => a -> [a] -> Int
+    count e [] = 0
+    count e (a:r) = count e r + if a == e then 1 else 0
+
+    bits_to_number :: [Int] -> Int
+    bits_to_number = btn' . reverse
+      where
+        btn' :: [Int] -> Int
+        btn' [] = 0
+        btn' (a:r) = shift (btn' r) 1 + a 

app/D3P2.hs

@@ -0,0 +1,48 @@
+module Main where
+
+import Data.Bits (shift)
+
+
+main :: IO ()
+main = interact solution
+
+solution :: String -> String
+solution = show
+  . (\(x,y) -> bits_to_number x * bits_to_number y)
+  . (\x -> (o2 0 x, co2 0 x))
+  . map (map (read . (:[])))
+  . lines
+  where
+    bits_to_number :: [Int] -> Int
+    bits_to_number = btn' . reverse
+      where
+        btn' :: [Int] -> Int
+        btn' []    = 0
+        btn' (a:r) = shift (btn' r) 1 + a
+
+count :: Eq a => Int -> a -> [[a]] -> Int
+count _ _ []    = 0
+count p e (a:r) = count p e r + if a !! p == e then 1 else 0
+
+
+o2 :: Int -> [[Int]] -> [Int]
+o2 _ [n] = n
+o2 n x   = o2 next (filter (\e -> e !! n == mc) x)
+  where
+    next = n + 1
+    c0   = count n 0 x
+    c1   = count n 1 x
+    mc
+      | c0 <= c1 = 0
+      | otherwise = 1
+
+co2 :: Int -> [[Int]] -> [Int]
+co2 _ [n] = n
+co2 n x   = co2 next (filter (\e -> e !! n == lc) x)
+  where
+    next = n + 1
+    c0   = count n 0 x
+    c1   = count n 1 x
+    lc
+      | c0 <= c1 = 1
+      | otherwise = 0

app/D4P1.hs

@@ -0,0 +1,47 @@
+module Main where
+
+main :: IO ()
+main = interact solution
+
+type Board = [[Int]]
+type BoardMask = [[Bool]]
+
+scnd :: (b -> c) -> (a, b) -> (a, c)
+scnd f (a, b) = (a, f b)
+
+frst :: (a -> c) -> (a, b) -> (c, b)
+frst f (a, b) = (f a, b)
+
+solution :: String -> String
+solution =
+  show
+  -- ([Int], [Boards])
+  . scnd toBoards
+  . scnd (map (map (read :: String -> Int)))
+  . scnd (filter (not . null))
+  . scnd (map words)
+  . frst (map (read :: String -> Int))
+  . frst splitcomma
+  . (\x -> (head x, tail x))
+  . lines
+  where
+    splitcomma :: String -> [String] -- "stole" the implementation from `words`
+    splitcomma s = case dropWhile (==',') s of
+      "" -> []
+      s' -> w : splitcomma s''
+        where
+          (w, s'') = break (==',') s'      
+
+toBoards :: [[Int]] -> [Board]
+toBoards [] = []
+toBoards (a:b:c:d:e:r) = [a,b,c,d,e]:toBoards r
+
+calculateScore :: Int -> -- ^ winning number
+                  Board -> -- ^ winning board
+                  BoardMask -> -- ^ drawn numbers
+                  Int
+calculateScore = undefined
+
+checkWinning :: BoardMask -> Bool
+checkWinning = undefined
+

app/D4P2.hs

@@ -0,0 +1,36 @@
+module Main where
+
+main :: IO ()
+main = interact solution
+
+type Board = [[Int]]
+
+scnd :: (b -> c) -> (a, b) -> (a, c)
+scnd f (a, b) = (a, f b)
+
+frst :: (a -> c) -> (a, b) -> (c, b)
+frst f (a, b) = (f a, b)
+
+solution :: String -> String
+solution =
+  show
+  -- ([Int], [Boards])
+  . scnd toBoards
+  . scnd (map (map (read :: String -> Int)))
+  . scnd (filter (not . null))
+  . scnd (map words)
+  . frst (map (read :: String -> Int))
+  . frst splitcomma
+  . (\x -> (head x, tail x))
+  . lines
+  where
+    splitcomma :: String -> [String] -- "stole" the implementation from `words`
+    splitcomma s = case dropWhile (==',') s of
+      "" -> []
+      s' -> w : splitcomma s''
+        where
+          (w, s'') = break (==',') s'      
+
+toBoards :: [[Int]] -> [Board]
+toBoards [] = []
+toBoards (a:b:c:d:e:r) = [a,b,c,d,e]:toBoards r