From 0d249ca4fed17793fe7c284d60b65c8f3e5af1fc Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Wed, 11 Dec 2019 09:06:15 +0000 Subject: [PATCH] Done day 10 --- advent10/package.yaml | 59 +++++++++++++++++++ advent10/src/advent10.hs | 120 +++++++++++++++++++++++++++++++++++++++ data/advent10.txt | 21 +++++++ data/advent10a.txt | 5 ++ data/advent10b.txt | 10 ++++ data/advent10l.txt | 20 +++++++ data/advent10s.txt | 5 ++ data/advent10xr.txt | 10 ++++ data/advent10xs.txt | 10 ++++ stack.yaml | 1 + 10 files changed, 261 insertions(+) create mode 100644 advent10/package.yaml create mode 100644 advent10/src/advent10.hs create mode 100644 data/advent10.txt create mode 100644 data/advent10a.txt create mode 100644 data/advent10b.txt create mode 100644 data/advent10l.txt create mode 100644 data/advent10s.txt create mode 100644 data/advent10xr.txt create mode 100644 data/advent10xs.txt diff --git a/advent10/package.yaml b/advent10/package.yaml new file mode 100644 index 0000000..75a923b --- /dev/null +++ b/advent10/package.yaml @@ -0,0 +1,59 @@ +# This YAML file describes your package. Stack will automatically generate a +# Cabal file when you run `stack build`. See the hpack website for help with +# this file: . + +name: advent10 +synopsis: Advent of Code +version: '0.0.1' + +default-extensions: +- AllowAmbiguousTypes +- ApplicativeDo +- BangPatterns +- BlockArguments +- DataKinds +- DeriveFoldable +- DeriveFunctor +- DeriveGeneric +- DeriveTraversable +- EmptyCase +- FlexibleContexts +- FlexibleInstances +- FunctionalDependencies +- GADTs +- GeneralizedNewtypeDeriving +- ImplicitParams +- KindSignatures +- LambdaCase +- MonadComprehensions +- MonoLocalBinds +- MultiParamTypeClasses +- MultiWayIf +- NegativeLiterals +- NumDecimals +- OverloadedLists +- OverloadedStrings +- PartialTypeSignatures +- PatternGuards +- PatternSynonyms +- PolyKinds +- RankNTypes +- RecordWildCards +- ScopedTypeVariables +- TemplateHaskell +- TransformListComp +- TupleSections +- TypeApplications +- TypeInType +- TypeOperators +- ViewPatterns + + +executables: + advent10: + main: advent10.hs + source-dirs: src + dependencies: + - base >= 2 && < 6 + - containers + - linear \ No newline at end of file diff --git a/advent10/src/advent10.hs b/advent10/src/advent10.hs new file mode 100644 index 0000000..95c0287 --- /dev/null +++ b/advent10/src/advent10.hs @@ -0,0 +1,120 @@ +import Data.Ratio +import qualified Data.Set as S +import qualified Data.Map.Strict as M +-- import Data.Map.Strict ((!)) +import Linear (V2(..), (^+^), (^-^), (*^), (*^)) +import Linear.Metric (norm) + +import Data.List +import Data.Ord + + +type Bounds = (Int, Int) +type Position = V2 Int +type Delta = V2 (Ratio Int) + +type Asteroids = S.Set Position + +type TargetInfo = (Float, Float) +type Targets = M.Map TargetInfo Position + +main :: IO () +main = do + text <- readFile "data/advent10.txt" + let (asteroids, bounds) = successfulParse text + -- print asteroids + let (monitor, visCount) = bestVisible bounds asteroids + print visCount -- part 1 + let targets = makeTargets monitor (S.delete monitor asteroids) + -- print targets + print $ part2 targets + + +part2 targets = 100 * x + y + where V2 x y = (targetSequence targets)!!199 + + +bestVisible :: Bounds -> Asteroids -> (Position, Int) +bestVisible bounds asteroids = maximumBy (comparing snd) $ S.toList $ S.map (visibleCount bounds asteroids) asteroids + +visibleCount :: Bounds -> Asteroids -> Position -> (Position, Int) +visibleCount bounds asteroids origin = (origin, S.size $ visible bounds origin asteroids) + +visible :: Bounds -> Position -> Asteroids -> Asteroids +visible bounds origin asteroids = S.delete origin $ S.difference asteroids screened + where screened = allScreenings bounds origin asteroids + +allScreenings :: Bounds -> Position -> Asteroids -> Asteroids +allScreenings bounds origin asteroids = S.foldl' (screenings bounds origin) S.empty asteroids + + +screenings :: Bounds -> Position -> Asteroids -> Position -> Asteroids +screenings bounds origin@(V2 ox oy) screened0 target@(V2 tx ty) + | origin == target = screened0 + | otherwise = S.union screened0 screened + where maxComponent = max (abs (tx - ox)) (abs (ty - oy)) + delta = V2 ((tx - ox) % maxComponent) ((ty - oy) % maxComponent) + startR = V2 (tx % 1) (ty % 1) + rawScreens = takeWhile (inBounds bounds) [startR ^+^ n *^ delta | n <- [1..]] + screens = filter isIntegral rawScreens + screenInteger = map integerVec screens + fullScreened = S.fromList screenInteger + screened = S.delete target fullScreened + +inBounds :: Bounds -> Delta -> Bool +inBounds (maxX, maxY) (V2 x y) = (x >= 0) && (x <= (maxX % 1)) && (y >= 0) && (y <= (maxY % 1)) + +integerVec :: Delta -> Position +integerVec (V2 x y) = V2 (numerator x) (numerator y) + +isIntegral :: Delta -> Bool +isIntegral (V2 x y) = (denominator x == 1) && (denominator y == 1) + + +makeTargets :: Position -> Asteroids -> Targets +makeTargets origin asteroids = S.foldl' addTarget M.empty asteroids + where addTarget m t = M.insert (targetInfo origin t) t m + +targetInfo :: Position -> Position -> TargetInfo +targetInfo origin target = (angle, range) + where V2 dx dy = target - origin + angle = atan2 (fromIntegral dy) (fromIntegral dx) + -- recipRange = 1 / (norm (V2 (fromIntegral dy) (fromIntegral dx))) + range = norm (V2 (fromIntegral dy) (fromIntegral dx)) + +possibleTargets :: Float -> Targets -> Targets +possibleTargets angle targets = M.filterWithKey (\(a, _) _ -> a > angle) targets + +firstTarget :: Targets -> (TargetInfo, Position) +firstTarget targets = M.findMin targets + +targetSequence targets = targetNext ((- pi / 2) - 0.001) targets + +targetNext :: Float -> Targets -> [Position] +targetNext angle targets + | M.null targets = [] + | M.null possibles = targetNext (- pi) targets + | otherwise = (target:(targetNext angle' targets')) + where possibles = possibleTargets angle targets + ((targetAngle, targetRange), target) = firstTarget possibles + targets' = M.delete (targetAngle, targetRange) targets + angle' = targetAngle + + +successfulParse :: String -> (Asteroids, Bounds) +successfulParse input = ( S.fromList [(V2 x y) | x <- [0..maxX], y <- [0..maxY] + , isAsteroid x y + ] + , (maxX, maxY) + ) + where grid = lines input + maxX = (length $ head grid) - 1 + maxY = (length grid) - 1 + isAsteroid x y = (grid!!y)!!x == '#' + + +showPattern (maxX, maxY) asteroids = unlines rows + where rows = [[cell x y | x <- [0..maxX]] | y <- [0..maxY] ] + cell x y = if S.member (V2 x y) asteroids then '#' else '.' + + \ No newline at end of file diff --git a/data/advent10.txt b/data/advent10.txt new file mode 100644 index 0000000..a52d097 --- /dev/null +++ b/data/advent10.txt @@ -0,0 +1,21 @@ +###..#########.#####. +.####.#####..####.#.# +.###.#.#.#####.##..## +##.####.#.########### +###...#.####.#.#.#### +#.##..###.########... +#.#######.##.#######. +.#..#.#..###...####.# +#######.##.##.###..## +#.#......#....#.#.#.. +######.###.#.#.##...# +####.#...#.#######.#. +.######.#####.####### +##.##.##.#####.##.#.# +###.#######..##.#.... +###.##.##..##.#####.# +##.########.#.#.##### +.##....##..###.#...#. +#..#.####.######..### +..#.####.############ +..##...###..######### \ No newline at end of file diff --git a/data/advent10a.txt b/data/advent10a.txt new file mode 100644 index 0000000..737ae7f --- /dev/null +++ b/data/advent10a.txt @@ -0,0 +1,5 @@ +.#..# +..... +##### +....# +...## diff --git a/data/advent10b.txt b/data/advent10b.txt new file mode 100644 index 0000000..987698f --- /dev/null +++ b/data/advent10b.txt @@ -0,0 +1,10 @@ +......#.#. +#..#.#.... +..#######. +.#.#.###.. +.#..#..... +..#....#.# +#..#....#. +.##.#..### +##...#..#. +.#....#### diff --git a/data/advent10l.txt b/data/advent10l.txt new file mode 100644 index 0000000..33437ba --- /dev/null +++ b/data/advent10l.txt @@ -0,0 +1,20 @@ +.#..##.###...####### +##.############..##. +.#.######.########.# +.###.#######.####.#. +#####.##.#.##.###.## +..#####..#.######### +#################### +#.####....###.#.#.## +##.################# +#####.##.###..####.. +..######..##.####### +####.##.####...##..# +.#####..#.######.### +##...#.##########... +#.##########.####### +.####.#.###.###.#.## +....##.##.###..##### +.#.#.###########.### +#.#.#.#####.####.### +###.##.####.##.#..## diff --git a/data/advent10s.txt b/data/advent10s.txt new file mode 100644 index 0000000..38b0c1b --- /dev/null +++ b/data/advent10s.txt @@ -0,0 +1,5 @@ +.#....#####...#.. +##...##.#####..## +##...#...#.#####. +..#.....#...###.. +..#.#.....#....## diff --git a/data/advent10xr.txt b/data/advent10xr.txt new file mode 100644 index 0000000..ee05c63 --- /dev/null +++ b/data/advent10xr.txt @@ -0,0 +1,10 @@ +.......... +.......... +......#... +.........# +....#.#... +.....#.... +..###.#.## +.......#.. +....#...#. +...#..#..# diff --git a/data/advent10xs.txt b/data/advent10xs.txt new file mode 100644 index 0000000..dd96965 --- /dev/null +++ b/data/advent10xs.txt @@ -0,0 +1,10 @@ +#......... +...#...... +...#...... +.####..... +..#....... +.......... +.......... +.......... +.......... +.......... diff --git a/stack.yaml b/stack.yaml index 8f4b3e1..31a36eb 100644 --- a/stack.yaml +++ b/stack.yaml @@ -46,6 +46,7 @@ packages: - advent07 - advent08 - advent09 +- advent10 # Dependency packages to be pulled from upstream that are not in the resolver. -- 2.34.1