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
|
module Day12B where
import System.Environment (getArgs)
data Instruction = North Int | East Int |
South Int | West Int |
TLeft Int | TRight Int |
Forward Int
deriving (Eq, Show, Ord);
-- ((shipX, shipY), (wY, wX))
type State = ((Int, Int), (Int, Int));
initialState :: State;
initialState = ((0, 0), (10, 1));
rotateAround :: (Int, Int) -> Int -> (Int, Int)
rotateAround (wx, wy) (-90) = (-wy, wx)
rotateAround (wx, wy) 0 = (wx, wy)
rotateAround (wx, wy) 90 = (wy, -wx)
rotateAround (wx, wy) 180 = (-wx, -wy)
rotateAround (wx, wy) (-180) = rotateAround (wx, wy) 180
rotateAround (wx, wy) 270 = rotateAround (wx, wy) (-90)
rotateAround (wx, wy) (-270) = rotateAround (wx, wy) 90
rotateAround _ _ = error "Direction not defined"
moveToward :: (Int, Int) -> (Int, Int) -> Int -> (Int, Int)
moveToward (sx, sy) (wx, wy) r = (sx + (wx * r), sy + (wy * r))
readInstructions :: String -> [Instruction]
readInstructions = map readInstruction . lines
where readInstruction ('N':xs) = North $ read xs
readInstruction ('S':xs) = South $ read xs
readInstruction ('E':xs) = East $ read xs
readInstruction ('W':xs) = West $ read xs
readInstruction ('L':xs) = TLeft $ read xs
readInstruction ('R':xs) = TRight $ read xs
readInstruction ('F':xs) = Forward $ read xs
readInstruction _ = error "Invalid instruction"
doInstruction :: Instruction -> State -> State
doInstruction (North r) ((sx, sy), (wx, wy)) = ((sx, sy), (wx, wy + r))
doInstruction (South r) ((sx, sy), (wx, wy)) = ((sx, sy), (wx, wy - r))
doInstruction (East r) ((sx, sy), (wx, wy)) = ((sx, sy), (wx + r, wy))
doInstruction (West r) ((sx, sy), (wx, wy)) = ((sx, sy), (wx - r, wy))
doInstruction (TLeft r) ((sx, sy), (wx, wy)) = ((sx, sy), rotateAround (wx, wy) (-r))
doInstruction (TRight r) ((sx, sy), (wx, wy)) = ((sx, sy), rotateAround (wx, wy) r)
doInstruction (Forward r) ((sx, sy), (wx, wy)) = (moveToward (sx, sy) (wx, wy) r, (wx, wy))
instructionsFromFile :: String -> IO [Instruction]
instructionsFromFile s = do
contents <- readFile s;
return $ readInstructions contents;
main :: IO ()
main = do
args <- getArgs;
is <- instructionsFromFile (head args);
let final = foldl (flip doInstruction) initialState is;
putStrLn $ "Final State: " ++ show final;
let ((x, y), _) = final;
let dist = abs x + abs y;
putStrLn $ "Distance: " ++ show dist;
return ();
|
