2023 day 5 in Haskell

This is terrible. On my machine this finishes in just under 3 minutes.

2023/.envrc

@@ -0,0 +1 @@
+use flake

2023/05/Day05.cabal

@@ -0,0 +1,19 @@
+cabal-version:   3.0
+name:            Day05
+version:         0.1.0.0
+license:         NONE
+build-type:      Simple
+extra-doc-files: CHANGELOG.md
+
+common warnings
+    ghc-options: -Wall
+
+executable Day05
+    import:           warnings
+    main-is:          Day05.hs
+    build-depends:    base ^>=4.17.2.1
+                    , attoparsec ^>=0.14.4
+                    , text ^>=2.1
+                    , containers ^>=0.6.7
+    hs-source-dirs:   .
+    default-language: Haskell2010

2023/05/Day05.hs

@@ -0,0 +1,80 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+
+import Data.Attoparsec.Text
+
+type Seeds = [Int]
+type Range = (Int, Int)
+type Mapping = (Range, Int)
+
+type Input = (Seeds, [[Mapping]])
+
+main :: IO ()
+main = do
+  input <- TIO.getContents >>= parseInput
+  putStrLn ("Part 1: " <> show (part1 input))
+  putStrLn ("Part 2: " <> show (part2 input))
+
+parseInput :: T.Text -> IO Input
+parseInput s = case parseOnly inputParser s of
+  Right i -> pure i
+  Left e -> error e
+
+inputParser :: Parser Input
+inputParser =  do
+  seeds <- "seeds: " *> sepBy1 decimal " " <* endOfLine <* endOfLine -- seeds: 1 2 3\n
+  mappings <- many1 mappingSection <* endOfInput
+  return (seeds, mappings)
+
+mappingSection :: Parser [Mapping]
+mappingSection = do
+  _ <- takeTill isEndOfLine <* endOfLine -- foo-to-bar map:\n
+  mappings <- many1 mappingList
+  _ <- choice [endOfLine, endOfInput] -- either a blank line or EOF
+  return mappings
+
+mappingList :: Parser Mapping
+mappingList = do
+  dst <- decimal <* space
+  src <- decimal <* space
+  size <- decimal <* endOfLine
+  return ((src, src + size), dst - src)
+
+part1 :: Input -> Int
+part1 (seeds, mappings) = solution [(x, x+1) | x <- seeds] mappings
+
+part2 :: Input -> Int
+part2 (seeds, mappings) = solution (toRange $ toPairs seeds) mappings
+
+solution :: [Range] -> [[Mapping]] -> Int
+solution ranges mappings = fst $ head $ filter (\(_, v) -> any (`inRange` v) ranges) $ [ (x, mapValues reversed x) | x <- [0..] ]
+  where reversed = reverseMappings mappings
+
+mapValues :: [[Mapping]] -> Int -> Int
+mapValues ms x = foldl (flip mapValue) x ms
+
+toPairs :: Ord a => [a] -> [(a, a)]
+toPairs [] = []
+toPairs [_] = error "Expected the list to have even number of elements"
+toPairs (a:b:xs) = (a, b) : toPairs xs
+
+toRange :: Num a => [(a, a)] -> [(a, a)]
+toRange xs = [(a, a + b - 1) | (a, b) <- xs]
+
+inRange :: Range -> Int -> Bool
+inRange (start, end) x = x >= start && x < end
+
+mapValue :: [Mapping] -> Int -> Int
+mapValue [] x = x
+mapValue ((range, diff):ms) x
+  | inRange range x = x + diff
+  | otherwise = mapValue ms x
+
+reverseMappings :: [[Mapping]] -> [[Mapping]]
+reverseMappings ms = reverse $ [map negateDiff m | m <- ms]
+
+negateDiff :: (Range, Int) -> (Range, Int)
+negateDiff ((start, end), diff) = ((start + diff, end + diff), -diff)

2023/05/example

@@ -0,0 +1,33 @@
+seeds: 79 14 55 13
+
+seed-to-soil map:
+50 98 2
+52 50 48
+
+soil-to-fertilizer map:
+0 15 37
+37 52 2
+39 0 15
+
+fertilizer-to-water map:
+49 53 8
+0 11 42
+42 0 7
+57 7 4
+
+water-to-light map:
+88 18 7
+18 25 70
+
+light-to-temperature map:
+45 77 23
+81 45 19
+68 64 13
+
+temperature-to-humidity map:
+0 69 1
+1 0 69
+
+humidity-to-location map:
+60 56 37
+56 93 4

2023/flake.lock

@@ -0,0 +1,60 @@
+{
+  "nodes": {
+    "flake-utils": {
+      "inputs": {
+        "systems": "systems"
+      },
+      "locked": {
+        "lastModified": 1701680307,
+        "narHash": "sha256-kAuep2h5ajznlPMD9rnQyffWG8EM/C73lejGofXvdM8=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "4022d587cbbfd70fe950c1e2083a02621806a725",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1701680448,
+        "narHash": "sha256-jyBmBxAIOgSxuViuffo4ah8+NRHfY/9ByozjiLk/rf4=",
+        "owner": "nixos",
+        "repo": "nixpkgs",
+        "rev": "6f3d9c7288802bd463f1419c1354a2d8b5ad1d9a",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nixos",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "root": {
+      "inputs": {
+        "flake-utils": "flake-utils",
+        "nixpkgs": "nixpkgs"
+      }
+    },
+    "systems": {
+      "locked": {
+        "lastModified": 1681028828,
+        "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
+        "owner": "nix-systems",
+        "repo": "default",
+        "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nix-systems",
+        "repo": "default",
+        "type": "github"
+      }
+    }
+  },
+  "root": "root",
+  "version": 7
+}

2023/flake.nix

@@ -0,0 +1,20 @@
+{
+  description = "A flake for pulling in dependencies.";
+
+  inputs = {
+
+    nixpkgs.url = "github:nixos/nixpkgs";
+    flake-utils.url = "github:numtide/flake-utils";
+  };
+
+  outputs = { self, nixpkgs, flake-utils, ... }:
+    flake-utils.lib.eachDefaultSystem (system:
+      let
+        pkgs = import nixpkgs { inherit system; };
+      in rec {
+        devShells.default = with pkgs; mkShell {
+          buildInputs = [ ghc haskell-language-server cabal-install ];
+        };
+      }
+    );
+}