AdventOfCode/2020/11_haskell.ipynb

146 lines
4 KiB
Text

{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"puzzle <- readFile \"11.txt\"\n",
"plines = lines puzzle"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 11"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"2113"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import qualified Data.Map as Map\n",
"import qualified Data.Set as Set\n",
"\n",
"width = length $ head plines :: Int\n",
"height = length plines :: Int\n",
"\n",
"cell :: Int -> Int -> Char\n",
"cell x y = plines !! y !! x\n",
"\n",
"empty :: Int -> Int -> Bool\n",
"empty x y = cell x y == '.'\n",
"seat :: Int -> Int -> Bool\n",
"seat x y = cell x y == 'L'\n",
"\n",
"adjacent :: Int -> Int -> [(Int, Int)]\n",
"adjacent x y = [(p,q) | dx <- [-1..1], dy <- [-1..1], (dx,dy)/=(0,0), let p=x+dx; q=y+dy, 0<=p, p<width, 0<=q, q<height, seat p q]\n",
"\n",
"nextCell :: Set.Set (Int, Int) -> [(Int, Int)] -> (Int, Int) -> Bool\n",
"nextCell active qs p@(x, y) = not a && cnt == 0 || a && cnt < 4\n",
" where a = Set.member p active\n",
" cnt = length $ Set.intersection active $ Set.fromList qs\n",
"\n",
"next :: Map.Map (Int, Int) [(Int, Int)] -> Set.Set (Int, Int) -> Set.Set (Int, Int)\n",
"next graph active = Set.fromList [p | (p, qs) <- Map.toList graph, nextCell active qs p]\n",
"\n",
"solve :: Set.Set (Int, Int) -> Map.Map (Int, Int) [(Int, Int)] -> Int\n",
"solve active graph\n",
" | active == new = length active\n",
" | otherwise = solve new graph\n",
" where new = next graph active\n",
"\n",
"solve Set.empty $ Map.fromList [((x, y), adjacent x y) | y <- [0..height-1], x <- [0..width-1], seat x y]"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"1865"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import Data.Maybe\n",
"\n",
"raycast :: Int -> Int -> Int -> Int -> Maybe (Int, Int)\n",
"raycast x y dx dy\n",
" | x<0 || x>=width || y<0 || y>=height = Nothing\n",
" | seat x y = Just (x, y)\n",
" | otherwise = raycast (x+dx) (y+dy) dx dy\n",
"\n",
"adjacent :: Int -> Int -> [(Int, Int)]\n",
"adjacent x y = catMaybes [raycast (x+dx) (y+dy) dx dy | dx <- [-1..1], dy <- [-1..1], (dx,dy)/=(0,0)]\n",
"\n",
"nextCell :: Set.Set (Int, Int) -> [(Int, Int)] -> (Int, Int) -> Bool\n",
"nextCell active qs p@(x, y) = not a && cnt == 0 || a && cnt < 5\n",
" where a = Set.member p active\n",
" cnt = length $ Set.intersection active $ Set.fromList qs\n",
"\n",
"next :: Map.Map (Int, Int) [(Int, Int)] -> Set.Set (Int, Int) -> Set.Set (Int, Int)\n",
"next graph active = Set.fromList [p | (p, qs) <- Map.toList graph, nextCell active qs p]\n",
"\n",
"solve :: Set.Set (Int, Int) -> Map.Map (Int, Int) [(Int, Int)] -> Int\n",
"solve active graph\n",
" | active == new = length active\n",
" | otherwise = solve new graph\n",
" where new = next graph active\n",
"\n",
"solve Set.empty $ Map.fromList [((x, y), adjacent x y) | y <- [0..height-1], x <- [0..width-1], seat x y]"
]
}
],
"metadata": {
"kernelspec": {
"display_name": "Haskell",
"language": "haskell",
"name": "haskell"
},
"language_info": {
"codemirror_mode": "Haskell",
"file_extension": ".hs",
"mimetype": "text/x-haskell",
"name": "haskell",
"pygments_lexer": "Haskell",
"version": "8.8.4"
}
},
"nbformat": 4,
"nbformat_minor": 4
}