Add Haskell

This commit is contained in:
Felix Bargfeldt 2023-10-19 22:01:47 +02:00
parent 175864a2f2
commit 20408a4294
Signed by: Defelo
GPG key ID: 2A05272471204DD3
32 changed files with 469 additions and 2074 deletions

1
.envrc Normal file
View file

@ -0,0 +1 @@
use nix

2
.gitignore vendored
View file

@ -1,3 +1,5 @@
/.cache
/.direnv
target
.build
__pycache__

View file

@ -1,97 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"import System.IO\n",
"\n",
"handle <- openFile \"01.txt\" ReadMode \n",
"puzzle <- hGetContents handle \n",
"let plines = lines puzzle\n",
"\n",
"int x = read x :: Int"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 01"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"259716"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"let nums = map int plines\n",
" in head [a*b | a <- nums, b <- nums, a + b == 2020]"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"120637440"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"let nums = map int plines\n",
" in head [a*b*c | a <- nums, b <- nums, c <- nums, a + b + c == 2020]"
]
}
],
"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
}

View file

@ -1,106 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"import System.IO\n",
"\n",
"handle <- openFile \"02.txt\" ReadMode \n",
"puzzle <- hGetContents handle \n",
"let plines = lines puzzle\n",
"\n",
"int x = read x :: Int"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 02"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"424"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import Data.List.Split\n",
"\n",
"count e = foldl (\\a x -> if x == e then a + 1 else a) 0\n",
"\n",
"valid x c [a, b] = a <= cnt && cnt <= b\n",
" where cnt = count c x\n",
"test [a,b,c] = valid c (head b) $ map int $ splitOn \"-\" a\n",
"\n",
"count True $ map (test.words) plines"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"747"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"valid x c k = foldl (/=) False [x !! (e-1) == c | e <- k]\n",
"test [a,b,c] = valid c (head b) $ map int $ splitOn \"-\" a\n",
"\n",
"count True $ map (test.words) plines"
]
}
],
"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
}

View file

@ -1,97 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"import System.IO\n",
"\n",
"handle <- openFile \"03.txt\" ReadMode \n",
"puzzle <- hGetContents handle \n",
"let plines = lines puzzle\n",
"\n",
"int x = read x :: Int"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 03"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"294"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"length $ filter (\\(i, line) -> line !! mod (i*3) (length line) == '#') $ zip [0..] plines"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"5774564250"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"slice lst x = [e | (i, e) <- zip [0..] lst, mod i x == 0]\n",
"count a b = length $ filter (\\(i, line) -> line !! mod (i*a) (length line) == '#') $ zip [0..] $ slice plines b\n",
"product [count a 1 | a <- [1,3,5,7]] * count 1 2"
]
}
],
"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
}

View file

@ -1,112 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"puzzle <- readFile \"04.txt\"\n",
"plines = lines puzzle\n",
"\n",
"int x = read x :: Int"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 04"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"200"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import qualified Data.Map as Map\n",
"import Data.List.Split\n",
"\n",
"valid fields = all (`Map.member` fields) [\"byr\",\"iyr\",\"eyr\",\"hgt\",\"hcl\",\"ecl\",\"pid\"]\n",
"length $ filter valid [Map.fromList . map ((\\[a,b]->(a,b)) . splitOn \":\") $ concatMap words $ lines pp | pp <- splitOn \"\\n\\n\" puzzle]"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"116"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import qualified Data.Map as Map\n",
"import Data.List.Split\n",
"import Data.Maybe\n",
"\n",
"checkField fields (f, k) = k `Map.member` fields && f (fromMaybe \"\" $ Map.lookup k fields)\n",
"valid fields = all (checkField fields) [\n",
" (\\x -> 1920 <= int x && int x <= 2002, \"byr\"),\n",
" (\\x -> 2010 <= int x && int x <= 2020, \"iyr\"),\n",
" (\\x -> 2020 <= int x && int x <= 2030, \"eyr\"),\n",
" (\\x -> case head (reads x :: [(Int, String)]) of (h,\"cm\") -> 150 <= h && h <= 193\n",
" (h,\"in\") -> 59 <= h && h <= 76\n",
" _ -> False, \"hgt\"),\n",
" (\\x -> head x == '#' && all (`elem` \"0123456789abcdef\") (tail x), \"hcl\"),\n",
" ((`elem` words \"amb blu brn gry grn hzl oth\"), \"ecl\"),\n",
" (\\x -> length x == 9, \"pid\")\n",
" ]\n",
"length $ filter valid [Map.fromList . map ((\\[a,b]->(a,b)) . splitOn \":\") $ concatMap words $ lines pp | pp <- splitOn \"\\n\\n\" puzzle]"
]
}
],
"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
}

View file

@ -1,98 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"puzzle <- readFile \"05.txt\"\n",
"plines = lines puzzle\n",
"\n",
"int x = read x :: Int"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 05"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"938"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"seat = foldl (\\acc e -> acc * 2 + if e `elem` \"BR\" then 1 else 0) 0\n",
"foldl max 0 $ map seat plines"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"696"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import qualified Data.Set as Set\n",
"\n",
"let seats = Set.fromList $ map seat plines\n",
" b = foldl max 0 seats\n",
" a = foldl min b seats\n",
" in head . Set.toList $ Set.difference (Set.fromList [a..b]) seats"
]
}
],
"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
}

View file

@ -1,95 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"puzzle <- readFile \"06.txt\"\n",
"plines = lines puzzle\n",
"\n",
"int x = read x :: Int"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 06"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"6782"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import qualified Data.Set as Set\n",
"import Data.List.Split\n",
"\n",
"sum $ map (length.Set.fromList.concat.words) $ splitOn \"\\n\\n\" puzzle"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"3596"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"sum $ map (length . foldl Set.intersection (Set.fromList puzzle) . map Set.fromList . words) $ splitOn \"\\n\\n\" puzzle"
]
}
],
"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
}

