Day 13 (dirty)
This commit is contained in:
parent
6ee8b3fafa
commit
f8d0b6c0da
1 changed files with 88 additions and 17 deletions
105
day13/main.hs
105
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
|
||||
|
|
|
|||
Loading…
Reference in a new issue