stuff

aoc2021.cabal

@@ -1,20 +1,10 @@
-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
+cabal-version: 2.4
+name: aoc2021
+version: 0.1.0.0
+synopsis: My solutions to AoC 2021
+license: BSD-3-Clause
+author: Annwan
+maintainer: annwan@outlook.fr
 
 extra-source-files:
     README.org
@@ -57,6 +47,6 @@ executable d3p2
 
 executable d4p1
     main-is: D4P1.hs
-    build-depends: base ^>=4.15.0.0
+    build-depends: base ^>=4.15.0.0, split
     hs-source-dirs: app
     default-language: Haskell2010

app/D4P1.hs

@@ -1,47 +1,64 @@
 module Main where
 
+import Data.List.Split (chunksOf, splitOn)
+import Debug.Trace (traceShowId)
+import Data.List (transpose)
+
 main :: IO ()
 main = interact solution
 
-type Board = [[Int]]
-type BoardMask = [[Bool]]
+type Board = [(Bool, Int)]
 
-scnd :: (b -> c) -> (a, b) -> (a, c)
-scnd f (a, b) = (a, f b)
+second :: (b -> c) -> (a, b) -> (a, c)
+second f (a, b) = (a, f b)
+second2 :: (a -> b -> c) -> (a, b) -> (a, c)
+second2 f (a, b) = (a, f a b)
 
-frst :: (a -> c) -> (a, b) -> (c, b)
-frst f (a, b) = (f a, b)
+first :: (a -> c) -> (a, b) -> (c, b)
+first 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
+solution = show
+         . second2 applydraws
+         . second ( chunksOf 25
+                  . zip (repeat False)
+                  . map (read :: String -> Int)
+                  . concatMap words
+                  )
+         . first ( map (read :: String -> Int)
+                 . splitOn ","
+                 )
+         . (\x -> (head x, tail x))
+         . lines
+
+select :: Int -> Board -> Board
+select n = map (\(d, p) -> ((n == p) || d, p))
+
+hasWon :: Board -> Bool
+hasWon b = any and r || any and (transpose r)
+  where r = chunksOf 5 (map fst b)
+
+score :: Int -> Board -> Int
+score lastn b = lastn * boardleft b
+  where boardleft = sum . map snd . filter (not . fst)
+
+applydraw :: Int -> [Board] -> [Board]
+applydraw n = map (select n)
+
+applydraws ::[Int] -> [Board] -> [(Int, [Board])]
+applydraws []     _ = []
+applydraws (n:ns) b = (n, nb) : applydraws ns nb
+  where
+    nb = applydraw n b
+
+getWinning :: [[Board]] -- ^ Mapped boards
+           -> Board
+getWinning [] = error "WTF"
+getWinning (bs:r) = if any hasWon bs then getWinning' bs else getWinning r
   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
+    getWinning' :: [Board] -> Board
+    getWinning' (b:bs)
+      | hasWon b = b
+      | otherwise = getWinning' bs
+    getWinning' [] = error "Wtf"
 

app/D4P2.hs

@@ -1,36 +0,0 @@
-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