View file

@ -1,103 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"puzzle <- readFile \"07.txt\"\n",
"plines = lines puzzle"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 07"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"124"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import qualified Data.List as List\n",
"import qualified Data.Map as Map\n",
"import qualified Data.Set as Set\n",
"import Data.List.Split\n",
"import Data.Maybe\n",
"\n",
"parse (x:xs) = (x, [p++\" \"++q | a <- xs, let w = words a, 2 <= length w, let (q:p:_) = reverse w])\n",
"let m = Map.fromList $ map (parse . splitOn \" bag\") plines\n",
" g = Map.fromList [(key, [k | (k,v) <- Map.toList m, key `elem` v]) | key <- List.nub $ concat $ Map.elems m]\n",
" dfs p = foldl Set.union (Set.singleton p) [dfs q | q <- fromMaybe [] $ Map.lookup p g]\n",
" in (length.dfs) \"shiny gold\" - 1"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"34862"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"parse (x:xs) = (x, [(read s,p++\" \"++q) | a <- xs, let w = words a, 3 <= length w, let (q:p:s:_) = reverse w, p/=\"no\"])\n",
"let g = Map.fromList $ map (parse . splitOn \" bag\") plines\n",
" dfs p = 1 + sum [n * dfs q | (n,q) <- fromMaybe [] $ Map.lookup p g]\n",
" in dfs \"shiny gold\" - 1"
]
}
],
"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
}

View file

@ -1,120 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"puzzle <- readFile \"08.txt\"\n",
"plines = lines puzzle"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 08"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"1654"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import qualified Data.Set as Set\n",
"\n",
"cmd :: Int -> String\n",
"cmd pc = head $ words $ plines !! pc\n",
"\n",
"arg :: Int -> Int\n",
"arg pc = read (if head x == '+' then tail x else x) \n",
" where x = last $ words $ plines !! pc\n",
"\n",
"add :: Int -> Set.Set Int -> Set.Set Int\n",
"add a s = Set.union s $ Set.singleton a\n",
"\n",
"simulate :: Int -> Int -> Set.Set Int -> Int\n",
"simulate pc a seen\n",
" | Set.member pc seen = a\n",
" | pc >= length plines = a\n",
" | cmd pc == \"acc\" = simulate (pc + 1) (a + arg pc) $ add pc seen\n",
" | cmd pc == \"jmp\" = simulate (pc + arg pc) a $ add pc seen\n",
" | cmd pc == \"nop\" = simulate (pc + 1) a $ add pc seen\n",
" \n",
"simulate 0 0 Set.empty"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"833"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import Data.Maybe\n",
"\n",
"simulate :: Int -> Int -> Set.Set Int -> Int -> Maybe Int\n",
"simulate pc a seen f\n",
" | Set.member pc seen = Nothing\n",
" | pc >= length plines = Just a\n",
" | cmd pc == \"acc\" = simulate (pc + 1) (a + arg pc) (add pc seen) f\n",
" | cmd pc==\"jmp\" && f/=pc || cmd pc==\"nop\" && f==pc = simulate (pc + arg pc) a (add pc seen) f\n",
" | otherwise = simulate (pc + 1) a (add pc seen) f\n",
" \n",
"head $ mapMaybe (simulate 0 0 Set.empty) [1..]"
]
}
],
"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
}

View file

@ -1,109 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"puzzle <- readFile \"09.txt\"\n",
"plines = lines puzzle"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 09"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"31161678"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"num :: Int -> Int\n",
"num idx = read $ plines !! idx\n",
"\n",
"test :: Int -> Int -> Bool\n",
"test idx target = or [a + b == target | i <- [idx..idx+24], j <- [i+1..idx+24], let [a,b] = map num [i,j], a/=b]\n",
"\n",
"head [num i | i <- [25..length plines-1], not $ test (i-25) $ num i]"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"5453868"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"sumRange :: Int -> Int -> Int\n",
"sumRange start end = sum $ map num [start..end]\n",
"\n",
"findRange :: Int -> Int -> Maybe Int\n",
"findRange idx target\n",
" | target == 0 = Just $ idx - 1\n",
" | target < 0 = Nothing\n",
" | otherwise = findRange (idx+1) $ target - num idx\n",
"\n",
"minmax :: Int -> Maybe Int -> Int\n",
"minmax a (Just b) = minimum x + maximum x\n",
" where x = map num [a..b]\n",
"\n",
"head [minmax i j | i <- [0..length plines-1], let j = findRange (i+1) $ 31161678 - num i, case j of Just _ -> True; _ -> False]"
]
}
],
"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
}

View file

@ -1,111 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"puzzle <- readFile \"10.txt\"\n",
"plines = lines puzzle"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 10"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"1885"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import Data.List (sort)\n",
"\n",
"nums = sort $ map read plines :: [Int]\n",
"\n",
"count :: Eq a => [a] -> a -> Int\n",
"count lst a = foldl (\\acc e -> if e == a then acc + 1 else acc) 0 lst\n",
"\n",
"let diffs = head nums:[(nums !! i) - (nums !! (i - 1)) | i <- [1..length nums - 1]]\n",
" in count diffs 1 * (count diffs 3 + 1)"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"2024782584832"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import qualified Data.Map as Map\n",
"\n",
"count :: Int -> Int -> Map.Map (Int, Int) Int -> (Int, Map.Map (Int, Int) Int)\n",
"count idx joltage dp\n",
" | idx == length nums = (if joltage == last nums then 1 else 0, dp)\n",
" | nums !! idx - joltage > 3 = (0, dp)\n",
" | otherwise = case Map.lookup (idx, joltage) dp of\n",
" Just c -> (c, dp)\n",
" _ -> let\n",
" (a, dp2) = count (idx + 1) joltage dp\n",
" (b, dp3) = count (idx + 1) (nums !! idx) dp2\n",
" in (a + b, Map.union dp3 $ Map.singleton (idx, joltage) (a + b))\n",
"\n",
"fst $ count 0 0 Map.empty"
]
}
],
"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
}

