blob: fd81216e4cdb4a6db7a58f662269d098ada4b971 (
plain)
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
|
{-# LANGUAGE LambdaCase #-}
module Main where
import Data.Bifunctor (bimap, first, second)
import Data.List (foldl', nub)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (isPrefixOf, pack, split, unpack)
import Utils
type Point = (Int, Int)
data Fold = LeftFold Int | UpFold Int deriving (Show)
parseFold :: String -> Fold
parseFold s =
let (coord, num) = drop 11 s $> splitToPair (== '=')
in if coord == "x"
then LeftFold (read num)
else UpFold (read num)
foldLeft :: Int -> [Point] -> [Point]
foldLeft yLine = map (first (\x -> min x $ yLine + (yLine - x))) .> nub
foldUp :: Int -> [Point] -> [Point]
foldUp xLine = map (second (\y -> min y $ xLine + (xLine - y))) .> nub
doFold points fold = case fold of
LeftFold yLine -> foldLeft yLine points
UpFold xLine -> foldUp xLine points
e1 :: [Point] -> [Fold] -> [Point]
e1 points folds =
doFold points (head folds)
printCode :: [Point] -> IO ()
printCode points =
let pointsSet = Set.fromList points
xSize = maximum (map fst points) + 1
ySize = maximum (map snd points) + 1
pointToChar p = if p `elem` pointsSet then '#' else '.'
rowStrs = [0 .. ySize - 1] $> map (\y -> [0 .. xSize - 1] $> map (\x -> pointToChar (x, y)))
in rowStrs $> map putStrLn .> sequence_
e2 =
foldl' doFold
main :: IO ()
main =
do
contents <- getContents
let input =
contents
$> lines
.> break null
let pointsStr = fst input
let foldsStr = snd input $> drop 1
let points = pointsStr $> map (splitToPair (== ',') .> bimap read read) :: [Point]
let folds = foldsStr $> map parseFold
let result1 = e1 points folds
result1 $> length .> print
let result2 = e2 points folds
result2 $> length .> print
result2 $> printCode
|
