grids-0.5.0.1

Safe HaskellNone
LanguageHaskell2010

Data.Grid

Contents

Synopsis

Grids

newtype Grid (dims :: [Nat]) a Source #

An grid of arbitrary dimensions.

e.g. a Grid [2, 3] Int might look like:

generate id :: Grid [2, 3] Int
fromNestedLists [[0,1,2],
                 [3,4,5]]

Constructors

Grid 

Fields

Instances
Functor (Grid dims) Source # 
Instance details

Defined in Data.Grid.Internal.Grid

Methods

fmap :: (a -> b) -> Grid dims a -> Grid dims b #

(<$) :: a -> Grid dims b -> Grid dims a #

IsGrid dims => Applicative (Grid dims) Source # 
Instance details

Defined in Data.Grid.Internal.Grid

Methods

pure :: a -> Grid dims a #

(<*>) :: Grid dims (a -> b) -> Grid dims a -> Grid dims b #

liftA2 :: (a -> b -> c) -> Grid dims a -> Grid dims b -> Grid dims c #

(*>) :: Grid dims a -> Grid dims b -> Grid dims b #

(<*) :: Grid dims a -> Grid dims b -> Grid dims a #

Foldable (Grid dims) Source # 
Instance details

Defined in Data.Grid.Internal.Grid

Methods

fold :: Monoid m => Grid dims m -> m #

foldMap :: Monoid m => (a -> m) -> Grid dims a -> m #

foldr :: (a -> b -> b) -> b -> Grid dims a -> b #

foldr' :: (a -> b -> b) -> b -> Grid dims a -> b #

foldl :: (b -> a -> b) -> b -> Grid dims a -> b #

foldl' :: (b -> a -> b) -> b -> Grid dims a -> b #

foldr1 :: (a -> a -> a) -> Grid dims a -> a #

foldl1 :: (a -> a -> a) -> Grid dims a -> a #

toList :: Grid dims a -> [a] #

null :: Grid dims a -> Bool #

length :: Grid dims a -> Int #

elem :: Eq a => a -> Grid dims a -> Bool #

maximum :: Ord a => Grid dims a -> a #

minimum :: Ord a => Grid dims a -> a #

sum :: Num a => Grid dims a -> a #

product :: Num a => Grid dims a -> a #

Traversable (Grid dims) Source # 
Instance details

Defined in Data.Grid.Internal.Grid

Methods

traverse :: Applicative f => (a -> f b) -> Grid dims a -> f (Grid dims b) #

sequenceA :: Applicative f => Grid dims (f a) -> f (Grid dims a) #

mapM :: Monad m => (a -> m b) -> Grid dims a -> m (Grid dims b) #

sequence :: Monad m => Grid dims (m a) -> m (Grid dims a) #

IsGrid dims => Distributive (Grid dims) Source # 
Instance details

Defined in Data.Grid.Internal.Grid

Methods

distribute :: Functor f => f (Grid dims a) -> Grid dims (f a) #

collect :: Functor f => (a -> Grid dims b) -> f a -> Grid dims (f b) #

distributeM :: Monad m => m (Grid dims a) -> Grid dims (m a) #

collectM :: Monad m => (a -> Grid dims b) -> m a -> Grid dims (m b) #

IsGrid dims => Representable (Grid dims) Source # 
Instance details

Defined in Data.Grid.Internal.Grid

Associated Types

type Rep (Grid dims) :: Type #

Methods

tabulate :: (Rep (Grid dims) -> a) -> Grid dims a #

index :: Grid dims a -> Rep (Grid dims) -> a #

Eq a => Eq (Grid dims a) Source # 
Instance details

Defined in Data.Grid.Internal.Grid

Methods

(==) :: Grid dims a -> Grid dims a -> Bool #

(/=) :: Grid dims a -> Grid dims a -> Bool #

(Num n, IsGrid dims) => Num (Grid dims n) Source # 
Instance details

Defined in Data.Grid.Internal.Grid

Methods

(+) :: Grid dims n -> Grid dims n -> Grid dims n #

(-) :: Grid dims n -> Grid dims n -> Grid dims n #

(*) :: Grid dims n -> Grid dims n -> Grid dims n #

negate :: Grid dims n -> Grid dims n #

