{-# 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
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
type Point = V2 Int
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)
-> Set a
-> [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)
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)
-> Set a
-> Set a
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)))
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
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
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
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
'#')
parseAsciiMapV2
:: Set Char
-> String
-> 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
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|
.##..###...##..####.####..##..#..#.###...##.#..#.#.....##..###..###...###.#..#.#...#.####
#..#.#..#.#..#.#....#....#..#.#..#..#.....#.#.#..#....#..#.#..#.#..#.#....#..#.#...#....#
#..#.###..#....###..###..#....####..#.....#.##...#....#..#.#..#.#..#.#....#..#..#.#....#.
####.#..#.#....#....#....#.##.#..#..#.....#.#.#..#....#..#.###..###...##..#..#...#....#..
#..#.#..#.#..#.#....#....#..#.#..#..#..#..#.#.#..#....#..#.#....#.#.....#.#..#...#...#...
#..#.###...##..####.#.....###.#..#.###..##..#..#.####..##..#....#..#.###...##....#...####
|])
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|
..##...#####...####..######.######..####..#....#....###.#....#.#......#....#.#####..#####..#....#.######
.#..#..#....#.#....#.#......#......#....#.#....#.....#..#...#..#......##...#.#....#.#....#.#....#......#
#....#.#....#.#......#......#......#......#....#.....#..#..#...#......##...#.#....#.#....#..#..#.......#
#....#.#....#.#......#......#......#......#....#.....#..#.#....#......#.#..#.#....#.#....#..#..#......#.
#....#.#####..#......#####..#####..#......######.....#..##.....#......#.#..#.#####..#####....##......#..
######.#....#.#......#......#......#..###.#....#.....#..##.....#......#..#.#.#......#..#.....##.....#...
#....#.#....#.#......#......#......#....#.#....#.....#..#.#....#......#..#.#.#......#...#...#..#...#....
#....#.#....#.#......#......#......#....#.#....#.#...#..#..#...#......#...##.#......#...#...#..#..#.....
#....#.#....#.#....#.#......#......#...##.#....#.#...#..#...#..#......#...##.#......#....#.#....#.#.....
#....#.#####...####..######.#.......###.#.#....#..###...#....#.######.#....#.#......#....#.#....#.######
|])