View file

@ -1,146 +0,0 @@
{
"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
}

View file

@ -1,121 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"puzzle <- readFile \"12.txt\"\n",
"plines = lines puzzle"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 12"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"590"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"rotate :: Int -> Int -> Int -> (Int, Int)\n",
"rotate dx dy n\n",
" | n `mod` 4 == 0 = (dx, dy)\n",
" | otherwise = rotate dy (-dx) (n-1)\n",
"\n",
"solve :: Int -> Int -> Int -> Int -> Int -> Int\n",
"solve x y dx dy i\n",
" | i >= length plines = sum $ map abs [x,y]\n",
" | cmd == 'N' = solve x (y-n) dx dy (i+1)\n",
" | cmd == 'E' = solve (x+n) y dx dy (i+1)\n",
" | cmd == 'S' = solve x (y+n) dx dy (i+1)\n",
" | cmd == 'W' = solve (x-n) y dx dy (i+1)\n",
" | cmd == 'F' = solve (x+dx*n) (y+dy*n) dx dy (i+1)\n",
" | cmd == 'L' = let (rx, ry) = rotate dx dy (n `div` 90) in solve x y rx ry (i+1)\n",
" | cmd == 'R' = let (rx, ry) = rotate dx dy (-n `div` 90) in solve x y rx ry (i+1)\n",
" where cmd = head (plines !! i)\n",
" n = read $ tail (plines !! i) :: Int\n",
"\n",
"solve 0 0 1 0 0"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"42013"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"solve :: Int -> Int -> Int -> Int -> Int -> Int\n",
"solve x y wx wy i\n",
" | i >= length plines = sum $ map abs [x,y]\n",
" | cmd == 'N' = solve x y wx (wy-n) (i+1)\n",
" | cmd == 'E' = solve x y (wx+n) wy (i+1)\n",
" | cmd == 'S' = solve x y wx (wy+n) (i+1)\n",
" | cmd == 'W' = solve x y (wx-n) wy (i+1)\n",
" | cmd == 'F' = solve (x+wx*n) (y+wy*n) wx wy (i+1)\n",
" | cmd == 'L' = let (rx, ry) = rotate wx wy (n `div` 90) in solve x y rx ry (i+1)\n",
" | cmd == 'R' = let (rx, ry) = rotate wx wy (-n `div` 90) in solve x y rx ry (i+1)\n",
" where cmd = head (plines !! i)\n",
" n = read $ tail (plines !! i) :: Int\n",
"\n",
"solve 0 0 10 (-1) 0"
]
}
],
"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
}

View file

@ -1,109 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"puzzle <- readFile \"13.txt\"\n",
"plines = lines puzzle"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 13"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"1835"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import Data.List.Split\n",
"\n",
"target = read $ head plines :: Int\n",
"nums = map read $ filter (/=\"x\") $ splitOn \",\" $ last plines :: [Int]\n",
"\n",
"let (t, n) = minimum [((target `div` n + 1) * n - target, n) | n <- nums]\n",
" in t * n"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"247086664214628"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"extendedGcd :: Int -> Int -> (Int, Int, Int)\n",
"extendedGcd 0 b = (b, 0, 1)\n",
"extendedGcd a b = (g, y - (b `div` a) * x, x)\n",
" where (g, x, y) = extendedGcd (b `mod` a) a\n",
"\n",
"chineseRemainder :: [Int] -> [Int] -> Int\n",
"chineseRemainder n a = sum [ai * x * p | (ni, ai) <- zip n a, let p = prod `div` ni; (_, x, _) = extendedGcd p ni] `mod` prod\n",
" where prod = product n\n",
"\n",
"nums = [(read x, i) | (x, i) <- zip (splitOn \",\" $ last plines) [0..], x /= \"x\"] :: [(Int, Int)]\n",
"\n",
"let n = map fst nums\n",
" a = map (uncurry (-)) nums\n",
" in chineseRemainder n a"
]
}
],
"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
}

View file

