{-# 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           Language.Haskell.TH.Syntax.Compat (liftSplice)
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 { forall a. V2 a -> a
v2x :: !a, forall a. V2 a -> a
v2y :: !a }
  deriving (Int -> V2 a -> ShowS
forall a. Show a => Int -> V2 a -> ShowS
forall a. Show a => [V2 a] -> ShowS
forall a. Show a => V2 a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V2 a] -> ShowS
$cshowList :: forall a. Show a => [V2 a] -> ShowS
show :: V2 a -> String
$cshow :: forall a. Show a => V2 a -> String
showsPrec :: Int -> V2 a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> V2 a -> ShowS
Show, forall a b. a -> V2 b -> V2 a
forall a b. (a -> b) -> V2 a -> V2 b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> V2 b -> V2 a
$c<$ :: forall a b. a -> V2 b -> V2 a
fmap :: forall a b. (a -> b) -> V2 a -> V2 b
$cfmap :: forall a b. (a -> b) -> V2 a -> V2 b
Functor, V2 a -> V2 a -> Bool
forall a. Eq a => V2 a -> V2 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V2 a -> V2 a -> Bool
$c/= :: forall a. Eq a => V2 a -> V2 a -> Bool
== :: V2 a -> V2 a -> Bool
$c== :: forall a. Eq a => V2 a -> V2 a -> Bool
Eq, V2 a -> V2 a -> Bool
V2 a -> V2 a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (V2 a)
forall a. Ord a => V2 a -> V2 a -> Bool
forall a. Ord a => V2 a -> V2 a -> Ordering
forall a. Ord a => V2 a -> V2 a -> V2 a
min :: V2 a -> V2 a -> V2 a
$cmin :: forall a. Ord a => V2 a -> V2 a -> V2 a
max :: V2 a -> V2 a -> V2 a
$cmax :: forall a. Ord a => V2 a -> V2 a -> V2 a
>= :: V2 a -> V2 a -> Bool
$c>= :: forall a. Ord a => V2 a -> V2 a -> Bool
> :: V2 a -> V2 a -> Bool
$c> :: forall a. Ord a => V2 a -> V2 a -> Bool
<= :: V2 a -> V2 a -> Bool
$c<= :: forall a. Ord a => V2 a -> V2 a -> Bool
< :: V2 a -> V2 a -> Bool
$c< :: forall a. Ord a => V2 a -> V2 a -> Bool
compare :: V2 a -> V2 a -> Ordering
$ccompare :: forall a. Ord a => V2 a -> V2 a -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (V2 a) x -> V2 a
forall a x. V2 a -> Rep (V2 a) x
$cto :: forall a x. Rep (V2 a) x -> V2 a
$cfrom :: forall a x. V2 a -> Rep (V2 a) x
Generic, V2 a -> DataType
V2 a -> Constr
forall {a}. Data a => Typeable (V2 a)
forall a. Data a => V2 a -> DataType
forall a. Data a => V2 a -> Constr
forall a. Data a => (forall b. Data b => b -> b) -> V2 a -> V2 a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> V2 a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> V2 a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> V2 a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> V2 a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> V2 a -> m (V2 a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> V2 a -> m (V2 a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (V2 a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> V2 a -> c (V2 a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (V2 a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (V2 a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (V2 a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> V2 a -> c (V2 a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (V2 a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> V2 a -> m (V2 a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> V2 a -> m (V2 a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> V2 a -> m (V2 a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> V2 a -> m (V2 a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> V2 a -> m (V2 a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> V2 a -> m (V2 a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> V2 a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> V2 a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> V2 a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> V2 a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> V2 a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> V2 a -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> V2 a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> V2 a -> r
gmapT :: (forall b. Data b => b -> b) -> V2 a -> V2 a
$cgmapT :: forall a. Data a => (forall b. Data b => b -> b) -> V2 a -> V2 a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (V2 a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (V2 a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (V2 a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (V2 a))
dataTypeOf :: V2 a -> DataType
$cdataTypeOf :: forall a. Data a => V2 a -> DataType
toConstr :: V2 a -> Constr
$ctoConstr :: forall a. Data a => V2 a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (V2 a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (V2 a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> V2 a -> c (V2 a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> V2 a -> c (V2 a)
Data)

instance Applicative V2 where
    pure :: forall a. a -> V2 a
pure a
x = forall a. a -> a -> V2 a
V2 a
x a
x
    V2 a -> b
fx a -> b
fy <*> :: forall a b. V2 (a -> b) -> V2 a -> V2 b
<*> V2 a
x a
y = forall a. a -> a -> V2 a
V2 (a -> b
fx a
x) (a -> b
fy a
y)

instance Num a => Num (V2 a) where
    V2 a
x1 a
y1 + :: V2 a -> V2 a -> V2 a
+ V2 a
x2 a
y2 = forall a. a -> a -> V2 a
V2 (a
x1 forall a. Num a => a -> a -> a
+ a
x2) (a
y1 forall a. Num a => a -> a -> a
+ a
y2)
    V2 a
x1 a
y1 - :: V2 a -> V2 a -> V2 a
- V2 a
x2 a
y2 = forall a. a -> a -> V2 a
V2 (a
x1 forall a. Num a => a -> a -> a
- a
x2) (a
y1 forall a. Num a => a -> a -> a
- a
y2)
    V2 a
x1 a
y1 * :: V2 a -> V2 a -> V2 a
* V2 a
x2 a
y2 = forall a. a -> a -> V2 a
V2 (a
x1 forall a. Num a => a -> a -> a
* a
x2) (a
y1 forall a. Num a => a -> a -> a
* a
y2)
    negate :: V2 a -> V2 a
negate (V2 a
x a
y) = forall a. a -> a -> V2 a
V2 (forall a. Num a => a -> a
negate a
x) (forall a. Num a => a -> a
negate a
y)
    abs :: V2 a -> V2 a
abs (V2 a
x a
y) = forall a. a -> a -> V2 a
V2 (forall a. Num a => a -> a
abs a
x) (forall a. Num a => a -> a
abs a
y)
    signum :: V2 a -> V2 a
signum (V2 a
x a
y) = forall a. a -> a -> V2 a
V2 (forall a. Num a => a -> a
signum a
x) (forall a. Num a => a -> a
signum a
y)
    fromInteger :: Integer -> V2 a
fromInteger Integer
x = forall a. a -> a -> V2 a
V2 (forall a. Num a => Integer -> a
fromInteger Integer
x) (forall a. Num a => Integer -> a
fromInteger Integer
x)

instance Fractional a => Fractional (V2 a) where
    recip :: V2 a -> V2 a
recip (V2 a
x a
y) = forall a. a -> a -> V2 a
V2 (forall a. Fractional a => a -> a
recip a
x) (forall a. Fractional a => a -> a
recip a
y)
    V2 a
x1 a
y1 / :: V2 a -> V2 a -> V2 a
/ V2 a
x2 a
y2 = forall a. a -> a -> V2 a
V2 (a
x1 forall a. Fractional a => a -> a -> a
/ a
x2) (a
y1 forall a. Fractional a => a -> a -> a
/ a
y2)
    fromRational :: Rational -> V2 a
fromRational Rational
x = forall a. a -> a -> V2 a
V2 (forall a. Fractional a => Rational -> a
fromRational Rational
x) (forall a. Fractional a => Rational -> a
fromRational Rational
x)

instance Lift a => Lift (V2 a) where
    lift :: forall (m :: * -> *). Quote m => V2 a -> m Exp
lift (V2 a
x a
y) = do
      Exp
lx <- forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift a
x
      Exp
ly <- forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift a
y
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
AppE (Exp -> Exp -> Exp
AppE (Name -> Exp
ConE 'V2) Exp
lx) Exp
ly
#if MIN_VERSION_template_haskell(2,16,0)
    liftTyped :: forall (m :: * -> *). Quote m => V2 a -> Code m (V2 a)
liftTyped = forall a (m :: * -> *). m (TExp a) -> Splice m a
liftSplice forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Exp -> TExp a
TExp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
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 :: Set Point -> Map (V2 Double) (Set (Set Point))
contiguousShapes Set Point
s0 = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. Semigroup a => a -> a -> a
(<>)
    [ (V2 Double
com, forall a. a -> Set a
S.singleton (forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (forall a. Num a => a -> a -> a
subtract Point
topCorner) Set Point
s))
    | Set Point
s <- forall a. Ord a => (a -> Set a) -> Set a -> [Set a]
allSubgraphs (forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> [Point]
fullNeighbs) Set Point
s0
    , let com :: V2 Double
com            = forall (f :: * -> *) b a.
(Foldable f, Fractional b) =>
(a -> b) -> f a -> b
mean (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral) Set Point
s
          V2 Point
topCorner Point
_ = forall a (f :: * -> *) (g :: * -> *).
(Bounded a, Foldable f, Applicative g, Ord a) =>
f (g a) -> V2 (g a)
boundingBox Set Point
s
    ]

allSubgraphs
    :: forall a. Ord a
    => (a -> Set a)     -- ^ Expansion
    -> Set a            -- ^ points
    -> [Set a]
allSubgraphs :: forall a. Ord a => (a -> Set a) -> Set a -> [Set a]
allSubgraphs a -> Set a
f = [Set a] -> Set a -> [Set a]
go []
  where
    go :: [Set a] -> Set a -> [Set a]
go ![Set a]
seen !Set a
rest = case forall a. Set a -> Maybe (a, Set a)
S.minView Set a
rest of
      Maybe (a, Set a)
Nothing      -> [Set a]
seen
      Just (a
x, Set a
xs) ->
        let new :: Set a
new = forall a. Ord a => (a -> Set a) -> Set a -> Set a
floodFill (forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set a
xs forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Set a
f) (forall a. a -> Set a
S.singleton a
x)
        in  [Set a] -> Set a -> [Set a]
go (Set a
new forall a. a -> [a] -> [a]
: [Set a]
seen) (Set a
xs forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set a
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 :: forall a. Ord a => (V2 Double -> a) -> Set Point -> [Set Point]
contiguousShapesBy V2 Double -> a
f = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys V2 Double -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Point -> Map (V2 Double) (Set (Set Point))
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 :: forall a. Ord a => (a -> Set a) -> Set a -> Set a
floodFill a -> Set a
f = Set a -> Set a -> Set a
go forall a. Set a
S.empty
  where
    go :: Set a -> Set a -> Set a
go !Set a
innr !Set a
outr
        | forall a. Set a -> Bool
S.null Set a
outr' = Set a
innr'
        | Bool
otherwise    = Set a -> Set a -> Set a
go Set a
innr' Set a
outr'
      where
        innr' :: Set a
innr' = forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
innr Set a
outr
        outr' :: Set a
outr' = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Set a
f Set a
outr forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set a
innr'

fullNeighbs :: Point -> [Point]
fullNeighbs :: Point -> [Point]
fullNeighbs Point
p = [ Point
p forall a. Num a => a -> a -> a
+ forall a. a -> a -> V2 a
V2 Int
dx Int
dy
                | Int
dx <- [-Int
1 .. Int
1]
                , Int
dy <- if Int
dx forall a. Eq a => a -> a -> Bool
== Int
0 then [-Int
1,Int
1] else [-Int
1..Int
1]
                ]

boundingBox :: (Bounded a, Foldable f, Applicative g, Ord a) => f (g a) -> V2 (g a)
boundingBox :: forall a (f :: * -> *) (g :: * -> *).
(Bounded a, Foldable f, Applicative g, Ord a) =>
f (g a) -> V2 (g a)
boundingBox = (\(Ap g (Min a)
mn, Ap g (Max a)
mx) -> forall a. a -> a -> V2 a
V2 (forall a. Min a -> a
getMin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g (Min a)
mn) (forall a. Max a -> a
getMax forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g (Max a)
mx))
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\g a
p -> (forall {k} (f :: k -> *) (a :: k). f a -> Ap f a
Ap (forall a. a -> Min a
Min forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g a
p), forall {k} (f :: k -> *) (a :: k). f a -> Ap f a
Ap (forall a. a -> Max a
Max forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g a
p)))

-- | will error if empty list
mean :: (Foldable f, Fractional b) => (a -> b) -> f a -> b
mean :: forall (f :: * -> *) b a.
(Foldable f, Fractional b) =>
(a -> b) -> f a -> b
mean a -> b
f f a
xs0 = b
sx1 forall a. Fractional a => a -> a -> a
/ b
sx0
  where
    (b
sx0, b
sx1) = forall {t}. Num t => t -> b -> [a] -> (t, b)
go b
0 b
0 (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f a
xs0)
    go :: t -> b -> [a] -> (t, b)
go !t
x0 !b
x1 = \case
      []   -> (t
x0, b
x1)
      a
x:[a]
xs -> t -> b -> [a] -> (t, b)
go (t
x0 forall a. Num a => a -> a -> a
+ t
1) (b
x1 forall a. Num a => a -> a -> a
+ a -> b
f a
x) [a]
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 { LetterMap -> Map (Set Point) Char
getLetterMap :: Map (Set Point) Char }
  deriving (Int -> LetterMap -> ShowS
[LetterMap] -> ShowS
LetterMap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LetterMap] -> ShowS
$cshowList :: [LetterMap] -> ShowS
show :: LetterMap -> String
$cshow :: LetterMap -> String
showsPrec :: Int -> LetterMap -> ShowS
$cshowsPrec :: Int -> LetterMap -> ShowS
Show, LetterMap -> LetterMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LetterMap -> LetterMap -> Bool
$c/= :: LetterMap -> LetterMap -> Bool
== :: LetterMap -> LetterMap -> Bool
$c== :: LetterMap -> LetterMap -> Bool
Eq, Eq LetterMap
LetterMap -> LetterMap -> Bool
LetterMap -> LetterMap -> Ordering
LetterMap -> LetterMap -> LetterMap
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LetterMap -> LetterMap -> LetterMap
$cmin :: LetterMap -> LetterMap -> LetterMap
max :: LetterMap -> LetterMap -> LetterMap
$cmax :: LetterMap -> LetterMap -> LetterMap
>= :: LetterMap -> LetterMap -> Bool
$c>= :: LetterMap -> LetterMap -> Bool
> :: LetterMap -> LetterMap -> Bool
$c> :: LetterMap -> LetterMap -> Bool
<= :: LetterMap -> LetterMap -> Bool
$c<= :: LetterMap -> LetterMap -> Bool
< :: LetterMap -> LetterMap -> Bool
$c< :: LetterMap -> LetterMap -> Bool
compare :: LetterMap -> LetterMap -> Ordering
$ccompare :: LetterMap -> LetterMap -> Ordering
Ord, NonEmpty LetterMap -> LetterMap
LetterMap -> LetterMap -> LetterMap
forall b. Integral b => b -> LetterMap -> LetterMap
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> LetterMap -> LetterMap
$cstimes :: forall b. Integral b => b -> LetterMap -> LetterMap
sconcat :: NonEmpty LetterMap -> LetterMap
$csconcat :: NonEmpty LetterMap -> LetterMap
<> :: LetterMap -> LetterMap -> LetterMap
$c<> :: LetterMap -> LetterMap -> LetterMap
Semigroup, Semigroup LetterMap
LetterMap
[LetterMap] -> LetterMap
LetterMap -> LetterMap -> LetterMap
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [LetterMap] -> LetterMap
$cmconcat :: [LetterMap] -> LetterMap
mappend :: LetterMap -> LetterMap -> LetterMap
$cmappend :: LetterMap -> LetterMap -> LetterMap
mempty :: LetterMap
$cmempty :: LetterMap
Monoid, forall x. Rep LetterMap x -> LetterMap
forall x. LetterMap -> Rep LetterMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LetterMap x -> LetterMap
$cfrom :: forall x. LetterMap -> Rep LetterMap x
Generic, Typeable LetterMap
LetterMap -> DataType
LetterMap -> Constr
(forall b. Data b => b -> b) -> LetterMap -> LetterMap
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LetterMap -> u
forall u. (forall d. Data d => d -> u) -> LetterMap -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LetterMap -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LetterMap -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LetterMap -> m LetterMap
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LetterMap -> m LetterMap
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LetterMap
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetterMap -> c LetterMap
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LetterMap)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetterMap)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LetterMap -> m LetterMap
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LetterMap -> m LetterMap
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LetterMap -> m LetterMap
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LetterMap -> m LetterMap
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LetterMap -> m LetterMap
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LetterMap -> m LetterMap
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LetterMap -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LetterMap -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> LetterMap -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LetterMap -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LetterMap -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LetterMap -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LetterMap -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LetterMap -> r
gmapT :: (forall b. Data b => b -> b) -> LetterMap -> LetterMap
$cgmapT :: (forall b. Data b => b -> b) -> LetterMap -> LetterMap
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetterMap)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetterMap)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LetterMap)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LetterMap)
dataTypeOf :: LetterMap -> DataType
$cdataTypeOf :: LetterMap -> DataType
toConstr :: LetterMap -> Constr
$ctoConstr :: LetterMap -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LetterMap
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LetterMap
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetterMap -> c LetterMap
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetterMap -> c LetterMap
Data)

instance Lift LetterMap where
    lift :: forall (m :: * -> *). Quote m => LetterMap -> m Exp
lift (LetterMap Map (Set Point) Char
x) = Exp -> Exp -> Exp
AppE (Name -> Exp
ConE 'LetterMap) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift Map (Set Point) Char
x
#if MIN_VERSION_template_haskell(2,16,0)
    liftTyped :: forall (m :: * -> *). Quote m => LetterMap -> Code m LetterMap
liftTyped = forall a (m :: * -> *). m (TExp a) -> Splice m a
liftSplice forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Exp -> TExp a
TExp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
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 :: Set Point -> LetterMap -> Maybe Char
lookupLetterMap Set Point
k = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Set Point
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. LetterMap -> Map (Set Point) Char
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 :: String -> String -> LetterMap
parseLetterMap String
ls = Map (Set Point) Char -> LetterMap
LetterMap
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip (,)) String
ls
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => (V2 Double -> a) -> Set Point -> [Set Point]
contiguousShapesBy forall a. V2 a -> a
v2x
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Char -> String -> Set Point
parseAsciiMapV2 (forall a. a -> Set a
S.singleton Char
'#')

-- | 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 :: Set Char -> String -> Set Point
parseAsciiMapV2 Set Char
c = forall m a b. Monoid m => (a -> b -> m) -> [a] -> [b] -> m
zipWithFold (\Int
j -> forall m a b. Monoid m => (a -> b -> m) -> [a] -> [b] -> m
zipWithFold (\Int
i Char
x ->
                        if Char
x forall a. Ord a => a -> Set a -> Bool
`S.member` Set Char
c
                          then forall a. a -> Set a
S.singleton (forall a. a -> a -> V2 a
V2 Int
i Int
j)
                          else forall a. Set a
S.empty
                      ) [Int
0..]) [Int
0..]
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

zipWithFold
    :: Monoid m
    => (a -> b -> m)
    -> [a]
    -> [b]
    -> m
zipWithFold :: forall m a b. Monoid m => (a -> b -> m) -> [a] -> [b] -> m
zipWithFold a -> b -> m
f [a]
xs = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> m
f [a]
xs

-- | Seen in 2016 Day 8, 2019 Day 8 and 11, 2021 Day 13, 2022 Day 10.  4x6
-- glyphs.
--
-- Load using @uncurry 'parseLetterMap'@.
rawLetterforms1 :: (String, String)
rawLetterforms1 :: (String, String)
rawLetterforms1 = (String
"ABCEFGHIJKLOPRSUYZ", forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
' ') forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
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 :: (String, String)
rawLetterforms2 = (String
"ABCEFGHJKLNPRXZ", forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
' ') forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 [here|
..##...#####...####..######.######..####..#....#....###.#....#.#......#....#.#####..#####..#....#.######
.#..#..#....#.#....#.#......#......#....#.#....#.....#..#...#..#......##...#.#....#.#....#.#....#......#
#....#.#....#.#......#......#......#......#....#.....#..#..#...#......##...#.#....#.#....#..#..#.......#
#....#.#....#.#......#......#......#......#....#.....#..#.#....#......#.#..#.#....#.#....#..#..#......#.
#....#.#####..#......#####..#####..#......######.....#..##.....#......#.#..#.#####..#####....##......#..
######.#....#.#......#......#......#..###.#....#.....#..##.....#......#..#.#.#......#..#.....##.....#...
#....#.#....#.#......#......#......#....#.#....#.....#..#.#....#......#..#.#.#......#...#...#..#...#....
#....#.#....#.#......#......#......#....#.#....#.#...#..#..#...#......#...##.#......#...#...#..#..#.....
#....#.#....#.#....#.#......#......#...##.#....#.#...#..#...#..#......#...##.#......#....#.#....#.#.....
#....#.#####...####..######.#.......###.#.#....#..###...#....#.######.#....#.#......#....#.#....#.######
|])