From 1ab2865a3286aa0a1340e3bad742fde3f7871996 Mon Sep 17 00:00:00 2001
From: Maciej Jur <maciej@kamoshi.org>
Date: Sat, 16 Dec 2023 17:01:59 +0100
Subject: [PATCH] haskell: 2023 11 b

---
 2023/haskell/app/Main.hs        |  2 +-
 2023/haskell/solutions/Day11.hs | 33 ++++++++++++++-------------------
 2023/haskell/tests/Main.hs      |  3 ++-
 3 files changed, 17 insertions(+), 21 deletions(-)

diff --git a/2023/haskell/app/Main.hs b/2023/haskell/app/Main.hs
index 7048b56..db4156f 100644
--- a/2023/haskell/app/Main.hs
+++ b/2023/haskell/app/Main.hs
@@ -43,5 +43,5 @@ main = do
   --run 08 Day08.parse Day08.solveA Day08.solveB
   --run 09 Day09.parse Day09.solveA Day09.solveB
   --run 10 Day10.parse Day10.solveA Day10.solveB
-  run 11 Day11.parse Day11.solveA Day11.solveA
+  run 11 Day11.parse Day11.solveA Day11.solveB
   --run 15 Day15.parse Day15.solveA Day15.solveB
diff --git a/2023/haskell/solutions/Day11.hs b/2023/haskell/solutions/Day11.hs
index 3e2ade1..8f0ea2b 100644
--- a/2023/haskell/solutions/Day11.hs
+++ b/2023/haskell/solutions/Day11.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Day11 (parse, solveA) where
+module Day11 (parse, solveA, solveB) where
 
 import Data.Void (Void)
 import Data.Text (Text)
@@ -31,19 +31,6 @@ parse = first errorBundlePretty . runParser grid ""
 pairs :: [a] -> [(a, a)]
 pairs xs = [(x, y) | (x:ys) <- tails xs, y <- ys]
 
-input :: Text
-input =
-  "...#......\n\
-  \.......#..\n\
-  \#.........\n\
-  \..........\n\
-  \......#...\n\
-  \.#........\n\
-  \.........#\n\
-  \..........\n\
-  \.......#..\n\
-  \#...#.....\n"
-
 expanded :: Grid -> ([Row], [Col])
 expanded = bimap filterE (filterE . transpose) . join (,)
   where
@@ -53,8 +40,8 @@ expanded = bimap filterE (filterE . transpose) . join (,)
 galaxies :: Grid -> [(Row, Col)]
 galaxies = map fst . filter ((G ==) . snd) . withCoords
 
-solveA :: Grid -> Int
-solveA = do
+solve :: Int -> Grid -> Int
+solve m = do
   gs <- galaxies
   es <- expanded
   return $ sum . map (distance es) . pairs $ gs
@@ -66,8 +53,16 @@ solveA = do
     crossed :: Int -> Int -> [Int] -> Int
     crossed a b = length . filter (between a b)
     distance :: ([Row], [Col]) -> ((Row, Col), (Row, Col)) -> Int
-    distance (rs, cs) ((r1, c1), (r2, c2)) = abs (r1 - r2) + abs (c1 - c2) + crossed r1 r2 rs + crossed c1 c2 cs
+    distance (rs, cs) ((r1, c1), (r2, c2)) =
+      let dr = abs (r1 - r2)
+          dc = abs (c1 - c2)
+          m' = (m - 1)
+          er = m' * crossed r1 r2 rs
+          ec = m' * crossed c1 c2 cs
+      in dr + dc + er + ec
 
--- >>> solveA <$> parse input
--- Right 374
+solveA :: Grid -> Int
+solveA = solve 2
 
+solveB :: Grid -> Int
+solveB = solve 1000000
diff --git a/2023/haskell/tests/Main.hs b/2023/haskell/tests/Main.hs
index e9f7e63..c0b6ec1 100644
--- a/2023/haskell/tests/Main.hs
+++ b/2023/haskell/tests/Main.hs
@@ -281,7 +281,8 @@ day11 :: Test
 day11 =
   let parsed = Day11.parse input
   in TestList
-    [ TestCase $ assertEqual "A" (Right 374) (Day11.solveA <$> parsed)
+    [ TestCase $ assertEqual "A" (Right 374)      (Day11.solveA <$> parsed)
+    , TestCase $ assertEqual "B" (Right 82000210) (Day11.solveB <$> parsed)
     ]
   where
     input =