@ -1,143 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"puzzle <- readFile \"14.txt\"\n",
"plines = lines puzzle"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 14"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"14839536808842"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import qualified Data.Map as Map\n",
"import Data.List (isPrefixOf)\n",
"import Data.List.Split\n",
"\n",
"intToBin :: Int -> Int -> String\n",
"intToBin _ 0 = \"\"\n",
"intToBin num len = intToBin (num `div` 2) (len - 1) ++ show (num `mod` 2)\n",
"\n",
"binToInt :: String -> Int\n",
"binToInt = foldl (\\acc e -> acc * 2 + read (e:\"\")) 0\n",
"\n",
"applyMask :: String -> Int -> Int\n",
"applyMask mask value = binToInt [if m == 'X' then x else m | (m, x) <- zip mask $ intToBin value 36]\n",
"\n",
"handleMask :: [String] -> Map.Map Int Int -> Int\n",
"handleMask (x:xs) = solve xs $ last $ splitOn \" = \" x\n",
"\n",
"handleMem :: [String] -> String -> Map.Map Int Int -> Int\n",
"handleMem (x:xs) mask mem = solve xs mask $ Map.insert a (applyMask mask b) mem\n",
" where [a,b] = map read $ splitOn \"] = \" $ last $ splitOn \"[\" x :: [Int]\n",
"\n",
"solve :: [String] -> String -> Map.Map Int Int -> Int\n",
"solve [] mask mem = sum $ Map.elems mem\n",
"solve line@(x:_) mask mem\n",
" | \"mask\" `isPrefixOf` x = handleMask line mem\n",
" | otherwise = handleMem line mask mem\n",
"\n",
"solve plines (replicate 36 'X') Map.empty"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"4215284199669"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import Data.Bits (shiftL, testBit)\n",
"\n",
"iterReplace :: [Int] -> String -> Int -> String\n",
"iterReplace floating a i = [Map.findWithDefault x j tr | (j, x) <- zip [0..] a]\n",
" where tr = Map.fromList [(f, if testBit i j then '1' else '0') | (j, f) <- zip [0..] floating]\n",
"\n",
"iter :: String -> [Int]\n",
"iter a = map (binToInt . iterReplace floating a) [0 .. 1 `shiftL` length floating - 1]\n",
" where floating = filter (('X'==).(a!!)) [0..35]\n",
"\n",
"applyMask :: String -> Int -> String\n",
"applyMask mask value = [if m == '0' then x else m | (m, x) <- zip mask $ intToBin value 36]\n",
"\n",
"handleMask :: [String] -> Map.Map Int Int -> Int\n",
"handleMask (x:xs) = solve xs $ last $ splitOn \" = \" x\n",
"\n",
"handleMem :: [String] -> String -> Map.Map Int Int -> Int\n",
"handleMem (x:xs) mask mem = solve xs mask $ foldl (\\acc e -> Map.insert e b acc) mem $ iter $ applyMask mask a\n",
" where [a,b] = map read $ splitOn \"] = \" $ last $ splitOn \"[\" x :: [Int]\n",
"\n",
"solve :: [String] -> String -> Map.Map Int Int -> Int\n",
"solve [] mask mem = sum $ Map.elems mem\n",
"solve line@(x:_) mask mem\n",
" | \"mask\" `isPrefixOf` x = handleMask line mem\n",
" | otherwise = handleMem line mask mem\n",
"\n",
"solve plines (replicate 36 'X') Map.empty"
]
}
],
"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
}

View file

@ -1,125 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"puzzle <- readFile \"15.txt\"\n",
"plines = lines puzzle"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 15"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"1618"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import qualified Data.Map as Map\n",
"import Data.List.Split\n",
"\n",
"nums = map read $ splitOn \",\" puzzle :: [Int]\n",
"\n",
"solve :: Int -> Int -> Map.Map Int Int -> Int\n",
"solve i n hist\n",
" | i == 2020 = n\n",
" | otherwise = solve (i+1) o $ Map.insert n (i-1) hist\n",
" where o = i - 1 - Map.findWithDefault (i-1) n hist\n",
"\n",
"initialize :: Int -> Map.Map Int Int -> Int\n",
"initialize i hist\n",
" | i == length nums - 1 = solve (i+1) (nums !! i) newMap\n",
" | otherwise = initialize (i+1) newMap\n",
" where newMap = Map.insert (nums !! i) i hist\n",
"\n",
"initialize 0 Map.empty"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"548531"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import qualified Data.Map as Map\n",
"import Data.List.Split\n",
"\n",
"nums = map read $ splitOn \",\" puzzle :: [Int]\n",
"\n",
"next :: Int -> (Int, Map.Map Int Int) -> (Int, Map.Map Int Int)\n",
"next i (n, hist) = (o, Map.insert n (i-1) hist)\n",
" where o = i - 1 - Map.findWithDefault (i-1) n hist\n",
"\n",
"solve :: Int -> Int -> Map.Map Int Int -> Int\n",
"solve i n hist = fst $ foldl (flip next) (n, hist) [i..30000000-1]\n",
"\n",
"initialize :: Int -> Map.Map Int Int -> Int\n",
"initialize i hist\n",
" | i == length nums - 1 = solve (i+1) (nums !! i) newMap\n",
" | otherwise = initialize (i+1) newMap\n",
" where newMap = Map.insert (nums !! i) i hist\n",
"\n",
"initialize 0 Map.empty"
]
}
],
"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
}

View file

