From 2d3a55176eff4330d92ab9b2bfc427fcc092279d Mon Sep 17 00:00:00 2001 From: "Antoine \"Annwan\" Combet" Date: Wed, 16 Mar 2022 20:22:17 +0100 Subject: [PATCH] stuff --- .gitignore | 0 README.org | 0 aoc2021.cabal | 26 +++++---------- app/D1P1.hs | 0 app/D1P2.hs | 0 app/D2P1.hs | 0 app/D2P2.hs | 0 app/D3P1.hs | 0 app/D3P2.hs | 0 app/D4P1.hs | 89 ++++++++++++++++++++++++++++++--------------------- app/D4P2.hs | 36 --------------------- 11 files changed, 61 insertions(+), 90 deletions(-) mode change 100644 => 100755 .gitignore mode change 100644 => 100755 README.org mode change 100644 => 100755 aoc2021.cabal mode change 100644 => 100755 app/D1P1.hs mode change 100644 => 100755 app/D1P2.hs mode change 100644 => 100755 app/D2P1.hs mode change 100644 => 100755 app/D2P2.hs mode change 100644 => 100755 app/D3P1.hs mode change 100644 => 100755 app/D3P2.hs mode change 100644 => 100755 app/D4P1.hs delete mode 100644 app/D4P2.hs diff --git a/.gitignore b/.gitignore old mode 100644 new mode 100755 diff --git a/README.org b/README.org old mode 100644 new mode 100755 diff --git a/aoc2021.cabal b/aoc2021.cabal old mode 100644 new mode 100755 index 21b1bcf..c3934d1 --- a/aoc2021.cabal +++ b/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 \ No newline at end of file diff --git a/app/D1P1.hs b/app/D1P1.hs old mode 100644 new mode 100755 diff --git a/app/D1P2.hs b/app/D1P2.hs old mode 100644 new mode 100755 diff --git a/app/D2P1.hs b/app/D2P1.hs old mode 100644 new mode 100755 diff --git a/app/D2P2.hs b/app/D2P2.hs old mode 100644 new mode 100755 diff --git a/app/D3P1.hs b/app/D3P1.hs old mode 100644 new mode 100755 diff --git a/app/D3P2.hs b/app/D3P2.hs old mode 100644 new mode 100755 diff --git a/app/D4P1.hs b/app/D4P1.hs old mode 100644 new mode 100755 index ff1f024..7d78125 --- a/app/D4P1.hs +++ b/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" diff --git a/app/D4P2.hs b/app/D4P2.hs deleted file mode 100644 index 58ae096..0000000 --- a/app/D4P2.hs +++ /dev/null @@ -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