abs :: Grid dims n -> Grid dims n #

signum :: Grid dims n -> Grid dims n #

fromInteger :: Integer -> Grid dims n #

(PrettyList (NestedLists dims a), IsGrid dims, Show (NestedLists dims a)) => Show (Grid dims a) Source # 
Instance details

Defined in Data.Grid.Internal.Grid

Methods

showsPrec :: Int -> Grid dims a -> ShowS #

show :: Grid dims a -> String #

showList :: [Grid dims a] -> ShowS #

(IsGrid dims, Semigroup a) => Semigroup (Grid dims a) Source # 
Instance details

Defined in Data.Grid.Internal.Grid

Methods

(<>) :: Grid dims a -> Grid dims a -> Grid dims a #

sconcat :: NonEmpty (Grid dims a) -> Grid dims a #

stimes :: Integral b => b -> Grid dims a -> Grid dims a #

(IsGrid dims, Monoid a) => Monoid (Grid dims a) Source # 
Instance details

Defined in Data.Grid.Internal.Grid

Methods

mempty :: Grid dims a #

mappend :: Grid dims a -> Grid dims a -> Grid dims a #

mconcat :: [Grid dims a] -> Grid dims a #

NFData a => NFData (Grid dims a) Source # 
Instance details

Defined in Data.Grid.Internal.Grid

Methods

rnf :: Grid dims a -> () #

type Rep (Grid dims) Source # 
Instance details

Defined in Data.Grid.Internal.Grid

type Rep (Grid dims) = Coord dims

Creation

generate :: forall dims a. IsGrid dims => (Int -> a) -> Grid dims a Source #

Build a grid by selecting an element for each element

tabulate :: Representable f => (Rep f -> a) -> f a #

fmap f . tabulatetabulate . fmap f

If no definition is provided, this will default to gtabulate.

fromNestedLists :: forall dims a. IsGrid dims => NestedLists dims a -> Maybe (Grid dims a) Source #

Turn a nested list structure into a Grid if the list is well formed. Required list nesting increases for each dimension

fromNestedLists [[0,1,2],[3,4,5]] :: Maybe (Grid [2, 3] Int)
Just (Grid [[0,1,2],[3,4,5]])
fromNestedLists [[0],[1,2]] :: Maybe (Grid [2, 3] Int)
Nothing

fromNestedLists' :: forall dims a. IsGrid dims => NestedLists dims a -> Grid dims a Source #

Partial variant of fromNestedLists which errors on malformed input

fromList :: forall dims a. IsGrid dims => [a] -> Maybe (Grid dims a) Source #

Convert a list into a Grid or fail if not provided the correct number of elements

G.fromList [0, 1, 2, 3, 4, 5] :: Maybe (Grid [2, 3] Int)
Just (Grid [[0,1,2],[3,4,5]])
G.fromList [0, 1, 2, 3] :: Maybe (Grid [2, 3] Int)
Nothing

fromList' :: forall dims a. IsGrid dims => [a] -> Grid dims a Source #

Partial variant of fromList which errors on malformed input

Collapsing

toNestedLists :: forall dims a. IsGrid dims => Grid dims a -> NestedLists dims a Source #

Turn a grid into a nested list structure. List nesting increases for each dimension

toNestedLists (G.generate id :: Grid [2, 3] Int)
[[0,1,2],[3,4,5]]

Indexing

newtype Coord (dims :: [Nat]) Source #

The index type for Grids.

Constructors

Coord 

Fields

Instances
IsList (Coord dims) Source # 
Instance details

Defined in Data.Grid.Internal.Coord

Associated Types

type Item (Coord dims) :: Type #

Methods

fromList :: [Item (Coord dims)] -> Coord dims #

fromListN :: Int -> [Item (Coord dims)] -> Coord dims #

toList :: Coord dims -> [Item (Coord dims)] #

