{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Advent.OCR.Internal (
V2(..)
, Point
, parseLettersV2
, parseLettersEitherV2
, parseAsciiMapV2
, LetterMap(..)
, lookupLetterMap
, defaultLetterMap
, rawLetterforms1
, rawLetterforms2
, parseLetterMap
, contiguousShapes
, contiguousShapesBy
) where
import Advent.OCR.LetterMap
import Data.Default.Class
import Data.Maybe
import Data.Monoid
import Data.Set (Set)
import Language.Haskell.TH.Lift
import qualified Data.Set as S
parseLettersV2
:: LetterMap
-> Set Point
-> Maybe String
parseLettersV2 :: LetterMap -> Set Point -> Maybe String
parseLettersV2 LetterMap
lm = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Char
'?') forall a. a -> a
id)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LetterMap -> Set Point -> Maybe [Either (Set Point) Char]
parseLettersEitherV2 LetterMap
lm
parseLettersEitherV2
:: LetterMap
-> Set Point
-> Maybe [Either (Set Point) Char]
parseLettersEitherV2 :: LetterMap -> Set Point -> Maybe [Either (Set Point) Char]
parseLettersEitherV2 LetterMap
lm Set Point
letters = forall a. [a] -> Maybe a
listToMaybe [[Either (Set Point) Char]]
attempts
where
attempts :: [[Either (Set Point) Char]]
attempts =
[ [Either (Set Point) Char]
res
| Point -> Point
refl <- [forall a. a -> a
id, forall {a}. Num a => V2 a -> V2 a
reflX]
, Point -> Point
rots <- [forall a. a -> a
id, forall {a}. Num a => V2 a -> V2 a
perp, forall a. Num a => a -> a
negate, forall a. Num a => a -> a
negate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Num a => V2 a -> V2 a
perp]
, let ls :: Set Point
ls = forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (Point -> Point
rots forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point
refl) Set Point
letters
((Sum Double
n, Sum Double
goodCount), [Either (Set Point) Char]
res) = Set Point -> ((Sum Double, Sum Double), [Either (Set Point) Char])
tryMe Set Point
ls
percGood :: Double
percGood = Double
goodCount forall a. Fractional a => a -> a -> a
/ Double
n :: Double
, Double
n forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Double
percGood forall a. Ord a => a -> a -> Bool
>= Double
0.5
]
tryMe :: Set Point -> ((Sum Double, Sum Double), [Either (Set Point) Char])
tryMe = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Set Point
c -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((forall a. a -> Sum a
Sum Double
1, forall a. a -> Sum a
Sum Double
0), forall a b. a -> Either a b
Left Set Point
c) (((forall a. a -> Sum a
Sum Double
1, forall a. a -> Sum a
Sum Double
1),) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Point -> LetterMap -> Maybe Char
lookupLetterMap Set Point
c forall a b. (a -> b) -> a -> b
$ LetterMap
lm)
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
perp :: V2 a -> V2 a
perp (V2 a
x a
y) = forall a. a -> a -> V2 a
V2 (forall a. Num a => a -> a
negate a
y) a
x
reflX :: V2 a -> V2 a
reflX (V2 a
x a
y) = forall a. a -> a -> V2 a
V2 (forall a. Num a => a -> a
negate a
x) a
y
instance Default LetterMap where
def :: LetterMap
def = LetterMap
defaultLetterMap
defaultLetterMap :: LetterMap
defaultLetterMap :: LetterMap
defaultLetterMap = $( lift $ uncurry parseLetterMap rawLetterforms1
<> uncurry parseLetterMap rawLetterforms2
)