packages feed

comfort-array-shape (empty) → 0.0

raw patch · 12 files changed

+447/−0 lines, 12 filesdep +ChasingBottomsdep +QuickCheckdep +basesetup-changed

Dependencies added: ChasingBottoms, QuickCheck, base, comfort-array, comfort-array-shape, containers, doctest-exitcode-stdio, doctest-lib, fixed-length, non-empty, tagged, tfp, utility-ht

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) Henning Thielemann 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ comfort-array-shape.cabal view
@@ -0,0 +1,93 @@+Cabal-Version:    2.2+Name:             comfort-array-shape+Version:          0.0+License:          BSD-3-Clause+License-File:     LICENSE+Author:           Henning Thielemann <haskell@henning-thielemann.de>+Maintainer:       Henning Thielemann <haskell@henning-thielemann.de>+Homepage:         https://hub.darcs.net/thielema/comfort-array-shape/+Category:         Data Structures+Synopsis:         Additional shape types for the comfort-array package+Description:+  Some extra array shape types+  additional to the ones in the @comfort-array@ package.+  These require some more package dependencies+  and use type-encoded natural numbers.+  .+  * @Static.ZeroBased@:+    Like @Shape.ZeroBased@ but with type-encoded number as size.+  .+  * @Simplex@:+    Simplices of any dimension, where the dimension is encoded in the type.+    Only a private module for demonstration.+    Production-ready implementation in @comfort-array@.++Tested-With:      GHC==7.4.2, GHC==7.8.4, GHC==8.2.2, GHC==8.6.5+Build-Type:       Simple+Extra-Source-Files:+  test-module.list++Source-Repository this+  Tag:         0.0+  Type:        darcs+  Location:    https://hub.darcs.net/thielema/comfort-array-shape/++Source-Repository head+  Type:        darcs+  Location:    https://hub.darcs.net/thielema/comfort-array-shape/++Library+  Build-Depends:+    comfort-array >=0.5 && <0.6,+    tfp >=1.0.2 && <1.1,+    fixed-length >=0.2 && <0.3,+    utility-ht >=0.0.10 && <0.1,+    base >=4.5 && <5++  GHC-Options:      -Wall+  Default-Language: Haskell98+  Hs-Source-Dirs:   src+  Exposed-Modules:+    Data.Array.Comfort.Shape.Static++Library experimental+  Build-Depends:+    comfort-array,+    tfp,+    fixed-length,+    non-empty >=0.3.2 && <0.4,+    utility-ht,+    base++  GHC-Options:      -Wall+  Default-Language: Haskell98+  Hs-Source-Dirs:   src+  Exposed-Modules:+    Data.Array.Comfort.Shape.Extra++Test-Suite comfort-array-shape-test+  Type: exitcode-stdio-1.0+  Build-Depends:+    experimental,+    comfort-array-shape,+    comfort-array,+    doctest-exitcode-stdio >=0.0 && <0.1,+    doctest-lib >=0.1 && <0.1.1,+    fixed-length >=0.2.3 && <0.3,+    tfp,+    ChasingBottoms >=1.2.2 && <1.4,+    tagged,+    containers,+    QuickCheck,+    base++  GHC-Options:      -Wall+  Default-Language: Haskell98+  Hs-Source-Dirs:   test+  Main-Is:          Main.hs+  Other-Modules:+    DocTest.Data.Array.Comfort.Shape.Static+    DocTest.Data.Array.Comfort.Shape.Extra+    DocTest.Main+    Test.Shape+    Test.Utility
+ src/Data/Array/Comfort/Shape/Extra.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE GADTs #-}+module Data.Array.Comfort.Shape.Extra+   {- DEPRECATED "use Data.Array.Comfort.Shape.Simplex instead" -}+   (+   Simplex(..),+   ) where++import qualified Data.Array.Comfort.Shape as Shape++import qualified Type.Data.Num.Unary as Unary+import Type.Data.Num (integralFromProxy)+import Type.Base.Proxy (Proxy(Proxy))++import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold+import qualified Data.FixedLength as FL+import qualified Data.NonEmpty as NonEmpty+import qualified Data.List.HT as ListHT++import Control.Applicative ((<$>))+++{- $setup+>>> import qualified Data.Array.Comfort.Shape.Extra as ShapeExtra+>>> import qualified Data.Array.Comfort.Shape as Shape+>>>+>>> import qualified Type.Data.Num.Unary.Literal as TypeNum+>>> import qualified Type.Data.Num.Unary as Unary+-}+++{- |+Simplex is a generalization of 'Shape.Triangular' to more than two dimensions.+Indices are tuples of fixed size+with elements ordered in ascending, strictly ascending,+descending or strictly descending order.+\"Order\" refers to the index order in 'indices'.+In order to avoid confusion we suggest that the order of 'indices'+is consistent with '<='.++Obviously, 'offset' implements ranking+and 'indexFromOffset' implements unranking+of combinations (in the combinatorial sense)+with or without repetitions.++>>> Shape.indices $ ShapeExtra.Simplex (Unary.unary TypeNum.u3) $ Shape.ZeroBased (4::Int)+[0!:1!:2!:end,0!:1!:3!:end,0!:2!:3!:end,1!:2!:3!:end]+-}+data Simplex d size =+   Simplex {+      simplexDimension :: UnaryProxy d,+      simplexSize :: size+   } deriving (Show)++type UnaryProxy d = Proxy (Unary.Un d)++-- cf. package combinatorial+binomials :: Integral a => a -> [a]+binomials n =+   scanl (\acc (num,den) -> div (acc*num) den) 1 (zip [n, pred n ..] [1..n])++simplexLayoutSize :: Integral i => Int -> i -> i+simplexLayoutSize d n =+   case drop d $ binomials n of+      [] -> 0+      m:_ -> m++instance (Unary.Natural d, Shape.C size) => Shape.C (Simplex d size) where+   size (Simplex d sz) =+      simplexLayoutSize (integralFromProxy d) (Shape.size sz)++headSingletonFromProxy ::+   (Unary.Natural d) => UnaryProxy d -> Unary.HeadSingleton d+headSingletonFromProxy Proxy = Unary.headSingleton++predHeadSingleton :: Unary.HeadSingleton (Unary.Succ d) -> UnaryProxy d+predHeadSingleton Unary.Succ = Proxy++simplexIndices :: (Unary.Natural d) => UnaryProxy d -> [a] -> [FL.T d a]+simplexIndices d =+   case headSingletonFromProxy d of+      Unary.Zero -> const [FL.end]+      m@Unary.Succ -> \as -> do+         (a,ts) <- zip as $ NonEmpty.tail $ NonEmpty.tails as+         (a FL.!:) <$> simplexIndices (predHeadSingleton m) ts++instance+   (Unary.Natural d, Shape.Indexed size) =>+      Shape.Indexed (Simplex d size) where+   type Index (Simplex d size) = FL.T d (Shape.Index size)+   indices (Simplex d sz) = simplexIndices d $ Shape.indices sz+   inBounds (Simplex _d sz) ix =+      let ixs = Fold.toList ix+          getOffset = Shape.offset sz+      in all (Shape.inBounds sz) ixs &&+         and (ListHT.mapAdjacent (<) $ map getOffset ixs)+   unifiedSizeOffset (Simplex d sz) =+      let (n, getOffset) = Shape.unifiedSizeOffset sz+          dInt = integralFromProxy d+      in (simplexLayoutSize dInt n,+          -- cf. Combinatorics.chooseRank+          \ixs -> do+            ks <- Trav.traverse getOffset $ Fold.toList ixs+            return $+               simplexLayoutSize dInt n - 1+               -+               sum+                  (zipWith simplexLayoutSize+                     (iterate pred dInt) (map (n-1-) ks)))++instance+   (Unary.Natural d, Shape.InvIndexed size) =>+      Shape.InvIndexed (Simplex d size) where+   unifiedIndexFromOffset (Simplex d sh) k =+      let n = Shape.size sh in+      let dInt = integralFromProxy d in+      Trav.sequenceA $ snd $+      Trav.mapAccumL+         (\(a,k0) m ->+            case dropWhile ((<0) . snd) $+                  map (\bi -> (bi, k0 - simplexLayoutSize m (n-bi-1))) $+                  takeWhile (<n) $ iterate (1+) a of+               [] -> error "unifiedIndexFromOffset: offset out of range"+               (b,k1):_ -> ((b+1, k1), Shape.unifiedIndexFromOffset sh b))+         (0, simplexLayoutSize dInt n - 1 - k)+         (NonEmpty.init $ NonEmpty.scanl (-) dInt $ FL.repeat 1)
+ src/Data/Array/Comfort/Shape/Static.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE TypeFamilies #-}+module Data.Array.Comfort.Shape.Static where++import qualified Data.FixedLength as FL++import qualified Data.Array.Comfort.Storable as Array+import qualified Data.Array.Comfort.Shape as Shape+import Data.Array.Comfort.Storable (Array)++import qualified Type.Data.Num.Unary as Unary+import Type.Data.Num (integralFromProxy)+import Type.Base.Proxy (Proxy(Proxy))++import Foreign.Storable (Storable)+++{- $setup+>>> import qualified Data.Array.Comfort.Shape.Static as Static+>>> import qualified Data.Array.Comfort.Shape as Shape+>>>+>>> import qualified Type.Data.Num.Unary.Literal as TypeNum+>>> import qualified Type.Data.Num.Unary as Unary+-}+++{- |+'ZeroBased' denotes a range starting at zero and has a certain length.++>>> Shape.indices (Static.ZeroBased (Unary.unary TypeNum.u0))+[]+>>> Shape.indices (Static.ZeroBased (Unary.unary TypeNum.u1))+[i0]+>>> Shape.indices (Static.ZeroBased (Unary.unary TypeNum.u7))+[i0,i1,i2,i3,i4,i5,i6]+-}+newtype ZeroBased n = ZeroBased {zeroBasedSize :: Proxy (Unary.Un n)}+   deriving (Eq, Show)++instance (Unary.Natural n) => Shape.C (ZeroBased n) where+   size (ZeroBased len) = integralFromProxy len++instance (Unary.Natural n) => Shape.Indexed (ZeroBased n) where+   type Index (ZeroBased n) = FL.Index n+   indices _len = FL.toList FL.indices+   unifiedOffset _len = return . fromIntegral . FL.numFromIndex+   inBounds _len _ix = True++instance (Unary.Natural n) => Shape.InvIndexed (ZeroBased n) where+   -- could be implemented using new fixed-length-0.2.1:FL.indexFromNum+   unifiedIndexFromOffset len k =+      case (0<=k, drop k $ Shape.indices len) of+         (True, i:_) -> return i+         _ ->+            Shape.throwOrError $+            Shape.messageIndexFromOffset "ShapeStatic.ZeroBased" k++instance (Unary.Natural n) => Shape.Static (ZeroBased n) where+   static = ZeroBased Proxy+++vector :: (Unary.Natural n, Storable a) => FL.T n a -> Array (ZeroBased n) a+vector = Array.fromList (ZeroBased Proxy) . FL.toList
+ test-module.list view
@@ -0,0 +1,2 @@+Data.Array.Comfort.Shape.Static+Data.Array.Comfort.Shape.Extra
+ test/DocTest/Data/Array/Comfort/Shape/Extra.hs view
@@ -0,0 +1,23 @@+-- Do not edit! Automatically created with doctest-extract from src/Data/Array/Comfort/Shape/Extra.hs+{-# LINE 24 "src/Data/Array/Comfort/Shape/Extra.hs" #-}++module DocTest.Data.Array.Comfort.Shape.Extra where++import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest++{-# LINE 25 "src/Data/Array/Comfort/Shape/Extra.hs" #-}+import     qualified Data.Array.Comfort.Shape.Extra as ShapeExtra+import     qualified Data.Array.Comfort.Shape as Shape++import     qualified Type.Data.Num.Unary.Literal as TypeNum+import     qualified Type.Data.Num.Unary as Unary++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Data.Array.Comfort.Shape.Extra:47: "+{-# LINE 47 "src/Data/Array/Comfort/Shape/Extra.hs" #-}+ DocTest.example+{-# LINE 47 "src/Data/Array/Comfort/Shape/Extra.hs" #-}+   (Shape.indices $ ShapeExtra.Simplex (Unary.unary TypeNum.u3) $ Shape.ZeroBased (4::Int))+  [ExpectedLine [LineChunk "[0!:1!:2!:end,0!:1!:3!:end,0!:2!:3!:end,1!:2!:3!:end]"]]
+ test/DocTest/Data/Array/Comfort/Shape/Static.hs view
@@ -0,0 +1,35 @@+-- Do not edit! Automatically created with doctest-extract from src/Data/Array/Comfort/Shape/Static.hs+{-# LINE 17 "src/Data/Array/Comfort/Shape/Static.hs" #-}++module DocTest.Data.Array.Comfort.Shape.Static where++import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest++{-# LINE 18 "src/Data/Array/Comfort/Shape/Static.hs" #-}+import     qualified Data.Array.Comfort.Shape.Static as Static+import     qualified Data.Array.Comfort.Shape as Shape++import     qualified Type.Data.Num.Unary.Literal as TypeNum+import     qualified Type.Data.Num.Unary as Unary++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Data.Array.Comfort.Shape.Static:29: "+{-# LINE 29 "src/Data/Array/Comfort/Shape/Static.hs" #-}+ DocTest.example+{-# LINE 29 "src/Data/Array/Comfort/Shape/Static.hs" #-}+   (Shape.indices (Static.ZeroBased (Unary.unary TypeNum.u0)))+  [ExpectedLine [LineChunk "[]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape.Static:31: "+{-# LINE 31 "src/Data/Array/Comfort/Shape/Static.hs" #-}+ DocTest.example+{-# LINE 31 "src/Data/Array/Comfort/Shape/Static.hs" #-}+   (Shape.indices (Static.ZeroBased (Unary.unary TypeNum.u1)))+  [ExpectedLine [LineChunk "[i0]"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape.Static:33: "+{-# LINE 33 "src/Data/Array/Comfort/Shape/Static.hs" #-}+ DocTest.example+{-# LINE 33 "src/Data/Array/Comfort/Shape/Static.hs" #-}+   (Shape.indices (Static.ZeroBased (Unary.unary TypeNum.u7)))+  [ExpectedLine [LineChunk "[i0,i1,i2,i3,i4,i5,i6]"]]
+ test/DocTest/Main.hs view
@@ -0,0 +1,12 @@+-- Do not edit! Automatically created with doctest-extract.+module DocTest.Main where++import qualified DocTest.Data.Array.Comfort.Shape.Static+import qualified DocTest.Data.Array.Comfort.Shape.Extra++import qualified Test.DocTest.Driver as DocTest++main :: DocTest.T ()+main = do+    DocTest.Data.Array.Comfort.Shape.Static.test+    DocTest.Data.Array.Comfort.Shape.Extra.test
+ test/Main.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE TypeFamilies #-}+module Main where++import qualified DocTest.Main as DocTestMain+import qualified Test.Shape as TestShape+import Test.Utility (prefix)++import qualified Test.DocTest.Driver as DocTest+++main :: IO ()+main = DocTest.run $ (>> DocTestMain.main) $+   mapM_ (\(name,prop) ->+            DocTest.printPrefix (name ++ ": ") >> DocTest.property prop) $+   prefix "Shape" TestShape.tests +++   []
+ test/Test/Shape.hs view
@@ -0,0 +1,42 @@+module Test.Shape where++import qualified Data.Array.Comfort.Shape.Static as Static+import qualified Data.Array.Comfort.Shape.Extra as ShapeExtra+import qualified Data.Array.Comfort.Shape.Test as ShapeTest+import qualified Data.Array.Comfort.Shape as Shape++import qualified Type.Data.Num.Unary.Literal as TypeNum+import qualified Type.Data.Num.Unary as Unary+import Type.Base.Proxy (Proxy)++import qualified Test.QuickCheck as QC+import Test.Utility (prefix)++import Control.Applicative ((<$>))+++simplex :: (Unary.Natural n) => Proxy n -> [(String, QC.Property)]+simplex n =+   prefix+      ("Simplex." ++ show (Unary.integralFromProxy n :: Int))+      (ShapeTest.tests $+         (ShapeExtra.Simplex (Unary.unary n) . Shape.Range 'a' <$>+            QC.choose ('a','m')))++staticZeroBased :: (Unary.Natural n) => Proxy n -> [(String, QC.Property)]+staticZeroBased n =+   prefix+      ("Static.ZeroBased." ++ show (Unary.integralFromProxy n :: Int))+      (ShapeTest.tests $ return $ Static.ZeroBased $ Unary.unary n)++tests :: [(String, QC.Property)]+tests =+   simplex TypeNum.u0 +++   simplex TypeNum.u1 +++   simplex TypeNum.u2 +++   simplex TypeNum.u3 +++   simplex TypeNum.u4 +++   staticZeroBased TypeNum.u1 +++   staticZeroBased TypeNum.u2 +++   staticZeroBased TypeNum.u23 +++   []
+ test/Test/Utility.hs view
@@ -0,0 +1,5 @@+module Test.Utility where++prefix :: String -> [(String, test)] -> [(String, test)]+prefix msg =+   map (\(str,test) -> (msg ++ "." ++ str, test))