1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
module Main where
import System.Environment
import Data.Char
import Data.List
import Debug.Trace
import Data.Maybe
import Prelude hiding (Left, Right)
data Facing = Right | Down | Left | Up deriving (Show, Enum)
clockwise :: Facing -> Facing
counterclockwise :: Facing -> Facing
clockwise Up = Right
clockwise Right = Down
clockwise Down = Left
clockwise Left = Up
counterclockwise = foldl (.) id $ replicate 3 clockwise
data Tile = Open | Wall | Empty deriving (Show,Eq)
parseTile :: Char -> Tile
parseTile '.' = Open
parseTile '#' = Wall
parseTile ' ' = Empty
data Map = Map {
tiles :: [[Tile]],
width :: Int,
height :: Int
} deriving Show
data Position = Position (Int, Int) Facing deriving Show
data Instruction = MoveInstruction Int | RotateL | RotateR deriving Show
parseInstructions :: String -> [Instruction]
parseInstructions [] = []
parseInstructions ('R':xs) = RotateR:parseInstructions xs
parseInstructions ('L':xs) = RotateL:parseInstructions xs
parseInstructions s = let x = span isDigit s in MoveInstruction (read (fst x) :: Int):parseInstructions (snd x)
parse :: String -> IO (Map, [Instruction])
parse f = do
content <- lines <$> readFile f
let tiles = map (map parseTile) (take (length content - 2) content)
return (Map tiles (foldr (max.length) 0 tiles) $ length tiles , reverse $ parseInstructions $ last content)
runInstruction :: Map -> Instruction -> Position -> Position
runInstruction m (MoveInstruction n) p = fromMaybe p $ move n p m
runInstruction _ RotateR (Position p r) = Position p $ clockwise r
runInstruction _ RotateL (Position p r) = Position p $ counterclockwise r
nextPosition :: Position -> Position
nextPosition (Position (x,y) Up) = Position (x,y-1) Up
nextPosition (Position (x,y) Down) = Position (x,y+1) Down
nextPosition (Position (x,y) Left) = Position (x-1,y) Left
nextPosition (Position (x,y) Right) = Position (x+1,y) Right
wrapPosition :: Map -> Position -> Position
wrapPosition m (Position (x,y) r) = Position (x', y') r
where
y' = y `mod` height m
x' = x `mod` width m
move :: Int -> Position -> Map -> Maybe Position
move 1 p m = case tile of
Open -> Just p'
Wall -> Nothing
Empty -> move 1 p' m
where
p' = wrapPosition m $ nextPosition p
(Position (x,y) _) = p'
row = tiles m !! y
tile = if x < length row then row !! x else Empty
move n p m = Just $ fromMaybe p' $ move (n-1) p' m
where p' = fromMaybe p $ move 1 p m
runInstructions :: Map -> Position -> [Instruction] -> Position
runInstructions = foldr . runInstruction
main :: IO ()
main = do
args <- getArgs
(map, instructions) <- parse (head args)
let starting = maybe undefined ((`Position` Right).(,0)) $ elemIndex Open (head (tiles map))
let (Position (x,y) r) = runInstructions map starting instructions
let n = (1000 * (y+1)) + (4 * (x+1)) + fromEnum r
print n
|