@ -1,142 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"puzzle <- readFile \"16.txt\"\n",
"plines = lines puzzle"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 16"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"25788"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import Data.List.Split\n",
"\n",
"type Rule = (String, [(Int, Int)])\n",
"type Ticket = [Int]\n",
"\n",
"parseRule :: String -> Rule\n",
"parseRule line = (name, map ((\\[a, b] -> (a, b)) . map read . splitOn \"-\") $ splitOn \" or \" ranges)\n",
" where [name, ranges] = splitOn \": \" line\n",
"\n",
"rules = map parseRule . lines . head . splitOn \"\\n\\n\" $ puzzle :: [Rule]\n",
"\n",
"nearbyTickets = map (map read . splitOn \",\") . tail . lines . last . splitOn \"\\n\\n\" $ puzzle :: [Ticket]\n",
"\n",
"checkRule :: Int -> Rule -> Bool\n",
"checkRule num = any (\\(a, b) -> a <= num && num <= b) . snd\n",
"\n",
"fieldValid :: Int -> Bool\n",
"fieldValid field = any (checkRule field) rules\n",
"\n",
"sum [field | ticket <- nearbyTickets, field <- ticket, not $ fieldValid field]"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"3902565915559"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import qualified Data.Set as Set\n",
"import qualified Data.Map as Map\n",
"import Data.List (isPrefixOf)\n",
"import Data.Maybe\n",
"\n",
"n = length rules :: Int\n",
"\n",
"myTicket = map read . splitOn \",\" . last . lines . (!!1) . splitOn \"\\n\\n\" $ puzzle :: Ticket\n",
"\n",
"validTickets = filter (all fieldValid) nearbyTickets :: [Ticket]\n",
"\n",
"possibleAllocations = [Set.fromList $ filter (possible rule) [0..n-1] | rule <- [0..n-1]] :: [Set.Set Int]\n",
" where possible rule field = all (\\ticket -> checkRule (ticket !! field) (rules !! rule)) validTickets\n",
"\n",
"clearPossibility :: [Set.Set Int] -> Int -> [Set.Set Int]\n",
"clearPossibility possible num = map (Set.delete num) possible\n",
"\n",
"reduce :: [Maybe Int] -> [Set.Set Int] -> [Int]\n",
"reduce allocations possible = solve newAllocations newPossibleAllocations\n",
" where newAllocations = [case Set.toList $ possible !! i of \n",
" [x] -> Just x \n",
" _ -> y | (i, y) <- zip [0..n-1] allocations]\n",
" newPossibleAllocations = foldl clearPossibility possible $ catMaybes newAllocations\n",
"\n",
"solve :: [Maybe Int] -> [Set.Set Int] -> [Int]\n",
"solve allocations possible\n",
" | not $ any isNothing allocations = catMaybes allocations\n",
" | otherwise = reduce allocations possible\n",
"\n",
"departureValues :: [Int] -> Int\n",
"departureValues allocation = product $ map ((myTicket!!) . (allocation!!)) departureRules\n",
" where departureRules = [i | (i, (name, _)) <- zip [0..n-1] rules, \"departure\" `isPrefixOf` name]\n",
"\n",
"departureValues $ solve (replicate n Nothing) possibleAllocations"
]
}
],
"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
}

View file

@ -1,150 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"puzzle <- readFile \"17.txt\"\n",
"plines = lines puzzle"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day 17"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"289"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import qualified Data.Set as Set\n",
"import Data.List (nub)\n",
"\n",
"type Cube = (Int, Int, Int)\n",
"type State = Set.Set Cube\n",
"\n",
"adjacent = [(i, j, k) | i <- [-1..1], j <- [-1..1], k <- [-1..1]] :: [Cube]\n",
"\n",
"neighbours :: Cube -> [Cube]\n",
"neighbours (x, y, z) = [(x+i, y+j, z+k) | (i,j,k) <- adjacent]\n",
"\n",
"realNeighbours :: Cube -> [Cube]\n",
"realNeighbours cube = filter (/=cube) $ neighbours cube\n",
"\n",
"countNeighbours :: State -> Cube -> Int\n",
"countNeighbours state cube = length activeNeighbours\n",
" where activeNeighbours = filter (`Set.member` state) $ realNeighbours cube\n",
"\n",
"simulateCube :: State -> Cube -> Bool\n",
"simulateCube state cube\n",
" | active = count `elem` [2,3]\n",
" | otherwise = count == 3\n",
" where active = cube `Set.member` state\n",
" count = countNeighbours state cube\n",
"\n",
"simulate :: Int -> State -> Int\n",
"simulate 0 state = length state\n",
"simulate n state = simulate (n-1) $ Set.fromList newState\n",
" where toUpdate = nub . concatMap neighbours . Set.toList $ state\n",
" newState = filter (simulateCube state) toUpdate\n",
"\n",
"simulate 6 $ Set.fromList [(0, i, j) | (i, line) <- zip [0..] plines, (j, c) <- zip [0..] line, c == '#']"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"2084"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"type Cube = (Int, Int, Int, Int)\n",
"type State = Set.Set Cube\n",
"\n",
"adjacent = [(h, i, j, k) | h <- [-1..1], i <- [-1..1], j <- [-1..1], k <- [-1..1]] :: [Cube]\n",
"\n",
"union :: Ord a => [Set.Set a] -> Set.Set a\n",
"union = foldl Set.union Set.empty\n",
"\n",
"neighbours :: Cube -> Set.Set Cube\n",
"neighbours (w, x, y, z) = Set.fromList [(w+h, x+i, y+j, z+k) | (h,i,j,k) <- adjacent]\n",
"\n",
"realNeighbours :: Cube -> Set.Set Cube\n",
"realNeighbours cube = Set.filter (/=cube) $ neighbours cube\n",
"\n",
"countNeighbours :: State -> Cube -> Int\n",
"countNeighbours state cube = length activeNeighbours\n",
" where activeNeighbours = Set.filter (`Set.member` state) $ realNeighbours cube\n",
"\n",
"simulateCube :: State -> Cube -> Bool\n",
"simulateCube state cube\n",
" | active = count `elem` [2,3]\n",
" | otherwise = count == 3\n",
" where active = cube `Set.member` state\n",
" count = countNeighbours state cube\n",
"\n",
"simulate :: Int -> State -> Int\n",
"simulate 0 state = length state\n",
"simulate n state = simulate (n-1) . Set.filter (simulateCube state) . union . Set.toList . Set.map neighbours $ state\n",
"\n",
"simulate 6 $ Set.fromList [(0, 0, i, j) | (i, line) <- zip [0..] plines, (j, c) <- zip [0..] line, c == '#']"
]
}
],
"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
}

19
Haskell/2022/01.hs Normal file
View file

