Copyright | (c) Justin Le 2019 |
---|---|
License | BSD3 |
Maintainer | justin@jle.im |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
AOC.Common
Description
Common functions for solutions
Synopsis
- iterateMaybe :: (a -> Maybe a) -> a -> [a]
- loopMaybe :: (a -> Maybe a) -> a -> a
- loopMaybeM :: Monad m => (a -> m (Maybe a)) -> a -> m a
- loopEither :: (a -> Either r a) -> a -> r
- firstJust :: Foldable t => (a -> Maybe b) -> t a -> Maybe b
- (!!!) :: [a] -> Int -> a
- (!?) :: [a] -> Int -> Maybe a
- drop' :: Int -> [a] -> [a]
- dup :: a -> (a, a)
- scanlT :: Traversable t => (b -> a -> b) -> b -> t a -> t b
- scanrT :: Traversable t => (a -> b -> b) -> b -> t a -> t b
- firstRepeated :: Ord a => [a] -> Maybe a
- fixedPoint :: Eq a => (a -> a) -> a -> a
- floodFill :: Ord a => (a -> Set a) -> Set a -> Set a
- floodFillCount :: Ord a => (a -> Set a) -> Set a -> (Int, Set a)
- countTrue :: Foldable f => (a -> Bool) -> f a -> Int
- freqs :: (Foldable f, Ord a) => f a -> Map a Int
- lookupFreq :: Ord a => a -> Map a Int -> Int
- freqList :: (Foldable f, Ord a) => f a -> [(Int, a)]
- revFreq :: (Foldable f, Ord a) => f a -> IntMap (NESet a)
- perturbations :: (a -> [a]) -> [a] -> [[a]]
- clearOut :: (Char -> Bool) -> String -> String
- foldMapPar :: Monoid b => (a -> b) -> [a] -> b
- foldMapPar1 :: Semigroup b => (a -> b) -> NonEmpty a -> b
- meanVar :: Fractional a => Fold a (a, a)
- maximumVal :: Ord b => Map a b -> Maybe (a, b)
- maximumValBy :: (b -> b -> Ordering) -> Map a b -> Maybe (a, b)
- minimumVal :: Ord b => Map a b -> Maybe (a, b)
- minimumValBy :: (b -> b -> Ordering) -> Map a b -> Maybe (a, b)
- maximumValNE :: Ord b => NEMap a b -> (a, b)
- maximumValByNE :: (b -> b -> Ordering) -> NEMap a b -> (a, b)
- minimumValNE :: Ord b => NEMap a b -> (a, b)
- minimumValByNE :: (b -> b -> Ordering) -> NEMap a b -> (a, b)
- listTup :: [a] -> Maybe (a, a)
- listTup3 :: [a] -> Maybe (a, a, a)
- listTup4 :: [a] -> Maybe (a, a, a, a)
- deleteFinite :: KnownNat n => Finite (n + 1) -> Finite (n + 1) -> Maybe (Finite n)
- type Letter = Finite 26
- charFinite :: Char -> Maybe (Bool, Finite 26)
- _CharFinite :: Prism' Char (Bool, Finite 26)
- digitToIntSafe :: Char -> Maybe Int
- caeser :: Finite 26 -> Char -> Char
- eitherItem :: Lens' (Either a a) a
- getDown :: Down a -> a
- toNatural :: Integral a => a -> Maybe Natural
- newtype TokStream a = TokStream {
- getTokStream :: [a]
- parseTokStream :: Foldable t => Parsec e (TokStream s) a -> t s -> Either (ParseErrorBundle (TokStream s) e) a
- parseTokStream_ :: (Alternative m, Foldable t) => Parsec e (TokStream s) a -> t s -> m a
- parseTokStreamT :: (Foldable t, Monad m) => ParsecT e (TokStream s) m a -> t s -> m (Either (ParseErrorBundle (TokStream s) e) a)
- parseTokStreamT_ :: (Alternative f, Foldable t, Monad m) => ParsecT e (TokStream s) m a -> t s -> m (f a)
- nextMatch :: MonadParsec e s m => m a -> m a
- type Point = V2 Int
- cardinalNeighbs :: Point -> [Point]
- cardinalNeighbsSet :: Point -> Set Point
- fullNeighbs :: Point -> [Point]
- fullNeighbsSet :: Point -> Set Point
- mannDist :: (Foldable f, Num a, Num (f a)) => f a -> f a -> a
- mulPoint :: Point -> Point -> Point
- lineTo :: Point -> Point -> [Point]
- data Dir
- parseDir :: Char -> Maybe Dir
- dirPoint :: Dir -> Point
- dirPoint' :: Dir -> Point
- mulDir :: Dir -> Dir -> Dir
- memoPoint :: Memo Point
- boundingBox :: (Foldable1 f, Applicative g, Ord a) => f (g a) -> V2 (g a)
- boundingBox' :: Foldable f => f Point -> Maybe (V2 Point)
- parseAsciiMap :: (Char -> Maybe a) -> String -> Map Point a
- asciiGrid :: IndexedFold Point String Char
- newtype ScanPoint = SP {}
- displayAsciiMap :: Char -> Map Point Char -> String
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.
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.
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
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
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.
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.
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.
Simple type util
deleteFinite :: KnownNat n => Finite (n + 1) -> Finite (n + 1) -> Maybe (Finite n) Source #
Delete a potential value from a Finite
.
eitherItem :: Lens' (Either a a) a Source #
Parsers
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
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
cardinalNeighbs :: Point -> [Point] Source #
fullNeighbs :: Point -> [Point] 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
Instances
Enum Dir Source # | |
Eq Dir Source # | |
Ord Dir Source # | |
Show Dir Source # | |
Generic Dir Source # | |
Semigroup Dir Source # | |
Monoid Dir Source # | |
NFData Dir Source # | |
Defined in AOC.Common | |
Hashable Dir Source # | |
Defined in AOC.Common | |
Group Dir Source # | |
Abelian Dir Source # | |
Defined in AOC.Common | |
type Rep Dir Source # | |
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))) |
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.
Instances
Eq ScanPoint Source # | |
Num ScanPoint Source # | |
Ord ScanPoint Source # | |
Show ScanPoint Source # | |
Generic ScanPoint Source # | |
NFData ScanPoint Source # | |
Defined in AOC.Common | |
Hashable ScanPoint Source # | |
Defined in AOC.Common | |
type Rep ScanPoint Source # | |
Defined in AOC.Common |
Orphan instances
FunctorWithIndex k (NEMap k) Source # | |
FoldableWithIndex k (NEMap k) Source # | |
TraversableWithIndex k (NEMap k) Source # | |
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 # | |
(Ixed (v a), Index (v a) ~ Int, IxValue (v a) ~ a) => Ixed (Vector v n a) Source # | |