yogsototh/adventofcode
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

updated pb 13 speed, map are really slow...

Browse source
This commit is contained in:
Yann Esposito (Yogsototh) 2017-12-13 22:05:18 +01:00
parent ea35b588f8
commit 744aec1540
Signed by untrusted user who does not match committer: yogsototh
GPG key ID: 7B19A4C650D59646
3 changed files with 50 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
app/Main.hs
View file

@ -161,5 +161,5 @@ day13 = do
let sol1 = fmap Day13.solution1 input
showSol "Solution 1" (int (fromMaybe 0 sol1))
input2 <- Day13.parseInput
let sol2 = fmap Day13.solution2 input2
let sol2 = Day13.solution2 =<< input2
showSol "Solution 2" (int (fromMaybe 0 sol2))

16
src/Day13.hs
View file

@ -417,13 +417,21 @@ solution2naive st =
caughtToken :: Int -> Int -> Int -> Bool
caughtToken delay x depth = (x + delay) `rem` (2*(depth - 1)) == 0
collisions :: Int -> Map Int Int -> [Bool]
collisions delay depths = Map.mapWithKey (caughtToken delay) depths & Map.elems
collisions :: Int -> [(Int,Int)] -> [Bool]
collisions delay depths = [caughtToken delay x y | (x,y) <- depths]
solution2 :: Map Int Int -> Int
solution2 depths = go depths 0
solution2noopt :: Map Int Int -> Int
solution2noopt depths = go (Map.toList depths) 0
where
go depths delay =
if not (or (collisions delay depths))
then delay
else go depths (delay + 1)
-- | Slightly faster than solution2brute
solution2 :: Map Int Int -> Maybe Int
solution2 depths = find (uncaught (Map.toList depths)) [0..period-1]
where
uncaught :: [(Int,Int)] -> Int -> Bool
uncaught depths delay = not (or (collisions delay depths))
period = foldl' lcm 1 (map (\x -> (x-1)*2) (Map.elems depths))

64
test/Spec.hs
View file

@ -32,29 +32,10 @@ main = defaultMain $
, testDay08
, testDay09
, testDay10
, testGroup "Day 12"
[ testGroup "Solution 1"
[ testCase "Example" $
fmap Day12.solution1 (Day12.parseTxt Day12.testTxt) @?= Just 6
]
, testGroup "Solution 2"
[ testCase "Example" $
fmap Day12.solution2 (Day12.parseTxt Day12.testTxt) @?= Just 2
]
]
, testGroup "Day 13"
[ testGroup "Solution 1"
[ testCase "Example" $
(Day13.solution1 . Day13.mkAppState)
<$> Day13.parseTxt Day13.testInput
@?= Just 24
]
, testGroup "Solution 2"
[ testCase "Example" $
fmap Day13.solution2 (Day13.parseTxt Day13.testInput) @?= Just 10
]
]
]
, testDay11
, testDay12
, testDay13
]
testDay01 =
testGroup "Day 1"
@ -75,10 +56,13 @@ testDay01 =
testDay02 =
testGroup "Day 2"
[ testCase "example problem 1" $
Day02.solution1 [[5,1,9,5],[7,5,3],[2,4,6,8]] @?= 18
, testCase "example problem 2" $
Day02.solution2 [[5,9,2,8],[9,4,7,3],[3,8,6,5]] @?= 9
[ testGroup "Solution 1"
[ testCase "Example" $
Day02.solution1 [[5,1,9,5],[7,5,3],[2,4,6,8]] @?= 18]
, testGroup "Solution 2"
[testCase "Example" $
Day02.solution2 [[5,9,2,8],[9,4,7,3],[3,8,6,5]] @?= 9
]
]
testDay03 =
@ -233,3 +217,29 @@ testDay11 =
(Day11.solution1 (Day11.parseTxt txt) @?= v)
check2 txt v = testCase (toS txt)
(Day11.solution2 (Day11.parseTxt txt) @?= v)
testDay12 =
testGroup "Day 12"
[ testGroup "Solution 1"
[ testCase "Example" $
fmap Day12.solution1 (Day12.parseTxt Day12.testTxt) @?= Just 6
]
, testGroup "Solution 2"
[ testCase "Example" $
fmap Day12.solution2 (Day12.parseTxt Day12.testTxt) @?= Just 2
]
]
testDay13 =
testGroup "Day 13"
[ testGroup "Solution 1"
[ testCase "Example" $
(Day13.solution1 . Day13.mkAppState) <$> Day13.parseTxt Day13.testInput
@?= Just 24
]
, testGroup "Solution 2"
[ testCase "Example" $
(Day13.solution2 =<< Day13.parseTxt Day13.testInput) @?= Just 10
]
]