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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
module Main (main) where
import System.Environment ( getArgs )
import Text.Read (readMaybe)
import Data.Bifunctor (bimap)
import Data.Maybe (fromMaybe)
import qualified Data.Set as Set
import Control.Monad.Zip (MonadZip(mzip))
import Control.Exception (assert)
main :: IO ()
main = getArgs >>= readFile . head >>= print . solveDay9
solveDay9 :: String -> String
solveDay9 = formatDay9Result . fmap solveDay9Parts . parseDay9Input
formatDay9Result :: Maybe (Int, Int) -> String
formatDay9Result Nothing = "Failed to read input for day9."
formatDay9Result (Just (p1, p2)) = "Part 1: " ++ show p1 ++ ", Part 2: " ++ show p2
-- Imho it's stupid that Haskell by default imports Right and Left.
-- Also, that there's no dedicated Result type, and rather Either is used.
data Direction = MoveUp | MoveRight | MoveDown | MoveLeft
data MultiCommand = MultiCommand Direction Word -- using Word here gives a "is >= 0" check in readMaybe for free (I think).
newtype Command = Command Direction
parseDay9Input :: String -> Maybe [MultiCommand]
parseDay9Input = mapM readInputLine . lines
readInputLine :: String -> Maybe MultiCommand
readInputLine ('U':' ':n) = MultiCommand MoveUp <$> readMaybe n
readInputLine ('R':' ':n) = MultiCommand MoveRight <$> readMaybe n
readInputLine ('D':' ':n) = MultiCommand MoveDown <$> readMaybe n
readInputLine ('L':' ':n) = MultiCommand MoveLeft <$> readMaybe n
readInputLine _ = Nothing
solveDay9Parts :: [MultiCommand] -> (Int, Int)
solveDay9Parts = bimap solveDay9Part1 solveDay9Part2 . dup . unMultiCommands
where dup a = (a,a)
unMultiCommands :: [MultiCommand] -> [Command]
unMultiCommands = concatMap unMultiCommand
unMultiCommand :: MultiCommand -> [Command]
unMultiCommand (MultiCommand _ 0) = []
unMultiCommand (MultiCommand d n) = Command d:unMultiCommand (MultiCommand d (n-1))
data AllowedRelativeOffset = MinusOne | Zero | PlusOne
newtype RelativeTail = RelativeTail (AllowedRelativeOffset, AllowedRelativeOffset)
newtype AbsoluteHead = AbsoluteHead (Int, Int)
newtype AbsoluteTail = AbsoluteTail (Int, Int) deriving (Eq, Ord)
data RopePosition = RopePosition AbsoluteHead RelativeTail
startingRopePosition :: RopePosition
startingRopePosition = RopePosition (AbsoluteHead (0,0)) (RelativeTail (Zero, Zero))
solveDay9Part1 :: [Command] -> Int
solveDay9Part1 = length . Set.fromList . tailPositions . ropePositions -- building a set is cheaper than making sure every element in the list is unique.
tailPositions :: [RopePosition] -> [AbsoluteTail]
tailPositions = map tailPosition
where tailPosition (RopePosition (AbsoluteHead (x,y)) (RelativeTail (dx, dy))) = AbsoluteTail (applyOffset x dx, applyOffset y dy)
applyOffset i MinusOne = i-1
applyOffset i Zero = i
applyOffset i PlusOne = i+1
ropePositions :: [Command] -> [RopePosition]
ropePositions = scanl applyCommand startingRopePosition -- this could also be `tail . scanl applyCommand startingRopePosition` but that would ignore starting pos.
data VirtualRelativeOffset = VMinusTwo | VMinusOne | VZero | VPlusOne | VPlusTwo
newtype VirtualRelativeTail = VirtualRelativeTail (VirtualRelativeOffset, VirtualRelativeOffset)
-- Where, after applying the command to the head, the tail would be if it weren't connected.
virtualizeRelativeTail :: RelativeTail -> Command -> VirtualRelativeTail
virtualizeRelativeTail (RelativeTail (x,y)) (Command MoveUp) = VirtualRelativeTail (virtualFromRelativeOffset x, decrementOffset y)
virtualizeRelativeTail (RelativeTail (x,y)) (Command MoveDown) = VirtualRelativeTail (virtualFromRelativeOffset x, incrementOffset y)
virtualizeRelativeTail (RelativeTail (x,y)) (Command MoveRight) = VirtualRelativeTail (decrementOffset x, virtualFromRelativeOffset y)
virtualizeRelativeTail (RelativeTail (x,y)) (Command MoveLeft) = VirtualRelativeTail (incrementOffset x, virtualFromRelativeOffset y)
-- Makes the tail realize it's still connected to the head.
realizeVirtualTail :: VirtualRelativeTail -> RelativeTail
realizeVirtualTail v = fromMaybe (realizeVirtualTailByMoving v) (tryRealizeVirtualTailWithoutMoving v)
tryRealizeVirtualTailWithoutMoving :: VirtualRelativeTail -> Maybe RelativeTail
tryRealizeVirtualTailWithoutMoving (VirtualRelativeTail (x,y)) = RelativeTail <$> mzip (tryRealizeOffsetWithoutMoving x) (tryRealizeOffsetWithoutMoving y)
tryRealizeOffsetWithoutMoving :: VirtualRelativeOffset -> Maybe AllowedRelativeOffset
tryRealizeOffsetWithoutMoving VMinusOne = Just MinusOne
tryRealizeOffsetWithoutMoving VZero = Just Zero
tryRealizeOffsetWithoutMoving VPlusOne = Just PlusOne
tryRealizeOffsetWithoutMoving _ = Nothing
realizeVirtualTailByMoving :: VirtualRelativeTail -> RelativeTail
realizeVirtualTailByMoving (VirtualRelativeTail (x,y)) = RelativeTail (moveOffsetTowardsZero x, moveOffsetTowardsZero y)
moveOffsetTowardsZero :: VirtualRelativeOffset -> AllowedRelativeOffset
moveOffsetTowardsZero VMinusTwo = MinusOne
moveOffsetTowardsZero VMinusOne = Zero
moveOffsetTowardsZero VZero = Zero
moveOffsetTowardsZero VPlusOne = Zero
moveOffsetTowardsZero vPlusTwo = PlusOne
virtualFromRelativeOffset :: AllowedRelativeOffset -> VirtualRelativeOffset
virtualFromRelativeOffset MinusOne = VMinusOne
virtualFromRelativeOffset Zero = VZero
virtualFromRelativeOffset PlusOne = VPlusOne
decrementOffset :: AllowedRelativeOffset -> VirtualRelativeOffset
decrementOffset MinusOne = VMinusTwo
decrementOffset Zero = VMinusOne
decrementOffset PlusOne = VZero
incrementOffset :: AllowedRelativeOffset -> VirtualRelativeOffset
incrementOffset MinusOne = VZero
incrementOffset Zero = VPlusOne
incrementOffset PlusOne = VPlusTwo
applyCommandToAbsoluteHead :: AbsoluteHead -> Command -> AbsoluteHead
applyCommandToAbsoluteHead (AbsoluteHead (x,y)) (Command MoveUp) = AbsoluteHead (x,y+1)
applyCommandToAbsoluteHead (AbsoluteHead (x,y)) (Command MoveDown) = AbsoluteHead (x,y-1)
applyCommandToAbsoluteHead (AbsoluteHead (x,y)) (Command MoveRight) = AbsoluteHead (x+1,y)
applyCommandToAbsoluteHead (AbsoluteHead (x,y)) (Command MoveLeft) = AbsoluteHead (x-1,y)
applyCommand :: RopePosition -> Command -> RopePosition
applyCommand (RopePosition head tail) c = RopePosition (applyCommandToAbsoluteHead head c) (realizeVirtualTail $ virtualizeRelativeTail tail c)
solveDay9Part2 :: [Command] -> Int
solveDay9Part2 = undefined
|
