From 769a2f409b590ed91ba3de6f3368a0375ec31ca8 Mon Sep 17 00:00:00 2001 From: Anup Kishore Date: Wed, 21 Feb 2018 11:21:37 +0530 Subject: [PATCH] Day 3 solutions --- day3/Main.hs | 101 +++++++++++++++++++++++++++++++++++++++++++++++++++ package.yaml | 9 +++++ 2 files changed, 110 insertions(+) create mode 100644 day3/Main.hs diff --git a/day3/Main.hs b/day3/Main.hs new file mode 100644 index 0000000..efc06d1 --- /dev/null +++ b/day3/Main.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE OverloadedStrings, NamedFieldPuns #-} + +module Main where + +import qualified Data.Map as Map +import Data.Map (Map) +import qualified Data.Maybe as Maybe +import Lib (rotate) +import System.Environment (getArgs) +import System.Exit (exitSuccess, exitWith, ExitCode(..)) +import System.IO (hPutStr, stderr) + +getData :: IO Int +getData = return 361527 + +usage :: IO () +usage = putStrLn "Usage: stack exec day-n [--two] [...args]" + +doOne :: Int -> Int +doOne x = + let corner = (floor :: Double -> Int) . sqrt $ fromIntegral x + corner' = + (if odd corner + then corner + else corner - 1) + side = (corner' - 1) `div` 2 + diff = x - (corner' * corner') + diff' = diff `rem` corner' + diff'' = abs (side - diff') + in diff'' + side + +data Move + = U + | L + | D + | R + deriving (Show) + +type Coord = (Int, Int) + +generateRing :: Int -> [Move] +generateRing n = + concat [[R], replicate n U, replicate (n + 1) L, replicate (n + 1) D, replicate (n + 1) R] + +spiral :: [Move] +spiral = concatMap generateRing [1,3 ..] + +doMove :: Coord -> Move -> Coord +doMove (x, y) U = (x, y + 1) +doMove (x, y) L = (x - 1, y) +doMove (x, y) D = (x, y - 1) +doMove (x, y) R = (x + 1, y) + +buildSpiral :: Int -> [Coord] +buildSpiral n = scanl doMove (0, 0) . take (n - 1) $ spiral + +sumNeighbors :: Map Coord Int -> [Coord] -> Int +sumNeighbors prev = sum . map (\k -> Map.findWithDefault 0 k prev) + +checkNeighbors :: (Map Coord Int, [Int]) -> (Coord, [Coord]) -> (Map Coord Int, [Int]) +checkNeighbors (prev, l) (c, n) = + let val = sumNeighbors prev n + in (Map.insert c val prev, val : l) + +safeGet + :: Ord k + => Map k a -> k -> Maybe a +safeGet m k = Map.findWithDefault Nothing k . Map.map Just $ m + +generateNeighborlyValues :: [Coord] -> [Int] +generateNeighborlyValues [] = [1] +generateNeighborlyValues xs = + reverse . + snd . foldl checkNeighbors (Map.singleton (0, 0) 1, [1]) . zip xs . map neighbors $ xs + +directions :: [Move] +directions = [U, L, D, R] + +neighbors :: Coord -> [Coord] +neighbors c = map (doMove c) directions ++ diagonals + where + diagonals :: [Coord] + diagonals = map (\(m1, m2) -> doMove (doMove c m1) m2) . zip directions $ rotate 1 directions + +doTwo :: Int -> Either String Int +doTwo m = + maybe (Left "Not enough spiral") Right . + Maybe.listToMaybe . filter (> m) . generateNeighborlyValues . tail $ + buildSpiral m + +parse :: [String] -> IO () +parse ["--help"] = usage +parse ["--two"] = either (hPutStr stderr) print =<< doTwo <$> getData +parse [] = print =<< doOne <$> getData +parse _ = usage >> exitWith (ExitFailure 1) + +main :: IO () +main = do + args <- getArgs + parse args + exitSuccess diff --git a/package.yaml b/package.yaml index 01c6834..f50f766 100644 --- a/package.yaml +++ b/package.yaml @@ -16,6 +16,7 @@ extra-source-files: dependencies: - base >=4.7 && <5 - text >=1.2.2.0 +- containers ghc-options: [-Wall, -Wwarn] library: @@ -43,6 +44,14 @@ executables: - Paths_aoc2017 dependencies: - aoc2017 + day-3: + main: Main + source-dirs: day3 + ghc-options: [ -threaded, -rtsopts, -with-rtsopts=-N] + other-modules: + - Paths_aoc2017 + dependencies: + - aoc2017 tests: