From ded4fc4475ef0a1fc946ac372c28ca48f16951e6 Mon Sep 17 00:00:00 2001
From: Eric Mertens <emertens@gmail.com>
Date: Tue, 12 Dec 2023 22:02:53 -0800
Subject: [PATCH] 2023-13

---
 solutions/solutions.cabal |  4 +++
 solutions/src/2023/13.hs  | 70 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 74 insertions(+)
 create mode 100644 solutions/src/2023/13.hs

diff --git a/solutions/solutions.cabal b/solutions/solutions.cabal
index dbc2075..d25ef14 100644
--- a/solutions/solutions.cabal
+++ b/solutions/solutions.cabal
@@ -1045,3 +1045,7 @@ executable sln_2023_12
   import:              day
   main-is:             2023/12.hs
   build-depends:       array
+
+executable sln_2023_13
+  import:              day
+  main-is:             2023/13.hs
diff --git a/solutions/src/2023/13.hs b/solutions/src/2023/13.hs
new file mode 100644
index 0000000..b7e87a6
--- /dev/null
+++ b/solutions/src/2023/13.hs
@@ -0,0 +1,70 @@
+{-# Language QuasiQuotes #-}
+{-|
+Module      : Main
+Description : Day 13 solution
+Copyright   : (c) Eric Mertens, 2023
+License     : ISC
+Maintainer  : emertens@gmail.com
+
+<https://adventofcode.com/2023/day/13>
+
+>>> :{
+:main +
+"#.##..##.
+..#.##.#.
+##......#
+##......#
+..#.##.#.
+..##..##.
+#.#.##.#.\n
+#...##..#
+#....#..#
+..##..###
+#####.##.
+#####.##.
+..##..###
+#....#..#
+"
+:}
+405
+400
+
+-}
+module Main (main) where
+
+import Advent (format)
+import Data.List (inits, tails, transpose)
+
+-- |
+--
+-- >>> :main
+-- 28895
+-- 31603
+main :: IO ()
+main =
+ do input <- [format|2023 13 (%s%n)*&%n|]
+    print (sum (concatMap (solver 0) input))
+    print (sum (concatMap solver' input))
+
+findReflection :: Int {- ^ differences -} -> [String] -> [Int]
+findReflection target xs =
+  [ i
+  | (i,l,r) <- zip3 [0..] (inits xs) (tails xs)
+  , not (null l), not (null r)
+  , target == sum (zipWith (\x y -> sum (zipWith val x y)) (reverse l) r)
+  ]
+
+solver :: Int -> [String] -> [Int]
+solver target xs = findReflection target (transpose xs) ++ map (100*) (findReflection target xs)
+
+solver' :: [String] -> [Int]
+solver' xs =
+  take 1
+  [ new
+  | old <- solver 0 xs
+  , new <- solver 1 xs
+  , new /= old
+  ]
+
+val :: Char -> Char -> Int
+val x y = if x == y then 0 else 1