From f41863a68b24a65604725e6cd17d4f2567e6cbe4 Mon Sep 17 00:00:00 2001 From: Martin Potier Date: Thu, 17 Dec 2020 15:54:32 +0200 Subject: [PATCH] Best effort --- day13/main.hs | 117 ++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 105 insertions(+), 12 deletions(-) diff --git a/day13/main.hs b/day13/main.hs index 066bb89..58a2ebc 100755 --- a/day13/main.hs +++ b/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