Day 13

Cleaned up

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.Monad (foldM)
-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)
-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,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)
+solvePart2 :: String -> Maybe (Integer,Integer)
-solvePart2Clever str = do
+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 $ solvePart2 exampleData
-  print $ (lcm' [100,23,98],getProduct $ foldMap Product [100,23,98])
+  print $ solvePart2 "1\n17,x,13,19"
-  print $ lcm' [7,13,59,31,19]
+  print $ solvePart2 "1\n67,7,59,61"
-  print $ lcm'' [7,13,59,31,19]
+  print $ solvePart2 "1\n67,x,7,59,61"
-  putStrLn "The lcm of a list of number is the first number that all of them   "
+  print $ solvePart2 "1\n67,7,x,59,61"
-  putStrLn "divide ie when are the different “gears” all in sync again, after  "
+  print $ solvePart2 "1\n1789,37,47,1889"
-  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 $ solvePart2Naive exampleData
+  print $ solvePart2 input
-  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