packages feed

grids (empty) → 0.1.0.0

raw patch · 7 files changed

+388/−0 lines, 7 filesdep +adjunctionsdep +basedep +distributivesetup-changed

Dependencies added: adjunctions, base, distributive, finite-typelits, lens, vector

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for grids++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Chris Penner (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Chris Penner nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,116 @@+# Grids++Grids can have an arbitrary amount of dimensions, specified by a type-level+list of `Nat`s, here's how we might represent a Tic-Tac-Toe board:++```haskell+data Piece = X | O deriving Show+toPiece n = if even n then X+                      else O++ticTacToe :: Grid [3, 3] Piece+ticTacToe = generate toPiece+```++You can collapse the grid down to nested lists! The output type of `toNestedLists` depends on your dimensions, e.g.:++- `Grid [3, 3] Piece` will generate: `[[Piece]]`+- `Grid [2, 2, 2] Char` will generate: `[[[Char]]]`+- ...etc++```haskell+λ> toNestedLists ticTacToe+[ [X,O,X]+, [O,X,O]+, [X,O,X]]+```++You can even create a grid from nested lists! `fromNestedLists` returns a grid+if possible, or `Nothing` if the provided lists don't match the structure of+the grid you specify:++```haskell+λ> fromNestedLists [[1, 2], [3, 4]] :: Maybe (Grid '[2, 2] Int)+Just (Grid [[1,2]+           ,[3,4]])+λ> fromNestedLists [[1], [2]] :: Maybe (Grid '[2, 2] Int)+Nothing+```++Grids are Representable Functors, Applicatives, Foldable, and are Traversable!++You can do things like piecewise addition using their applicative instance:++```haskell+λ> let g = generate id :: Grid '[2, 3] Int+λ> g+(Grid [[0,1,2]+      ,[3,4,5]])+λ> liftA2 (+) g g+(Grid [[0,2,4]+      ,[6,8,10]])+λ> liftA2 (*) g g+(Grid [[0,1,4]+      ,[9,16,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 get a value at an 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 `R.index` (1 :# 1)+4+λ> g `R.index` (1 :# 0)+3+λ> g `R.index` (0 :# 2)+2+```++You can also use the `cell` Lens from `Data.Grid.Lens` to access and mutate+indices:++```haskell+λ> g ^. cell (0 :# 1)+1+λ> g & cell (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`).++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.++- `fromList :: [a] -> Maybe (Grid dims a)`+- `fromNestedLists :: NestedLists dims a -> Maybe (Grid dims a)`+- `generate :: (Int -> a) -> Grid dims a`+- `tabulate :: (Coord dims -> a) -> Grid dims a`+- `pure :: a -> Grid dims a`++## Updating++Use either the `cell` lens, or fmap, applicative, traversable.+For batch updates using the underlying Vector implementation use `(//)`++- `(//) :: Grid dims a -> [(Coord dims, a)] -> Grid dims a`
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ grids.cabal view
@@ -0,0 +1,44 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 934ce335991599a57471bf99e8fd952b854e86050c0098f06acf32c8430ee1a8++name:           grids+version:        0.1.0.0+description:    Arbitrary sized type-safe grids with useful combinators+category:       Data Structures+homepage:       https://github.com/ChrisPenner/grids#readme+bug-reports:    https://github.com/ChrisPenner/grids/issues+author:         Chris Penner+maintainer:     christopher.penner@gmail.com+copyright:      Chris Penner+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/ChrisPenner/grids++library+  exposed-modules:+      Data.Grid+      Data.Grid.Lens+  other-modules:+      Paths_grids+  hs-source-dirs:+      src+  build-depends:+      adjunctions+    , base >=4.7 && <5+    , distributive+    , finite-typelits+    , lens+    , vector+  default-language: Haskell2010
+ src/Data/Grid.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# language ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UndecidableSuperClasses #-}++module Data.Grid where++import           Data.Distributive+import           Data.Functor.Rep+import qualified Data.Vector                   as V+import           GHC.TypeLits                  as L+import           Data.Proxy+import           Data.Functor.Compose+import           Control.Lens+import           Data.Kind+import           GHC.TypeNats                  as N+import           Data.Finite+import           Control.Applicative+import           Data.List+import           Data.Bifunctor++newtype Grid (dims :: [Nat]) a =+  Grid  (V.Vector a)+  deriving (Eq, Functor, Foldable, Traversable)++instance (NestLists dims, Show (NestedLists dims a)) => Show (Grid dims a) where+  show g = "(Grid " ++ show (toNestedLists g) ++ ")"++instance (Dimensions dims, Semigroup a) => Semigroup (Grid dims a) where+  (<>) = liftA2 (<>)++instance (Dimensions dims, Monoid a) => Monoid (Grid dims a) where+  mempty = pure mempty++instance (Dimensions dims) => Applicative (Grid dims) where+  pure a = tabulate (const a)+  liftA2 f (Grid v) (Grid u) = Grid $ V.zipWith f v u++type family GridSize dims :: Nat where+  GridSize '[] = 0+  GridSize (x:'[]) = x+  GridSize (x:xs) = (x N.* GridSize xs)++data x :# y = x :# y+  deriving (Show, Eq, Ord)++infixr 9 :#++type family Coord (dims :: [Nat]) where+  Coord '[n] = Finite n+  Coord (n:xs) = Finite n :# Coord xs++sizeof :: forall (dims :: [Nat]) . KnownNat (GridSize dims) => Proxy dims -> Int+sizeof _ = fromIntegral (L.natVal (Proxy @(GridSize dims)))++type NumericConstraints dims = (KnownNat (GridSize dims))++type Dims = [Int]++class (NumericConstraints dims, KnownNat (GridSize dims)) => Dimensions (dims :: [Nat]) where+  toCoord :: Proxy dims -> Finite (GridSize dims) -> Coord dims+  fromCoord :: Proxy dims -> Coord dims -> Finite (GridSize dims)++instance (KnownNat x) => Dimensions '[x] where+  toCoord _ i = i+  fromCoord _ i = i++toCoord' :: Dims -> Int -> [Int]+toCoord' []       _ = []+toCoord' [_     ] n = [n]+toCoord' (_ : ds) n = (n `div` product ds) : toCoord' ds (n `mod` product ds)++fromCoord' :: Dims -> [Int] -> Int+fromCoord' _        []       = 1+fromCoord' _        [c     ] = c+fromCoord' (_ : ds) (c : cs) = c * product ds + fromCoord' ds cs++toFinite :: (KnownNat n) => Integral m => m -> Finite n+toFinite = finite . fromIntegral++fromFinite :: Num n => Finite m -> n+fromFinite = fromIntegral . getFinite++instance (KnownNat (x N.* GridSize (y:xs)), KnownNat x, Dimensions (y:xs)) => Dimensions (x:y:xs) where+  toCoord _ n = firstCoord :# toCoord (Proxy @(y:xs)) remainder+    where+      firstCoord = toFinite (n `div` fromIntegral (sizeof (Proxy @(y:xs))))+      remainder = toFinite (fromFinite n `mod` sizeof (Proxy @(y:xs)))+  fromCoord _ (x :# ys) =+    toFinite $ firstPart + rest+      where+        firstPart = fromFinite x * sizeof (Proxy @(y:xs))+        rest = fromFinite (fromCoord (Proxy @(y:xs)) ys)++instance (Dimensions dims) => Distributive (Grid dims) where+  distribute = distributeRep++instance (Dimensions dims) => Representable (Grid dims) where+  type Rep (Grid dims) = Coord dims+  index (Grid v) ind = v V.! fromIntegral (fromCoord (Proxy @dims) ind)+  tabulate f = Grid $ V.generate (fromIntegral $ sizeof (Proxy @dims)) (f . toCoord (Proxy @dims) . fromIntegral)++instance (Dimensions dims, ind ~ Coord dims)+  => FunctorWithIndex ind (Grid dims) where+    imap = imapRep++instance (Dimensions dims, ind ~ Coord dims)+  => FoldableWithIndex ind (Grid dims) where+    ifoldMap = ifoldMapRep++instance (Dimensions dims, ind ~ Coord dims)+  => TraversableWithIndex ind (Grid dims) where+    itraverse = itraverseRep++generate :: forall dims a . Dimensions dims => (Int -> a) -> Grid dims a+generate f = Grid $ V.generate (sizeof (Proxy @dims)) f++type family NestedLists (dims :: [Nat]) a where+  NestedLists '[] a = a+  NestedLists (_:xs) a = [NestedLists xs a]++class NestLists (dims :: [Nat]) where+  nestLists :: Proxy dims -> V.Vector a -> NestedLists dims a++chunkVector :: forall n a . KnownNat n => Proxy n -> V.Vector a -> [V.Vector a]+chunkVector _ v+  | V.null v+  = []+  | otherwise+  = let (before, after) = V.splitAt (fromIntegral $ L.natVal (Proxy @n)) v+    in  before : chunkVector (Proxy @n) after++instance (KnownNat n) => NestLists '[n] where+  nestLists _ = V.toList++instance (KnownNat n, NestLists (n:ns), Dimensions (m:n:ns), Dimensions (n:ns)) => NestLists (m:n:ns) where+  nestLists _ v = nestLists (Proxy @(n:ns)) <$> chunkVector (Proxy @(GridSize (n:ns))) v++toNestedLists+  :: forall dims a . (NestLists dims) => Grid dims a -> NestedLists dims a+toNestedLists (Grid v) = nestLists (Proxy @dims) v++class UnNestLists (dims :: [Nat]) where+  unNestLists :: Proxy dims -> NestedLists dims a -> [a]++instance UnNestLists '[n] where+  unNestLists _ xs = xs++instance (UnNestLists (n:ns)) => UnNestLists (m:n:ns) where+  unNestLists _ xs = concat (unNestLists (Proxy @(n:ns)) <$> xs)++fromNestedLists+  :: forall dims a+   . (UnNestLists dims, Dimensions dims)+  => NestedLists dims a+  -> Maybe (Grid dims a)+fromNestedLists = fromList . unNestLists (Proxy @dims)++fromList :: forall a dims . (Dimensions dims) => [a] -> Maybe (Grid dims a)+fromList xs =+  let v = V.fromList xs+  in  if V.length v == sizeof (Proxy @dims) then Just $ Grid v else Nothing++(//)+  :: forall dims a+   . (Dimensions dims)+  => Grid dims a+  -> [(Coord dims, a)]+  -> Grid dims a+(Grid v) // xs =+  Grid (v V.// fmap (first (fromFinite . fromCoord (Proxy @dims))) xs)
+ src/Data/Grid/Lens.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleContexts #-}+module Data.Grid.Lens where++import Data.Grid+import Control.Lens as L+import Data.Functor.Rep as R++cell+  :: (Dimensions dims, Eq (Coord dims)) => Coord dims -> Lens' (Grid dims a) a+cell c = lens (`R.index` c) (\s b -> s & itraversed . L.index c .~ b)