diff --git a/day13/main.hs b/day13/main.hs index 97c13d2..199c6b4 100755 --- a/day13/main.hs +++ b/day13/main.hs @@ -1,34 +1,20 @@ #! /usr/bin/env -S"GHCRTS=-N4" nix-shell #! nix-shell -p ghcid -#! nix-shell -p "haskellPackages.ghcWithPackages (p: with p; [pretty-simple attoparsec arithmoi containers parallel semirings])" +#! nix-shell -p "haskellPackages.ghcWithPackages (p: with p; [pretty-simple attoparsec arithmoi])" #! nix-shell -i "ghcid -c 'ghci' -T main" {-# OPTIONS_GHC -Wall -Wincomplete-uni-patterns #-} -{-# OPTIONS_GHC -Wno-unused-top-binds -Wno-unused-imports #-} -{-# OPTIONS_GHC -Wno-unused-matches -Wno-type-defaults #-} -{-# OPTIONS_GHC -Wno-unused-local-binds #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DataKinds #-} import Control.Applicative -import Control.Monad -import Control.Parallel.Strategies (parMap, parListChunk, rdeepseq) +import Control.Monad (foldM) import Data.Attoparsec.Text (Parser) import Data.Euclidean (gcdExt) -import Data.IntSet (IntSet) -import Data.List (find,sortOn,sort) +import Data.List (find,sortOn) import Data.Maybe (fromMaybe,catMaybes) -import Data.Monoid -import Data.Text (Text) -import Data.Vector (Vector) -import Debug.Trace (trace,traceShow,traceShowId) -import Math.NumberTheory.ArithmeticFunctions -import Math.NumberTheory.Primes import Text.Pretty.Simple import qualified Data.Attoparsec.Text as A -import qualified Data.IntSet as I import qualified Data.Text as T -import qualified Data.Vector as V exampleData :: String exampleData = "939\n7,13,x,x,59,x,31,19" @@ -64,60 +50,6 @@ inputParser2 = do parseInput2 :: String -> Either String (Int,[Maybe Int]) parseInput2 = (A.parseOnly inputParser2) . T.pack -gcd' :: [Int] -> Int -gcd' = head - . (\xs -> if length xs > 1 then drop 1 xs else xs) - . I.toDescList - . (\x -> foldl I.intersection (I.unions x) x) - . map divisorsSmall - --- lcm on a list of Ints -lcm' :: [Int] -> Int -lcm' (x:xs) = go x xs - where - go x0 (y:ys) = go (lcm x0 y) (ys) - go x0 [] = x0 -lcm' [] = 1 - --- lcm on a list of Ints -lcm'' :: [Int] -> Int -lcm'' xs = prodL xs `div` gcd' xs - where - prodL = getProduct . foldMap Product - --- Too slow -modList :: [(Int,Int)] -> [ [Int] ] -modList = fmap f - where - f (n,m) = filter (\x -> (x + n) `mod` m == 0) [1..] - -findAllEq :: [[Int]] -> Maybe [Int] -findAllEq = find (\xs -> notElem (head xs) xs) - --- Can you feel how much fun I'm not having anymore? -isT :: Int -> Int -> [(Int,Int)] -> Int -isT tpx x xs = head $ catMaybes $ map go allTs - where - allTs = [tpx,2*tpx..] - go :: Int -> Maybe Int - go tpx0 = case and (parMap rdeepseq (go' tpx0) xs) of - True -> Just (tpx0 - x) - _ -> Nothing - go' tpx0' (shift,fact) = - -- trace ("tpx:"<>show tpx0'<>",shift:"<>show shift<>",x:"<>show x<>",fact:"<>show fact) $ - (tpx0' - x + shift) `mod` fact == 0 - -solvePart2Naive :: String -> Either String Int -solvePart2Naive str = do - (_,xs) <- parseInput2 str - let startAndIds = traceShowId $ catMaybes $ sequence <$> zip [0..] xs - let sortedStartAndIds = reverse $ sortOn snd $ startAndIds - -- pure $ sortedStartAndIds - let (x,t) = head sortedStartAndIds - pure $ isT t x sortedStartAndIds - - - -- -------------------------------------------------------------------------- -- -- Here I sneak around a bit, and realize the problem is well defined -- -- (and solved!) already: it's called the Chinese Remainder Theorem -- @@ -170,58 +102,28 @@ e2m :: Either e a -> Maybe a e2m (Right v) = Just v e2m _ = Nothing -solvePart2Clever :: String -> Maybe (Integer,Integer) -solvePart2Clever str = do +solvePart2 :: String -> Maybe (Integer,Integer) +solvePart2 str = do (_,xs) <- e2m $ parseInput2 str let startAndIds = catMaybes $ sequence <$> zip [0..] (map (fmap fromIntegral) xs) - let chineseEqs = traceShowId $ fmap (\(a,n) -> ((-a) `mod` n, n)) startAndIds + let chineseEqs = fmap (\(a,n) -> ((-a) `mod` n, n)) startAndIds foldM chinese (1,1) chineseEqs main :: IO () main = do putStrLn ":: Test" pPrint $ A.parseOnly inputParser $ T.pack exampleData - pPrint $ take 3 ((\n -> [1,n..]) 59) + pPrint $ take 3 ((\n -> [1,(n::Integer)..]) 59) putStrLn ":: Day 13 - Part 1" input <- readFile "day13/input" pPrint $ solvePart1 exampleData pPrint $ solvePart1 input putStrLn ":: Test 2" - print $ (43+127) `mod` 8921 == ((43 `mod` 8921) + (127 `mod` 8921)) `mod` 8921 - print $ (lcm' [100,23,98],getProduct $ foldMap Product [100,23,98]) - print $ lcm' [7,13,59,31,19] - print $ lcm'' [7,13,59,31,19] - putStrLn "The lcm of a list of number is the first number that all of them " - putStrLn "divide ie when are the different “gears” all in sync again, after " - putStrLn "t=0 " - print $ (div (lcm' [7,13,59,31,19])) <$> [7,13,59,31,19] - print $ (div 1068781) <$> [7,13,59,31,19] - print $ (mod (lcm' [7,13,59,31,19])) <$> [7,13,59,31,19] - print $ (mod 1068781) <$> [7,13,59,31,19] - putStrLn "::: 🎶 Musical Interlude 🎶" - print $ (1068781 + 4) `div` 59 - print $ (1068781 + 4) `mod` 59 - print $ (1068781 + 6) `mod` 31 - print $ (1068781 + 7) `mod` 19 - print $ (1068781 + 1) `mod` 13 - print $ (1068781 + 0) `mod` 7 - print $ 100000000000000 `mod` 631 - print $ 100000000000000 `div` 631 + print $ solvePart2 exampleData + print $ solvePart2 "1\n17,x,13,19" + print $ solvePart2 "1\n67,7,59,61" + print $ solvePart2 "1\n67,x,7,59,61" + print $ solvePart2 "1\n67,7,x,59,61" + print $ solvePart2 "1\n1789,37,47,1889" putStrLn ":: Day 13 - Part 2" - print $ solvePart2Naive exampleData - print $ solvePart2Naive "1\n17,x,13,19" - print $ solvePart2Naive "1\n67,7,59,61" - print $ solvePart2Naive "1\n67,x,7,59,61" - print $ solvePart2Naive "1\n67,7,x,59,61" - print $ solvePart2Naive "1\n1789,37,47,1889" - putStrLn "" - print $ solvePart2Clever exampleData - print $ solvePart2Clever "1\n17,x,13,19" - print $ solvePart2Clever "1\n67,7,59,61" - print $ solvePart2Clever "1\n67,x,7,59,61" - print $ solvePart2Clever "1\n67,7,x,59,61" - print $ solvePart2Clever "1\n1789,37,47,1889" - putStrLn "" - -- Don't, it just takes forever. - -- print $ solvePart2Naive input - print $ solvePart2Clever input + print $ solvePart2 input