grids 0.3.0.0 → 0.4.0.0

raw patch · 19 files changed

+357/−292 lines, 19 filesdep +bifunctorsPVP ok

version bump matches the API change (PVP)

Dependencies added: bifunctors

API changes (from Hackage documentation)

Files

• README.md +26/−21
• grids.cabal +10/−5
• src/Data/Grid.hs +22/−27
• src/Data/Grid/Examples/Conway.hs +15/−11
• src/Data/Grid/Examples/Intro.hs +7/−8
• src/Data/Grid/Internal/Convolution.hs +41/−54
• src/Data/Grid/Internal/Coord.hs +3/−9
• src/Data/Grid/Internal/Errors.hs +3/−3
• src/Data/Grid/Internal/Grid.hs +8/−2
• src/Data/Grid/Internal/Identity.hs +0/−18
• src/Data/Grid/Internal/Lens.hs +1/−2
• src/Data/Grid/Internal/Nest.hs +0/−2
• src/Data/Grid/Internal/NestedLists.hs +0/−1
• src/Data/Grid/Internal/Pretty.hs +2/−2
• src/Data/Grid/Internal/Shapes.hs +55/−0
• src/Data/Grid/Internal/Transpose.hs +5/−9
• test/Spec.hs +4/−118
• test/Spec/Grid.hs +128/−0
• test/Spec/Shapes.hs +27/−0

