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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
module Main (main) where
import System.Environment ( getArgs )
import Data.Bifunctor (first)
import Data.List (transpose)
import qualified Data.Set as Set
main :: IO ()
main = getArgs >>= readFile . head >>= print . solveDay8
solveDay8 :: String -> String
solveDay8 = formatDay8Result . fmap solveDay8Parts . parseDay8Input
formatDay8Result :: Maybe (Int, Int) -> String
formatDay8Result Nothing = "Input didn't parse. Check that it is a rectangular grid with values from 0-9."
formatDay8Result (Just (p1, p2)) = "Part 1: " ++ show p1 ++ ", Part 2: " ++ show p2
newtype Day8Input = Day8Input [[Height]] -- but with guarantee that it's rectangular
data Height = Zero | One | Two | Three | Four | Five | Six | Seven | Eight | Nine
deriving (Eq, Ord)
heightFromChar :: Char -> Maybe Height -- this could also be done using the Enum typeclass' toEnum function and an intermediate Int
heightFromChar '0' = Just Zero
heightFromChar '1' = Just One
heightFromChar '2' = Just Two
heightFromChar '3' = Just Three
heightFromChar '4' = Just Four
heightFromChar '5' = Just Five
heightFromChar '6' = Just Six
heightFromChar '7' = Just Seven
heightFromChar '8' = Just Eight
heightFromChar '9' = Just Nine
heightFromChar _ = Nothing
validateDay8Input :: [[Height]] -> Maybe Day8Input
validateDay8Input [] = Nothing
validateDay8Input (h:hs) = if all ((== length h) . length) hs then Just $ Day8Input $ h:hs else Nothing
parseDay8Input :: String -> Maybe Day8Input
parseDay8Input = (=<<) validateDay8Input . mapM (mapM heightFromChar) . lines
solveDay8Parts :: Day8Input -> (Int, Int)
solveDay8Parts i = (solveDay8Part1 i, solveDay8Part2 i)
solveDay8Part1 :: Day8Input -> Int
solveDay8Part1 = countVisibleTrees . identifyTrees
countVisibleTrees :: ForestWithIds -> Int
countVisibleTrees = length . getVisibleTrees
identifyTrees :: Day8Input -> ForestWithIds
identifyTrees (Day8Input i) = ForestWithIds $ identifyTreesWorker i (TreeId 0)
where identifyTreesWorker [] _ = []
identifyTreesWorker (l:ls) id = (\(identifiedLine, firstIdInNextLine) -> identifiedLine:identifyTreesWorker ls firstIdInNextLine) $ identifyTreesInLine l id
identifyTreesInLine [] id = ([], id)
identifyTreesInLine (t:ts) id = Data.Bifunctor.first (TreeWithId (id, t) :) $ identifyTreesInLine ts (nextTreeId id)
getVisibleTrees :: ForestWithIds -> Set.Set TreeId
getVisibleTrees s = getVisibleTreesFromSide firstSide
$ getVisibleTreesFromSide secondSide
$ getVisibleTreesFromSide thirdSide
$ getVisibleTreesFromSide fourthSide Set.empty
where firstSide = s
secondSide = rotateForestLeft firstSide
thirdSide = rotateForestLeft secondSide
fourthSide = rotateForestLeft thirdSide
rotateForestLeft :: ForestWithIds -> ForestWithIds
rotateForestLeft (ForestWithIds l) = ForestWithIds $ rotateRectangularListLeft l
rotateRectangularListLeft :: [[a]] -> [[a]]
rotateRectangularListLeft = reverse . transpose
rotateRectangularListRight :: [[a]] -> [[a]]
rotateRectangularListRight = transpose . reverse
getVisibleTreesFromSide :: ForestWithIds -> Set.Set TreeId -> Set.Set TreeId
getVisibleTreesFromSide (ForestWithIds ls) ids = foldl getVisibleTreesInLine ids ls
getVisibleTreesInLine :: Set.Set TreeId -> [TreeWithId] -> Set.Set TreeId
getVisibleTreesInLine ids = fst . foldl addIfHigher (ids, Nothing)
where addIfHigher (oldSet, Nothing) (TreeWithId (id, height)) = (Set.insert id oldSet, Just height)
addIfHigher (oldSet, Just oldHeight) (TreeWithId (id, height)) =
if height > oldHeight then (Set.insert id oldSet, Just height) else (oldSet, Just oldHeight)
newtype TreeId = TreeId Int deriving (Ord, Eq)
nextTreeId :: TreeId -> TreeId
nextTreeId (TreeId i) = TreeId (i+1)
newtype TreeWithId = TreeWithId (TreeId, Height)
newtype ForestWithIds = ForestWithIds [[TreeWithId]]
solveDay8Part2 :: Day8Input -> Int
solveDay8Part2 = maximum . map maximum . scenicScores
scenicScores :: Day8Input -> [[Int]]
scenicScores x = mulElements (firstSide x) $ mulElements (secondSide x) $ mulElements (thirdSide x) (fourthSide x)
where mulElements = zipWith (zipWith (*))
firstSide (Day8Input hs) = scenicScoreFromLeft hs
secondSide (Day8Input hs) = rotateRectangularListLeft $ scenicScoreFromLeft $ rotateRectangularListRight hs
thirdSide (Day8Input hs) = rotateRectangularListLeft $ rotateRectangularListLeft $ scenicScoreFromLeft $ rotateRectangularListRight $ rotateRectangularListRight hs
fourthSide (Day8Input hs) = rotateRectangularListRight $ scenicScoreFromLeft $ rotateRectangularListLeft hs
-- Well, that sucks. Part 1 result is unusable for part 2... But we can do a scanl to transform each tree in each of the 4 sides to its viewing distance.
-- Or, probably it's easier to just write the function instead of using scanl.
-- And once that's döner, we can rotate everything back to the original orientation, multiply up and boom, partay!
newtype DistanceSinceHeight = DistanceSinceHeight (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)
getDistanceSinceHeight :: DistanceSinceHeight -> Height -> Int
getDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Zero = ze
getDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) One = on
getDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Two = tw
getDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Three = th
getDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Four = fo
getDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Five = fi
getDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Six = si
getDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Seven = se
getDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Eight = ei
getDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Nine = ni
stepDistanceSinceHeight :: DistanceSinceHeight -> Height -> DistanceSinceHeight
stepDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Zero = DistanceSinceHeight (1,on+1,tw+1,th+1,fo+1,fi+1,si+1,se+1,ei+1,ni+1)
stepDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) One = DistanceSinceHeight (1,1,tw+1,th+1,fo+1,fi+1,si+1,se+1,ei+1,ni+1)
stepDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Two = DistanceSinceHeight (1,1,1,th+1,fo+1,fi+1,si+1,se+1,ei+1,ni+1)
stepDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Three = DistanceSinceHeight (1,1,1,1,fo+1,fi+1,si+1,se+1,ei+1,ni+1)
stepDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Four = DistanceSinceHeight (1,1,1,1,1,fi+1,si+1,se+1,ei+1,ni+1)
stepDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Five = DistanceSinceHeight (1,1,1,1,1,1,si+1,se+1,ei+1,ni+1)
stepDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Six = DistanceSinceHeight (1,1,1,1,1,1,1,se+1,ei+1,ni+1)
stepDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Seven = DistanceSinceHeight (1,1,1,1,1,1,1,1,ei+1,ni+1)
stepDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Eight = DistanceSinceHeight (1,1,1,1,1,1,1,1,1,ni+1)
stepDistanceSinceHeight (DistanceSinceHeight (ze,on,tw,th,fo,fi,si,se,ei,ni)) Nine = DistanceSinceHeight (1,1,1,1,1,1,1,1,1,1)
scenicScoreFromLeft :: [[Height]] -> [[Int]]
scenicScoreFromLeft = map scenicScoreFromLeftForRow
scenicScoreFromLeftForRow :: [Height] -> [Int]
scenicScoreFromLeftForRow = map fst . tail . scanl scenicScanner (-1, DistanceSinceHeight (0,0,0,0,0,0,0,0,0,0))
where scenicScanner (_, d) h = (getDistanceSinceHeight d h, stepDistanceSinceHeight d h)
|
