advent-of-code-ocr-0.1.2.1: Parse Advent of Code ASCII art letters
Copyright(c) Justin Le 2020
LicenseBSD3
Maintainerjustin@jle.im
Stabilityexperimental
Portabilitynon-portable
Safe HaskellSafe-Inferred
LanguageHaskell2010

Advent.OCR.Internal

Description

Internal utility functions for Advent.OCR.

Synopsis

Parse

data V2 a Source #

Type used internally to represent points; useful for its Num and Applicative instances.

Constructors

V2 

Fields

Instances

Instances details
Applicative V2 Source # 
Instance details

Defined in Advent.OCR.LetterMap

Methods

pure :: a -> V2 a #

(<*>) :: V2 (a -> b) -> V2 a -> V2 b #

liftA2 :: (a -> b -> c) -> V2 a -> V2 b -> V2 c #

(*>) :: V2 a -> V2 b -> V2 b #

(<*) :: V2 a -> V2 b -> V2 a #

Functor V2 Source # 
Instance details

Defined in Advent.OCR.LetterMap

Methods

fmap :: (a -> b) -> V2 a -> V2 b #

(<$) :: a -> V2 b -> V2 a #

Lift a => Lift (V2 a :: Type) Source # 
Instance details

Defined in Advent.OCR.LetterMap

Methods

lift :: Quote m => V2 a -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => V2 a -> Code m (V2 a) #

Data a => Data (V2 a) Source # 
Instance details

Defined in Advent.OCR.LetterMap

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> V2 a -> c (V2 a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (V2 a) #

toConstr :: V2 a -> Constr #

dataTypeOf :: V2 a -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (V2 a)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (V2 a)) #

gmapT :: (forall b. Data b => b -> b) -> V2 a -> V2 a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> V2 a -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> V2 a -> r #

gmapQ :: (forall d. Data d => d -> u) -> V2 a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> V2 a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> V2 a -> m (V2 a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> V2 a -> m (V2 a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> V2 a -> m (V2 a) #

Generic (V2 a) Source # 
Instance details

Defined in Advent.OCR.LetterMap

Associated Types

type Rep (V2 a) :: Type -> Type #

Methods

from :: V2 a -> Rep (V2 a) x #

to :: Rep (V2 a) x -> V2 a #

Num a => Num (V2 a) Source # 
Instance details

Defined in Advent.OCR.LetterMap

Methods

(+) :: V2 a -> V2 a -> V2 a #

(-) :: V2 a -> V2 a -> V2 a #

(*) :: V2 a -> V2 a -> V2 a #

negate :: V2 a -> V2 a #

abs :: V2 a -> V2 a #

signum :: V2 a -> V2 a #

fromInteger :: Integer -> V2 a #

Fractional a => Fractional (V2 a) Source # 
Instance details

Defined in Advent.OCR.LetterMap

Methods

(/) :: V2 a -> V2 a -> V2 a #

recip :: V2 a -> V2 a #

fromRational :: Rational -> V2 a #

Show a => Show (V2 a) Source # 
Instance details

Defined in Advent.OCR.LetterMap

Methods

showsPrec :: Int -> V2 a -> ShowS #

show :: V2 a -> String #

showList :: [V2 a] -> ShowS #

Eq a => Eq (V2 a) Source # 
Instance details

Defined in Advent.OCR.LetterMap

Methods

(==) :: V2 a -> V2 a -> Bool #

(/=) :: V2 a -> V2 a -> Bool #

Ord a => Ord (V2 a) Source # 
Instance details

Defined in Advent.OCR.LetterMap

Methods

compare :: 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 #

max :: V2 a -> V2 a -> V2 a #

min :: V2 a -> V2 a -> V2 a #

type Rep (V2 a) Source # 
Instance details

Defined in Advent.OCR.LetterMap

type Rep (V2 a) = D1 ('MetaData "V2" "Advent.OCR.LetterMap" "advent-of-code-ocr-0.1.2.1-Lh8la7tptHeJXsL9QW6ry6" 'False) (C1 ('MetaCons "V2" 'PrefixI 'True) (S1 ('MetaSel ('Just "v2x") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 a) :*: S1 ('MetaSel ('Just "v2y") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 a)))

type Point = V2 Int Source #

A point is a 2-vector of ints.

parseLettersV2 :: LetterMap -> Set Point -> Maybe String Source #

A version of parseLetters taking Point. Used internally.

parseLettersEitherV2 :: LetterMap -> Set Point -> Maybe [Either (Set Point) Char] Source #

A version of parseLettersEither taking (and returning) Point. Used internally.

parseAsciiMapV2 Source #

Arguments

:: Set Char

characters to use as "on"/included

-> String

raw map ASCII art

-> Set Point 

Parse raw ASCII art into a set of points, usable with parseLettersV2.

Letter Map

newtype LetterMap Source #

A database associating a set of "on" points to the letter they represent.

See defaultLetterMap for a database compatible with Advent of Code 2015-2019.

Constructors

LetterMap 

Instances

Instances details
Data LetterMap Source # 
Instance details

Defined in Advent.OCR.LetterMap

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> LetterMap -> c LetterMap #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c LetterMap #

toConstr :: LetterMap -> Constr #

dataTypeOf :: LetterMap -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c LetterMap) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetterMap) #

gmapT :: (forall b. Data b => b -> b) -> LetterMap -> LetterMap #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> LetterMap -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> LetterMap -> r #

gmapQ :: (forall d. Data d => d -> u) -> LetterMap -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> LetterMap -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> LetterMap -> m LetterMap #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> LetterMap -> m LetterMap #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> LetterMap -> m LetterMap #

Monoid LetterMap Source # 
Instance details

Defined in Advent.OCR.LetterMap

Semigroup LetterMap Source # 
Instance details

Defined in Advent.OCR.LetterMap

Generic LetterMap Source # 
Instance details

Defined in Advent.OCR.LetterMap

Associated Types

type Rep LetterMap :: Type -> Type #

Show LetterMap Source # 
Instance details

Defined in Advent.OCR.LetterMap

Default LetterMap Source #

Default is compatible with all challenges in Advent of Code 2015 to 2019.

Instance details

Defined in Advent.OCR.Internal

Methods

def :: LetterMap #

Eq LetterMap Source # 
Instance details

Defined in Advent.OCR.LetterMap

Ord LetterMap Source # 
Instance details

Defined in Advent.OCR.LetterMap

Lift LetterMap Source # 
Instance details

Defined in Advent.OCR.LetterMap

Methods

lift :: Quote m => LetterMap -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => LetterMap -> Code m LetterMap #

type Rep LetterMap Source # 
Instance details

Defined in Advent.OCR.LetterMap

type Rep LetterMap = D1 ('MetaData "LetterMap" "Advent.OCR.LetterMap" "advent-of-code-ocr-0.1.2.1-Lh8la7tptHeJXsL9QW6ry6" 'True) (C1 ('MetaCons "LetterMap" 'PrefixI 'True) (S1 ('MetaSel ('Just "getLetterMap") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map (Set Point) Char))))

lookupLetterMap :: Set Point -> LetterMap -> Maybe Char Source #

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.

defaultLetterMap :: LetterMap Source #

The default lettermap compatible all challenges in Advent of Code 2015 - 2019.

rawLetterforms1 :: (String, String) Source #

Seen in 2016 Day 8, 2019 Day 8 and 11, 2021 Day 13, 2022 Day 10. 4x6 glyphs.

Load using uncurry parseLetterMap.

parseLetterMap :: [Char] -> String -> LetterMap Source #

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.

Utility

contiguousShapes :: Set Point -> Map (V2 Double) (Set (Set Point)) Source #

The set of unconnected shapes, indexed by their original center of mass

contiguousShapesBy :: Ord a => (V2 Double -> a) -> Set Point -> [Set Point] Source #

The set of unconnected shapes, sorted against some function on their original center of masses.

Orphan instances

Default LetterMap Source #

Default is compatible with all challenges in Advent of Code 2015 to 2019.

Instance details

Methods

def :: LetterMap #