@ -0,0 +1,19 @@
import Data.List
import Lib
type Input = [[Int]]
main :: IO ()
main = aoc 2022 1 setup solve1 solve2 ["1"]
solve1 :: Input -> Int
solve1 = maximum . map sum
solve2 :: Input -> Int
solve2 = sum . take 3 . reverse . sort . map sum
setup :: String -> Input
setup = foldr add [[]] . lines
where
add "" acc = [] : acc
add x (a : as) = (read x : a) : as

16
Haskell/2022/02.hs Normal file
View file

@ -0,0 +1,16 @@
import Data.Char
import Lib
type Input = [(Int, Int)]
main :: IO ()
main = aoc 2022 2 setup solve1 solve2 ["1"]
solve1 :: Input -> Int
solve1 = sum . map (\(x, y) -> (y - x + 1) `mod` 3 * 3 + y)
solve2 :: Input -> Int
solve2 = sum . map (\(x, y) -> (y + x) `mod` 3 + y * 3 - 2)
setup :: String -> Input
setup = map (\[a, _, b] -> (ord a - 64, ord b - 87)) . lines

31
Haskell/2022/03.hs Normal file
View file

@ -0,0 +1,31 @@
import Data.Char
import Data.List
import Data.Maybe
import Lib
type Input = [String]
main :: IO ()
main = aoc 2022 3 setup solve1 solve2 ["1"]
solve1 :: Input -> Int
solve1 = sum . map (prio . fromJust . uncurry (find . flip elem) . splitHalf)
solve2 :: Input -> Int
solve2 = sum . map (prio . fromJust . \(x : xs) -> find (flip all xs . elem) x) . join3
setup :: String -> Input
setup = lines
splitHalf :: String -> (String, String)
splitHalf s = splitAt (length s `div` 2) s
join3 :: Input -> [[String]]
join3 = foldr add [[]]
where
add x (a : as)
| length a == 3 = [x] : a : as
| otherwise = (x : a) : as
prio :: Char -> Int
prio c = ord c - if c >= 'a' then 96 else 38

24
Haskell/2022/04.hs Normal file
View file

@ -0,0 +1,24 @@
import Lib
import Text.Regex.TDFA
type Assignment = (Int, Int)
type Input = [(Assignment, Assignment)]
main :: IO ()
main = aoc 2022 4 setup solve1 solve2 ["1"]
solve1 :: Input -> Int
solve1 = length . filter (\(a, b) -> contains a b || contains b a)
solve2 :: Input -> Int
solve2 = length . filter (uncurry overlaps)
setup :: String -> Input
setup = map ((\[a, b, c, d] -> ((a, b), (c, d))) . (map read . getAllTextMatches . (=~ "[0-9]+"))) . lines
contains :: Assignment -> Assignment -> Bool
contains (a, b) (c, d) = a <= c && d <= b
overlaps :: Assignment -> Assignment -> Bool
overlaps (a, b) (c, d) = not $ b < c || d < a

47
Haskell/2022/05.hs Normal file
View file

@ -0,0 +1,47 @@
import Lib
import Text.Regex.TDFA
type Stack = [Char]
type Instruction = (Int, Int, Int)
type Input = ([Stack], [Instruction])
main :: IO ()
main = aoc 2022 5 setup solve1 solve2 ["1"]
solve1 :: Input -> String
solve1 = solve reverse
solve2 :: Input -> String
solve2 = solve id
solve :: ([Char] -> [Char]) -> Input -> String
solve f = map head . (uncurry . simulate) f
setup :: String -> Input
setup = (\l -> (stacks l, instructions l)) . lines
where
stacks = parseStacks . init . takeWhile (not . null)
instructions = parseInstructions . tail . dropWhile (not . null)
parseStacks :: [String] -> [Stack]
parseStacks l = map ((dropWhile (== ' ') . flip map l . flip (!!)) . (+ 1) . (* 4)) [0 .. n - 1]
where
n = (`div` 4) $ (+ 1) $ length $ head l
parseInstructions :: [String] -> [Instruction]
parseInstructions = map ((\[a, b, c] -> (a, b - 1, c - 1)) . map read . getAllTextMatches . (=~ "[0-9]+"))
simulate :: ([Char] -> [Char]) -> [Stack] -> [Instruction] -> [Stack]
simulate f stacks [] = stacks
simulate f stacks ((n, a, b) : xs) = simulate f (newStacks 0) xs
where
crates = take n $ stacks !! a
newA = drop n $ stacks !! a
newB = f crates ++ stacks !! b
newStacks i
| i == length stacks = []
| i == a = newA : newStacks (i + 1)
| i == b = newB : newStacks (i + 1)
| otherwise = stacks !! i : newStacks (i + 1)

28
Haskell/2022/06.hs Normal file
View file

@ -0,0 +1,28 @@
import Data.List
import Data.Maybe
import Lib
type Input = String
main :: IO ()
main = aoc 2022 6 setup solve1 solve2 ["1", "2", "3", "4", "5"]
solve1 :: Input -> Int
solve1 = solve 4
solve2 :: Input -> Int
solve2 = solve 14
solve :: Int -> Input -> Int
solve n = (+ n) . fromJust . findIndex unique . slices n
setup :: String -> Input
setup = id
slices :: Int -> [a] -> [[a]]
slices n lst
| null $ drop (n - 1) lst = []
| otherwise = take n lst : slices n (tail lst)
unique :: (Eq a) => [a] -> Bool
unique lst = length (nub lst) == length lst

64
Haskell/2022/07.hs Normal file
View file

