advent-of-code-ocr (empty) → 0.1.0.0

raw patch · 11 files changed

+823/−0 lines, 11 filesdep +advent-of-code-ocrdep +basedep +containerssetup-changed

Dependencies added: advent-of-code-ocr, base, containers, criterion, data-default-class, heredoc, hspec, optparse-applicative, template-haskell, th-lift, th-lift-instances

Files

• CHANGELOG.md +11/−0
• LICENSE +30/−0
• README.md +51/−0
• Setup.hs +2/−0
• advent-of-code-ocr.cabal +108/−0
• app/ocr.hs +39/−0
• bench/bench.hs +37/−0
• src/Advent/OCR.hs +153/−0
• src/Advent/OCR/Internal.hs +85/−0
• src/Advent/OCR/LetterMap.hs +238/−0
• test/Spec.hs +69/−0

@@ -0,0 +1,11 @@+Changelog+=========++Version 0.1.0.0+---------------++*November 24, 2020*++<https://github.com/mstksg/advent-of-code-ocr/releases/tag/v0.1.0.0>++*   Initial Release

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,51 @@+# advent-of-code-ocr++"OCR" letter recognition for [Advent of Code][aoc] puzzles, compatible with all+puzzles from 2015 to 2019.  Also comes with a handy command line utility to+parse the ASCII art directly from stdin:++[aoc]: https://adventofcode.com++```+$ cat abc.txt+.##..###...##.+#..#.#..#.#..#+#..#.###..#...+####.#..#.#...+#..#.#..#.#..#+#..#.###...##.+$ cat abc.txt | advent-of-code-ocr+ABC+```++## Installation++To use as a library, add *advent-of-code-ocr* as a hackage dependency like you+would any other.++To use as an executable:++```bash+# using stack+stack install advent-of-code-ocr+# using cabal+cabal install advent-of-code-ocr+# from source+git clone https://github.com/mstksg/advent-of-code-ocr+cd advent-of-code-ocr+cabal install     # or stack install+```++## Compatibility++Should be compatible with all challenges from 2015 to 2019.  However, I have+only tested it with:+++*   2016 Day 8+*   2018 Day 10+*   2019 Day 8+*   2019 Day 11++And it is possible I have missed some.  If you notice any I am missing, please+let me know!

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,108 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 0805d230cfe0698678c80d553c5e6fddf779fa9b6dc4a8ce5afee7dd03dd3c74++name:           advent-of-code-ocr+version:        0.1.0.0+synopsis:       Parse Advent of Code ASCII art letters+description:    "OCR" letter recognition for <https://adventofcode.com Advent of Code>+                puzzles, compatible with all puzzles from 2015 to 2019.  Also comes with a+                handy command line utility to parse the ASCII art directly from stdin.+category:       Text+homepage:       https://github.com/mstksg/advent-of-code-ocr#readme+bug-reports:    https://github.com/mstksg/advent-of-code-ocr/issues+author:         Justin Le+maintainer:     justin@jle.im+copyright:      2020 Justin Le+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/mstksg/advent-of-code-ocr++library+  exposed-modules:+      Advent.OCR+      Advent.OCR.Internal+  other-modules:+      Advent.OCR.LetterMap+  hs-source-dirs:+      src+  ghc-options: -Wall -Werror=incomplete-patterns -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , containers+    , data-default-class+    , heredoc+    , template-haskell+    , th-lift+    , th-lift-instances+  default-language: Haskell2010++executable advent-of-code-ocr+  main-is: ocr.hs+  other-modules:+      Paths_advent_of_code_ocr+  hs-source-dirs:+      app+  ghc-options: -Wall -Werror=incomplete-patterns -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      advent-of-code-ocr+    , base >=4.7 && <5+    , containers+    , data-default-class+    , heredoc+    , optparse-applicative+    , template-haskell+    , th-lift+    , th-lift-instances+  default-language: Haskell2010++test-suite advent-of-code-ocr-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_advent_of_code_ocr+  hs-source-dirs:+      test+  ghc-options: -Wall -Werror=incomplete-patterns -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      advent-of-code-ocr+    , base >=4.7 && <5+    , containers+    , data-default-class+    , heredoc+    , hspec+    , template-haskell+    , th-lift+    , th-lift-instances+  default-language: Haskell2010++benchmark advent-of-code-ocr-bench+  type: exitcode-stdio-1.0+  main-is: bench.hs+  other-modules:+      Paths_advent_of_code_ocr+  hs-source-dirs:+      bench+  ghc-options: -Wall -Werror=incomplete-patterns -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N -O2+  build-depends:+      advent-of-code-ocr+    , base >=4.7 && <5+    , containers+    , criterion+    , data-default-class+    , heredoc+    , template-haskell+    , th-lift+    , th-lift-instances+  default-language: Haskell2010

