Use the difference check

References:
- https://www.reddit.com/r/adventofcode/comments/18h940b/comment/kd56tbw/

Author: mnvr

13.hs

@@ -1,49 +1,35 @@
-import Control.Applicative ((<|>), asum)
+import Control.Applicative ((<|>))
 import Control.Arrow ((&&&))
-import Data.Bits (complementBit)
-import Data.List (transpose)
+import Data.List (transpose, find)
 import Data.Maybe (fromJust)
-import Numeric (readBin)
 
 main :: IO ()
 main = interact $ (++ "\n") . show . (p1 &&& p2) . parse
 
-type Pattern = ([Int], [Int])
+type Pattern = [String]
 
 parse :: String -> [Pattern]
 parse = from . lines
   where
     from [] = []
-    from ls = let (pl, rest) = span (/= "") ls in pat pl : from (drop 1 rest)
-    pat = ints &&& ints . transpose
-    ints = map int
-    int s = case readBin $ map (\c -> if c == '.' then '0' else '1') s of
-        [(i, _)] -> i
-
-rIndex :: [Int] -> Maybe Int
-rIndex = asum . rIndices
-
-rIndices :: [Int] -> [Maybe Int]
-rIndices xs = map f [1..length xs - 1]
-  where f i = let (a, b) = splitAt i xs
-                  j = min (length a) (length b)
-              in if take j (reverse a) == take j b then Just i else Nothing
-
-p1 :: [Pattern] -> Int
-p1 = sum . map (fromJust . ri)
-  where ri (rows, cols) = (*100) <$> rIndex rows <|> rIndex cols
-
-p2 :: [Pattern] -> Int
-p2 = sum . map smudge
-
-smudge :: Pattern -> Int
-smudge (rows, cols) = fromJust $ (*100) <$> rf <|> rc
-  where
-    or = rIndex rows
-    oc = rIndex cols
-    rf = asum $ filter (/= or) $ concatMap rIndices rowVariants
-    rc = asum $ filter (/= oc) $ concatMap rIndices colVariants
-    rowVariants = [flip y x rows | y <- [0..length rows - 1], x <- [0..length cols - 1]]
-    colVariants = [flip x y cols | y <- [0..length rows - 1], x <- [0..length cols - 1]]
-    flip y x ns = zipWith (\i r -> if i == y then flipBit x r else r) [0..] ns
-    flipBit x n = n `complementBit` x
+    from ls = let (pl, rest) = span (/= "") ls in pl : from (drop 1 rest)
+
+-- For all splits, find the differences across the reflection line. For part 1,
+-- where the mirroring is perfect, the won't be any difference. For part 2,
+-- where there's a single smidge, there'll be exactly one difference.
+
+reflectionLine :: Int -> [String] -> Maybe Int
+reflectionLine dx xs = find f [1..length xs - 1]
+  where f i = let (a, b) = splitAt i xs in difference (reverse a) b == dx
+
+difference :: [String] -> [String] -> Int
+difference xs = sum . zipWith rd xs
+  where rd r = sum . zipWith (\c1 c2 -> if c1 == c2 then 0 else 1) r
+
+solve :: Int -> [Pattern] -> Int
+solve dx = sum . map (fromJust . f)
+ where f p = (*100) <$> reflectionLine dx p <|> reflectionLine dx (transpose p)
+
+p1, p2 :: [Pattern] -> Int
+p1 = solve 0
+p2 = solve 1

13.string.hs renamed to 13.ints.hs

@@ -1,29 +1,34 @@
 import Control.Applicative ((<|>), asum)
 import Control.Arrow ((&&&))
+import Data.Bits (complementBit)
 import Data.List (transpose)
 import Data.Maybe (fromJust)
-
--- A variant of 13.hs that directly uses the string representation instead of
--- first converting them to their bitwise int representations. Somewhat
--- surprisingly, this is not slower. There is a slight difference when
--- optimized: under -O2 the bitwise representation version is slightly faster.
+import Numeric (readBin)
 
 main :: IO ()
 main = interact $ (++ "\n") . show . (p1 &&& p2) . parse
 
-type Pattern = ([String], [String])
+-- A variant of 13.hs that uses more explicit reflection testing. Additionally,
+-- it also uses an integer representation, although that doesn't make too big of
+-- a difference in runtime (compared to this same code, but using the strings
+-- themselves for various checks below).
+
+type Pattern = ([Int], [Int])
 
 parse :: String -> [Pattern]
 parse = from . lines
   where
     from [] = []
     from ls = let (pl, rest) = span (/= "") ls in pat pl : from (drop 1 rest)
-    pat = id &&& transpose
+    pat = ints &&& ints . transpose
+    ints = map int
+    int s = case readBin $ map (\c -> if c == '.' then '0' else '1') s of
+        [(i, _)] -> i
 
-rIndex :: [String] -> Maybe Int
+rIndex :: [Int] -> Maybe Int
 rIndex = asum . rIndices
 
-rIndices :: [String] -> [Maybe Int]
+rIndices :: [Int] -> [Maybe Int]
 rIndices xs = map f [1..length xs - 1]
   where f i = let (a, b) = splitAt i xs
                   j = min (length a) (length b)
@@ -46,6 +51,4 @@ smudge (rows, cols) = fromJust $ (*100) <$> rf <|> rc
     rowVariants = [flip y x rows | y <- [0..length rows - 1], x <- [0..length cols - 1]]
     colVariants = [flip x y cols | y <- [0..length rows - 1], x <- [0..length cols - 1]]
     flip y x ns = zipWith (\i r -> if i == y then flipBit x r else r) [0..] ns
-    flipBit x s = let (a, b:c) = splitAt x s in a ++ [flipC b] ++ c
-    flipC '.' = '#'
-    flipC '#' = '.'
+    flipBit x n = n `complementBit` x