Best effort
This commit is contained in:
parent
2240fd1325
commit
f41863a68b
117
day13/main.hs
117
day13/main.hs
|
|
@ -1,6 +1,6 @@
|
|||
#! /usr/bin/env -S"ANSWER=42" nix-shell
|
||||
#! nix-shell -p ghcid
|
||||
#! nix-shell -p "haskellPackages.ghcWithPackages (p: with p; [pretty-simple attoparsec arithmoi])"
|
||||
#! nix-shell -p "haskellPackages.ghcWithPackages (p: with p; [pretty-simple attoparsec arithmoi containers])"
|
||||
#! nix-shell -i "ghcid -c 'ghci' -T main"
|
||||
|
||||
{-# OPTIONS_GHC -Wall -Wincomplete-uni-patterns #-}
|
||||
|
|
@ -8,17 +8,25 @@
|
|||
{-# OPTIONS_GHC -Wno-unused-matches -Wno-type-defaults #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-local-binds #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
|
||||
import Control.Applicative
|
||||
import Data.Attoparsec.Text (Parser)
|
||||
import Data.Text (Text)
|
||||
import Debug.Trace (trace)
|
||||
import Text.Pretty.Simple
|
||||
import Data.IntSet (IntSet)
|
||||
import Data.List (find,sortOn,sort)
|
||||
import Data.Maybe (fromMaybe,catMaybes)
|
||||
import Data.List (find,sortOn)
|
||||
import qualified Data.Attoparsec.Text as A
|
||||
import qualified Data.Text as T
|
||||
import Data.Monoid
|
||||
import Data.Text (Text)
|
||||
import Data.Vector (Vector)
|
||||
import Debug.Trace (trace,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
|
||||
|
||||
exampleData :: String
|
||||
exampleData = "939\n7,13,x,x,59,x,31,19"
|
||||
|
|
@ -54,11 +62,70 @@ inputParser2 = do
|
|||
parseInput2 :: String -> Either String (Int,[Maybe Int])
|
||||
parseInput2 = (A.parseOnly inputParser2) . T.pack
|
||||
|
||||
solvePart2 :: String -> Either String [(Int,Int)]
|
||||
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)
|
||||
|
||||
isT :: Integer -> Int -> [(Int,Int)] -> Integer
|
||||
isT tpx x xs = head $ catMaybes $ map go allTs
|
||||
where
|
||||
allTs = [158478605388*tpx,158478605388*2*tpx..]
|
||||
go :: Integer -> Maybe Integer
|
||||
go tpx0 = case and (map (go' tpx0) xs) of
|
||||
True -> Just (tpx0 - (fromIntegral x))
|
||||
_ -> Nothing
|
||||
go' tpx0' (shift,fact) =
|
||||
-- trace ("tpx:"<>show tpx0'<>",shift:"<>show shift<>",x:"<>show x<>",fact:"<>show fact) $
|
||||
-- traceShowId $
|
||||
(tpx0' - (fromIntegral x) + (fromIntegral shift)) `mod` (fromIntegral fact) == 0
|
||||
|
||||
-- Solving part 2
|
||||
--
|
||||
-- Simple example with [(0,3),(1,5)], we're looking for a t, such that
|
||||
-- t + 0 = 3 * i, t+0 is divisible by 3 and
|
||||
-- t + 1 = 5 * j, t+1 is divisible by 5
|
||||
--
|
||||
-- Surely there must be some relation between i and j? There should be a number
|
||||
-- such that 3 * i_0 = 5 * j_0 = n_0. n is here the least common multiple (lcm)
|
||||
-- of 3 and 5, in our case lcm(3,5) = 15 (because both numbers are prime)
|
||||
--
|
||||
-- 3 * i_0 = 15 & 5 * j_0 = 15 -> i_0 = 5 & j_0 = 3
|
||||
--
|
||||
-- Now what?
|
||||
solvePart2 :: String -> Either String Integer
|
||||
solvePart2 str = do
|
||||
(_,xs) <- parseInput2 str
|
||||
let startAndIds = catMaybes $ sequence <$> zip [0..] xs
|
||||
pure startAndIds
|
||||
let sortedStartAndIds = reverse $ sortOn snd $ startAndIds
|
||||
-- pure $ sortedStartAndIds
|
||||
let (x,t) = head sortedStartAndIds
|
||||
pure $ isT (fromIntegral t) x sortedStartAndIds
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
|
@ -69,7 +136,33 @@ main = do
|
|||
input <- readFile "day13/input"
|
||||
pPrint $ solvePart1 exampleData
|
||||
pPrint $ solvePart1 input
|
||||
putStrLn ":: Test"
|
||||
print $ unPrime . fst <$> factorise (1068781::Integer)
|
||||
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
|
||||
putStrLn ":: Day 13 - Part 2"
|
||||
print $ solvePart2 exampleData
|
||||
-- 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
|
||||
|
|
|
|||
Loading…
Reference in New Issue