@@ -0,0 +1,39 @@+{-# LANGUAGE LambdaCase      #-}+{-# LANGUAGE RecordWildCards #-}++import           Advent.OCR+import           Options.Applicative+import           System.Exit+import           System.IO+import qualified Data.Set            as S++data Opts = Opts+    { oChars :: S.Set Char+    }+  deriving Show++parseOpts :: Parser Opts+parseOpts = Opts <$>+    option (S.fromList <$> str)+      ( long "chars"+     <> short 'c'+     <> help "characters to treat as \"on\"/included"+     <> value (S.singleton '#')+     <> showDefaultWith S.toList+     <> metavar "CHARS"+      )++main :: IO ()+main = do+    Opts{..} <- execParser $+      info (parseOpts <**> helper)+        ( fullDesc+       <> progDesc "Parse an ASCII image into its letters."+       <> header "advent-of-code-orc - Advent of Code ASCII parser"+        )+    inp <- getContents+    case asciiMapToLetters oChars inp of+      Nothing  -> do+        hPutStrLn stderr "No valid parse"+        exitFailure+      Just res -> putStrLn res

@@ -0,0 +1,37 @@+{-# LANGUAGE QuasiQuotes #-}++import           Advent.OCR+import           Criterion.Main+import           Data.Set       (Set)+import           Text.Heredoc+import qualified Data.Set       as S++main :: IO ()+main = defaultMainWith defaultConfig [+    bench "small font" $ nf parseLetters smallFont+  , bench "large font" $ nf parseLetters bigFont+  ]++smallFont :: Set (Int, Int)+smallFont = parseAsciiMap (S.singleton '#') $ drop 1 [here|+####...##.#..#.###..#..#..##..###..#...+...#....#.#..#.#..#.#.#..#..#.#..#.#...+..#.....#.####.#..#.##...#....#..#.#...+.#......#.#..#.###..#.#..#....###..#...+#....#..#.#..#.#.#..#.#..#..#.#....#...+####..##..#..#.#..#.#..#..##..#....####+|]++bigFont :: Set (Int, Int)+bigFont = parseAsciiMap (S.singleton '#') $ drop 1 [here|+..##....#....#..######..#.......#........####.....##....#.....+.#..#...#....#.......#..#.......#.......#....#...#..#...#.....+#....#..#....#.......#..#.......#.......#.......#....#..#.....+#....#..#....#......#...#.......#.......#.......#....#..#.....+#....#..######.....#....#.......#.......#.......#....#..#.....+######..#....#....#.....#.......#.......#.......######..#.....+#....#..#....#...#......#.......#.......#.......#....#..#.....+#....#..#....#..#.......#.......#.......#.......#....#..#.....+#....#..#....#..#.......#.......#.......#....#..#....#..#.....+#....#..#....#..######..######..######...####...#....#..######+|]

@@ -0,0 +1,153 @@+-- |+-- Module      : Advent.OCR+-- Copyright   : (c) Justin Le 2020+-- License     : BSD3+--+-- Maintainer  : justin@jle.im+-- Stability   : experimental+-- Portability : non-portable+--+-- Library to parse "ASCII Art" letters from <https://adventofcode.com+-- Advent of Code> puzzles.  Compatible with all puzzles from 2015 to 2019.+--+module Advent.OCR (+  -- * Parse+    parseLetters+  , parseLettersWith+  , parseLettersEither+  , unsafeParseLetters+  , parseAsciiMap+  , asciiMapToLetters+  -- * Letter Map+  , LetterMap+  , defaultLetterMap+  -- ** Custom Letter Map+  , parseLetters'+  , parseLettersWith'+  , parseLettersEither'+  , unsafeParseLetters'+  , asciiMapToLetters'+  ) where++import           Advent.OCR.Internal+import           Data.Bifunctor+import           Data.Maybe+import           Data.Set            (Set)+import qualified Data.Set            as S++-- | A version of 'parseLettersWith'' accepting a custom 'LetterMap'+-- letterform database.+parseLettersWith'+    :: LetterMap        -- ^ database of letterforms+    -> (a -> Int)       -- ^ get X+    -> (a -> Int)       -- ^ get Y+    -> Set a+    -> Maybe String+parseLettersWith' lm f g = parseLettersV2 lm . S.map (\x -> V2 (f x) (g x))++-- | A version of 'parseLetters' that takes a set of any type of value, as+-- long as you provide functions to access the X and Y coordinates.+parseLettersWith+    :: (a -> Int)       -- ^ get X+    -> (a -> Int)       -- ^ get Y+    -> Set a+    -> Maybe String+parseLettersWith = parseLettersWith' defaultLetterMap++-- | A version of 'parseLetters'' accepting a custom 'LetterMap' letterform+-- database.+parseLetters'+    :: LetterMap            -- ^ database of letterforms+    -> Set (Int, Int)       -- ^ set of points+    -> Maybe String         -- ^ result, with unknown letters replaced with "?"+parseLetters' lm = parseLettersV2 lm . S.mapMonotonic (uncurry V2)++-- | The go-to default: given a set of point coordinates, parse it into+-- the string it represents.  Should be compatible with any Advent of Code+-- challenge from 2015 to 2019.+--+-- @+-- 'parseLetters' 'defaultLetterMap' myPoints+--+-- -- or, using Data.Default+-- 'parseLetters' 'Data.Default.Class.def' myPoints+-- @+--+-- A 'Nothing' means that there were no recognized letters found.  A 'Just'+-- means that least 50% of letter forms are recognized.  Unrecognized+-- characters will be replaced with "?"; for more information, use+-- 'parseLettersEither'.+--+-- This function is robust to changes in orientation or flipping, but will+-- be fastest if the coordinates are oriented with (0,0) on the upper left+-- corner.  However, because of this, it might return the wrong answer if+-- your coordinates are /not/ oriented this way and your result is+-- symmetrical: it'll always prioritize the interpretaion against (0,0)+-- upper-left orientation first.+parseLetters+    :: Set (Int, Int)       -- ^ set of points+    -> Maybe String         -- ^ result, with unknown letters replaced with "?"+parseLetters = parseLetters' defaultLetterMap++-- | A version of 'parseLettersEither'' accepting a custom 'LetterMap'+-- letterform database.+parseLettersEither'+    :: LetterMap            -- ^ database of letterforms+    -> Set (Int, Int)+    -> Maybe [Either (Set (Int, Int)) Char]+parseLettersEither' lm = (fmap . map . first . S.mapMonotonic) (\(V2 x y) -> (x, y))+                      . parseLettersEitherV2 lm+                      . S.mapMonotonic (uncurry V2)++-- | A version of 'parseLetters' returning a list of characters that were+-- either recognized or unrecognized; in the case of unrecognized+-- characters, returns the set of their coordinates but shifted to (0, 0)+-- as its upper left corner.+parseLettersEither+    :: Set (Int, Int)+    -> Maybe [Either (Set (Int, Int)) Char]+parseLettersEither = parseLettersEither' defaultLetterMap++-- | A version of 'unsafeParseLetters'' accepting a custom 'LetterMap'+-- letterform database.+unsafeParseLetters'+    :: LetterMap+    -> Set (Int, Int)+    -> String+unsafeParseLetters' lm =+      fromMaybe (error "Advent.OCR.unsafeParseLetters': Unable to parse letters")+    . parseLetters' lm++-- | A version of 'parseLetters' that will be undefined ('error') when no+-- parse is found.+unsafeParseLetters+    :: Set (Int, Int)+    -> String+unsafeParseLetters =+      fromMaybe (error "Advent.OCR.unsafeParseLetters: Unable to parse letters")+    . parseLetters++-- | Parse raw ASCII art into a set of points, usable with+-- 'parseLetters'.+parseAsciiMap+    :: Set Char             -- ^ characters to use as "on"/included+    -> String               -- ^ raw ASCII art+    -> Set (Int, Int)+parseAsciiMap c = S.mapMonotonic (\(V2 x y) -> (x, y)) . parseAsciiMapV2 c++-- | A version of 'asciiMapToLetters'' accepting a custom 'LetterMap'+-- letterform database.+asciiMapToLetters'+    :: Set Char             -- ^ characters to use as "on"/included in ASCII art+    -> LetterMap            -- ^ database of letterforms+    -> String               -- ^ raw ASCII art+    -> Maybe String+asciiMapToLetters' c lm = parseLettersV2 lm . parseAsciiMapV2 c++-- | Convenient all-in-one utility function combining 'parseAsciiMap' and+-- 'parseLetters', to directly parse ASCII art into its letters.+asciiMapToLetters+    :: Set Char             -- ^ characters to use as "on"/included in ASCII art+    -> String               -- ^ raw ASCII art+    -> Maybe String+asciiMapToLetters c = asciiMapToLetters' c defaultLetterMap

@@ -0,0 +1,85 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections   #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Module      : Advent.OCR.Internal+-- Copyright   : (c) Justin Le 2020+-- License     : BSD3+--+-- Maintainer  : justin@jle.im+-- Stability   : experimental+-- Portability : non-portable+--+-- Internal utility functions for "Advent.OCR".+++module Advent.OCR.Internal (+  -- * Parse+    V2(..)+  , Point+  , parseLettersV2+  , parseLettersEitherV2+  , parseAsciiMapV2+  -- * Letter Map+  , LetterMap(..)+  , lookupLetterMap+  , defaultLetterMap+  , rawLetterforms1+  , rawLetterforms2+  , parseLetterMap+  -- * Utility+  , contiguousShapes+  , contiguousShapesBy+  ) where++import           Advent.OCR.LetterMap+import           Data.Default.Class+import           Data.Maybe+import           Data.Monoid+import           Data.Set                   (Set)+import           Language.Haskell.TH.Lift+import qualified Data.Set                   as S++-- | A version of 'Advent.OCR.parseLetters' taking 'Point'.  Used+-- internally.+parseLettersV2+    :: LetterMap+    -> Set Point+    -> Maybe String+parseLettersV2 lm = (fmap . map) (either (const '?') id)+                  . parseLettersEitherV2 lm++-- | A version of 'Advent.OCR.parseLettersEither' taking (and returning)+-- 'Point'. Used internally.+parseLettersEitherV2+    :: LetterMap+    -> Set Point+    -> Maybe [Either (Set Point) Char]+parseLettersEitherV2 lm letters = listToMaybe attempts+  where+    attempts =+      [ res+      | refl <- [id, reflX]+      , rots <- [id, perp, negate, negate . perp]+      , let ls = S.map (rots . refl) letters+            ((Sum n, Sum goodCount), res) = tryMe ls+            percGood = goodCount / n :: Double+      , n > 0 && percGood >= 0.5+      ]+    tryMe = traverse (\c -> maybe ((Sum 1, Sum 0), Left c) (((Sum 1, Sum 1),) . Right) . lookupLetterMap c $ lm)+          . contiguousShapesBy v2x+    perp (V2 x y) = V2 (negate y) x+    reflX (V2 x y) = V2 (negate x) y++-- | Default is compatible with all challenges in Advent of Code 2015 to+-- 2019.+instance Default LetterMap where+    def = defaultLetterMap++-- | The default lettermap compatible all challenges in Advent of Code 2015+-- - 2019.+defaultLetterMap :: LetterMap+defaultLetterMap = $( lift $ uncurry parseLetterMap rawLetterforms1+                          <> uncurry parseLetterMap rawLetterforms2+                    )

@@ -0,0 +1,238 @@+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE QuasiQuotes                #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TemplateHaskell            #-}++module Advent.OCR.LetterMap (+    LetterMap(..)+  , V2(..)+  , Point+  , contiguousShapes+  , contiguousShapesBy+  , parseAsciiMapV2+  , rawLetterforms1+  , rawLetterforms2+  , parseLetterMap+  , lookupLetterMap+  ) where++import           Data.Data                  (Data)+import           Data.Foldable+import           Data.Map                   (Map)+import           Data.Monoid+import           Data.Semigroup+import           Data.Set                   (Set)+import           GHC.Generics+import           Instances.TH.Lift          ()+import           Language.Haskell.TH.Lift+import           Language.Haskell.TH.Syntax+import           Text.Heredoc               (here)+import qualified Data.Map                   as M+import qualified Data.Set                   as S++-- | Type used internally to represent points; useful for its 'Num' and+-- 'Applicative' instances.+data V2 a = V2 { v2x :: !a, v2y :: !a }+  deriving (Show, Functor, Eq, Ord, Generic, Data)++instance Applicative V2 where+    pure x = V2 x x+    V2 fx fy <*> V2 x y = V2 (fx x) (fy y)++instance Num a => Num (V2 a) where+    V2 x1 y1 + V2 x2 y2 = V2 (x1 + x2) (y1 + y2)+    V2 x1 y1 - V2 x2 y2 = V2 (x1 - x2) (y1 - y2)+    V2 x1 y1 * V2 x2 y2 = V2 (x1 * x2) (y1 * y2)+    negate (V2 x y) = V2 (negate x) (negate y)+    abs (V2 x y) = V2 (abs x) (abs y)+    signum (V2 x y) = V2 (signum x) (signum y)+    fromInteger x = V2 (fromInteger x) (fromInteger x)++instance Fractional a => Fractional (V2 a) where+    recip (V2 x y) = V2 (recip x) (recip y)+    V2 x1 y1 / V2 x2 y2 = V2 (x1 / x2) (y1 / y2)+    fromRational x = V2 (fromRational x) (fromRational x)++instance Lift a => Lift (V2 a) where+    lift (V2 x y) = do+      lx <- lift x+      ly <- lift y+      pure $ AppE (AppE (ConE 'V2) lx) ly+#if MIN_VERSION_template_haskell(2,16,0)+    liftTyped = fmap TExp . lift+#endif++-- | A point is a 2-vector of ints.+type Point = V2 Int++-- | The set of unconnected shapes, indexed by their original center of+-- mass+contiguousShapes :: Set Point -> Map (V2 Double) (Set (Set Point))+contiguousShapes s0 = M.fromListWith (<>)+    [ (com, S.singleton (S.map (subtract topCorner) s))+    | s <- allSubgraphs (S.fromList . fullNeighbs) s0+    , let com            = mean (fmap fromIntegral) s+          V2 topCorner _ = boundingBox s+    ]++allSubgraphs+    :: forall a. Ord a+    => (a -> Set a)     -- ^ Expansion+    -> Set a            -- ^ points+    -> [Set a]+allSubgraphs f = go []+  where+    go !seen !rest = case S.minView rest of+      Nothing      -> seen+      Just (x, xs) ->+        let new = floodFill (S.intersection xs . f) (S.singleton x)+        in  go (new : seen) (xs `S.difference` new)++-- | The set of unconnected shapes, sorted against some function on their+-- original center of masses.+contiguousShapesBy+    :: Ord a+    => (V2 Double -> a)+    -> Set Point+    -> [Set Point]+contiguousShapesBy f = concatMap toList . M.mapKeys f . contiguousShapes++floodFill+    :: Ord a+    => (a -> Set a)     -- ^ Expansion (be sure to limit allowed points)+    -> Set a            -- ^ Start points+    -> Set a            -- ^ Flood filled, with count of number of steps+floodFill f = go S.empty+  where+    go !innr !outr+        | S.null outr' = innr'+        | otherwise    = go innr' outr'+      where+        innr' = S.union innr outr+        outr' = foldMap f outr `S.difference` innr'++fullNeighbs :: Point -> [Point]+fullNeighbs p = [ p + V2 dx dy+                | dx <- [-1 .. 1]+                , dy <- if dx == 0 then [-1,1] else [-1..1]+                ]++boundingBox :: (Bounded a, Foldable f, Applicative g, Ord a) => f (g a) -> V2 (g a)+boundingBox = (\(Ap mn, Ap mx) -> V2 (getMin <$> mn) (getMax <$> mx))+            . foldMap (\p -> (Ap (Min <$> p), Ap (Max <$> p)))++-- | will error if empty list+mean :: (Foldable f, Fractional b) => (a -> b) -> f a -> b+mean f xs0 = sx1 / sx0+  where+    (sx0, sx1) = go 0 0 (toList xs0)+    go !x0 !x1 = \case+      []   -> (x0, x1)+      x:xs -> go (x0 + 1) (x1 + f x) xs++-- | A database associating a set of "on" points to the+-- letter they represent.+--+-- See 'Advent.OCR.Internal.defaultLetterMap' for a database compatible+-- with Advent of Code 2015-2019.+newtype LetterMap = LetterMap { getLetterMap :: Map (Set Point) Char }+  deriving (Show, Eq, Ord, Semigroup, Monoid, Generic, Data)++instance Lift LetterMap where+    lift (LetterMap x) = AppE (ConE 'LetterMap) <$> lift x+#if MIN_VERSION_template_haskell(2,16,0)+    liftTyped = fmap TExp . lift+#endif++-- | Lookup a set of points for the letter it represents in a 'LetterMap'.+-- The set is expected to be aligned with (0,0) as the upper left corner of+-- its obunding box.+lookupLetterMap :: Set Point -> LetterMap -> Maybe Char+lookupLetterMap k = M.lookup k . getLetterMap++-- | Given a list of characters and ASCII art for all those characters+-- (from left to right), builds the appropriate 'LetterMap'.+--+-- An example usage would be:+--+-- @+-- 'parseLetterMap' "ABC" abcArt+-- @+--+-- where @abcArt@ is:+--+-- > .##..###...##.+-- > #..#.#..#.#..#+-- > #..#.###..#...+-- > ####.#..#.#...+-- > #..#.#..#.#..#+-- > #..#.###...##.+--+-- Expects ASCII art where @#@ is the "on"/included character.+parseLetterMap :: [Char] -> String -> LetterMap+parseLetterMap ls = LetterMap+                  . M.fromList+                  . zipWith (flip (,)) ls+                  . contiguousShapesBy v2x+                  . parseAsciiMapV2 (S.singleton '#')++-- | Parse raw ASCII art into a set of points, usable with+-- 'Advent.OCR.Internal.parseLettersV2'.+parseAsciiMapV2+    :: Set Char             -- ^ characters to use as "on"/included+    -> String               -- ^ raw map ASCII art+    -> Set Point+parseAsciiMapV2 c = zipWithFold (\j -> zipWithFold (\i x ->+                        if x `S.member` c+                          then S.singleton (V2 i j)+                          else S.empty+                      ) [0..]) [0..]+                  . lines++zipWithFold+    :: Monoid m+    => (a -> b -> m)+    -> [a]+    -> [b]+    -> m+zipWithFold f xs = fold . zipWith f xs++-- | Seen in 2016 Day 8, 2019 Day 8 and 11.  4x6 glyphs.+--+-- Load using @uncurry 'parseLetterMap'@.+rawLetterforms1 :: (String, String)+rawLetterforms1 = ("ABCEFGHJKLPRUYZ", drop 1 [here|+.##..###...##..####.####..##..#..#...##.#..#.#....###..###..#..#.#...#.####+#..#.#..#.#..#.#....#....#..#.#..#....#.#.#..#....#..#.#..#.#..#.#...#....#+#..#.###..#....###..###..#....####....#.##...#....#..#.#..#.#..#..#.#....#.+####.#..#.#....#....#....#.##.#..#....#.#.#..#....###..###..#..#...#....#..+#..#.#..#.#..#.#....#....#..#.#..#.#..#.#.#..#....#....#.#..#..#...#...#...+#..#.###...##..####.#.....###.#..#..##..#..#.####.#....#..#..##....#...####+|])++-- | Based on+-- <https://gist.github.com/usbpc/5fa0be48ad7b4b0594b3b8b029bc47b4>.  6x10+-- glyphs.+--+-- Seen in 2018 Day 10.+--+-- Load using @uncurry 'parseLetterMap'@.+rawLetterforms2 :: (String, String)+rawLetterforms2 = ("ABCEFGHJKLNPRXZ", drop 1 [here|+..##...#####...####..######.######..####..#....#....###.#....#.#......#....#.#####..#####..#....#.######+.#..#..#....#.#....#.#......#......#....#.#....#.....#..#...#..#......##...#.#....#.#....#.#....#......#+#....#.#....#.#......#......#......#......#....#.....#..#..#...#......##...#.#....#.#....#..#..#.......#+#....#.#....#.#......#......#......#......#....#.....#..#.#....#......#.#..#.#....#.#....#..#..#......#.+#....#.#####..#......#####..#####..#......######.....#..##.....#......#.#..#.#####..#####....##......#..+######.#....#.#......#......#......#..###.#....#.....#..##.....#......#..#.#.#......#..#.....##.....#...+#....#.#....#.#......#......#......#....#.#....#.....#..#.#....#......#..#.#.#......#...#...#..#...#....+#....#.#....#.#......#......#......#....#.#....#.#...#..#..#...#......#...##.#......#...#...#..#..#.....+#....#.#....#.#....#.#......#......#...##.#....#.#...#..#...#..#......#...##.#......#....#.#....#.#.....+#....#.#####...####..######.#.......###.#.#....#..###...#....#.######.#....#.#......#....#.#....#.######+|])

@@ -0,0 +1,69 @@+{-# LANGUAGE QuasiQuotes #-}++import           Advent.OCR+import           Test.Hspec+import           Text.Heredoc+import qualified Data.Set     as S++main :: IO ()+main = hspec $ do+    describe "2016 Day 8" $ do+      it "should parse a sample result correctly" $ do+        asciiMapToLetters (S.singleton '#') y2016d08+            `shouldBe` Just "ZJHRKCPLYJ"+    describe "2018 Day 10" $ do+      it "should parse a sample result correctly" $ do+        asciiMapToLetters (S.singleton '#') y2018d10+            `shouldBe` Just "AHZLLCAL"+    describe "2019 Day 8" $ do+      it "should parse a sample result correctly" $ do+        asciiMapToLetters (S.singleton '#') y2019d08+            `shouldBe` Just "UBUFP"+    describe "2019 Day 11" $ do+      it "should parse a sample result correctly, even mirrored" $ do+        asciiMapToLetters (S.singleton '#') y2019d11+            `shouldBe` Just "JKZLZJBH"++y2016d08 :: String+y2016d08 = drop 1 [here|+####...##.#..#.###..#..#..##..###..#....#...#..##+...#....#.#..#.#..#.#.#..#..#.#..#.#....#...#...#+..#.....#.####.#..#.##...#....#..#.#.....#.#....#+.#......#.#..#.###..#.#..#....###..#......#.....#+#....#..#.#..#.#.#..#.#..#..#.#....#......#..#..#+####..##..#..#.#..#.#..#..##..#....####...#...##.+|]++y2018d10 :: String+y2018d10 = drop 1 [here|+..##....#....#..######..#.......#........####.....##....#.....+.#..#...#....#.......#..#.......#.......#....#...#..#...#.....+#....#..#....#.......#..#.......#.......#.......#....#..#.....+#....#..#....#......#...#.......#.......#.......#....#..#.....+#....#..######.....#....#.......#.......#.......#....#..#.....+######..#....#....#.....#.......#.......#.......######..#.....+#....#..#....#...#......#.......#.......#.......#....#..#.....+#....#..#....#..#.......#.......#.......#.......#....#..#.....+#....#..#....#..#.......#.......#.......#....#..#....#..#.....+#....#..#....#..######..######..######...####...#....#..######+|]++y2019d08 :: String+y2019d08 = drop 1 [here|+#..#.###..#..#.####.###.+#..#.#..#.#..#.#....#..#+#..#.###..#..#.###..#..#+#..#.#..#.#..#.#....###.+#..#.#..#.#..#.#....#...+.##..###...##..#....#...+|]++y2019d11 :: String+y2019d11 = drop 1 [here|+.##..#..#.####.####.####..##..###..#..#+#..#.#.#..#....#....#....#..#.#..#.#..#+...#.#.#...#...#.....#......#.#..#.#..#+...#.##.....#..#......#.....#.###..####+...#.#.#.....#.#.......#....#.#..#.#..#+..##.#..#.####.#....####...##.###..#..#+|]