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
|
{-# LANGUAGE TupleSections #-}
module Main where
import qualified Data.Array as A
import Data.List
import Input
import Util
generate :: A.Ix i => (i, i) -> (i -> a) -> A.Array i a
generate bounds f = A.listArray bounds (map f (A.range bounds))
main :: IO ()
main = do
inp <- getInput 13
let pointstrs :| foldstrs:_ = splitOn null inp
points :: [(Int, Int)]
points = map (\s -> let [a,b] = toList (splitOn (== ',') s) in (read a, read b)) pointstrs
folds :: [(Char, Int)]
folds = map (\s -> let [a,b] = toList (splitOn (== '=') s) in (last a, read b)) foldstrs
minmax = (,) <$> minimum <*> maximum
arr0 = let (x1, x2) = minmax (map fst points)
(y1, y2) = minmax (map snd points)
in A.accumArray (+) 0 ((x1, y1), (x2, y2)) (map (,1::Int) points)
at arr idx | A.inRange (A.bounds arr) idx = arr A.! idx
| otherwise = 0
doFold 'x' lim arr =
let ((x1, y1), (x2, y2)) = A.bounds arr
in generate ((min x1 (lim - (x2 - lim)), y1), (lim - 1, y2)) $ \(x, y) ->
arr `at` (x, y) + arr `at` (lim + (lim - x), y)
doFold 'y' lim arr =
let ((x1, y1), (x2, y2)) = A.bounds arr
in generate ((x1, min y1 (lim - (y2 - lim))), (x2, lim - 1)) $ \(x, y) ->
arr `at` (x, y) + arr `at` (x, lim + (lim - y))
doFold _ _ _ = error "rip"
nvisible = length . filter (>0) . A.elems
draw arr =
let ((x1, y1), (x2, y2)) = A.bounds arr
in unlines [concat [if arr A.! (x, y) > 0 then "█" else "·"
| x <- [x1..x2]]
| y <- [y1..y2]]
print (nvisible (let (dir, lim) = head folds in doFold dir lim arr0))
putStr (draw (foldl' (\arr (dir, lim) -> doFold dir lim arr) arr0 folds))
|
