From: Neil Smith Date: Fri, 23 Dec 2016 19:43:01 +0000 (+0000) Subject: Better naming of source files X-Git-Url: https://git.njae.me.uk/?a=commitdiff_plain;h=refs%2Fheads%2Fstack;p=advent-of-code-16.git Better naming of source files --- diff --git a/adventofcode1601/adventofcode1601.cabal b/adventofcode1601/adventofcode1601.cabal index a152de7..3c5289a 100644 --- a/adventofcode1601/adventofcode1601.cabal +++ b/adventofcode1601/adventofcode1601.cabal @@ -20,7 +20,7 @@ library executable advent01 hs-source-dirs: app - main-is: Main.hs + main-is: advent01.hs ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N build-depends: base , adventofcode1601 diff --git a/adventofcode1601/app/Main.hs b/adventofcode1601/app/Main.hs deleted file mode 100644 index b76195d..0000000 --- a/adventofcode1601/app/Main.hs +++ /dev/null @@ -1,99 +0,0 @@ -module Main(main) where - -import Data.List (sort) -import Data.List.Split (splitOn) - --- turn direction, number of steps -data Step = Step Char Int deriving (Show) - -data Direction = North | East | South | West - deriving (Enum, Show, Bounded, Eq) - --- direction, easting, northing -data Position = Position Direction Int Int deriving (Show) --- Two positions are the same if they're in the same place, --- regardless of facing -instance Eq Position where - Position _ e n == Position _ e' n' = e == e' && n == n' - -main :: IO () -main = do - instructions <- readFile "data/advent01.txt" - part1 instructions - part2 instructions - -part1 :: String -> IO () -part1 instructions = do - let answer = finalDistance $ last $ stepsFromStart $ steps instructions - print answer - -part2 :: String -> IO () -part2 instructions = do - let visited = finalDistance $ firstRepeat $ stepsFromStart $ expandSteps $ steps instructions - print visited - - --- Extract the steps from the input string. -steps :: String -> [Step] -steps s = map readStep $ splitOn ", " s - where readStep (d:l) = Step d (read l) - --- Take steps from the starting position -stepsFromStart :: [Step] -> [Position] -stepsFromStart = takeSteps (Position North 0 0) - --- Calculate manhattan distance from start to this state -finalDistance :: Position -> Int -finalDistance (Position _ e n) = (abs e) + (abs n) - --- For part 2: convert one step of many spaces to many steps of one space each -expandSteps :: [Step] -> [Step] -expandSteps = - concatMap expandStep - where expandStep (Step dir d) = (Step dir 1) : replicate (d - 1) (Step 'S' 1) - --- Execute a series of steps, keeping track of the positions after each step -takeSteps :: Position -> [Step] -> [Position] --- takeSteps pos steps = scanl move pos steps -takeSteps = scanl move - --- Make one move, by updating direction then position -move :: Position -> Step -> Position -move (Position facing easting northing) - (Step turnInstr distance) = - Position facing' easting' northing' - where facing' = turn turnInstr facing - (easting', northing') = takeStep facing' distance easting northing - --- Turn right, left, or straight -turn :: Char -> Direction -> Direction -turn 'R' direction = turnCW direction -turn 'L' direction = turnACW direction -turn 'S' direction = direction - --- Move in the current direction -takeStep :: Direction -> Int -> Int -> Int -> (Int, Int) -takeStep North d e n = (e, n+d) -takeStep South d e n = (e, n-d) -takeStep West d e n = (e-d, n) -takeStep East d e n = (e+d, n) - - --- | a `succ` that wraps -turnCW :: (Bounded a, Enum a, Eq a) => a -> a -turnCW dir | dir == maxBound = minBound - | otherwise = succ dir - --- | a `pred` that wraps -turnACW :: (Bounded a, Enum a, Eq a) => a -> a -turnACW dir | dir == minBound = maxBound - | otherwise = pred dir - --- All the prefixes of a list of items -prefixes = scanl addTerm [] - where addTerm ps t = ps ++ [t] - --- The first item that exists in a prefix of the list to that point -firstRepeat positions = - last $ head $ dropWhile (\p -> (last p) `notElem` (tail $ reverse p)) - (tail $ prefixes positions) diff --git a/adventofcode1601/app/advent01.hs b/adventofcode1601/app/advent01.hs new file mode 100644 index 0000000..b76195d --- /dev/null +++ b/adventofcode1601/app/advent01.hs @@ -0,0 +1,99 @@ +module Main(main) where + +import Data.List (sort) +import Data.List.Split (splitOn) + +-- turn direction, number of steps +data Step = Step Char Int deriving (Show) + +data Direction = North | East | South | West + deriving (Enum, Show, Bounded, Eq) + +-- direction, easting, northing +data Position = Position Direction Int Int deriving (Show) +-- Two positions are the same if they're in the same place, +-- regardless of facing +instance Eq Position where + Position _ e n == Position _ e' n' = e == e' && n == n' + +main :: IO () +main = do + instructions <- readFile "data/advent01.txt" + part1 instructions + part2 instructions + +part1 :: String -> IO () +part1 instructions = do + let answer = finalDistance $ last $ stepsFromStart $ steps instructions + print answer + +part2 :: String -> IO () +part2 instructions = do + let visited = finalDistance $ firstRepeat $ stepsFromStart $ expandSteps $ steps instructions + print visited + + +-- Extract the steps from the input string. +steps :: String -> [Step] +steps s = map readStep $ splitOn ", " s + where readStep (d:l) = Step d (read l) + +-- Take steps from the starting position +stepsFromStart :: [Step] -> [Position] +stepsFromStart = takeSteps (Position North 0 0) + +-- Calculate manhattan distance from start to this state +finalDistance :: Position -> Int +finalDistance (Position _ e n) = (abs e) + (abs n) + +-- For part 2: convert one step of many spaces to many steps of one space each +expandSteps :: [Step] -> [Step] +expandSteps = + concatMap expandStep + where expandStep (Step dir d) = (Step dir 1) : replicate (d - 1) (Step 'S' 1) + +-- Execute a series of steps, keeping track of the positions after each step +takeSteps :: Position -> [Step] -> [Position] +-- takeSteps pos steps = scanl move pos steps +takeSteps = scanl move + +-- Make one move, by updating direction then position +move :: Position -> Step -> Position +move (Position facing easting northing) + (Step turnInstr distance) = + Position facing' easting' northing' + where facing' = turn turnInstr facing + (easting', northing') = takeStep facing' distance easting northing + +-- Turn right, left, or straight +turn :: Char -> Direction -> Direction +turn 'R' direction = turnCW direction +turn 'L' direction = turnACW direction +turn 'S' direction = direction + +-- Move in the current direction +takeStep :: Direction -> Int -> Int -> Int -> (Int, Int) +takeStep North d e n = (e, n+d) +takeStep South d e n = (e, n-d) +takeStep West d e n = (e-d, n) +takeStep East d e n = (e+d, n) + + +-- | a `succ` that wraps +turnCW :: (Bounded a, Enum a, Eq a) => a -> a +turnCW dir | dir == maxBound = minBound + | otherwise = succ dir + +-- | a `pred` that wraps +turnACW :: (Bounded a, Enum a, Eq a) => a -> a +turnACW dir | dir == minBound = maxBound + | otherwise = pred dir + +-- All the prefixes of a list of items +prefixes = scanl addTerm [] + where addTerm ps t = ps ++ [t] + +-- The first item that exists in a prefix of the list to that point +firstRepeat positions = + last $ head $ dropWhile (\p -> (last p) `notElem` (tail $ reverse p)) + (tail $ prefixes positions) diff --git a/adventofcode1602/adventofcode1602.cabal b/adventofcode1602/adventofcode1602.cabal index 1e4aa7d..ca22935 100644 --- a/adventofcode1602/adventofcode1602.cabal +++ b/adventofcode1602/adventofcode1602.cabal @@ -20,7 +20,7 @@ library executable advent02 hs-source-dirs: app - main-is: Main.hs + main-is: advent02.hs ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N build-depends: base , adventofcode1602 diff --git a/adventofcode1602/app/Main.hs b/adventofcode1602/app/Main.hs deleted file mode 100644 index 747001d..0000000 --- a/adventofcode1602/app/Main.hs +++ /dev/null @@ -1,90 +0,0 @@ -module Main(main) where - -import Data.Array.IArray - --- Row 1 is top, column 1 is left -type Position = (Int, Int) -type Keyboard = Array Position Char - -kb1 = ["xxxxx", - "x123x", - "x456x", - "x789x", - "xxxxx"] - -kb2 = ["xxxxxxx", - "xxx1xxx", - "xx234xx", - "x56789x", - "xxABCxx", - "xxxDxxx", - "xxxxxxx"] - -enumerate = zip [0..] - -mkKeyboard :: [String] -> Keyboard -mkKeyboard kb = array ((0, 0), (length kb - 1, length (kb!!0) - 1)) - [((i, j), c) | (i, r) <- enumerate kb, (j, c) <- enumerate r] - -keyboard1 = mkKeyboard kb1 -keyboard2 = mkKeyboard kb2 - -findKey :: Keyboard -> Char-> Position -findKey kb c = fst $ head $ filter (\a -> (snd a) == c) $ assocs kb - --- data Coord = One | Two | Three --- deriving (Read, Show, Eq, Ord, Enum, Bounded) --- -- instance Bounded Coord where --- -- minBound = Coord 1 --- -- maxBound = Coord 3 - --- data Position = Position Coord Coord --- deriving (Show, Eq) - -main :: IO () -main = do - instrText <- readFile "data/advent02.txt" - let instructions = lines instrText - part1 instructions - part2 instructions - -part1 :: [String] -> IO () -part1 instructions = do - putStrLn $ followInstructions keyboard1 instructions - - -part2 :: [String] -> IO () -part2 instructions = do - putStrLn $ followInstructions keyboard2 instructions - - -followInstructions :: Keyboard -> [String] -> String -followInstructions kb instr = moveSeries kb (startPosition kb) instr - - -startPosition :: Keyboard -> Position -startPosition kb = findKey kb '5' - -moveSeries :: Keyboard -> Position -> [String] -> String -moveSeries _ _ [] = [] -moveSeries kb p (i:is) = (n:ns) - where p' = makeMoves kb p i - n = kb ! p' - ns = moveSeries kb p' is - -makeMoves :: Keyboard -> Position -> [Char] -> Position -makeMoves kb p ms = foldl (safeMove kb) p ms - -safeMove :: Keyboard -> Position -> Char -> Position -safeMove kb pos dir = maybeRevert kb pos (move pos dir) - -move :: Position -> Char -> Position -move (r, c) 'U' = (r-1, c) -move (r, c) 'D' = (r+1, c) -move (r, c) 'L' = (r, c-1) -move (r, c) 'R' = (r, c+1) - -maybeRevert :: Keyboard -> Position -> Position -> Position -maybeRevert kb oldPos newPos - | kb ! newPos == 'x' = oldPos - | otherwise = newPos diff --git a/adventofcode1602/app/advent02.hs b/adventofcode1602/app/advent02.hs new file mode 100644 index 0000000..747001d --- /dev/null +++ b/adventofcode1602/app/advent02.hs @@ -0,0 +1,90 @@ +module Main(main) where + +import Data.Array.IArray + +-- Row 1 is top, column 1 is left +type Position = (Int, Int) +type Keyboard = Array Position Char + +kb1 = ["xxxxx", + "x123x", + "x456x", + "x789x", + "xxxxx"] + +kb2 = ["xxxxxxx", + "xxx1xxx", + "xx234xx", + "x56789x", + "xxABCxx", + "xxxDxxx", + "xxxxxxx"] + +enumerate = zip [0..] + +mkKeyboard :: [String] -> Keyboard +mkKeyboard kb = array ((0, 0), (length kb - 1, length (kb!!0) - 1)) + [((i, j), c) | (i, r) <- enumerate kb, (j, c) <- enumerate r] + +keyboard1 = mkKeyboard kb1 +keyboard2 = mkKeyboard kb2 + +findKey :: Keyboard -> Char-> Position +findKey kb c = fst $ head $ filter (\a -> (snd a) == c) $ assocs kb + +-- data Coord = One | Two | Three +-- deriving (Read, Show, Eq, Ord, Enum, Bounded) +-- -- instance Bounded Coord where +-- -- minBound = Coord 1 +-- -- maxBound = Coord 3 + +-- data Position = Position Coord Coord +-- deriving (Show, Eq) + +main :: IO () +main = do + instrText <- readFile "data/advent02.txt" + let instructions = lines instrText + part1 instructions + part2 instructions + +part1 :: [String] -> IO () +part1 instructions = do + putStrLn $ followInstructions keyboard1 instructions + + +part2 :: [String] -> IO () +part2 instructions = do + putStrLn $ followInstructions keyboard2 instructions + + +followInstructions :: Keyboard -> [String] -> String +followInstructions kb instr = moveSeries kb (startPosition kb) instr + + +startPosition :: Keyboard -> Position +startPosition kb = findKey kb '5' + +moveSeries :: Keyboard -> Position -> [String] -> String +moveSeries _ _ [] = [] +moveSeries kb p (i:is) = (n:ns) + where p' = makeMoves kb p i + n = kb ! p' + ns = moveSeries kb p' is + +makeMoves :: Keyboard -> Position -> [Char] -> Position +makeMoves kb p ms = foldl (safeMove kb) p ms + +safeMove :: Keyboard -> Position -> Char -> Position +safeMove kb pos dir = maybeRevert kb pos (move pos dir) + +move :: Position -> Char -> Position +move (r, c) 'U' = (r-1, c) +move (r, c) 'D' = (r+1, c) +move (r, c) 'L' = (r, c-1) +move (r, c) 'R' = (r, c+1) + +maybeRevert :: Keyboard -> Position -> Position -> Position +maybeRevert kb oldPos newPos + | kb ! newPos == 'x' = oldPos + | otherwise = newPos