diff --git a/adventofcode.cabal b/adventofcode.cabal index ba2d30c..16508f3 100644 --- a/adventofcode.cabal +++ b/adventofcode.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: dd5686d02b76a5cdfd0af22f3af753c80816616396b5f3c7ad773a552f9d0647 +-- hash: 1e758d0525406b84a2b0161fe229f8b799eefbe00c43229a99d7360878eb5368 name: adventofcode version: 0.1.0.0 @@ -49,8 +49,8 @@ library Day17 Day18 Day19 - other-modules: Day20 + other-modules: DayXX Permutations Paths_adventofcode diff --git a/app/Main.hs b/app/Main.hs index 3cc87fb..45a8385 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -27,7 +27,7 @@ import qualified Day16 import qualified Day17 import qualified Day18 import qualified Day19 --- import qualified Day20 +import qualified Day20 -- import qualified Day21 -- import qualified Day22 -- import qualified Day23 @@ -64,7 +64,7 @@ solutions = Map.fromList [(["01"], day01) ,(["17"], day17) ,(["18"], day18) ,(["19"], day19) - ,(["20"], dayXX) + ,(["20"], day20) ,(["21"], dayXX) ,(["22"], dayXX) ,(["23"], dayXX) @@ -208,8 +208,8 @@ day16 = do input <- Day16.parseInput sol1 <- Day16.solution1 16 input showSol "Solution 1" (text (toS sol1)) - -- sol2 <- Day16.solution2 16 input - -- showSol "Solution 2" (text (toS sol2)) + let sol2 = Day16.solution2 16 1000000000 input + showSol "Solution 2" (text (toS sol2)) day17 :: IO () day17 = do @@ -240,5 +240,14 @@ day19 = do let sol2 = Day19.solution2 input showSol "Solution 2" (int sol2) +day20 :: IO () +day20 = do + putText "Day 20:" + input <- Day20.parseInput + let sol1 = Day20.solution1 input + showSol "Solution 1" (int sol1) + let sol2 = Day20.solution2 input + showSol "Solution 2" (int sol2) + dayXX :: IO () dayXX = putText "Not done yet" diff --git a/package.yaml b/package.yaml index 5385149..99a4221 100644 --- a/package.yaml +++ b/package.yaml @@ -32,7 +32,7 @@ library: - Day17 - Day18 - Day19 - # - Day20 + - Day20 # - Day21 # - Day22 # - Day23 diff --git a/src/Day16.hs b/src/Day16.hs index 2979ef4..a48e0d3 100644 --- a/src/Day16.hs +++ b/src/Day16.hs @@ -194,20 +194,26 @@ data Dance = Dance { iperm :: Permutation Int , cperm :: Permutation Char } deriving (Eq, Show) -applyCmd :: Command -> Dance -> Dance -applyCmd (Spin n) d@Dance{..} = d { iperm = rotate n iperm } -applyCmd (Exchange i j) d@Dance{..} = d { iperm = swap i j iperm } -applyCmd (Partner x y) d@Dance{..} = d { cperm = swap x y cperm } +applyCmd :: Permutation Int -> Permutation Char -> Dance -> Command -> Dance +applyCmd p0 _ d@Dance{..} (Spin n) = d { iperm = iperm <> rotate n p0 } +applyCmd p0 _ d@Dance{..} (Exchange i j) = d { iperm = iperm <> swap i j p0 } +applyCmd _ p0 d@Dance{..} (Partner x y) = d { cperm = swap x y p0 <> cperm } solution2 :: Int -> Int -> [Command] -> [Char] solution2 len nbIter commands = do let letters = take len ['a'..'p'] lastLetter = fromMaybe 'a' (head (reverse letters)) - initDance = Dance (nullPerm (0,len-1)) (nullPerm ('a',lastLetter)) - firstDance = foldl' (flip applyCmd) initDance commands + ip = nullPerm (0,len-1) + cp = nullPerm ('a',lastLetter) + initDance = Dance ip cp + firstDance = foldl' (applyCmd ip cp) initDance commands finalDance = stimes nbIter firstDance - tmpArray = listArray (0,len-1) (elems (unPerm (cperm finalDance))) - permute (iperm finalDance) tmpArray & elems + tmpArray = listArray ('a',lastLetter) letters + permute (cperm finalDance) tmpArray + & elems + & listArray (0,len-1) + & permute (iperm finalDance) + & elems instance Semigroup Dance where Dance r1 p1 <> Dance r2 p2 = Dance (r1 <> r2) (p1 <> p2) diff --git a/src/Day20.hs b/src/Day20.hs index c59139d..59fc7c6 100644 --- a/src/Day20.hs +++ b/src/Day20.hs @@ -2,6 +2,8 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-| @@ -61,6 +63,7 @@ import Control.Lens hiding ((&)) -- import Data.Array import Data.Generics.Product -- import qualified Data.Text as T +import qualified Data.Set as Set import GHC.Generics import Text.Parsec hiding (State) @@ -114,7 +117,7 @@ parseInt = do str <- many1 digit let strint = case sgn of Nothing -> str - Just _ -> "-" <> str + Just _ -> "-" <> str return $ fromMaybe 0 (reads strint & head & fmap fst) -- Solution 1 @@ -142,11 +145,65 @@ solution1 input = type Solution2 = Int solution2 :: Input -> Solution2 -solution2 grid = - let initState = undefined - in extractSol $ execState solve2 initState +solution2 input = + let sorted = input + & zip ([0..] :: [Int]) + & sortOn (\(_,p)->d (pos p)) + & sortOn (\(_,p)->d (vit p)) + & sortOn (\(_,p)->d (acc p)) + in notCollided sorted & map fst & Set.fromList & Set.size where - extractSol :: AppState -> Solution2 - extractSol = undefined - solve2 :: State AppState () - solve2 = undefined + d = dist mempty + notCollided :: [(Int,Particle)] -> [(Int,Particle)] + notCollided sorted = do + (i,p1) <- sorted + (j,p2) <- sorted + guard (j > i) + guard (not (collide p1 p2)) + return (i,p1) + collide :: Particle -> Particle -> Bool + collide p1 p2 = let trivialracines = [1..10] + in checkRacines p1 p2 trivialracines + potentialRacines :: Particle -> Particle -> [Int] + potentialRacines p1 p2 = + let a = (acc p1 ^. field @"x") - (acc p2 ^. field @"x") + b = (vit p1 ^. field @"x") - (vit p2 ^. field @"x") + c = (pos p1 ^. field @"x") - (pos p2 ^. field @"x") + in + if a /= 0 + then + let delta = b^2 - 4*a*c in + if delta >= 0 + then [ (-b + isqrt delta) `div` (2*a) + , (-b - isqrt delta) `div` (2*a) + , 1+(-b - isqrt delta) `div` (2*a) + , 1+(-b + isqrt delta) `div` (2*a) + , 2+(-b - isqrt delta) `div` (2*a) + , 2+(-b + isqrt delta) `div` (2*a) + ] & filter (>0) + else [] + else [-c `div` b | b /= 0] + isqrt :: Int -> Int + isqrt = fromIntegral . floor . sqrt . fromIntegral + pol :: Particle -> Particle -> Lens' Coord Int -> (Int -> Int) + pol p1 p2 l = \x -> a*(x*x) + (b*x) + c + where + a :: Int + a = (acc p1 ^. l) - (acc p2 ^. l) + b :: Int + b = (vit p1 ^. l) - (vit p2 ^. l) + c :: Int + c = (pos p1 ^. l) - (pos p2 ^. l) + checkRacines :: Particle -> Particle -> [Int] -> Bool + checkRacines _ _ [] = False + checkRacines p1 p2 (x:xs) = + traceShow (p1,p2,x + , pol p1 p2 (field @"x") x == 0 + , pol p1 p2 (field @"y") x == 0 + , pol p1 p2 (field @"z") x == 0) + (pol p1 p2 (field @"x") x == 0 + && pol p1 p2 (field @"y") x == 0 + && pol p1 p2 (field @"z") x == 0) + || checkRacines p1 p2 xs + + diff --git a/src/Permutations.hs b/src/Permutations.hs index c5c8ed9..7abb32e 100644 --- a/src/Permutations.hs +++ b/src/Permutations.hs @@ -6,14 +6,18 @@ import Protolude hiding (swap) import Data.Array import Data.Proxy import Data.Semigroup +import qualified Data.Set as Set import GHC.TypeLits +-- | properties +-- a permutation is a bijection newtype Permutation i = - Permutation (Array i i) + Permutation { unPerm :: Array i i } deriving (Eq,Ord,Show) -unPerm :: Permutation i -> Array i i -unPerm (Permutation x) = x +isBijection :: (Ix i) => Permutation i -> Bool +isBijection p = + Set.fromList (elems (unPerm p)) == Set.fromList (indices (unPerm p)) permute :: (Ix i,Enum i) => Permutation i -> Array i e -> Array i e permute (Permutation p) a = @@ -48,24 +52,4 @@ rotate n (Permutation p) = instance (Ix i,Enum i) => Semigroup (Permutation i) where Permutation a1 <> Permutation a2 = Permutation $ - array (bounds a2) [ (i, a2 ! j) | (i,j) <- assocs a1] - -{- - -0 1 2 === 0 -1 0 2 => p1 -0 2 1 => p2 -2 1 0 => p3 -1 2 0 => p4 - -p1 <> p2 ===> 2 0 1 -p2 <> p1 ===> 1 2 0 - --} - -testPermutation = - let p0 = nullPerm (0,2) - p1 = swap 0 1 p0 - p2 = swap 1 2 p0 - p3 = p1 <> p2 - in p2 <> p1 + array (bounds a1) [ (i, a1 ! j) | (i,j) <- assocs a2] diff --git a/test/Spec.hs b/test/Spec.hs index 3d60619..93bee09 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -48,6 +48,7 @@ main = defaultMain $ , testDay13 , testDay14 , testDay15 + , testDay16 ] testDay01 = @@ -285,9 +286,24 @@ testDay15 = testDay16 = testGroup "Day 16" - [ testGroup "Solution 1" [] - , testGroup "Solution 2" [] + [ testGroup "Solution 1" + [ testCase "Example" $ do + sol1 <- Day16.solution1 5 Day16.testInput + sol1 @?= "baedc" + ] + , testGroup "Solution 2" + [ testCase "Check equal to sol1 input of length 1" $ test2 1 + , testCase "Check equal to sol1 input of length 1000" $ test2 1000 + ] ] + where + test2 n = do + input <- fmap (take n) Day16.parseInput + sol1 <- Day16.solution1 16 input + let sol2 = Day16.solution2 16 1 input + sol1 @?= sol2 + + testDay17 = testGroup "Day 17"