Day 13: A Maze of Twisty Little Cubicles



In [1]:

    
inputLines = lines <$> readFile "input/day13.txt"
inputNumber = read . head <$> inputLines



In [2]:

    
import Control.Applicative
import Control.Lens (over)
import Control.Lens.Tuple
import Data.Bits
import qualified Data.Set as Set

Find out if a number has an odd number of bits



In [3]:

    
oddNumberOfBits :: Int -> Bool
oddNumberOfBits 1 = True
oddNumberOfBits 0 = False
oddNumberOfBits n = oddNumberOfBits (n `mod` 2) `xor` oddNumberOfBits (n `div` 2)

Find out if there is a wall at a given position

We constrain the movement to positions with non-negativ coordinates by putting walls at positions where x or y is negative.



In [4]:

    
isWall :: Int -> (Int, Int) -> Bool
isWall puzzleInput (x, y)
    | x < 0 = True
    | y < 0 = True
    | otherwise = oddNumberOfBits $ x*x + 3*x + 2*x*y + y + y*y + puzzleInput

Find out all positions which are newly reachable in a single move

These are the positions which

can be reached from any position in currentPositions in a single move,
are not contained in visitedPositions yet,
do not have walls.



In [5]:

    
type Positions = Set.Set (Int, Int)



In [6]:

    
newPositions :: Int -> Positions -> Positions -> Positions
newPositions puzzleInput visitedPositions currentPositions =
    Set.filter (not . isWall puzzleInput) allNewPositions
    where
        allNewPositions = Set.filter (not . (`Set.member` visitedPositions)) allReachablePositions
        allReachablePositions = Set.fromList allReachablePositionsList
        allReachablePositionsList = over <$> [_1, _2] <*> [succ, pred] <*> currentPositionsList
        currentPositionsList = Set.elems currentPositions

Find out how a single step affects the visited positions and the current (i.e., newly visited) positions



In [7]:

    
step :: Int -> (Positions, Positions) -> (Positions, Positions)
step puzzleInput (visitedPositions, currentPositions) = (newVisitedPositions, newCurrentPositions)
    where
        newCurrentPositions = newPositions puzzleInput visitedPositions currentPositions
        newVisitedPositions = visitedPositions `Set.union` newCurrentPositions

Determine the number of steps needed to reach the target from any current position



In [8]:

    
remainingStepsToTarget :: Int -> (Int, Int) -> Positions -> Positions -> Int
remainingStepsToTarget puzzleInput target visitedPositions currentPositions
    | target `elem` currentPositions = 0
    | otherwise = succ $ remainingStepsToTarget puzzleInput target newVisitedPositions newCurrentPositions
    where
        (newVisitedPositions, newCurrentPositions) = step puzzleInput (visitedPositions, currentPositions)

Find the number of steps needed to reach the target from a given origin



In [9]:

    
stepsToTarget :: Int -> (Int, Int) -> (Int, Int) -> Int
stepsToTarget puzzleInput target origin = remainingStepsToTarget puzzleInput target initialSet initialSet
    where
        initialSet = Set.singleton origin

Part 1: How many steps are needed to reach (31, 39) from (1, 1)?



In [10]:

    
part1 :: Int -> Int
part1 puzzleInput = stepsToTarget puzzleInput (31, 39) (1, 1)



In [11]:

    
part1 <$> inputNumber

Find the positions which are reachable from the origin in a given number of moves



In [12]:

    
reachablePositions :: Int -> Int -> (Int, Int) -> Positions
reachablePositions puzzleInput moves origin =
    fst $ last $ take (succ moves) $ iterate (step puzzleInput) initialState
    where
        initialState = (initialPositions, initialPositions)
        initialPositions = Set.singleton origin

Part 2: How many positions can be reached in 50 steps from (1, 1)?



In [13]:

    
part2 :: Int -> Int
part2 puzzleInput = Set.size $ reachablePositions puzzleInput 50 (1, 1)



In [14]:

    
part2 <$> inputNumber