@ -0,0 +1,64 @@
import Data.List
import Lib
type Filename = String
type Filesize = Int
data File = Dir Filename | File Filename Filesize deriving (Show)
data Command = Cd String | Ls [File] deriving (Show)
data FileTree = TreeDir Filesize [FileTree] | TreeFile Filesize deriving (Show)
type Input = [Int]
main :: IO ()
main = aoc 2022 7 setup solve1 solve2 ["1"]
solve1 :: Input -> Int
solve1 = sum . filter (<= 100000)
solve2 :: Input -> Int
solve2 dirs = minimum $ filter (>= 30000000 - 70000000 + head dirs) dirs
setup :: String -> Input
setup = flattenTree . (: []) . buildTree . collectFiles [] . parseCommands . lines
parseCommands :: [String] -> [Command]
parseCommands [] = []
parseCommands (x : xs)
| "$ cd" `isPrefixOf` x = Cd (drop 5 x) : parseCommands xs
| "$ ls" `isPrefixOf` x = Ls (map parseFile $ takeWhile inLs xs) : parseCommands (dropWhile inLs xs)
where
inLs = not . isPrefixOf "$"
parseFile :: String -> File
parseFile ('d' : 'i' : 'r' : ' ' : x) = Dir x
parseFile x = File (drop 1 $ dropWhile (/= ' ') x) (read $ takeWhile (/= ' ') x)
collectFiles :: [Filename] -> [Command] -> [([String], Int)]
collectFiles path [] = []
collectFiles path (Cd "/" : xs) = collectFiles [] xs
collectFiles [] (Cd ".." : xs) = collectFiles [] xs
collectFiles path (Cd ".." : xs) = collectFiles (init path) xs
collectFiles path (Cd name : xs) = collectFiles (path ++ [name]) xs
collectFiles path (Ls x : xs) = [(path ++ [name], size) | (File name size) <- x] ++ collectFiles path xs
buildTree :: [([String], Int)] -> FileTree
buildTree xs = TreeDir (treeSize $ dirs ++ files) $ dirs ++ files
where
files = [TreeFile size | ([name], size) <- xs]
dirNames = nub [name | (name : _ : _, _) <- xs]
dirEntries dir = [(ps, size) | (p : ps, size) <- xs, p == dir]
dirs = [buildTree $ dirEntries name | name <- dirNames]
treeSize :: [FileTree] -> Int
treeSize [] = 0
treeSize ((TreeDir size entries) : xs) = treeSize entries + treeSize xs
treeSize ((TreeFile size) : xs) = size + treeSize xs
flattenTree :: [FileTree] -> [Int]
flattenTree [] = []
flattenTree (TreeDir size entries : xs) = size : (flattenTree entries ++ flattenTree xs)
flattenTree (_ : xs) = flattenTree xs

63
Haskell/2022/08.hs Normal file
View file

@ -0,0 +1,63 @@
import Lib
data Direction = North | East | South | West
type Coord = (Int, Int)
type Size = (Int, Int)
type Grid = [[Int]]
type Input = (Size, Grid)
main :: IO ()
main = aoc 2022 8 setup solve1 solve2 ["1"]
solve1 :: Input -> Int
solve1 input@(size, _) = length $ filter (isVisible input) $ coords size
solve2 input@(size, _) = maximum $ map (scenicScore input) $ coords size
setup :: String -> Input
setup inp = ((length grid, length $ head grid), grid)
where
grid = map parseLine $ lines inp
parseLine :: String -> [Int]
parseLine = map (read . (: []))
isVisible :: Input -> Coord -> Bool
isVisible input p = any (canSeeEdge input p) [North, East, South, West]
scenicScore :: Input -> Coord -> Int
scenicScore input p = product $ map (visibleTrees input p) [North, East, South, West]
canSeeEdge :: Input -> Coord -> Direction -> Bool
canSeeEdge (size, grid) p d = all ((< at grid p) . at grid) $ steps d size p
visibleTrees :: Input -> Coord -> Direction -> Int
visibleTrees (size, grid) p d = length $ takeWhileInclusive ((< at grid p) . at grid) $ steps d size p
steps :: Direction -> Size -> Coord -> [Coord]
steps d size = takeWhile (inGrid size) . iterate (step d) . step d
step :: Direction -> Coord -> Coord
step North (i, j) = (i - 1, j)
step East (i, j) = (i, j + 1)
step South (i, j) = (i + 1, j)
step West (i, j) = (i, j - 1)
inGrid :: Size -> Coord -> Bool
inGrid (h, w) (i, j) = 0 <= i && i < h && 0 <= j && j < w
coords :: Size -> [Coord]
coords (h, w) = [(i, j) | i <- [0 .. h - 1], j <- [0 .. w - 1]]
at :: Grid -> Coord -> Int
at grid (i, j) = grid !! i !! j
takeWhileInclusive :: (a -> Bool) -> [a] -> [a]
takeWhileInclusive f [] = []
takeWhileInclusive f (x : xs)
| f x = x : takeWhileInclusive f xs
| otherwise = [x]

65
Haskell/2022/09.hs Normal file
View file