(KnownNat n, Bounded (Coord ns)) => Bounded (Coord (n ': ns)) Source # 
Instance details

Defined in Data.Grid.Internal.Coord

Methods

minBound :: Coord (n ': ns) #

maxBound :: Coord (n ': ns) #

Bounded (Coord ([] :: [Nat])) Source # 
Instance details

Defined in Data.Grid.Internal.Coord

Methods

minBound :: Coord [] #

maxBound :: Coord [] #

(KnownNat x, KnownNat y, Sizable (y ': rest), Bounded (Coord rest), Enum (Coord (y ': rest))) => Enum (Coord (x ': (y ': rest))) Source # 
Instance details

Defined in Data.Grid.Internal.Coord

Methods

succ :: Coord (x ': (y ': rest)) -> Coord (x ': (y ': rest)) #

pred :: Coord (x ': (y ': rest)) -> Coord (x ': (y ': rest)) #

toEnum :: Int -> Coord (x ': (y ': rest)) #

fromEnum :: Coord (x ': (y ': rest)) -> Int #

enumFrom :: Coord (x ': (y ': rest)) -> [Coord (x ': (y ': rest))] #

enumFromThen :: Coord (x ': (y ': rest)) -> Coord (x ': (y ': rest)) -> [Coord (x ': (y ': rest))] #

enumFromTo :: Coord (x ': (y ': rest)) -> Coord (x ': (y ': rest)) -> [Coord (x ': (y ': rest))] #

enumFromThenTo :: Coord (x ': (y ': rest)) -> Coord (x ': (y ': rest)) -> Coord (x ': (y ': rest)) -> [Coord (x ': (y ': rest))] #

