{-# 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 { V2 a -> a
v2x :: !a, V2 a -> a
v2y :: !a }
  deriving (Int -> V2 a -> ShowS
[V2 a] -> ShowS
V2 a -> String
(Int -> V2 a -> ShowS)
-> (V2 a -> String) -> ([V2 a] -> ShowS) -> Show (V2 a)
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, a -> V2 b -> V2 a
(a -> b) -> V2 a -> V2 b
(forall a b. (a -> b) -> V2 a -> V2 b)
-> (forall a b. a -> V2 b -> V2 a) -> Functor V2
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
<$ :: a -> V2 b -> V2 a
$c<$ :: forall a b. a -> V2 b -> V2 a
fmap :: (a -> b) -> V2 a -> V2 b
$cfmap :: forall a b. (a -> b) -> V2 a -> V2 b
Functor, V2 a -> V2 a -> Bool
(V2 a -> V2 a -> Bool) -> (V2 a -> V2 a -> Bool) -> Eq (V2 a)
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, Eq (V2 a)
Eq (V2 a)
-> (V2 a -> V2 a -> Ordering)
-> (V2 a -> V2 a -> Bool)
-> (V2 a -> V2 a -> Bool)
-> (V2 a -> V2 a -> Bool)
-> (V2 a -> V2 a -> Bool)
-> (V2 a -> V2 a -> V2 a)
-> (V2 a -> V2 a -> V2 a)
-> Ord (V2 a)
V2 a -> V2 a -> Bool
V2 a -> V2 a -> Ordering
V2 a -> V2 a -> V2 a
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
$cp1Ord :: forall a. Ord a => Eq (V2 a)
Ord, (forall x. V2 a -> Rep (V2 a) x)
-> (forall x. Rep (V2 a) x -> V2 a) -> Generic (V2 a)
forall x. Rep (V2 a) x -> V2 a
forall x. V2 a -> Rep (V2 a) x
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, Typeable (V2 a)
DataType
Constr
Typeable (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 (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (V2 a))
-> (V2 a -> Constr)
-> (V2 a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (V2 a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (V2 a)))
-> ((forall b. Data b => b -> b) -> V2 a -> V2 a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> V2 a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> V2 a -> r)
-> (forall u. (forall d. Data d => d -> u) -> V2 a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> V2 a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> V2 a -> m (V2 a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> V2 a -> m (V2 a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> V2 a -> m (V2 a))
-> Data (V2 a)
V2 a -> DataType
V2 a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (V2 a))
(forall b. Data b => b -> b) -> V2 a -> V2 a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> V2 a -> c (V2 a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (V2 a)
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 u. Int -> (forall d. Data d => d -> u) -> V2 a -> u
forall u. (forall d. Data d => d -> u) -> V2 a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> V2 a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> V2 a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> V2 a -> m (V2 a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> V2 a -> m (V2 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))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (V2 a))
$cV2 :: Constr
$tV2 :: DataType
gmapMo :: (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 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 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 :: 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 d. Data d => d -> u) -> V2 a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> V2 a -> [u]
gmapQr :: (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 :: (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 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 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 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 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)
$cp1Data :: forall a. Data a => Typeable (V2 a)
Data)

instance Applicative V2 where
    pure :: a -> V2 a
pure a
x = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
x a
x
    V2 a -> b
fx a -> b
fy <*> :: V2 (a -> b) -> V2 a -> V2 b
<*> V2 a
x a
y = b -> b -> V2 b
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 = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a
x1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
x2) (a
y1 a -> a -> a
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 = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a
x1 a -> a -> a
forall a. Num a => a -> a -> a
- a
x2) (a
y1 a -> a -> a
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 = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a
x1 a -> a -> a
forall a. Num a => a -> a -> a
* a
x2) (a
y1 a -> a -> a
forall a. Num a => a -> a -> a
* a
y2)
    negate :: V2 a -> V2 a
negate (V2 a
x a
y) = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a -> a
forall a. Num a => a -> a
negate a
x) (a -> a
forall a. Num a => a -> a
negate a
y)
    abs :: V2 a -> V2 a
abs (V2 a
x a
y) = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a -> a
forall a. Num a => a -> a
abs a
x) (a -> a
forall a. Num a => a -> a
abs a
y)
    signum :: V2 a -> V2 a
signum (V2 a
x a
y) = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a -> a
forall a. Num a => a -> a
signum a
x) (a -> a
forall a. Num a => a -> a
signum a
y)
    fromInteger :: Integer -> V2 a
