From f8d0b6c0da3c6e72c379930a5c770875f476f74e Mon Sep 17 00:00:00 2001 From: Martin Potier Date: Mon, 21 Dec 2020 15:27:51 +0200 Subject: [PATCH] Day 13 (dirty) --- day13/main.hs | 105 ++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 88 insertions(+), 17 deletions(-) diff --git a/day13/main.hs b/day13/main.hs index 5c31e76..97c13d2 100755 --- a/day13/main.hs +++ b/day13/main.hs @@ -1,6 +1,6 @@ #! /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])" +#! nix-shell -p "haskellPackages.ghcWithPackages (p: with p; [pretty-simple attoparsec arithmoi containers parallel semirings])" #! nix-shell -i "ghcid -c 'ghci' -T main" {-# OPTIONS_GHC -Wall -Wincomplete-uni-patterns #-} @@ -11,23 +11,24 @@ {-# LANGUAGE DataKinds #-} import Control.Applicative +import Control.Monad +import Control.Parallel.Strategies (parMap, parListChunk, rdeepseq) import Data.Attoparsec.Text (Parser) +import Data.Euclidean (gcdExt) import Data.IntSet (IntSet) import Data.List (find,sortOn,sort) import Data.Maybe (fromMaybe,catMaybes) import Data.Monoid import Data.Text (Text) import Data.Vector (Vector) -import Debug.Trace (trace,traceShowId) +import Debug.Trace (trace,traceShow,traceShowId) import Math.NumberTheory.ArithmeticFunctions import Math.NumberTheory.Primes ---import Math.NumberTheory.Moduli.Class 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 -import Control.Parallel.Strategies (parMap, parListChunk, rdeepseq) exampleData :: String exampleData = "939\n7,13,x,x,59,x,31,19" @@ -97,7 +98,7 @@ findAllEq = find (\xs -> notElem (head xs) xs) isT :: Int -> Int -> [(Int,Int)] -> Int isT tpx x xs = head $ catMaybes $ map go allTs where - allTs = [158478605388*tpx,158478605389*tpx..] + allTs = [tpx,2*tpx..] go :: Int -> Maybe Int go tpx0 = case and (parMap rdeepseq (go' tpx0) xs) of True -> Just (tpx0 - x) @@ -106,15 +107,76 @@ isT tpx x xs = head $ catMaybes $ map go allTs -- trace ("tpx:"<>show tpx0'<>",shift:"<>show shift<>",x:"<>show x<>",fact:"<>show fact) $ (tpx0' - x + shift) `mod` fact == 0 -solvePart2 :: String -> Either String Int -solvePart2 str = do +solvePart2Naive :: String -> Either String Int +solvePart2Naive str = do (_,xs) <- parseInput2 str - let startAndIds = catMaybes $ sequence <$> zip [0..] xs - let sortedStartAndIds = traceShowId $ reverse $ sortOn snd $ startAndIds + 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 -- +-- https://en.wikipedia.org/wiki/Chinese_remainder_theorem -- +-- -------------------------------------------------------------------------- -- +-- Apllying the theorem allows to reduce a system of equation on x: -- +-- -- +-- x ≡ a1 (mod n1) -- +-- · -- +-- · -- +-- · -- +-- x ≡ ak (mod nk) -- +-- -- +-- to a single equation: -- +-- -- +-- x ≡ as (mod ns) -- +-- -- +-- It relates to the buses schedules in the following way: t is x, the bus -- +-- number is the modulo factor (since a bus comes *every* ni) and subsequent -- +-- additions to t (for other buses) is (-ai), so, for a but coming at -- +-- t+ai, one would write x ≡ -ai (mod ni) -- +-- -- +-- I chose to encode ai and ni as a tuple (ai,ni), named startAndIds -- +-- -- +-- Basically, we're creating a “chinese” function: -- +-- -- +-- chinese :: (Int,Int) -> (Int,Int) -> (Int,Int) -- +-- -- +-- Then, given a list [(Int, Int)] we can fold over it to obtain the solution -- +-- -- + +chinese :: (Integer,Integer) -> (Integer,Integer) -> Maybe (Integer,Integer) +chinese (0,n1) (0,n2) = chinese (n1,n1) (n2,n2) +chinese v (0,n2) = chinese v (n2,n2) +chinese (0,n1) v = chinese (n1,n1) v +chinese (a1,n1) (a2,n2) = do + -- Computes a solution such that: n1×c1 + n2×c2 = g, for some c2 + -- n1×c1 - g = - n2×c2, for some c2 + -- 1/n2 (n1×c1 - g) = - c2, for some c2 (n2 is > 0) + -- - 1/n2 (n1×c1 - g) = c2, for some c2 (n2 is > 0) + -- n1 and n2 must be coprimes for this to work (g must be 1), fail otherwise + (m1,m2) <- case gcdExt n1 n2 of + (1,c1) -> Just ( c1, negate ((n1 * c1) - 1) `div` n2 ) + _ -> Nothing + let x = a1 * m2 * n2 + a2 * m1 * n1 + let a12 = x `mod` (n1 * n2) + pure $ (a12, n1 * n2) + +e2m :: Either e a -> Maybe a +e2m (Right v) = Just v +e2m _ = Nothing + +solvePart2Clever :: String -> Maybe (Integer,Integer) +solvePart2Clever 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 + foldM chinese (1,1) chineseEqs + main :: IO () main = do putStrLn ":: Test" @@ -146,11 +208,20 @@ main = do print $ 100000000000000 `mod` 631 print $ 100000000000000 `div` 631 putStrLn ":: Day 13 - Part 2" - print $ solvePart2 "939\n3,5" - 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" - print $ solvePart2 input + 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