@ -0,0 +1,65 @@
import Data.List
import Data.Ord (clamp)
import Lib
import Prelude hiding (Left, Right)
data Direction = Up | Down | Left | Right deriving (Show)
type Position = (Int, Int)
type Rope = [Position]
type State = (Rope, [Position])
type Motion = (Direction, Int)
type Input = [Motion]
main :: IO ()
main = aoc 2022 9 setup solve1 solve2 ["1", "2"]
solve1 :: Input -> Int
solve1 = solve 2
solve2 :: Input -> Int
solve2 = solve 10
solve :: Int -> Input -> Int
solve n = length . nub . snd . foldl step (initialRope n, []) . directions
step :: State -> Direction -> State
step (rope, visited) m = (newRope, head newRope : visited)
where
newRope = stepRope rope m
stepRope :: Rope -> Direction -> Rope
stepRope r m = scanr follow (move m $ last r) $ init r
follow :: Position -> Position -> Position
follow (x, y) (x', y')
| abs (x - x') <= 1 && abs (y - y') <= 1 = (x, y)
| otherwise = (x + clamp (-1, 1) (x' - x), y + clamp (-1, 1) (y' - y))
directions :: [Motion] -> [Direction]
directions = concatMap $ uncurry $ flip replicate
setup :: String -> Input
setup = map parseMotion . lines
parseMotion :: String -> Motion
parseMotion (d : ' ' : n) = (parseDirection d, read n)
parseDirection :: Char -> Direction
parseDirection 'U' = Up
parseDirection 'D' = Down
parseDirection 'L' = Left
parseDirection 'R' = Right
move :: Direction -> Position -> Position
move Up (x, y) = (x, y - 1)
move Down (x, y) = (x, y + 1)
move Left (x, y) = (x - 1, y)
move Right (x, y) = (x + 1, y)
initialRope :: Int -> Rope
initialRope = flip replicate (0, 0)

74
Haskell/Lib.hs Normal file
View file

@ -0,0 +1,74 @@
module Lib (aoc) where
import Control.Monad
import Data.Bool
import Data.Functor
import qualified Data.Text
import System.Environment
import System.Exit
aoc :: (Print b, Print c) => Int -> Int -> (String -> a) -> (a -> b) -> (a -> c) -> [String] -> IO ()
aoc year day setup part1 part2 examples = do
let run f = f year day setup part1 part2
args <- getArgs
if args == ["test"]
then run test examples >>= bool exitFailure exitSuccess
else run main >> exitSuccess
main :: (Print b, Print c) => Int -> Int -> (String -> a) -> (a -> b) -> (a -> c) -> IO ()
main year day setup part1 part2 = do
let path = inputPath year day
input <- readFile path <&> setup
(putStrLn . toString . part1) input
(putStrLn . toString . part2) input
test :: (Print b, Print c) => Int -> Int -> (String -> a) -> (a -> b) -> (a -> c) -> [String] -> IO Bool
test year day setup part1 part2 examples = do
let inp = inputPath year day
let out = outputPath year day
a <- testInput "test_input_part1" inp (out 1) setup part1
b <- testInput "test_input_part2" inp (out 2) setup part2
cs <- sequence [testExample year day ex setup part1 part2 | ex <- examples]
pure $ a && b && and cs
testExample :: (Print b, Print c) => Int -> Int -> String -> (String -> a) -> (a -> b) -> (a -> c) -> IO Bool
testExample year day ex setup part1 part2 = do
let inp = exampleInputPath year day ex
let out = exampleOutputPath year day ex
a <- testInput ("test_ex" ++ ex ++ "_part1") inp (out 1) setup part1
b <- testInput ("test_ex" ++ ex ++ "_part2") inp (out 2) setup part2
pure $ a && b
testInput :: (Print b) => String -> String -> String -> (String -> a) -> (a -> b) -> IO Bool
testInput name inputPath outputPath setup solve = do
actual <- readFile inputPath <&> strip . toString . solve . setup
expected <- readFile outputPath <&> strip
let ok = actual == expected
if ok
then putStrLn $ name ++ ": ok"
else putStrLn $ name ++ ": fail: " ++ show actual ++ " /= " ++ show expected
pure ok
inputPath :: Int -> Int -> String
inputPath year day = "../.cache/" ++ show year ++ "/" ++ show day
outputPath :: Int -> Int -> Int -> String
outputPath year day part = inputPath year day ++ "." ++ show part
exampleInputPath :: Int -> Int -> String -> String
exampleInputPath year day ex = "../examples/" ++ show year ++ "/" ++ show day ++ "/" ++ ex
exampleOutputPath :: Int -> Int -> String -> Int -> String
exampleOutputPath year day ex part = exampleInputPath year day ex ++ "." ++ show part
strip :: String -> String
strip = Data.Text.unpack . Data.Text.strip . Data.Text.pack
class Print a where
toString :: a -> String
instance Print String where
toString = id
instance Print Int where
toString = show

24
Haskell/justfile Normal file
View file

@ -0,0 +1,24 @@
alias b := build
alias r := run
alias t := test
alias ty := test-year
alias ta := test-all
_default:
@just --list
build year day:
mkdir -p .build/{{year}}/{{day}}
ghc -o .build/{{year}}/{{day}}/{{day}} -outputdir .build/{{year}}/{{day}} -O {{year}}/{{day}}.hs >&2
run year day: (build year day)
.build/{{year}}/{{day}}/{{day}}
test year day: (build year day)
.build/{{year}}/{{day}}/{{day}} test
test-year year:
@for day in $(ls {{year}}); do just test {{year}} $(basename $day .hs); done
test-all:
@set -e; for year in *; do [[ -d $year ]] || continue; just test-year $year; done

View file

@ -1,90 +0,0 @@
{
"cells": [
{
"cell_type": "code",
"execution_count": 1,
"metadata": {},
"outputs": [],
"source": [
"puzzle <- readFile \"2020/XX.txt\"\n",
"plines = lines puzzle"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# Day XX"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 1"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"\"<puzzle input>\""
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"puzzle"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Puzzle 2"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {},
"outputs": [
{
"data": {
"text/plain": [
"\"<puzzle input>\""
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"puzzle"
]
}
],
"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
}

11
shell.nix Normal file
View file

@ -0,0 +1,11 @@
with import <nixpkgs> {};
mkShell {
buildInputs = [
just
# Haskell
(haskellPackages.ghcWithPackages (p: with p; [regex-tdfa]))
haskell-language-server
ormolu # haskell code formatter
];
}