fromInteger Integer
x = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x) (Integer -> a
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) = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a -> a
forall a. Fractional a => a -> a
recip a
x) (a -> a
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 = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a
x1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
x2) (a
y1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
y2)
    fromRational :: Rational -> V2 a
fromRational Rational
x = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (Rational -> a
forall a. Fractional a => Rational -> a
fromRational Rational
x) (Rational -> a
forall a. Fractional a => Rational -> a
fromRational Rational
x)

instance Lift a => Lift (V2 a) where
    lift :: V2 a -> Q Exp
lift (V2 a
x a
y) = do
      Exp
lx <- a -> Q Exp
forall t. Lift t => t -> Q Exp
lift a
x
      Exp
ly <- a -> Q Exp
forall t. Lift t => t -> Q Exp
lift a
y
      Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> Exp -> Q Exp
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 :: V2 a -> Q (TExp (V2 a))
liftTyped = (Exp -> TExp (V2 a)) -> Q Exp -> Q (TExp (V2 a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> TExp (V2 a)
forall a. Exp -> TExp a
TExp (Q Exp -> Q (TExp (V2 a)))
-> (V2 a -> Q Exp) -> V2 a -> Q (TExp (V2 a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 a -> Q Exp
forall t. Lift t => t -> Q 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 = (Set (Set Point) -> Set (Set Point) -> Set (Set Point))
-> [(V2 Double, Set (Set Point))]
-> Map (V2 Double) (Set (Set Point))
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith Set (Set Point) -> Set (Set Point) -> Set (Set Point)
forall a. Semigroup a => a -> a -> a
(<>)
    [ (V2 Double
com, Set Point -> Set (Set Point)
forall a. a -> Set a
S.singleton ((Point -> Point) -> Set Point -> Set Point
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (Point -> Point -> Point
forall a. Num a => a -> a -> a
subtract Point
topCorner) Set Point
s))
    | Set Point
s <- (Point -> Set Point) -> Set Point -> [Set Point]
forall a. Ord a => (a -> Set a) -> Set a -> [Set a]
allSubgraphs ([Point] -> Set Point
forall a. Ord a => [a] -> Set a
S.fromList ([Point] -> Set Point) -> (Point -> [Point]) -> Point -> Set Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> [Point]
fullNeighbs) Set Point
s0
    , let com :: V2 Double
com            = (Point -> V2 Double) -> Set Point -> V2 Double
forall (f :: * -> *) b a.
(Foldable f, Fractional b) =>
(a -> b) -> f a -> b
mean ((Int -> Double) -> Point -> V2 Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Set Point
s
          V2 Point
topCorner Point
_ = Set Point -> V2 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 :: (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 Set a -> Maybe (a, Set a)
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 = (a -> Set a) -> Set a -> Set a
forall a. Ord a => (a -> Set a) -> Set a -> Set a
floodFill (Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set a
xs (Set a -> Set a) -> (a -> Set a) -> a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Set a
f) (a -> Set a
forall a. a -> Set a
S.singleton a
x)
        in  [Set a] -> Set a -> [Set a]
go (Set a
new Set a -> [Set a] -> [Set a]
forall a. a -> [a] -> [a]
: [Set a]
seen) (Set a
xs Set a -> Set a -> Set a
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 :: (V2 Double -> a) -> Set Point -> [Set Point]
contiguousShapesBy V2 Double -> a
f = (Set (Set Point) -> [Set Point])
-> Map a (Set (Set Point)) -> [Set Point]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Set (Set Point) -> [Set Point]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Map a (Set (Set Point)) -> [Set Point])
-> (Set Point -> Map a (Set (Set Point)))
-> Set Point
-> [Set Point]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V2 Double -> a)
-> Map (V2 Double) (Set (Set Point)) -> Map a (Set (Set Point))
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys V2 Double -> a
f (Map (V2 Double) (Set (Set Point)) -> Map a (Set (Set Point)))
-> (Set Point -> Map (V2 Double) (Set (Set Point)))
-> Set Point
-> Map a (Set (Set Point))
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 :: (a -> Set a) -> Set a -> Set a
floodFill a -> Set a
f = Set a -> Set a -> Set a
go Set a
forall a. Set a
S.empty
  where
    go :: Set a -> Set a -> Set a
go !Set a
innr !Set a
outr
        | Set a -> Bool
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' = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
innr Set a
outr
        outr' :: Set a
outr' = (a -> Set a) -> Set a -> Set a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Set a
f Set a
outr Set a -> Set a -> Set a
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 Point -> Point -> Point
forall a. Num a => a -> a -> a
+ Int -> Int -> Point
forall a. a -> a -> V2 a
V2 Int
dx Int
dy
                | Int
dx <- [-Int
1 .. Int
1]
                , Int
dy <- if Int
dx Int -> Int -> Bool
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 :: f (g a) -> V2 (g a)
boundingBox = (\(Ap g (Min a)
mn, Ap g (Max a)
mx) -> g a -> g a -> V2 (g a)
forall a. a -> a -> V2 a
V2 (Min a -> a
forall a. Min a -> a
getMin (Min a -> a) -> g (Min a) -> g a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g (Min a)
mn) (Max a -> a
forall a. Max a -> a
getMax (Max a -> a) -> g (Max a) -> g a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g (Max a)
mx))
            ((Ap g (Min a), Ap g (Max a)) -> V2 (g a))
-> (f (g a) -> (Ap g (Min a), Ap g (Max a))) -> f (g a) -> V2 (g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g a -> (Ap g (Min a), Ap g (Max a)))
-> f (g a) -> (Ap g (Min a), Ap g (Max a))
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\g a
p -> (g (Min a) -> Ap g (Min a)
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (a -> Min a
forall a. a -> Min a
Min (a -> Min a) -> g a -> g (Min a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g a
p), g (Max a) -> Ap g (Max a)
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (a -> Max a
forall a. a -> Max a
Max (a -> Max a) -> g a -> g (Max a)
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 :: (a -> b) -> f a -> b
mean a -> b
f f a
xs0 = b
sx1 b -> b -> b
forall a. Fractional a => a -> a -> a
/ b
sx0
  where
    (b
sx0, b
sx1) = b -> b -> [a] -> (b, b)
forall t. Num t => t -> b -> [a] -> (t, b)
go b
0 b
0 (f a -> [a]
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 t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) (b
x1 b -> b -> b
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
(Int -> LetterMap -> ShowS)
-> (LetterMap -> String)
-> ([LetterMap] -> ShowS)
-> Show LetterMap
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
(LetterMap -> LetterMap -> Bool)
-> (LetterMap -> LetterMap -> Bool) -> Eq LetterMap
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
Eq LetterMap
-> (LetterMap -> LetterMap -> Ordering)
-> (LetterMap -> LetterMap -> Bool)
-> (LetterMap -> LetterMap -> Bool)
-> (LetterMap -> LetterMap -> Bool)
-> (LetterMap -> LetterMap -> Bool)
-> (LetterMap -> LetterMap -> LetterMap)
-> (LetterMap -> LetterMap -> LetterMap)
-> Ord 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
$cp1Ord :: Eq LetterMap
Ord, b -> LetterMap -> LetterMap
NonEmpty LetterMap -> LetterMap
LetterMap -> LetterMap -> LetterMap
(LetterMap -> LetterMap -> LetterMap)
-> (NonEmpty LetterMap -> LetterMap)
-> (forall b. Integral b => b -> LetterMap -> LetterMap)
-> Semigroup 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 :: 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
Semigroup LetterMap
-> LetterMap
-> (LetterMap -> LetterMap -> LetterMap)
-> ([LetterMap] -> LetterMap)
-> Monoid 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
$cp1Monoid :: Semigroup LetterMap
Monoid, (forall x. LetterMap -> Rep LetterMap x)
-> (forall x. Rep LetterMap x -> LetterMap) -> Generic LetterMap
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
DataType
Constr
Typeable LetterMap
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LetterMap -> c LetterMap)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LetterMap)
-> (LetterMap -> Constr)
-> (LetterMap -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> LetterMap -> LetterMap)
-> (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 u. (forall d. Data d => d -> u) -> LetterMap -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LetterMap -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LetterMap -> m LetterMap)
-> Data LetterMap
LetterMap -> DataType
LetterMap -> Constr
(forall b. Data b => b -> b) -> LetterMap -> LetterMap
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetterMap -> c LetterMap
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cLetterMap :: Constr
$tLetterMap :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> LetterMap -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LetterMap -> u
gmapQ :: (forall d. Data d => d -> u) -> LetterMap -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LetterMap -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable LetterMap
Data)

instance Lift LetterMap where
    lift :: LetterMap -> Q Exp
lift (LetterMap Map (Set Point) Char
x) = Exp -> Exp -> Exp
AppE (Name -> Exp
ConE 'LetterMap) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (Set Point) Char -> Q Exp
forall t. Lift t => t -> Q Exp
lift Map (Set Point) Char
x
#if MIN_VERSION_template_haskell(2,16,0)
    liftTyped :: LetterMap -> Q (TExp LetterMap)
liftTyped = (Exp -> TExp LetterMap) -> Q Exp -> Q (TExp LetterMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> TExp LetterMap
forall a. Exp -> TExp a
TExp (Q Exp -> Q (TExp LetterMap))
-> (LetterMap -> Q Exp) -> LetterMap -> Q (TExp LetterMap)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LetterMap -> Q Exp
forall t. Lift t => t -> Q 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 = Set Point -> Map (Set Point) Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Set Point
k (Map (Set Point) Char -> Maybe Char)
-> (LetterMap -> Map (Set Point) Char) -> LetterMap -> Maybe Char
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
                  (Map (Set Point) Char -> LetterMap)
-> (String -> Map (Set Point) Char) -> String -> LetterMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Set Point, Char)] -> Map (Set Point) Char
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                  ([(Set Point, Char)] -> Map (Set Point) Char)
-> (String -> [(Set Point, Char)])
-> String
-> Map (Set Point) Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Set Point -> (Set Point, Char))
-> String -> [Set Point] -> [(Set Point, Char)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Set Point -> Char -> (Set Point, Char))
-> Char -> Set Point -> (Set Point, Char)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,)) String
ls
                  ([Set Point] -> [(Set Point, Char)])
-> (String -> [Set Point]) -> String -> [(Set Point, Char)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V2 Double -> Double) -> Set Point -> [Set Point]
forall a. Ord a => (V2 Double -> a) -> Set Point -> [Set Point]
contiguousShapesBy V2 Double -> Double
forall a. V2 a -> a
v2x
                  (Set Point -> [Set Point])
-> (String -> Set Point) -> String -> [Set Point]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Char -> String -> Set Point
parseAsciiMapV2 (Char -> Set Char
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 = (Int -> String -> Set Point) -> [Int] -> [String] -> Set Point
forall m a b. Monoid m => (a -> b -> m) -> [a] -> [b] -> m
zipWithFold (\Int
j -> (Int -> Char -> Set Point) -> [Int] -> String -> Set Point
forall m a b. Monoid m => (a -> b -> m) -> [a] -> [b] -> m
zipWithFold (\Int
i Char
x ->
                        if Char
x Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Char
c
                          then Point -> Set Point
forall a. a -> Set a
S.singleton (Int -> Int -> Point
forall a. a -> a -> V2 a
V2 Int
i Int
j)
                          else Set Point
forall a. Set a
S.empty
                      ) [Int
0..]) [Int
0..]
                  ([String] -> Set Point)
-> (String -> [String]) -> String -> Set Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

zipWithFold
    :: Monoid m
    => (a -> b -> m)
    -> [a]
    -> [b]
    -> m
zipWithFold :: (a -> b -> m) -> [a] -> [b] -> m
zipWithFold a -> b -> m
f [a]
xs = [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([m] -> m) -> ([b] -> [m]) -> [b] -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> m) -> [a] -> [b] -> [m]
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.  4x6 glyphs.
--
-- Load using @uncurry 'parseLetterMap'@.
rawLetterforms1 :: (String, String)
rawLetterforms1 :: (String, String)
rawLetterforms1 = (String
"ABCEFGHIJKLOPRSUYZ", (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
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", (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 [here|
..##...#####...####..######.######..####..#....#....###.#....#.#......#....#.#####..#####..#....#.######
.#..#..#....#.#....#.#......#......#....#.#....#.....#..#...#..#......##...#.#....#.#....#.#....#......#
#....#.#....#.#......#......#......#......#....#.....#..#..#...#......##...#.#....#.#....#..#..#.......#
#....#.#....#.#......#......#......#......#....#.....#..#.#....#......#.#..#.#....#.#....#..#..#......#.
#....#.#####..#......#####..#####..#......######.....#..##.....#......#.#..#.#####..#####....##......#..
######.#....#.#......#......#......#..###.#....#.....#..##.....#......#..#.#.#......#..#.....##.....#...
#....#.#....#.#......#......#......#....#.#....#.....#..#.#....#......#..#.#.#......#...#...#..#...#....
#....#.#....#.#......#......#......#....#.#....#.#...#..#..#...#......#...##.#......#...#...#..#..#.....
#....#.#....#.#....#.#......#......#...##.#....#.#...#..#...#..#......#...##.#......#....#.#....#.#.....
#....#.#####...####..######.#.......###.#.#....#..###...#....#.######.#....#.#......#....#.#....#.######
|])