Haskell

This one was fun, I think I wrote my first lazy infinite loop I cancel out at runtime, lost some time because I had misread the requirements on turning right.

Runs in 45 seconds on my Laptop in power-saver mode, which isn’t very fast I fear.

import Control.Arrow hiding (first, second)

import Data.Map (Map)
import Data.Set (Set)
import Data.Bifunctor

import qualified Data.Array.Unboxed as Array
import qualified Data.List as List
import qualified Data.Set as Set
import Data.Array.Unboxed (UArray)

parse :: String -> (UArray (Int, Int) Char, (Int, Int))
parse s = (a, p)
        where
                p = Array.indices 
                        >>> filter ((a Array.!) >>> (== '^'))
                        >>> head
                        $ a
                a = Array.listArray ((1, 1), (n, m)) . filter (/= '\n') $ s
                l = lines s
                (n, m) = (length . head &&& pred . length) l

rotate90 d@(-1, 0) = (0, 1)
rotate90 d@(0,  1) = (1, 0)
rotate90 d@(1,  0) = (0, -1)
rotate90 d@(0, -1) = (-1, 0)

walkGuard :: (UArray (Int, Int) Char) -> (Int, Int) -> (Int, Int) -> [((Int, Int), (Int, Int))]
walkGuard a p d@(dy, dx)
        | not isInBounds                  = []
        | (maybe ' ' id tileAhead) == '#' = (p, d) : walkGuard a p rotatedDirection
        | otherwise                       = (p, d) : walkGuard a updatedPosition d
        where
                isInBounds = Array.inRange (Array.bounds a) p
                updatedPosition = bimap (+dy) (+dx) p
                tileAhead = a Array.!? updatedPosition
                rotatedDirection = rotate90 d

ruleGroup :: Eq a => (a, b) -> (a, b') -> Bool
ruleGroup = curry (uncurry (==) <<< fst *** fst)
                
arrayDisplay a = Array.indices
        >>> List.groupBy ruleGroup
        >>> map (map (a Array.!))
        >>> unlines
        $ a

walkedPositions a p d = walkGuard a p 
        >>> map fst
        >>> Set.fromList
        $ d

isLoop = isLoop' Set.empty
isLoop' _ [] = False
isLoop' s (l:ls)
        | l `Set.member` s = True
        | otherwise = isLoop' (Set.insert l s) ls

part1 (a, p) = walkedPositions a p
        >>> length
        $ (-1, 0)
part2 (a, p) = walkedPositions a p
        >>> Set.toList
        >>> map (, '#')
        >>> map (:[])
        >>> map (a Array.//)
        >>> map (\ a' -> walkGuard a' p (-1, 0))
        >>> filter (isLoop)
        >>> length
        $ (-1, 0)

main = getContents >>= print . (part1 &&& part2) . parse