diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for grids + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/grids.cabal b/grids.cabal new file mode 100644 --- /dev/null +++ b/grids.cabal @@ -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 diff --git a/src/Data/Grid.hs b/src/Data/Grid.hs new file mode 100644 --- /dev/null +++ b/src/Data/Grid.hs @@ -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) diff --git a/src/Data/Grid/Lens.hs b/src/Data/Grid/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Data/Grid/Lens.hs @@ -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)