Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit d05e469

Browse files
committed
simpler day 20
1 parent 3056c25 commit d05e469

File tree

3 files changed

+63
-45
lines changed

3 files changed

+63
-45
lines changed

‎reflections.md

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1950,6 +1950,14 @@ Day 20
19501950

19511951
[d20c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day20.hs
19521952

1953+
```haskell
1954+
data S = S { _sPos :: !(V.Vector (Maybe (L.V3 Int)))
1955+
, _sVel :: !(V.Vector (Maybe (L.V3 Int)))
1956+
, _sAcc :: !(V.Vector (Maybe (L.V3 Int)))
1957+
}
1958+
deriving Show
1959+
```
1960+
19531961
### Day 20 Benchmarks
19541962

19551963
```

‎src/AOC2017/Day20.hs

Lines changed: 45 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -1,65 +1,66 @@
1-
{-# LANGUAGE FlexibleContexts #-}
1+
-- module AOC2017.Day20 (day20a, day20b) where
2+
module AOC2017.Day20 where
23

3-
module AOC2017.Day20 (day20a, day20b) where
4+
import AOC2017.Types (Challenge)
5+
import AOC2017.Util (scanlT)
6+
import Data.Char (isDigit)
7+
import Data.Foldable (toList)
8+
import Data.List (find)
9+
import Data.List.Split (splitOn)
10+
import Data.Maybe (fromJust)
11+
import qualified Data.Map as M
12+
import qualified Data.Set as S
13+
import qualified Data.Vector as V
14+
import qualified Linear as L
415

5-
import AOC2017.Types (Challenge)
6-
import Control.Applicative (liftA2)
7-
import Control.Monad (mfilter)
8-
import Data.Char (isDigit)
9-
import Data.Foldable (toList)
10-
import Data.List
11-
import Data.List.Split (splitOn)
12-
import Data.Maybe (fromJust)
13-
import qualified Data.Map as M
14-
import qualified Data.Set as S
15-
import qualified Data.Vector as V
16-
import qualified Linear as L
16+
type Point = L.V3 Int
1717

18-
data S=S { _sPos :: !(V.Vector (Maybe (L.V3Int)))
19-
, _sVel :: !(V.Vector (Maybe (L.V3Int)))
20-
, _sAcc :: !(V.Vector (Maybe (L.V3Int)))
21-
}
22-
deriving Show
18+
data Particlea=P { _pAcc :: !a
19+
, _pVel :: !a
20+
, _pPos :: !a
21+
}
22+
deriving (Functor, Foldable, Traversable, Show, Eq, Ord)
2323

24-
step::S->S
25-
step s@S{..} = s { _sPos = p, _sVel = v }
26-
where
27-
[_,v,p] =scanl1 ((V.zipWith. liftA2) (+)) [_sAcc, _sVel, _sPos]
24+
typeSystem= [ParticlePoint]
25+
26+
step::Numa=>Particlea->Particlea
27+
step = scanlT (+)0
2828

29-
collide :: S -> S
30-
collide s@S{..} = s { _sPos = mfilter (`S.notMember` collisions) <$> _sPos }
29+
collide :: System -> System
30+
collide s0 = filter ((`S.notMember` collisions) . _pPos) s0
3131
where
32+
collisions :: S.Set Point
3233
collisions = M.keysSet . M.filter @Int (> 1)
33-
. M.fromListWith (+) . fmap (,1)
34-
$ foldMap toList _sPos
34+
. M.fromListWith (+)
35+
. map ((,1) . _pPos)
36+
$ toList s0
3537

36-
norm :: L.V3Int -> Int
38+
norm :: Point -> Int
3739
norm = sum . fmap abs
3840

3941
day20a :: Challenge
40-
day20a = show . V.minIndex
41-
. (fmap . fmap . fmap) norm
42-
. (\case S r v a -> V.zipWith3 L.V3 a v r)
42+
day20a = show . V.minIndex . V.fromList
43+
. (map . fmap) norm
4344
. parse
4445

4546
day20b :: Challenge
4647
day20b = show . length . fromJust . find stop
47-
. map (foldMap toList . _sPos)
48-
. iterate (collide . step)
48+
. (map .map) (norm . _pPos)
49+
. iterate (collide . mapstep)
4950
. parse
5051
where
51-
-- assumes there will be at least one particule left
52-
stop = (> 1000) . minimum . map norm
52+
stop = (> 1000) . minimum
5353

54-
parse :: String -> S
55-
parse = (\case L.V3 r v a -> S r v a)
56-
. traverse (fmap Just . parseLine)
57-
. V.fromList . lines
58-
59-
parseLine :: String -> L.V3 (L.V3 Int)
60-
parseLine (map(read.filter numChar).splitOn","->[pX,pY,pZ,vX,vY,vZ,aX,aY,aZ])
61-
= L.V3 (L.V3 pX pY pZ) (L.V3 vX vY vZ) (L.V3 aX aY aZ)
62-
parseLine _ = error "No parse"
54+
parse :: String -> System
55+
parse = map parseLine . lines
56+
where
57+
parseLine :: String -> Particle Point
58+
parseLine (map(read.filter numChar).splitOn","->[pX,pY,pZ,vX,vY,vZ,aX,aY,aZ])
59+
= P { _pAcc = L.V3 aX aY aZ
60+
, _pVel = L.V3 vX vY vZ
61+
, _pPos = L.V3 pX pY pZ
62+
}
63+
parseLine _ = error "No parse"
6364

6465
numChar :: Char -> Bool
6566
numChar c = isDigit c || c == '-'

‎src/AOC2017/Util.hs

Lines changed: 10 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,10 +3,13 @@ module AOC2017.Util (
33
, iterateMaybe
44
, (!!!)
55
, dup
6+
, scanlT
7+
, scanrT
68
) where
79

810
import Data.List
9-
import qualified Data.Text as T
11+
import Data.Traversable
12+
import qualified Data.Text as T
1013

1114
-- | Strict (!!)
1215
(!!!) :: [a] -> Int -> a
@@ -22,3 +25,9 @@ iterateMaybe f x0 = x0 : unfoldr (fmap dup . f) x0
2225

2326
dup :: a -> (a, a)
2427
dup x = (x, x)
28+
29+
scanlT :: Traversable t => (b -> a -> b) -> b -> t a -> t b
30+
scanlT f z = snd . mapAccumL (\x -> dup . f x) z
31+
32+
scanrT :: Traversable t => (a -> b -> b) -> b -> t a -> t b
33+
scanrT f z = snd . mapAccumR (\x -> dup . flip f x) z

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /