aoc2019-0.1.0.0: Development environment for Advent of Code challenges

Copyright(c) Justin Le 2019
LicenseBSD3
Maintainerjustin@jle.im
Stabilityexperimental
Portabilitynon-portable
Safe HaskellNone
LanguageHaskell2010

AOC.Common

Contents

Description

Common functions for solutions

Synopsis

Loops and searches

iterateMaybe :: (a -> Maybe a) -> a -> [a] Source #

Iterate until a Nothing is produced

loopMaybe :: (a -> Maybe a) -> a -> a Source #

Apply function until Nothing is produced, and return last produced value.

loopMaybeM :: Monad m => (a -> m (Maybe a)) -> a -> m a Source #

Apply monadic function until Nothing is produced, and return last produced value.

loopEither :: (a -> Either r a) -> a -> r Source #

Apply function until a Left.

firstJust :: Foldable t => (a -> Maybe b) -> t a -> Maybe b Source #

Like find, but instead of taking an a -> Bool, takes an a -> Maybe b and returns the first success.

(!!!) :: [a] -> Int -> a Source #

Strict (!!)

(!?) :: [a] -> Int -> Maybe a Source #

drop' :: Int -> [a] -> [a] Source #

Strict drop

dup :: a -> (a, a) Source #

A tuple of the same item twice

scanlT :: Traversable t => (b -> a -> b) -> b -> t a -> t b Source #

scanl generalized to all Traversable.

scanrT :: Traversable t => (a -> b -> b) -> b -> t a -> t b Source #

scanr generalized to all Traversable.

firstRepeated :: Ord a => [a] -> Maybe a Source #

Lazily find the first repeated item.

fixedPoint :: Eq a => (a -> a) -> a -> a Source #

Repeat a function until you get the same result twice.

floodFill Source #

Arguments

:: Ord a 
=> (a -> Set a)

Expansion (be sure to limit allowed points)

-> Set a

Start points

-> Set a

Flood filled

Flood fill from a starting set

floodFillCount Source #

Arguments

:: Ord a 
=> (a -> Set a)

Expansion (be sure to limit allowed points)

-> Set a

Start points

-> (Int, Set a)

Flood filled, with count of number of steps

Flood fill from a starting set, counting the number of steps

countTrue :: Foldable f => (a -> Bool) -> f a -> Int Source #

Count the number of items in a container where the predicate is true.

Lists

freqs :: (Foldable f, Ord a) => f a -> Map a Int Source #

Build a frequency map

lookupFreq :: Ord a => a -> Map a Int -> Int Source #

Look up a count from a frequency map, defaulting to zero if item is not foudn

freqList :: (Foldable f, Ord a) => f a -> [(Int, a)] Source #

Build a list of descending frequencies. Ties are sorted.

revFreq :: (Foldable f, Ord a) => f a -> IntMap (NESet a) Source #

Build a reverse frequency map

perturbations :: (a -> [a]) -> [a] -> [[a]] Source #

Collect all possible single-item perturbations from a given perturbing function.

perturbations (\i -> [i - 1, i + 1]) [0,10,100]

[ [-1,10,100]

, [ 1,10,100] , [ 0, 9,100] , [ 0,11,100] , [ 0,10, 99] , [ 0,10,101] ]

clearOut :: (Char -> Bool) -> String -> String Source #

Clear out characters not matching a predicate

foldMapPar :: Monoid b => (a -> b) -> [a] -> b Source #

foldMap, but in parallel.

foldMapPar1 :: Semigroup b => (a -> b) -> NonEmpty a -> b Source #

foldMap1, but in parallel.

meanVar :: Fractional a => Fold a (a, a) Source #

Fold for computing mean and variance

maximumVal :: Ord b => Map a b -> Maybe (a, b) Source #

Get the key-value pair corresponding to the maximum value in the map

maximumValBy :: (b -> b -> Ordering) -> Map a b -> Maybe (a, b) Source #

Get the key-value pair corresponding to the maximum value in the map, with a custom comparing function.

'maximumVal' == 'maximumValBy' 'compare'

minimumVal :: Ord b => Map a b -> Maybe (a, b) Source #

Get the key-value pair corresponding to the minimum value in the map

minimumValBy :: (b -> b -> Ordering) -> Map a b -> Maybe (a, b) Source #

Get the key-value pair corresponding to the minimum value in the map, with a custom comparing function.

'minimumVal' == 'minimumValBy' 'compare'

maximumValNE :: Ord b => NEMap a b -> (a, b) Source #

Version of maximumVal for nonempty maps.

maximumValByNE :: (b -> b -> Ordering) -> NEMap a b -> (a, b) Source #

Version of maximumValBy for nonempty maps.

minimumValNE :: Ord b => NEMap a b -> (a, b) Source #

Version of minimumVal for nonempty maps.

minimumValByNE :: (b -> b -> Ordering) -> NEMap a b -> (a, b) Source #

Version of minimumValBy for nonempty maps.

listTup :: [a] -> Maybe (a, a) Source #

listTup3 :: [a] -> Maybe (a, a, a) Source #

listTup4 :: [a] -> Maybe (a, a, a, a) Source #

Simple type util

deleteFinite :: KnownNat n => Finite (n + 1) -> Finite (n + 1) -> Maybe (Finite n) Source #

Delete a potential value from a Finite.

type Letter = Finite 26 Source #

charFinite :: Char -> Maybe (Bool, Finite 26) Source #

Parse a letter into a number 0 to 25. Returns False if lowercase and True if uppercase.

_CharFinite :: Prism' Char (Bool, Finite 26) Source #

Prism for a Char as (Bool, Finite 26), where the Finite is the letter parsed as a number from 0 to 25, and the Bool is lowercase (False) or uppercase (True).

caeser :: Finite 26 -> Char -> Char Source #

Caeser shift, preserving case. If you have an Int or Integer, convert into Finite using modulo.

getDown :: Down a -> a Source #

Parsers

newtype TokStream a Source #

Use a stream of tokens a as the underlying parser stream. Note that error messages for parser errors are going necessarily to be wonky.

Constructors

TokStream 

Fields

Instances
Functor TokStream Source # 
Instance details

Defined in AOC.Common

Methods

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

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

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

Defined in AOC.Common

Methods

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

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

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

Defined in AOC.Common

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

Defined in AOC.Common

Generic (TokStream a) Source # 
Instance details

Defined in AOC.Common

Associated Types

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

Methods

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

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

NFData a => NFData (TokStream a) Source # 
Instance details

Defined in AOC.Common

Methods

rnf :: TokStream a -> () #

Hashable a => Hashable (TokStream a) Source # 
Instance details

Defined in AOC.Common

Methods

hashWithSalt :: Int -> TokStream a -> Int #

hash :: TokStream a -> Int #

(Ord a, Show a) => Stream (TokStream a) Source # 
Instance details

Defined in AOC.Common

Associated Types

type Token (TokStream a) :: Type #

type Tokens (TokStream a) :: Type #

type Rep (TokStream a) Source # 
Instance details

Defined in AOC.Common

type Rep (TokStream a) = D1 (MetaData "TokStream" "AOC.Common" "aoc2019-0.1.0.0-EhTXSml1EW7BLze828MOzZ" True) (C1 (MetaCons "TokStream" PrefixI True) (S1 (MetaSel (Just "getTokStream") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [a])))
type Tokens (TokStream a) Source # 
Instance details

Defined in AOC.Common

type Tokens (TokStream a) = Seq a
type Token (TokStream a) Source # 
Instance details

Defined in AOC.Common

type Token (TokStream a) = a

parseTokStream :: Foldable t => Parsec e (TokStream s) a -> t s -> Either (ParseErrorBundle (TokStream s) e) a Source #

Parse a stream of tokens s purely, returning Either

parseTokStream_ :: (Alternative m, Foldable t) => Parsec e (TokStream s) a -> t s -> m a Source #

Parse a stream of tokens s purely

parseTokStreamT :: (Foldable t, Monad m) => ParsecT e (TokStream s) m a -> t s -> m (Either (ParseErrorBundle (TokStream s) e) a) Source #

Parse a stream of tokens s over an underlying monad, returning Either

parseTokStreamT_ :: (Alternative f, Foldable t, Monad m) => ParsecT e (TokStream s) m a -> t s -> m (f a) Source #

Parse a stream of tokens s over an underlying monad

nextMatch :: MonadParsec e s m => m a -> m a Source #

Skip every result until this token matches

Points

type Point = V2 Int Source #

2D Coordinate

mannDist :: (Foldable f, Num a, Num (f a)) => f a -> f a -> a Source #

mulPoint :: Point -> Point -> Point Source #

Treat as complex number multiplication. useful for rotations

lineTo :: Point -> Point -> [Point] Source #

Lattice points for line between points, not including endpoints

Directions

data Dir Source #

Constructors

North 
East 
South 
West 
Instances
Enum Dir Source # 
Instance details

Defined in AOC.Common

Methods

succ :: Dir -> Dir #

pred :: Dir -> Dir #

toEnum :: Int -> Dir #

fromEnum :: Dir -> Int #

enumFrom :: Dir -> [Dir] #

enumFromThen :: Dir -> Dir -> [Dir] #

enumFromTo :: Dir -> Dir -> [Dir] #

enumFromThenTo :: Dir -> Dir -> Dir -> [Dir] #

Eq Dir Source # 
Instance details

Defined in AOC.Common

Methods

(==) :: Dir -> Dir -> Bool #

(/=) :: Dir -> Dir -> Bool #

Ord Dir Source # 
Instance details

Defined in AOC.Common

Methods

compare :: Dir -> Dir -> Ordering #

(<) :: Dir -> Dir -> Bool #

(<=) :: Dir -> Dir -> Bool #

(>) :: Dir -> Dir -> Bool #

(>=) :: Dir -> Dir -> Bool #

max :: Dir -> Dir -> Dir #

min :: Dir -> Dir -> Dir #

Show Dir Source # 
Instance details

Defined in AOC.Common

Methods

showsPrec :: Int -> Dir -> ShowS #

show :: Dir -> String #

showList :: [Dir] -> ShowS #

Generic Dir Source # 
Instance details

Defined in AOC.Common

Associated Types

type Rep Dir :: Type -> Type #

Methods

from :: Dir -> Rep Dir x #

to :: Rep Dir x -> Dir #

Semigroup Dir Source #

<> is mulDir.

Instance details

Defined in AOC.Common

Methods

(<>) :: Dir -> Dir -> Dir #

sconcat :: NonEmpty Dir -> Dir #

stimes :: Integral b => b -> Dir -> Dir #

Monoid Dir Source # 
Instance details

Defined in AOC.Common

Methods

mempty :: Dir #

mappend :: Dir -> Dir -> Dir #

mconcat :: [Dir] -> Dir #

NFData Dir Source # 
Instance details

Defined in AOC.Common

Methods

rnf :: Dir -> () #

Hashable Dir Source # 
Instance details

Defined in AOC.Common

Methods

hashWithSalt :: Int -> Dir -> Int #

hash :: Dir -> Int #

Group Dir Source # 
Instance details

Defined in AOC.Common

Methods

invert :: Dir -> Dir #

pow :: Integral x => Dir -> x -> Dir #

Abelian Dir Source # 
Instance details

Defined in AOC.Common

type Rep Dir Source # 
Instance details

Defined in AOC.Common

type Rep Dir = D1 (MetaData "Dir" "AOC.Common" "aoc2019-0.1.0.0-EhTXSml1EW7BLze828MOzZ" False) ((C1 (MetaCons "North" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "East" PrefixI False) (U1 :: Type -> Type)) :+: (C1 (MetaCons "South" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "West" PrefixI False) (U1 :: Type -> Type)))

dirPoint' :: Dir -> Point Source #

dirPoint but with inverted y axis

mulDir :: Dir -> Dir -> Dir Source #

Multiply headings, taking North as straight, East as clockwise turn, West as counter-clockwise turn, and South as reverse.

Should be a commutative group; it's essentially complex number multiplication like mulPoint, with North = 1, West = i. The identity is North and the inverse is the opposite direction.

2D Maps

boundingBox :: (Foldable1 f, Applicative g, Ord a) => f (g a) -> V2 (g a) Source #

Find the minimum and maximum x and y from a collection of points.

Returns V2 (V2 xMin yMin) (V2 xMax yMax).

boundingBox' :: Foldable f => f Point -> Maybe (V2 Point) Source #

A version of boundingBox that works for normal possibly-empty lists.

newtype ScanPoint Source #

It's Point, but with a newtype wrapper so we have an Ord that sorts by y first, then x

Constructors

SP 

Fields

Instances
Eq ScanPoint Source # 
Instance details

Defined in AOC.Common

Num ScanPoint Source # 
Instance details

Defined in AOC.Common

Ord ScanPoint Source # 
Instance details

Defined in AOC.Common

Show ScanPoint Source # 
Instance details

Defined in AOC.Common

Generic ScanPoint Source # 
Instance details

Defined in AOC.Common

Associated Types

type Rep ScanPoint :: Type -> Type #

NFData ScanPoint Source # 
Instance details

Defined in AOC.Common

Methods

rnf :: ScanPoint -> () #

Hashable ScanPoint Source # 
Instance details

Defined in AOC.Common

type Rep ScanPoint Source # 
Instance details

Defined in AOC.Common

type Rep ScanPoint = D1 (MetaData "ScanPoint" "AOC.Common" "aoc2019-0.1.0.0-EhTXSml1EW7BLze828MOzZ" True) (C1 (MetaCons "SP" PrefixI True) (S1 (MetaSel (Just "_getSP") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Point)))

displayAsciiMap Source #

Arguments

:: Char

default tile

-> Map Point Char

tile map

-> String 

Orphan instances

FunctorWithIndex k (NEMap k) Source # 
Instance details

Methods

imap :: (k -> a -> b) -> NEMap k a -> NEMap k b #

imapped :: IndexedSetter k (NEMap k a) (NEMap k b) a b #

FoldableWithIndex k (NEMap k) Source # 
Instance details

Methods

ifoldMap :: Monoid m => (k -> a -> m) -> NEMap k a -> m #

ifolded :: IndexedFold k (NEMap k a) a #

ifoldr :: (k -> a -> b -> b) -> b -> NEMap k a -> b #

ifoldl :: (k -> b -> a -> b) -> b -> NEMap k a -> b #

ifoldr' :: (k -> a -> b -> b) -> b -> NEMap k a -> b #

ifoldl' :: (k -> b -> a -> b) -> b -> NEMap k a -> b #

TraversableWithIndex k (NEMap k) Source # 
Instance details

Methods

itraverse :: Applicative f => (k -> a -> f b) -> NEMap k a -> f (NEMap k b) #

itraversed :: IndexedTraversal k (NEMap k a) (NEMap k b) a b #

(Ord k, Ord p) => Ixed (OrdPSQ k p v) Source # 
Instance details

Methods

ix :: Index (OrdPSQ k p v) -> Traversal' (OrdPSQ k p v) (IxValue (OrdPSQ k p v)) #

(Ixed (v a), Index (v a) ~ Int, IxValue (v a) ~ a) => Ixed (Vector v n a) Source # 
Instance details

Methods

ix :: Index (Vector v n a) -> Traversal' (Vector v n a) (IxValue (Vector v n a)) #