KnownNat n => Enum (Coord (n ': ([] :: [Nat]))) Source # 
Instance details

Defined in Data.Grid.Internal.Coord

Methods

succ :: Coord (n ': []) -> Coord (n ': []) #

pred :: Coord (n ': []) -> Coord (n ': []) #

toEnum :: Int -> Coord (n ': []) #

fromEnum :: Coord (n ': []) -> Int #

enumFrom :: Coord (n ': []) -> [Coord (n ': [])] #

enumFromThen :: Coord (n ': []) -> Coord (n ': []) -> [Coord (n ': [])] #

enumFromTo :: Coord (n ': []) -> Coord (n ': []) -> [Coord (n ': [])] #

enumFromThenTo :: Coord (n ': []) -> Coord (n ': []) -> Coord (n ': []) -> [Coord (n ': [])] #

Eq (Coord dims) Source # 
Instance details

Defined in Data.Grid.Internal.Coord

Methods

(==) :: Coord dims -> Coord dims -> Bool #

(/=) :: Coord dims -> Coord dims -> Bool #

Enum (Coord ns) => Num (Coord ns) Source # 
Instance details

Defined in Data.Grid.Internal.Coord

Methods

(+) :: Coord ns -> Coord ns -> Coord ns #

(-) :: Coord ns -> Coord ns -> Coord ns #

(*) :: Coord ns -> Coord ns -> Coord ns #

negate :: Coord ns -> Coord ns #

abs :: Coord ns -> Coord ns #

signum :: Coord ns -> Coord ns #

fromInteger :: Integer -> Coord ns #

Show (Coord dims) Source # 
Instance details

Defined in Data.Grid.Internal.Coord

Methods

showsPrec :: Int -> Coord dims -> ShowS #

show :: Coord dims -> String #

showList :: [Coord dims] -> ShowS #

type Item (Coord dims) Source # 
Instance details

Defined in Data.Grid.Internal.Coord

type Item (Coord dims) = Int

coord :: forall dims. SingI dims => [Int] -> Maybe (Coord dims) Source #

Safely construct a Coord for a given grid size, checking that all indexes are in range

λ> coord @[3, 3] [1, 2]
Just [1, 2]

λ> coord @[3, 3] [3, 3]
Nothing

λ> coord @[3, 3] [1, 2, 3]
Nothing

unconsC :: Coord (n ': ns) -> (Int, Coord ns) Source #

Get the first index from a Coord

appendC :: Coord ns -> Coord ms -> Coord (ns ++ ms) Source #

Append two Coords

index :: Representable f => f a -> Rep f -> a #

If no definition is provided, this will default to gindex.

Updating

(//) :: forall dims a. IsGrid dims => Grid dims a -> [(Coord dims, a)] -> Grid dims a Source #

Update elements of a grid

Lenses

cell :: forall dims a. IsGrid dims => Coord dims -> Lens' (Grid dims a) a Source #

Focus an element of a Grid given its Coord

Convolution

autoConvolute Source #

Arguments

:: (IsGrid dims, IsGrid window, Functor f) 
=> (Grid window (Coord dims) -> f (Coord dims))

Restrict out of bounds coordinates in some way. Use clampWindow, wrapWindow or safeWindow

-> (f a -> b)

Collapse the context down to a value

-> Grid dims a

Starting grid

-> Grid dims b 

Perform a computation based on the context surrounding a cell Good for doing things like Linear Image Filters (e.g. gaussian blur) or simulating Cellular Automata (e.g. Conway's game of life)

This function accepts a function which indicates what to do with 'out-of-bounds' indexes, clampWindow, wrapWindow and safeWindow are examples.

It also acccepts a transformation function which operates over the functor created by the first parameter and collapses it down to a new value for the cell at that position.

This function is best used with Type Applications to denote the desired window size; the Grid passed to the given function contains the current cell (in the middle) and all the surrounding cells.

Here's an example of computing the average of all neighboring cells, repeating values at the edge of the grid when indexes are out of bounds (using clampWindow)

gaussian :: (IsGrid dims) => Grid dims Double -> Grid dims Double
gaussian = autoConvolute clampBounds avg
 where
  avg :: Grid '[3, 3] Double -> Double
  avg g = sum g / fromIntegral (length g)

convolute Source #

Arguments

:: (Functor f, IsGrid dims) 
=> (Coord dims -> f (Coord dims))

Build a neighboring context within a functor from the current coord

-> (f a -> b)

Collapse the context to a single value

-> Grid dims a

Starting grid

-> Grid dims b 

This is a fully generic version of autoConvolute which allows the user to provide a function which builds a context from the current coord, then provides a collapsing function over the same functor.

window :: forall window dims. IsGrid window => Coord dims -> Grid window (Coord dims) Source #

Given a coordinate generate a grid of size window filled with coordinates surrounding the given coord. Mostly used internally

Convolution Utils

partitionFocus :: forall window a. (Centered window, IsGrid window) => Grid window a -> (a, Grid window (Maybe a)) Source #

Bounds restriction

clampBounds :: (IsGrid dims, Functor f) => f (Coord dims) -> f (Coord dims) Source #

Use with autoConvolute; Clamp out-of-bounds coordinates to the nearest in-bounds coord.

wrapBounds :: (IsGrid dims, Functor f) => f (Coord dims) -> f (Coord dims) Source #

Use with autoConvolute; Wrap out-of-bounds coordinates pac-man style to the other side of the grid

omitBounds :: (IsGrid dims, Functor f) => f (Coord dims) -> Compose f Maybe (Coord dims) Source #

Use with autoConvolute; Out of bounds coords become Nothing

Permutations

transpose :: (IsGrid '[x, y], IsGrid '[y, x]) => Grid '[x, y] a -> Grid '[y, x] a Source #

Transpose a 2 dimensional matrix. Equivalent to:

permute @[1, 0]

permute :: forall (key :: [Nat]) from a invertedKey. (SingI invertedKey, invertedKey ~ InvertKey (EnumFromTo 0 (Length from - 1)) key, ValidPermutation key from, IsGrid from, IsGrid (Permuted key from)) => Grid from a -> Grid (Permuted key from) a Source #

Permute dimensions of a Grid. This is similar to MatLab's permute function

permute requires a type application containing a permutation pattern; The pattern is a re-ordering of the list [0..n] which represents the new dimension order. For example the permutation pattern [1, 2, 0] when applied to the dimensions [4, 5, 6] results in the dimensions [5, 6, 4].

For 2 dimensional matrixes, a permutation using [1, 0] is simply a matrix transpose

λ> small
fromNestedLists
  [[0,1,2]
  ,[3,4,5]
  ,[6,7,8]]

λ> permute @[1, 0] small
fromNestedLists
  [[0,3,6]
  ,[1,4,7]
  ,[2,5,8]]

permuteCoord :: forall (key :: [Nat]) to from. SingI key => Coord from -> Coord to Source #

Permute the dimensions of a coordinate according to a permutation pattern. see permute regarding permutation patterns

Joining

joinGrid :: Grid dims (Grid ns a) -> Grid (dims ++ ns) a Source #

The inverse of splitGrid, joinGrid will nest a grid from: > Grid outer (Grid inner a) -> Grid (outer ++ inner) a

For example, you can nest a simple 3x3 from smaller [3] grids as follows:

joinGrid (myGrid :: Grid [3] (Grid [3] a)) :: Grid '[3, 3] a

splitGrid :: forall outer inner a from. (IsGrid from, IsGrid inner, IsGrid outer, NestedLists from a ~ NestedLists outer (NestedLists inner a)) => Grid from a -> Grid outer (Grid inner a) Source #

The inverse of joinGrid, splitGrid outerDims innerDims will un-nest a grid from: > Grid (outer ++ inner) a -> Grid outer (Grid inner a)

For example, you can unnest a simple 3x3 as follows:

splitGrid @'[3] @'[3] myGrid :: Grid '[3] (Grid [3] a)

Typeclasses & Type Families

type IsGrid dims = (AllC KnownNat dims, SingI dims, Sizable dims, Representable (Grid dims), Enum (Coord dims), Bounded (Coord dims), Neighboring dims) Source #

class Sizable (dims :: [Nat]) where Source #

Represents valid dimensionalities. All non empty lists of Nats have an instance

Methods

nestLists :: Proxy dims -> Vector a -> NestedLists dims a Source #

unNestLists :: Proxy dims -> NestedLists dims a -> [a] Source #

gridSize :: Proxy dims -> Int Source #

Get the total size of a Grid of the given dimensions

gridSize (Proxy @'[2, 2]) == 4
Instances
(KnownNat x, Sizable (y ': xs)) => Sizable (x ': (y ': xs)) Source # 
Instance details

Defined in Data.Grid.Internal.NestedLists

Methods

nestLists :: Proxy (x ': (y ': xs)) -> Vector a -> NestedLists (x ': (y ': xs)) a Source #

unNestLists :: Proxy (x ': (y ': xs)) -> NestedLists (x ': (y ': xs)) a -> [a] Source #

gridSize :: Proxy (x ': (y ': xs)) -> Int Source #

KnownNat x => Sizable (x ': ([] :: [Nat])) Source # 
Instance details

Defined in Data.Grid.Internal.NestedLists

Methods

nestLists :: Proxy (x ': []) -> Vector a -> NestedLists (x ': []) a Source #

unNestLists :: Proxy (x ': []) -> NestedLists (x ': []) a -> [a] Source #

gridSize :: Proxy (x ': []) -> Int Source #

type family NestedLists (dims :: [Nat]) a where ... Source #

Computes the level of nesting requried to represent a given grid dimensionality as a nested list

NestedLists [2, 3] Int == [[Int]]
NestedLists [2, 3, 4] Int == [[[Int]]]

Equations

NestedLists '[] a = a 
NestedLists (_ ': xs) a = [NestedLists xs a] 

class Neighboring dims Source #

Minimal complete definition

neighborCoords

Instances
(KnownNat n, Neighboring ns) => Neighboring (n ': ns) Source # 
Instance details

Defined in Data.Grid.Internal.Grid

Methods

neighborCoords :: Grid (n ': ns) (Coord (n ': ns)) Source #

IsGrid (n ': ([] :: [Nat])) => Neighboring (n ': ([] :: [Nat])) Source # 
Instance details

Defined in Data.Grid.Internal.Grid

Methods

neighborCoords :: Grid (n ': []) (Coord (n ': [])) Source #

type ValidPermutation key from = (Sort key == EnumFromTo 0 (Length from - 1)) ?! (((((Text "Malformed permutation hint: " :<>: ShowType key) :$$: (Text "When permuting matrix of size: " :<>: ShowType from)) :$$: (Text "Key must be a permutation of " :<>: ShowType (EnumFromTo 0 (Length from - 1)))) :$$: Text "e.g. the identity permutation for 2x2 is @[0, 1]") :$$: Text "e.g. matrix transpose for 2x2 is @[1, 0]") Source #

type family Permuted (key :: [Nat]) (from :: [Nat]) :: [Nat] where ... Source #

Equations

Permuted '[] _ = '[] 
Permuted (x ': xs) from = (from !! x) ': Permuted xs from