@@ -2,12 +2,23 @@  [HACKAGE](http://hackage.haskell.org/package/grids) +**Note** this lib is still pretty new and relatively experimental, as such it+doesn't have great performance characteristics. Maybe don't use it in+performance critical applications.+ Grids can have an arbitrary amount of dimensions, specified by a type-level list of `Nat`s. -Each grid has Functor, Applicative, and Representable instances making it easy to do **Matlab-style** matrix programming. `liftA2 (+)` does piecewise addition, etc.+Each grid has Functor, Applicative, and Representable instances making it easy+to do **Matlab-style** matrix programming. The `Applicative` instance operates+piecewise making it easy to do most math operations. There's a `Num` instance+for grids holding numbers, so piecewise addition is just `grid1 + grid2`, the+`fromInteger` implementation allows things like `myGrid * 5` to perform+multiplication (although it's likely less efficient than using fmap!) -By combining with `Control.Comonad.Representable.Store` you can do context-wise **linear transformations** for things like **Image Processing** or **Cellular Automata**.+By combining with `Control.Comonad.Representable.Store` you can do context-wise+**linear transformations** for things like **Image Processing** or **Cellular+Automata**.  All in a typesafe package! @@ -75,31 +86,25 @@  ## Indexing -You can index into a grid using the `Coord` type family. The number of-coordinates you need depends on the shape of the grid. The Coord is stitched-together using the `:#` constructor from 1 or more `Finite` values. Each Finite-value is scoped to the size of its dimension, so you'll need to prove that each-index is within range (or just use `finite` to wrap an `Integer` and the-compiler will trust you). Here's the type of Coord for a few different Grids:--```haskell-Coord '[1] == Finite 1-Coord '[1, 2] == Finite 1 :# Finite 2-Coord '[1, 2, 3] == Finite 1 :# Finite 2 :# Finite 3-```+You can index into a grid using the `Coord` type. The number of+coordinates you need depends on the shape of the grid. +`Coord` is really just a wrapping over a list of integers. It's recommended that+you use `coord` to safely construct `Coord` values, but you can cheat and use +the `Coord` constructor or even `OverLoadedLists` if you want to.+ Here's the type of Coord for a few different Grids: -You can get a value at an index out using `index` from `Data.Functor.Rep`:+You can get a value out of a grid for a particular index out using `index` from `Data.Functor.Rep`:  ```haskell λ> let g = generate id :: Grid '[2, 3] Int λ> g (Grid [[0,1,2]       ,[3,4,5]])-λ> g `index` (1 :# 1)+λ> g `index` Coord [1 , 1] 4-λ> g `index` (1 :# 0)+λ> g `index` Coord [1, 0] 3-λ> g `index` (0 :# 2)+λ> g `index` Coord [0,  2] 2 ``` @@ -107,16 +112,16 @@ indices:  ```haskell-λ> g ^. cell (0 :# 1)+λ> g ^. cell (Coord [0, 1]) 1-λ> g & cell (0 :# 1) *~ 1000+λ> g & cell (Coord [0, 1]) *~ 1000 (Grid [[0,1000,2],[3,4,5]]) ```  ## Creation  You can generate a grid by providing a function over the integer position in the grid (`generate`) or by providing-a function over the coordinate position of the cell (`tabulate`).+a function over the coordinate position of the cell (`tabulate`). Or of course you can just use `pure`  You can also use the `fromList` and `fromNestedLists` functions which return a `Maybe (Grid dims a)` depending on whether the input list is well formed.

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.0.+-- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack ----- hash: b776a0436dd05eb78d384efe21494a96d7c6b28f0de9046d2011ea75f53025df+-- hash: 81ed5c93ce5bb167a555fdde42ef9944161ed9cff400c4000736623698c2582f  name:           grids-version:        0.3.0.0+version:        0.4.0.0 description:    Arbitrary sized type-safe grids with useful combinators category:       Data Structures homepage:       https://github.com/ChrisPenner/grids#readme@@ -35,21 +35,22 @@       Data.Grid.Internal.Coord       Data.Grid.Internal.Errors       Data.Grid.Internal.Grid-      Data.Grid.Internal.Identity       Data.Grid.Internal.Lens       Data.Grid.Internal.Nest       Data.Grid.Internal.NestedLists       Data.Grid.Internal.Pretty+      Data.Grid.Internal.Shapes       Data.Grid.Internal.Transpose   other-modules:       Paths_grids   hs-source-dirs:       src   default-extensions: KindSignatures PolyKinds TypeApplications ScopedTypeVariables TypeOperators TypeFamilies FlexibleInstances FlexibleContexts MultiParamTypeClasses DataKinds GeneralizedNewtypeDeriving DeriveTraversable DeriveFunctor ConstraintKinds-  ghc-options: -fwarn-redundant-constraints+  ghc-options: -fwarn-redundant-constraints -Wall   build-depends:       adjunctions     , base >=4.7 && <5+    , bifunctors     , comonad     , deepseq     , distributive@@ -61,6 +62,8 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:+      Spec.Grid+      Spec.Shapes       Paths_grids   hs-source-dirs:       test@@ -69,6 +72,7 @@   build-depends:       adjunctions     , base >=4.7 && <5+    , bifunctors     , comonad     , deepseq     , distributive@@ -90,6 +94,7 @@   build-depends:       adjunctions     , base >=4.7 && <5+    , bifunctors     , comonad     , deepseq     , distributive

@@ -1,7 +1,5 @@ module Data.Grid-  (-  -- * Grids-   Grid(..)+  ( Grid(..)    -- * Creation   , generate   , Rep.tabulate@@ -9,57 +7,54 @@   , fromNestedLists'   , fromList   , fromList'--  -- * Collapsing+   -- * Collapsing   , toNestedLists--  -- * Indexing+   -- * Indexing   , Coord(..)   , coord   , unconsC   , appendC   , Rep.index--  -- * Updating+   -- * Updating   , (//)--  -- * Lenses+   -- * Lenses   , cell--  -- * Convolution+   -- * Convolution   , autoConvolute   , convolute+  , window -  -- ** Window restriction-  , clampWindow-  , wrapWindow-  , safeWindow+   -- ** Convolution Utils+  , partitionFocus+  , centerCoord -  -- * Permutations+   -- ** Bounds restriction+  , clampBounds+  , wrapBounds+  , omitBounds+   -- * Permutations   , transpose   , permute   , permuteCoord--  -- * Joining+   -- * Joining   , joinGrid   , splitGrid--  -- * Assorted+   -- * Assorted   , gridSize--  -- * Typeclasses & Type Families+   -- * Typeclasses & Type Families   , Dimensions   , NestedLists   , Neighboring   , ValidPermutation   , Permuted-  )-where+  ) where +-- * Grids import           Data.Grid.Internal.Grid+import           Data.Grid.Internal.Shapes import           Data.Grid.Internal.Nest import           Data.Grid.Internal.Lens import           Data.Grid.Internal.Transpose import           Data.Grid.Internal.Coord import           Data.Grid.Internal.Convolution-import           Data.Functor.Rep as Rep+import           Data.Functor.Rep               as Rep

@@ -1,21 +1,23 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE ViewPatterns #-}+ module Data.Grid.Examples.Conway where  import Data.Grid import Data.Foldable import Data.List+import Data.Functor.Compose -rule :: Grid '[3, 3] Bool -> Bool-rule g = (currentCellAlive && livingNeighbours == 2) || livingNeighbours == 3- where-  currentCellAlive = g `index` Coord [1, 1] -- Get the center cell-  livingNeighbours =-    (if currentCellAlive then subtract 1 else id) . length . filter id $ toList-      g+rule' :: Grid [3, 3] Bool -> Bool+rule' (partitionFocus -> (currentCellAlive,  neighbours)) = (currentCellAlive && livingNeighbours == 2) || livingNeighbours == 3+  where+    livingNeighbours = length . filter id . toList . Compose $ neighbours -step :: (Dimensions dims) => Grid dims Bool -> Grid dims Bool-step = autoConvolute wrapWindow rule+step+  :: (Dimensions dims)+  => Grid dims Bool -> Grid dims Bool+step = autoConvolute @[3, 3] wrapBounds rule'  glider :: [Coord '[10, 10]] glider = Coord <$> [[0, 1], [1, 2], [2, 0], [2, 1], [2, 2]]@@ -27,8 +29,10 @@ simulate = (iterate step start !!)  showBool :: Bool -> Char-showBool True  = '#'+showBool True = '#' showBool False = '.' -showGrid :: (Dimensions '[x, y]) => Grid '[x, y] Bool -> String+showGrid+  :: (Dimensions '[x, y])+  => Grid '[x, y] Bool -> String showGrid = intercalate "\n" . toNestedLists . fmap showBool

@@ -4,12 +4,8 @@ module Data.Grid.Examples.Intro where  import Data.Grid-import Data.Maybe import Data.Functor.Compose import Data.Coerce-import Data.Foldable-import Data.Functor.Rep-import GHC.TypeNats hiding ()  simpleGrid :: Grid '[5, 5] Int simpleGrid = generate id@@ -25,6 +21,9 @@ mx :: Foldable f => f Int -> Int mx = maximum +verySmall :: Grid '[2, 2] Int+verySmall = generate id+ small :: Grid '[3, 3] Int small = generate id @@ -39,20 +38,20 @@ big = generate id  gauss :: (Dimensions dims) => Grid dims Double -> Grid dims Double-gauss = autoConvolute safeWindow gauss'+gauss = autoConvolute omitBounds gauss'  where   gauss' :: Compose (Grid '[3, 3]) Maybe Double -> Double   gauss' g = (sum g) / fromIntegral (length g)  clampGauss :: (Dimensions dims) => Grid dims Double -> Grid dims Double-clampGauss = autoConvolute clampWindow gauss'+clampGauss = autoConvolute clampBounds gauss'  where   gauss' :: Grid '[3, 3] Double -> Double   gauss' g = sum g / fromIntegral (length g)   seeNeighboring :: Grid '[3, 3] a -> Grid '[3, 3] (Grid '[3, 3] (Maybe a))-seeNeighboring = autoConvolute safeWindow go+seeNeighboring = autoConvolute omitBounds go  where   go :: Compose (Grid '[3, 3]) Maybe a -> Grid '[3, 3] (Maybe a)   go = getCompose . coerce@@ -67,5 +66,5 @@ simpleGauss = gauss doubleGrid  pacmanGauss :: (Dimensions dims) => Grid dims Double -> Grid dims Double-pacmanGauss = autoConvolute @'[3, 3] wrapWindow gauss'+pacmanGauss = autoConvolute @'[3, 3] wrapBounds gauss'   where gauss' g = sum g / fromIntegral (length g)

@@ -1,23 +1,33 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE AllowAmbiguousTypes #-}-module Data.Grid.Internal.Convolution where+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE DeriveTraversable #-} -import           Data.Grid.Internal.Grid-import           Data.Grid.Internal.Coord-import           Data.Grid.Internal.Nest-import           Data.Functor.Rep-import           GHC.TypeNats-import           Data.Kind-import           Control.Applicative-import           Data.Functor.Compose-import           Data.Foldable-import           Data.Coerce +module Data.Grid.Internal.Convolution +  ( autoConvolute+  , convolute+  , clampBounds+  , wrapBounds+  , omitBounds+  , window+  , Neighboring+  ) where+ import           Control.Comonad import           Control.Comonad.Representable.Store-import           Data.Maybe-import           Data.Proxy+import           Data.Functor.Compose+import           Data.Functor.Rep+import           Data.Grid.Internal.Coord+import           Data.Grid.Internal.Grid+import           Data.Grid.Internal.Nest+import           GHC.TypeNats  criticalError :: a criticalError = error@@ -39,12 +49,12 @@ -- 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 neighbouring 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 :: (Dimensions dims) => Grid dims Double -> Grid dims Double--- > gaussian = autoConvolute clampWindow avg+-- > gaussian = autoConvolute clampBounds avg -- >  where -- >   avg :: Grid '[3, 3] Double -> Double -- >   avg g = sum g / fromIntegral (length g)@@ -67,7 +77,7 @@ convolute   :: forall dims f a b    . (Functor f, Dimensions dims)-  => (Coord dims -> f (Coord dims))  -- ^ Build a neighbouring context within a functor from the current coord+  => (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@@ -95,64 +105,41 @@   fromWindow :: Grid window (Coord window) -> Grid window (Coord dims)   fromWindow = fmap coerceCoordDims --- data Orth a =---   Orth---     { up :: a---     , right :: a---     , down :: a---     , left :: a---     } deriving (Eq, Show, Functor, Traversable, Foldable)---- orthNeighbours :: Coord dims  -> Compose Orth Maybe (Coord dims )--- orthNeighbours c = Compose---   (   toMaybe---   <$> traverse---         (+)---         Orth {up = 0 :# (-1), right = 1 :# 0, down = 0 :# 1, left = -1 :# 0}---         c---   )---  where---   toMaybe c@(x :# y) | not (inBounds x) || not (inBounds y) = Nothing---                      | otherwise                            = Just c---- orthFromList [up', right', down', left'] =---   Orth {up = up, right = right', down = down', left = left'}- class Neighboring dims where-  neighbors :: Grid dims (Coord dims)+  neighborCoords :: Grid dims (Coord dims)  instance {-# OVERLAPPING #-} (KnownNat n) => Neighboring '[n]  where-  neighbors = fromList' . fmap (Coord . pure . subtract (numVals `div` 2)) . take numVals $ [0 .. ]+  neighborCoords = fromList' . fmap (Coord . pure . subtract (numVals `div` 2)) . take numVals $ [0 .. ]     where       numVals = gridSize @'[n]  instance (KnownNat n, Neighboring ns) => Neighboring (n:ns) where-  neighbors = joinGrid (addCoord <$> currentLevelNeighbors)+  neighborCoords = joinGrid (addCoord <$> currentLevelNeighbors)     where       addCoord :: Coord '[n]  -> Grid ns (Coord (n : ns) )       addCoord c = appendC c <$> nestedNeighbors       nestedNeighbors :: Grid ns (Coord ns )-      nestedNeighbors = neighbors+      nestedNeighbors = neighborCoords       currentLevelNeighbors :: Grid '[n] (Coord '[n] )-      currentLevelNeighbors = neighbors+      currentLevelNeighbors = neighborCoords  neighboring :: (Dimensions dims, Neighboring dims) => Coord dims -> Grid dims (Coord dims)-neighboring c = (c +) <$> neighbors+neighboring c = (c +) <$> neighborCoords  -- | Use with 'autoConvolute'; Clamp out-of-bounds coordinates to the nearest in-bounds coord.-clampWindow-  :: (Dimensions dims) => Grid window (Coord dims) -> Grid window (Coord dims)-clampWindow = fmap clampCoord+clampBounds+  :: (Dimensions dims, Functor f) => f (Coord dims) -> f (Coord dims)+clampBounds = fmap clampCoord  -- | Use with 'autoConvolute'; Wrap out-of-bounds coordinates pac-man style to the other side of the grid-wrapWindow-  :: (Dimensions dims) => Grid window (Coord dims) -> Grid window (Coord dims)-wrapWindow = fmap wrapCoord+wrapBounds+  :: (Dimensions dims, Functor f) => f (Coord dims) -> f (Coord dims)+wrapBounds = fmap wrapCoord  -- | Use with 'autoConvolute'; Out of bounds coords become 'Nothing'-safeWindow-  :: (Dimensions dims) => Grid window (Coord dims) -> Compose (Grid window) Maybe (Coord dims)-safeWindow = Compose . fmap wrap+omitBounds+  :: (Dimensions dims, Functor f) => f (Coord dims) -> Compose f Maybe (Coord dims)+omitBounds = Compose . fmap wrap   where     wrap c | coordInBounds c = Just c            | otherwise  = Nothing

@@ -13,21 +13,19 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+ module Data.Grid.Internal.Coord where  import           GHC.Exts import           GHC.TypeNats                      hiding ( Mod )-import           GHC.TypeLits hiding (natVal, Mod) import           Data.Proxy-import           Data.Kind import           Unsafe.Coerce-import           Data.Coerce-import           Data.List import           Data.Singletons.Prelude  -- | The index type for 'Grid's. newtype Coord (dims :: [Nat]) = Coord {unCoord :: [Int]}-  deriving (Eq)+  deriving (Eq, Show)  -- | Safely construct a 'Coord' for a given grid size, checking that all -- indexes are in range@@ -51,10 +49,6 @@   type Item (Coord dims) = Int   fromList = coerce   toList = coerce--instance Show (Coord dims)-  where-    show (Coord cs) = "[" ++ intercalate ", " (show <$> cs) ++ "]"  -- | Get the first index from a 'Coord' unconsC :: Coord (n : ns) -> (Int, Coord ns)

@@ -1,11 +1,11 @@ {-# LANGUAGE UndecidableInstances #-}-module Data.Grid.Internal.Errors where+module Data.Grid.Internal.Errors (type (?!), ErrorMessage(..)) where  import Data.Kind import GHC.TypeLits  type family (b :: Bool) ?! (e :: ErrorMessage) :: Constraint where-  True ?! _ = ()-  False ?! e = TypeError e+  'True ?! _ = ()+  'False ?! e = TypeError e  infixr 1 ?!

@@ -24,11 +24,9 @@ import           Data.Functor.Rep import qualified Data.Vector                   as V import           Data.Proxy-import           Data.Kind import           GHC.TypeNats                  as N                                                    hiding ( Mod ) import           Control.Applicative-import           Data.List import           Data.Bifunctor import           Data.Maybe import           Data.Singletons.Prelude@@ -65,6 +63,14 @@   type Rep (Grid dims) = Coord dims   index (Grid v) c = v V.! fromEnum c   tabulate f = Grid $ V.generate (fromIntegral $ gridSize @dims) (f . toEnum  . fromIntegral)++instance (Num n, Dimensions dims) => Num (Grid dims n) where+  (+)  = liftA2 (+)+  (*)  = liftA2 (*)+  abs = fmap abs+  signum = fmap signum+  fromInteger = pure . fromInteger+  negate = fmap negate  -- | Build a grid by selecting an element for each element generate :: forall dims a . (SingI dims) => (Int -> a) -> Grid dims a

@@ -1,18 +0,0 @@-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE PolyKinds #-}-module Data.Grid.Internal.Identity where--import Data.Grid.Internal.Grid-import Data.Vector as V-import Data.Proxy-import GHC.TypeNats---- idMatrix---   :: forall (n :: Nat) (ns :: [Nat]) ind x---    . (Num x, Dimensions (n : ns), Dimensions ns)---   => Grid (n : ns) x--- idMatrix = Grid ns---  where---   ns = V.generate (inhabitants @(n : ns)) thing---   thing n = if n `mod` (inhabitants @ns + 1) == 0 then 1 else 0

@@ -6,7 +6,6 @@ import Data.Grid.Internal.Grid import Data.Functor.Rep as R import Data.Vector as V-import Data.Proxy  type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t type Lens' s a  = Lens s s a a@@ -16,7 +15,7 @@  -- | Focus an element of a 'Grid' given its 'Coord' cell-  :: forall ind dims a+  :: forall dims a    . (Dimensions dims)   => Coord dims   -> Lens' (Grid dims a) a

@@ -5,9 +5,7 @@ module Data.Grid.Internal.Nest where  import Data.Grid.Internal.Grid-import Data.Grid.Internal.Coord import Data.Singletons.Prelude-import Data.Maybe   -- | The inverse of 'splitGrid', 

@@ -6,7 +6,6 @@ import           GHC.TypeNats                  as N import           Data.Singletons.Prelude import qualified Data.Vector                   as V-import           Data.List import           Data.Grid.Internal.Coord  type family AllC (c :: x -> Constraint) (ts :: [x]) :: Constraint where

@@ -14,5 +14,5 @@ instance (Show a) => PrettyList [[[ a ]]] where   prettyList ls = "[" ++ intercalate "\n\n," (unlines . overRest (" " ++ ) . lines . prettyList <$> ls) ++ "]"     where-      overRest f (l:ls) = l : fmap f ls-      overRest f ls = ls+      overRest f (x:xs) = x : fmap f xs+      overRest _ xs = xs

@@ -0,0 +1,55 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE UndecidableInstances #-}++module Data.Grid.Internal.Shapes+  ( partitionFocus+  , centerCoord+  , Centered+  ) where++import GHC.TypeNats+import Data.Grid.Internal.Grid+import Data.Grid.Internal.Coord+import Data.Singletons.Prelude+import Data.Coerce+import Data.Functor.Rep+import Data.Grid.Internal.Errors++partitionFocus :: forall window a.+               (Centered window, Dimensions window)+               => Grid window a+               -> (a, Grid window (Maybe a))+partitionFocus g = (g `index` centerCoord @window, imapRep wrapMaybe g)+  where+    wrapMaybe c a+      | c == centerCoord @window = Nothing+      | otherwise = Just a+++type Even (n :: Nat) = Mod n 2 == 0++type Odd (n :: Nat) = Not (Even n)++type OddC (n :: Nat) =+  Odd n ?! 'Text "Dimension '"+           ':<>: 'ShowType n +           ':<>: 'Text " must be odd to use 'neighbouring' functions"++class Centered (dims :: [Nat]) where+  centerCoord :: Coord dims++instance {-# OVERLAPPING #-} (OddC x, KnownNat x) => Centered '[x] where+  centerCoord = Coord [mid]+    where+      mid = (+1) . div 2 . fromIntegral . natVal $ Proxy @x++instance {-# OVERLAPPABLE #-} (OddC x, KnownNat x, Centered xs) => Centered (x:xs) where+  centerCoord = Coord (mid : coerce (centerCoord @xs))+    where+      mid = (+1) . div 2 . fromIntegral . natVal $ Proxy @x

@@ -16,9 +16,6 @@ import           Data.Singletons.Prelude.Maybe import           Data.Functor.Rep import           Data.Vector                   as V-import           Data.Kind-import           Data.Maybe-import           Data.List  type family Permuted (key :: [Nat]) (from :: [Nat]) :: [Nat] where   Permuted '[] _ = '[]@@ -26,11 +23,11 @@  type ValidPermutation key from =   (Sort key == EnumFromTo 0 (Length from TL.- 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 TL.- 1))-                :$$: Text "e.g. the identity permutation for 2x2 is @[0, 1]"-                :$$: Text "e.g. matrix transpose for 2x2 is @[1, 0]"+    ('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 TL.- 1))+                ':$$: 'Text "e.g. the identity permutation for 2x2 is @[0, 1]"+                ':$$: 'Text "e.g. matrix transpose for 2x2 is @[1, 0]"   )  -- | Permute dimensions of a 'Grid'. This is similar to MatLab's permute@@ -67,7 +64,6 @@   -> Grid (Permuted key from) a permute (Grid v) = result  where-  len = V.length v   result :: Grid (Permuted key from) a   result = tabulate     ((v V.!) . fromEnum  . permuteCoord @invertedKey @from)

@@ -2,125 +2,11 @@ {-# LANGUAGE TypeApplications #-} module Spec where +import qualified Spec.Grid as Grid+import qualified Spec.Shapes as Shapes import Test.Hspec-import qualified Data.Vector as V-import Data.Grid as G-import Control.Applicative-import Data.Maybe-import Data.Functor.Compose --smallGrid :: Grid '[2, 2] Int-smallGrid = G.generate id--medGrid :: Grid '[3, 3] Int-medGrid = G.generate id--dim3Grid :: Grid '[2, 3, 4] Int-dim3Grid = G.generate id---- main :: IO () main = hspec $ do-  describe "creation" $ do-    it "pure should make a grid of all one element" $ do-      let Grid v = pure 1 :: Grid '[2, 2] Int-      v `shouldBe` V.replicate 4 1--    it "generate should put things in the right places" $ do-      let g        = G.generate id :: Grid '[2, 2] Int-          expected = fromNestedLists [[0, 1], [2, 3]]-      Just g `shouldBe` expected--    it "tabulate should put coords in the right places" $ do-      let g        = tabulate id :: Grid '[2, 2] (Coord '[2, 2])-          expected = fromNestedLists-            [[Coord [0, 0], Coord [0, 1]], [Coord [1, 0], Coord [1, 1]]]-      Just g `shouldBe` expected--  describe "indexing" $ do-    it "index should retrieve correct elem" $ do-      (smallGrid `index` Coord [0, 0]) `shouldBe` 0-      (smallGrid `index` Coord [0, 1]) `shouldBe` 1-      (smallGrid `index` Coord [1, 0]) `shouldBe` 2-      (smallGrid `index` Coord [1, 1]) `shouldBe` 3--  describe "applicative" $ do-    it "should apply piecewise" $ do-      let expected = fromJust . fromNestedLists $ [[0, 2], [4, 6]]-      liftA2 (+) smallGrid smallGrid `shouldBe` expected--  describe "nested lists" $ do-    it "toNestedLists" $ toNestedLists smallGrid `shouldBe` [[0, 1], [2, 3]]-    it "fromNestedLists"-      $          fromNestedLists [[0, 1], [2, 3]]-      `shouldBe` Just smallGrid-    it "fromList" $ do-      G.fromList [0, 1, 2, 3] `shouldBe` Just smallGrid--  describe "updates" $ do-    it "(//)"-      $          (    smallGrid-                 G.// [(Coord [1, 1] :: Coord '[2, 2], 42), (Coord [0, 1], 100)]-                 )-      `shouldBe` fromNestedLists' [[0, 100], [2, 42]]--  describe "permutations" $ do-    it "transpose" $ do-      transpose smallGrid `shouldBe` fromNestedLists' [[0, 2], [1, 3]]-      transpose medGrid-        `shouldBe` fromNestedLists' [[0, 3, 6], [1, 4, 7], [2, 5, 8]]-    it "permute" $ do-      permute @'[1, 2, 0] dim3Grid `shouldBe` fromNestedLists'-        [ [[0, 12], [1, 13], [2, 14], [3, 15]]-        , [[4, 16], [5, 17], [6, 18], [7, 19]]-        , [[8, 20], [9, 21], [10, 22], [11, 23]]-        ]--  describe "convolutions" $ do-    it "autoConvolute with Clamp clamps out of bounds" $ do-      autoConvolute @'[3, 3] clampWindow toNestedLists smallGrid-        `shouldBe` fromNestedLists'-                     [ [ [[0, 0, 1], [0, 0, 1], [2, 2, 3]]-                       , [[0, 1, 1], [0, 1, 1], [2, 3, 3]]-                       ]-                     , [ [[0, 0, 1], [2, 2, 3], [2, 2, 3]]-                       , [[0, 1, 1], [2, 3, 3], [2, 3, 3]]-                       ]-                     ]--    it "autoConvolute with Mod wraps when out of bounds" $ do-      autoConvolute @'[3, 3] wrapWindow toNestedLists smallGrid-        `shouldBe` fromNestedLists'-                     [ [ [[3, 2, 3], [1, 0, 1], [3, 2, 3]]-                       , [[2, 3, 2], [0, 1, 0], [2, 3, 2]]-                       ]-                     , [ [[1, 0, 1], [3, 2, 3], [1, 0, 1]]-                       , [[0, 1, 0], [2, 3, 2], [0, 1, 0]]-                       ]-                     ]--    it "safeAutoConvolute gets 'Nothing' for out of bounds" $ do-      safeAutoConvolute @'[3, 3] toNestedLists smallGrid-        `shouldBe` fromNestedLists'-                     [ [ [ [Nothing, Nothing, Nothing]-                         , [Nothing, Just 0, Just 1]-                         , [Nothing, Just 2, Just 3]-                         ]-                       , [ [Nothing, Nothing, Nothing]-                         , [Just 0, Just 1, Nothing]-                         , [Just 2, Just 3, Nothing]-                         ]-                       ]-                     , [ [ [Nothing, Just 0, Just 1]-                         , [Nothing, Just 2, Just 3]-                         , [Nothing, Nothing, Nothing]-                         ]-                       , [ [Just 0, Just 1, Nothing]-                         , [Just 2, Just 3, Nothing]-                         , [Nothing, Nothing, Nothing]-                         ]-                       ]-                     ]+  Grid.spec+  Shapes.spec

@@ -0,0 +1,128 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE TypeApplications #-}+module Spec.Grid (spec) where++import Test.Hspec+import qualified Data.Vector as V+import Data.Grid as G+import Control.Applicative+import Data.Maybe+import Data.Functor.Compose+import Data.Foldable+++smallGrid :: Grid '[2, 2] Int+smallGrid = G.generate id++medGrid :: Grid '[3, 3] Int+medGrid = G.generate id++dim3Grid :: Grid '[2, 3, 4] Int+dim3Grid = G.generate id++spec :: Spec+spec = do+  describe "creation" $ do+    it "pure should make a grid of all one element" $ do+      let Grid v = pure 1 :: Grid '[2, 2] Int+      v `shouldBe` V.replicate 4 1++    it "generate should put things in the right places" $ do+      let g        = G.generate id :: Grid '[2, 2] Int+          expected = fromNestedLists [[0, 1], [2, 3]]+      Just g `shouldBe` expected++    it "tabulate should put coords in the right places" $ do+      let g        = tabulate id :: Grid '[2, 2] (Coord '[2, 2])+          expected = fromNestedLists+            [[Coord [0, 0], Coord [0, 1]], [Coord [1, 0], Coord [1, 1]]]+      Just g `shouldBe` expected++  describe "indexing" $ do+    it "index should retrieve correct elem" $ do+      (smallGrid `index` Coord [0, 0]) `shouldBe` 0+      (smallGrid `index` Coord [0, 1]) `shouldBe` 1+      (smallGrid `index` Coord [1, 0]) `shouldBe` 2+      (smallGrid `index` Coord [1, 1]) `shouldBe` 3++  describe "applicative" $ do+    it "should apply piecewise" $ do+      let expected = fromJust . fromNestedLists $ [[0, 2], [4, 6]]+      liftA2 (+) smallGrid smallGrid `shouldBe` expected++  describe "nested lists" $ do+    it "toNestedLists" $ toNestedLists smallGrid `shouldBe` [[0, 1], [2, 3]]+    it "fromNestedLists"+      $          fromNestedLists [[0, 1], [2, 3]]+      `shouldBe` Just smallGrid+    it "fromList" $ do+      G.fromList [0, 1, 2, 3] `shouldBe` Just smallGrid++    it "fromList'/toList round trip" $ do+      let g = generate @[5, 5, 5] id+      G.fromList' (toList g) `shouldBe` g++  describe "updates" $ do+    it "(//)"+      $          (    smallGrid+                 G.// [(Coord [1, 1] :: Coord '[2, 2], 42), (Coord [0, 1], 100)]+                 )+      `shouldBe` fromNestedLists' [[0, 100], [2, 42]]++  describe "permutations" $ do+    it "transpose" $ do+      transpose smallGrid `shouldBe` fromNestedLists' [[0, 2], [1, 3]]+      transpose medGrid+        `shouldBe` fromNestedLists' [[0, 3, 6], [1, 4, 7], [2, 5, 8]]+    it "permute" $ do+      permute @'[1, 2, 0] dim3Grid `shouldBe` fromNestedLists'+        [ [[0, 12], [1, 13], [2, 14], [3, 15]]+        , [[4, 16], [5, 17], [6, 18], [7, 19]]+        , [[8, 20], [9, 21], [10, 22], [11, 23]]+        ]++  describe "convolutions" $ do+    it "autoConvolute with Clamp clamps out of bounds" $ do+      autoConvolute @'[3, 3] clampBounds toNestedLists smallGrid+        `shouldBe` fromNestedLists'+                     [ [ [[0, 0, 1], [0, 0, 1], [2, 2, 3]]+                       , [[0, 1, 1], [0, 1, 1], [2, 3, 3]]+                       ]+                     , [ [[0, 0, 1], [2, 2, 3], [2, 2, 3]]+                       , [[0, 1, 1], [2, 3, 3], [2, 3, 3]]+                       ]+                     ]++    it "autoConvolute with Mod wraps when out of bounds" $ do+      autoConvolute @'[3, 3] wrapBounds toNestedLists smallGrid+        `shouldBe` fromNestedLists'+                     [ [ [[3, 2, 3], [1, 0, 1], [3, 2, 3]]+                       , [[2, 3, 2], [0, 1, 0], [2, 3, 2]]+                       ]+                     , [ [[1, 0, 1], [3, 2, 3], [1, 0, 1]]+                       , [[0, 1, 0], [2, 3, 2], [0, 1, 0]]+                       ]+                     ]++    it "autoConvolute with omitBounds gets 'Nothing' for out of bounds" $ do+      autoConvolute @'[3, 3] omitBounds (toNestedLists . getCompose) smallGrid+        `shouldBe` fromNestedLists'+                     [ [ [ [Nothing, Nothing, Nothing]+                         , [Nothing, Just 0, Just 1]+                         , [Nothing, Just 2, Just 3]+                         ]+                       , [ [Nothing, Nothing, Nothing]+                         , [Just 0, Just 1, Nothing]+                         , [Just 2, Just 3, Nothing]+                         ]+                       ]+                     , [ [ [Nothing, Just 0, Just 1]+                         , [Nothing, Just 2, Just 3]+                         , [Nothing, Nothing, Nothing]+                         ]+                       , [ [Just 0, Just 1, Nothing]+                         , [Just 2, Just 3, Nothing]+                         , [Nothing, Nothing, Nothing]+                         ]+                       ]+                     ]

@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE TypeApplications #-}+module Spec.Shapes (spec) where++import Test.Hspec hiding (focus)+import qualified Data.Vector as V+import Data.Grid as G+import Control.Applicative+import Data.Maybe+import Data.Functor.Compose+import Control.Comonad+import Control.Monad+import Data.Coerce++smallGrid :: Grid '[2, 2] Int+smallGrid = generate id++medGrid :: Grid '[3, 3] Int+medGrid = generate id++spec :: Spec+spec = +  describe "partitionFocus" $ do+    it "should split properly" $ do+      let g :: Grid [2, 2] Int = autoConvolute @[3, 3] omitBounds (sum . Compose . fmap join . snd . partitionFocus . getCompose) smallGrid+      let sums = fromNestedLists' [[6, 5], [4, 3]]+      g `shouldBe` sums