updated pb 13 speed, map are really slow...
This commit is contained in:
parent
ea35b588f8
commit
744aec1540
3 changed files with 50 additions and 32 deletions
|
@ -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
16
src/Day13.hs
|
@ -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))
|
||||
|
|
60
test/Spec.hs
60
test/Spec.hs
|
@ -32,28 +32,9 @@ 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 =
|
||||
|
@ -75,11 +56,14 @@ 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" $
|
||||
[ 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 =
|
||||
testGroup "Day 3"
|
||||
|
@ -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
|
||||
]
|
||||
]
|
||||
|
|
Loading…
Reference in a new issue