numhask-array 0.0.2 → 0.1.0.0
raw patch · 8 files changed
+908/−335 lines, 8 filesdep +QuickCheckdep +acceleratedep +accelerate-llvm
Dependencies added: QuickCheck, accelerate, accelerate-llvm, accelerate-llvm-native, dimensions, numhask-array, tasty, tasty-quickcheck
Files
- numhask-array.cabal +69/−75
- readme.md +8/−2
- src/NumHask/Accelerate.hs +248/−0
- src/NumHask/Array.hs +415/−217
- src/NumHask/Array/Example.hs +36/−38
- src/NumHask/Shape.hs +21/−0
- stack.yaml +4/−3
- test/test.hs +107/−0
numhask-array.cabal view
@@ -1,83 +1,77 @@-name: numhask-array-version: 0.0.2-synopsis:- See readme.md-description:- See readme.md for description.-category:- project-homepage:- https://github.com/tonyday567/numhask-array-license:- BSD3-license-file:- LICENSE-author:- Tony Day-maintainer:- tonyday567@gmail.com-copyright:- Tony Day-build-type:- Simple-cabal-version:- >=1.14-tested-with:- GHC == 8.0.1,- GHC == 8.2.1+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: b12ab804325bfe4f740c04d520e84b39268daf23cbe7c9b2e14e7cb2ef52dcc8++name: numhask-array+version: 0.1.0.0+synopsis: See readme.md+description: See readme.md for description.+category: project+homepage: https://github.com/tonyday567/numhask-array#readme+bug-reports: https://github.com/tonyday567/numhask-array/issues+author: Tony Day+maintainer: tonyday567@gmail.com+copyright: Tony Day+license: BSD3+license-file: LICENSE+tested-with: GHC==8.0.1 GHC==8.2.1 GHC==8.2.2+build-type: Simple+cabal-version: >= 1.10+ extra-source-files:- readme.md- stack.yaml+ readme.md+ stack.yaml++source-repository head+ type: git+ location: https://github.com/tonyday567/numhask-array+ library- default-language:- Haskell2010- ghc-options:- hs-source-dirs: - src+ hs-source-dirs:+ src+ default-extensions: NegativeLiterals NoImplicitPrelude OverloadedStrings UnicodeSyntax+ build-depends:+ QuickCheck+ , accelerate+ , accelerate-llvm+ , accelerate-llvm-native+ , adjunctions >=4.0 && <5+ , base >=4.7 && <5+ , deepseq >=1.4.2.0 && <2+ , dimensions+ , distributive >=0.4 && <0.6+ , ghc-typelits-natnormalise >=0.4 && <0.6+ , numhask >=0.1.2 && <0.2+ , protolude >=0.1 && <0.3+ , singletons >=2.0 && <3+ , typelits-witnesses >=0.2 && <0.3+ , vector >=0.10 && <0.13 exposed-modules:- NumHask.Array- NumHask.Array.Constraints- NumHask.Array.Example+ NumHask.Accelerate+ NumHask.Array+ NumHask.Array.Constraints+ NumHask.Array.Example+ NumHask.Shape other-modules:-- build-depends:- base >= 4.7 && < 5,- numhask >= 0.1.2 && < 0.2,- adjunctions >= 4.0 && < 5,- deepseq >= 1.4.2.0 && < 2,- distributive >= 0.4 && < 0.6,- ghc-typelits-natnormalise >= 0.4 && < 0.6,- protolude >= 0.1 && < 0.3,- singletons >= 2.0 && < 3,- typelits-witnesses >= 0.2 && < 0.3,- vector >= 0.10 && < 0.13- default-extensions:- NegativeLiterals,- NoImplicitPrelude,- OverloadedStrings,- UnicodeSyntax+ Paths_numhask_array+ default-language: Haskell2010 test-suite test- default-language:- Haskell2010- type:- exitcode-stdio-1.0+ type: exitcode-stdio-1.0+ main-is: test.hs hs-source-dirs:- test- main-is:- test.hs+ test+ default-extensions: NegativeLiterals NoImplicitPrelude OverloadedStrings UnicodeSyntax build-depends:- base >= 4.7 && < 5,- doctest,- numhask >= 0.1.2 && < 0.2- default-extensions:- NegativeLiterals,- NoImplicitPrelude,- OverloadedStrings,- UnicodeSyntax--source-repository head- type:- git- location:- https://github.com/tonyday567/numhask-array+ QuickCheck+ , base >=4.7 && <5+ , doctest+ , numhask >=0.1.2 && <0.2+ , numhask-array+ , tasty+ , tasty-quickcheck+ other-modules:+ Paths_numhask_array+ default-language: Haskell2010
readme.md view
@@ -5,13 +5,19 @@ An experimental array with: -- shape specified at the type level in n-dimensions-- a [vector](https://www.stackage.org/package/vector) backend+- a polymorphic container+- shape specified at the type level - Representable instances - [numhask](https://www.stackage.org/package/numhask) heirarchy instances See [Examples](src/NumHask/Array/Example.hs) for the emergent API. +Workflow+--- +pkg_config hack courtesy of accelerate +```+PKG_CONFIG_PATH=/usr/local/opt/libFFI/lib/pkgconfig stack build --ghc-options -freverse-errors+```
+ src/NumHask/Accelerate.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | safe-typed n-dimensional arrays with Accelerate arrays under the hood+module NumHask.Accelerate where++import Data.Array.Accelerate.Array.Sugar (listToShape)+import Data.Array.Accelerate.LLVM.Native (run)+import Data.Singletons+import Data.Singletons.TypeLits+import GHC.Exts+import GHC.Show+import NumHask.Prelude hiding (All, Map)+import NumHask.Shape+import qualified Data.Array.Accelerate as A++type family NatsToShape (ns :: [Nat]) where+ NatsToShape '[] = A.Z+ NatsToShape (x:xs) = NatsToShape xs A.:. Int++-- $setup+-- >>> :set -XDataKinds+-- >>> :set -XOverloadedLists+-- >>> :set -XTypeFamilies+-- >>> let a = [1..24] :: ArrayAcc '[2,3,4] Int+-- >>> let v = [1,2,3] :: ArrayAcc '[3] Int+-- >>> a+-- Array (Z :. 4 :. 3 :. 2) [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24]++newtype ArrayAcc (r :: [Nat]) a = ArrayAcc (A.Acc (A.Array (NatsToShape r) a))++instance forall (r :: [Nat]). (SingI r) => HasShape (ArrayAcc r) where+ type Shape (ArrayAcc r) = [Int]+ shape _ = fmap fromIntegral (fromSing (sing :: Sing r))++instance+ ( SingI r+ , Num a+ , A.Elt a+ , A.Shape (NatsToShape r)+ ) => IsList (ArrayAcc (r :: [Nat]) a) where+ type Item (ArrayAcc r a) = a+ fromList l = ArrayAcc $ A.use $ A.fromList (listToShape sh) l+ where+ sh = fmap fromIntegral (fromSing (sing :: Sing r))+ toList (ArrayAcc a) = A.toList $ run a++instance+ ( Show a+ , A.Elt a+ , SingI r+ , A.Shape (NatsToShape r)+ ) => Show (ArrayAcc r a) where+ show (ArrayAcc l) = GHC.Show.show $ run l++instance+ ( Eq a+ , A.Elt a+ , SingI r+ , A.Shape (NatsToShape r)+ , Eq (NatsToShape r)+ ) => Eq (ArrayAcc r a) where+ (==) (ArrayAcc a) (ArrayAcc b) = run a == run b++bin :: (A.Elt a, A.Shape (NatsToShape r)) =>+ (A.Exp a -> A.Exp a -> A.Exp a) -> ArrayAcc r a -> ArrayAcc r a -> ArrayAcc r a+bin f (ArrayAcc a) (ArrayAcc b) = ArrayAcc (A.zipWith f a b)++{-+singleton ::+ ( SingI r+ , A.Elt a+ , Num a+ , A.Shape (NatsToShape r)+ ) => [a] -> ArrayAcc (r :: [Nat]) a+singleton a = ArrayAcc $ A.use $ A.fromList (listToShape sh) a+ where+ sh = fmap fromIntegral (fromSing (sing :: Sing r))+-}++-- Exp additive instances+instance+ ( A.Num a+ , AdditiveMagma a) =>+ AdditiveMagma (A.Exp a) where+ plus = (A.+)++instance+ ( A.Num a+ , AdditiveUnital a) =>+ AdditiveUnital (A.Exp a) where+ zero = A.constant zero++instance+ ( A.Num a+ , AdditiveAssociative a) =>+ AdditiveAssociative (A.Exp a)++instance+ ( A.Num a+ , AdditiveCommutative a) =>+ AdditiveCommutative (A.Exp a)++instance+ ( A.Num a+ , Additive a) =>+ Additive (A.Exp a)++instance+ ( A.Num a+ , AdditiveInvertible a) =>+ AdditiveInvertible (A.Exp a) where+ negate = A.negate++instance+ ( A.Num a+ , AdditiveGroup a) =>+ AdditiveGroup (A.Exp a)++-- Exp multiplivcative instances+instance+ ( A.Num a+ , MultiplicativeMagma a) =>+ MultiplicativeMagma (A.Exp a) where+ times = (A.*)++instance+ ( A.Num a+ , MultiplicativeUnital a) =>+ MultiplicativeUnital (A.Exp a) where+ one = A.constant one++instance+ ( A.Num a+ , MultiplicativeAssociative a) =>+ MultiplicativeAssociative (A.Exp a)++instance+ ( A.Num a+ , MultiplicativeCommutative a) =>+ MultiplicativeCommutative (A.Exp a)++instance+ ( A.Num a+ , Multiplicative a) =>+ Multiplicative (A.Exp a)++instance+ ( A.Num a+ , Fractional (A.Exp a)+ , MultiplicativeInvertible a) =>+ MultiplicativeInvertible (A.Exp a) where+ recip = A.recip++instance+ ( A.Num a+ , Fractional (A.Exp a)+ , MultiplicativeGroup a) =>+ MultiplicativeGroup (A.Exp a)+++-- ArrayAcc additive instances+instance+ ( A.Shape (NatsToShape r)+ , SingI r+ , A.Num a+ , AdditiveMagma a+ ) =>+ AdditiveMagma (ArrayAcc r a) where+ plus = bin plus++instance+ ( A.Shape (NatsToShape r)+ , SingI r+ , A.Num a+ , AdditiveUnital a+ ) =>+ AdditiveUnital (ArrayAcc r a) where+ zero = ArrayAcc $ A.use (A.fromList (listToShape sh) (repeat zero))+ where+ sh = fmap fromIntegral (fromSing (sing :: Sing r))++instance+ ( A.Shape (NatsToShape r)+ , SingI r+ , A.Num a+ , AdditiveAssociative a+ ) =>+ AdditiveAssociative (ArrayAcc r a)++instance+ ( A.Shape (NatsToShape r)+ , SingI r+ , A.Num a+ , AdditiveCommutative a+ ) =>+ AdditiveCommutative (ArrayAcc r a)++instance+ ( A.Shape (NatsToShape r)+ , SingI r+ , A.Num a+ , Additive a+ ) =>+ Additive (ArrayAcc r a)++instance+ ( A.Shape (NatsToShape r)+ , SingI r+ , A.Num a+ , AdditiveInvertible a+ ) =>+ AdditiveInvertible (ArrayAcc r a) where+ negate (ArrayAcc a) = ArrayAcc $ A.map A.negate a++instance+ ( A.Shape (NatsToShape r)+ , SingI r+ , A.Num a+ , AdditiveGroup a+ ) =>+ AdditiveGroup (ArrayAcc r a)++-- $additive tests+-- >>> let m = [0..] :: ArrayAcc '[2,3] Int+-- >>> m+-- Array (Z :. 3 :. 2) [0,1,2,3,4,5]+--+-- >>> m+zero+-- Array (Z :. 3 :. 2) [0,1,2,3,4,5]+--+-- >>> m+m+-- Array (Z :. 3 :. 2) [0,2,4,6,8,10]+--+-- >>> m-m == zero+-- True++++
src/NumHask/Array.hs view
@@ -1,71 +1,56 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedLists #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wall #-}-{-# OPTIONS_GHC -fno-warn-type-defaults #-}+-- you don't need this for ghc-8.2.2+-- intero cracks about it though+-- and doctest as well+{-# LANGUAGE DatatypeContexts #-} --- | safe-typed n-dimensional arrays-module NumHask.Array- ( Array(..)- , SomeArray(..)- , row- , col- , unsafeRow- , unsafeCol- , slice- , unsafeSlice- , index- , unsafeIndex- , foldAlong- , mapAlong- , concatenate- , zipWith- , transpose- , squeeze- , (><)- , mmult- , fromList- ) where+module NumHask.Array where import Data.Distributive import Data.Functor.Rep+import Data.Kind+import Data.List ((!!)) import Data.Promotion.Prelude import Data.Singletons-import Data.Singletons.Prelude import Data.Singletons.TypeLits import GHC.Exts import GHC.Show-import GHC.Generics (Generic1)--- import Control.DeepSeq (NFData1) import NumHask.Array.Constraints-import NumHask.Prelude hiding (All, Map, (><), mmult, show, row, col, zipWith, transpose)+import NumHask.Prelude as P+import NumHask.Shape+import Numeric.Dimensions+import Numeric.Dimensions.Idx+import Numeric.Dimensions.XDim++import qualified Data.Singletons.Prelude as S import qualified Data.Vector as V-import qualified NumHask.Prelude as P-import Data.Kind+import qualified Test.QuickCheck as QC -- $setup -- >>> :set -XDataKinds -- >>> :set -XOverloadedLists -- >>> :set -XTypeFamilies--- >>> let a = [1..24] :: Array '[2,3,4] Int--- >>> let v = [1,2,3] :: Array '[3] Int+-- >>> let a = [1..24] :: Array [] '[2,3,4] Int+-- >>> let v = [1,2,3] :: Array [] '[3] Int --- | an n-dimensional array where shape is specified at the type level--- The main purpose of this, beyond safe typing, is to supply the Representable instance with an initial object.+-- | an array polymorphic in container and shape -- -- >>> a -- [[[1, 2, 3, 4],@@ -74,22 +59,91 @@ -- [[13, 14, 15, 16], -- [17, 18, 19, 20], -- [21, 22, 23, 24]]]-newtype Array (r :: [Nat]) a = Array (V.Vector a) deriving (Functor, Eq, Foldable, Generic, Generic1, NFData)+data family Array (c :: Type -> Type) (ds :: [k]) (a :: Type) --- | an n-dimensional array where shape is specified at the value level-data SomeArray a =- SomeArray [Int]- (V.Vector a)- deriving (Functor, Eq, Foldable)+-- | instance where dimensions are known at compile time+newtype instance (Dimensions ds) =>+ Array c ds t =+ Array { _getContainer :: c t}+ deriving (Functor, Foldable) --- | convert a 'Array' to a 'SomeArray', losing the type level shape-someArray :: (SingI r) => Array (r :: [Nat]) a -> SomeArray a-someArray n@(Array v) = SomeArray (shape n) v+-- | instance of array where some of the dimensions are known at compile time+-- it wraps an Array with some weird magic+data instance Array c (xds :: [XNat]) t = forall (ds :: [Nat]).+ ( FixedDim xds ds ~ ds+ , FixedXDim xds ds ~ xds+ , Dimensions ds) =>+ SomeArray (Array c ds t) -instance forall (r :: [Nat]). (SingI r) => HasShape (Array r) where- type Shape (Array r) = [Int]- shape _ = fmap fromIntegral (fromSing (sing :: Sing r))+-- | an array with dimensions represented at the value level+newtype AnyArray c a = AnyArray ([Int], c a) +-- | convert an array with type-level shape to value-level shape+anyArray :: (Dimensions ds) => Array c ds a -> AnyArray c a+anyArray arr@(Array c) = AnyArray (shape arr, c)++-- | a sweet class of container with attributes necessary to supply the set of operations here+class (Functor f) => Container f where+ generate :: Int -> (Int -> a) -> f a+ idx :: f a -> Int -> a+ cslice :: Int -> Int -> f a -> f a+ zipWith :: (a -> a -> a) -> f a -> f a -> f a+ -- Chunks a container into a list of containers whose dimension are each i+ chunkItUp :: [f a] -> Int -> f a -> [f a]+ cfoldl' :: (b -> a -> b) -> b -> f a -> b+ cfoldr :: (a -> b -> b) -> b -> f a -> b+ cconcat :: [f a] -> f a++instance Container V.Vector where+ generate = V.generate+ idx = V.unsafeIndex+ cslice = V.unsafeSlice+ zipWith = V.zipWith+ chunkItUp acc i v =+ if null v+ then acc+ else let (c, r) = V.splitAt i v+ in chunkItUp (c : acc) i r+ cfoldl' = V.foldl'+ cfoldr = V.foldr+ cconcat = V.concat++instance Container [] where+ generate n g = take n $ g <$> [0 ..]+ idx = (!!)+ cslice d t = take t . drop d+ zipWith = P.zipWith+ chunkItUp acc i v =+ if null v+ then acc+ else let (c, r) = splitAt i v+ in chunkItUp (c : acc) i r+ cfoldl' = foldl'+ cfoldr = foldr+ cconcat = mconcat++instance (Eq (c t), Dimensions ds) => Eq (Array c ds t) where+ (Array a) == (Array b) = a == b++xdimList :: XDim ds -> [Int]+xdimList (XDim d) = dimList d++dimList :: Dim ds -> [Int]+dimList D = []+dimList (d :* ds) = dimList d ++ dimList ds+dimList (Dn :: Dim m) = [dimVal' @m]+dimList (Dx (Dn :: Dim m)) = [dimVal' @m]++instance (Dimensions r) => HasShape (Array c r) where+ type Shape (Array c r) = [Int]+ shape _ = dimList $ dim @r++instance HasShape (Array c (xds :: [XNat])) where+ type Shape (Array c xds) = [Int]+ shape (SomeArray a) = shape a++-- * shape helpers where dimensions ~ [Int]+ -- | convert from n-dim shape index to a flat index -- -- >>> ind [2,3,4] [1,1,1]@@ -111,60 +165,54 @@ ([], x) ns -instance forall r. (SingI r) => Distributive (Array r) where- distribute f =- Array $ V.generate n $ \i -> fmap (\(Array v) -> V.unsafeIndex v i) f+instance forall r c. (Dimensions r, Container c) =>+ Distributive (Array c r) where+ distribute f = Array $ generate n $ \i -> fmap (\(Array v) -> idx v i) f where- n =- case (sing :: Sing r) of- SNil -> 1- (SCons x xs) -> product $ fromInteger <$> (fromSing x : fromSing xs)+ n = dimVal $ dim @r -instance forall (r :: [Nat]). (SingI r) => Representable (Array r) where- type Rep (Array r) = [Int]- tabulate f = Array $ V.generate (product ns) (f . unind ns)+instance forall r c. (Dimensions r, Container c) =>+ Representable (Array c r) where+ type Rep (Array c r) = [Int]+ tabulate f = Array $ generate (product ns) (f . unind ns) where- ns =- case (sing :: Sing r) of- SNil -> []- (SCons x xs) -> fromIntegral <$> (fromSing x : fromSing xs)- index (Array xs) rs = xs V.! ind ns rs+ ns = dimList $ dim @r+ index (Array xs) rs = xs `idx` ind ns rs where- ns =- case (sing :: Sing r) of- SNil -> []- (SCons x xs') -> fromIntegral <$> (fromSing x : fromSing xs')+ ns = dimList $ dim @r -- | from flat list-instance (SingI r, Num a) => IsList (Array (r :: [Nat]) a) where- type Item (Array r a) = a- fromList l = Array $ V.fromList $ take n $ l ++ repeat 0+instance+ ( Item (Array c r a) ~ Item (c a)+ , Dimensions r+ , AdditiveUnital a+ , IsList (c a)+ ) =>+ IsList (Array c r a) where+ type Item (Array c r a) = a+ fromList l = Array $ fromList $ take n $ l ++ repeat zero where- n =- case (sing :: Sing r) of- SNil -> 1- (SCons x xs') ->- product $ fromIntegral <$> (fromSing x : fromSing xs')- toList (Array v) = V.toList v+ n = dimVal (dim @r)+ toList (Array v) = GHC.Exts.toList v -instance (Show a) => Show (SomeArray a) where- show r@(SomeArray l _) = go (length l) r+instance (Show a, Show (Item (c a)), Container c, IsList (c a)) => Show (AnyArray c a) where+ show aa@(AnyArray (l,_)) = go (length l) aa where- go n r'@(SomeArray l' v') =+ go n aa'@(AnyArray (l', c')) = case length l' of- 0 -> show $ V.head v'- 1 -> "[" ++ intercalate ", " (show <$> GHC.Exts.toList v') ++ "]"+ 0 -> "[]"+ 1 -> "[" ++ intercalate ", " (GHC.Show.show <$> GHC.Exts.toList c') ++ "]" x -> "[" ++ intercalate (",\n" ++ replicate (n - x + 1) ' ')- (go n <$> flatten1 r') +++ (go n <$> flatten1 aa') ++ "]" -- | convert the top layer of a SomeArray to a [SomeArray]-flatten1 :: SomeArray a -> [SomeArray a]-flatten1 (SomeArray rep v) =- (\s -> SomeArray (drop 1 rep) (V.unsafeSlice (s * l) l v)) <$> ss+flatten1 :: (Container c) => AnyArray c a -> [AnyArray c a]+flatten1 (AnyArray (rep, v)) =+ (\s -> AnyArray (drop 1 rep, cslice (s * l) l v)) <$> ss where (n, l) = case rep of@@ -172,87 +220,150 @@ x:r -> (x, product r) ss = take n [0 ..] -instance (Show a, SingI r) => Show (Array (r :: [Nat]) a) where- show = show . someArray+instance (Show a, Show (Item (c a)), IsList (c a), Container c, Dimensions ds) => Show (Array c ds a) where+ show = GHC.Show.show . anyArray --- instance NFData (Array (r :: [Nat]) a) where- -- nrf (Array v) = Array (nrf v)+type Vector c n = Array c '[ n] +type Matrix c m n = Array c '[ m, n]++instance+ ( IsList (c a)+ , Item (c a) ~ a+ , KnownNat n+ , AdditiveUnital (Vector c n a)+ , QC.Arbitrary a+ , AdditiveUnital a+ , Num a+ ) =>+ QC.Arbitrary (Vector c n a) where+ arbitrary = QC.frequency [(1, pure zero), (9, fromList <$> QC.vector n)]+ where+ n = fromInteger $ natVal (Proxy :: Proxy n)++instance+ ( IsList (c a)+ , Item (c a) ~ a+ , AdditiveUnital (Matrix c m n a)+ , KnownNat m+ , KnownNat n+ , QC.Arbitrary a+ , AdditiveUnital a+ , Num a+ ) =>+ QC.Arbitrary (Matrix c m n a) where+ arbitrary = QC.frequency [(1, pure zero), (9, fromList <$> QC.vector (m * n))]+ where+ n = fromInteger $ natVal (Proxy :: Proxy n)+ m = fromInteger $ natVal (Proxy :: Proxy m)++ -- ** Operations -- | outer product -- -- todo: reconcile with numhask version ----- >>> v >< v+-- >>> v NumHask.Array.>< v -- [[1, 2, 3], -- [2, 4, 6], -- [3, 6, 9]]-(><) ::- forall (r :: [Nat]) (s :: [Nat]) a.- (CRing a, SingI r, SingI s, SingI (r :++ s))- => Array r a- -> Array s a- -> Array (r :++ s) a+(><) :: forall c (r :: [Nat]) (s :: [Nat]) a.+ ( Container c+ , CRing a+ , Dimensions r+ , Dimensions s+ , Dimensions (r ++ s))+ => Array c r a+ -> Array c s a+ -> Array c (r ++ s) a (><) m n = tabulate (\i -> index m (take dimm i) * index n (drop dimm i)) where dimm = length (shape m) --- | matrix multiplication for a '2-Array'+-- | matrix multiplication ----- >>> let a = [1, 2, 3, 4] :: Array '[2, 2] Int--- >>> let b = [5, 6, 7, 8] :: Array '[2, 2] Int+-- >>> let a = [1, 2, 3, 4] :: Array [] '[2, 2] Int+-- >>> let b = [5, 6, 7, 8] :: Array [] '[2, 2] Int -- >>> a -- [[1, 2], -- [3, 4]]+-- -- >>> b -- [[5, 6], -- [7, 8]]+-- -- >>> mmult a b -- [[19, 22], -- [43, 50]]-mmult ::- forall m n k a.- (Semiring a, Num a, CRing a, KnownNat m, KnownNat n, KnownNat k)- => Array '[ m, k] a- -> Array '[ k, n] a- -> Array '[ m, n] a+--+mmult :: forall c m n k a.+ ( Hilbert (Vector c k) a+ , Dimensions '[ m, k]+ , Dimensions '[ k, n]+ , Dimensions '[ m, n]+ , Container c+ , Semiring a+ , Num a+ , CRing a+ , KnownNat m+ , KnownNat n+ , KnownNat k+ )+ => Matrix c m k a+ -> Matrix c k n a+ -> Matrix c m n a mmult x y = tabulate (\[i, j] -> unsafeRow i x <.> unsafeCol j y) -- | extract the row of a matrix-row ::- forall i a m n. (KnownNat m, KnownNat n, KnownNat i, (i :< m) ~ 'True)+row :: forall c i a m n.+ ( Dimensions '[ m, n]+ , Container c+ , KnownNat m+ , KnownNat n+ , KnownNat i+ , (i S.:< m) ~ 'True+ ) => Proxy i- -> Array '[ m, n] a- -> Array '[ n] a+ -> Matrix c m n a+ -> Vector c n a row i_ = unsafeRow i where- i = (fromIntegral . fromSing . singByProxy) i_+ i = (fromIntegral . S.fromSing . S.singByProxy) i_ -unsafeRow ::- forall a m n. (KnownNat m, KnownNat n)+unsafeRow :: forall c a m n.+ ( Container c+ , KnownNat m+ , KnownNat n+ , Dimensions '[ m, n]) => Int- -> Array '[ m, n] a- -> Array '[ n] a-unsafeRow i t@(Array a) = Array $ V.unsafeSlice (i * n) n a+ -> Matrix c m n a+ -> Vector c n a+unsafeRow i t@(Array a) = Array $ cslice (i * n) n a where [_, n] = shape t -- | extract the column of a matrix-col ::- forall j a m n. (KnownNat m, KnownNat n, KnownNat j, (j :< n) ~ 'True)+col :: forall c j a m n.+ ( Dimensions '[ m, n]+ , Container c+ , KnownNat m+ , KnownNat n+ , KnownNat j+ , (j S.:< n) ~ 'True+ ) => Proxy j- -> Array '[ m, n] a- -> Array '[ m] a+ -> Matrix c m n a+ -> Vector c m a col j_ = unsafeCol j where- j = (fromIntegral . fromSing . singByProxy) j_+ j = (fromIntegral . S.fromSing . S.singByProxy) j_ unsafeCol ::- forall a m n. (KnownNat m, KnownNat n)+ forall c a m n. (Container c, KnownNat m, KnownNat n, Dimensions '[ m, n]) => Int- -> Array '[ m, n] a- -> Array '[ m] a-unsafeCol j t@(Array a) = Array $ V.generate m (\x -> a V.! (j + x * n))+ -> Matrix c m n a+ -> Vector c m a+unsafeCol j t@(Array a) = Array $ generate m (\x -> a `idx` (j + x * n)) where [m, n] = shape t @@ -260,80 +371,93 @@ -- -- >>> unsafeIndex a [0,2,1] -- 10-unsafeIndex :: SingI r => Array r a -> [Int] -> a-unsafeIndex t@(Array a) i = a V.! ind (shape t) i+unsafeIndex :: (Container c, Dimensions r) => Array c r a -> [Int] -> a+unsafeIndex t@(Array a) i = a `idx` ind (shape t) i -- | ----- >>> unsafeSlice [[0,1],[2],[1,2]] a :: Array '[2,1,2] Int+-- >>> unsafeSlice [[0,1],[2],[1,2]] a :: Array [] '[2,1,2] Int -- [[[10, 11]], -- [[22, 23]]]-unsafeSlice :: (SingI r) => [[Int]] -> Array r a -> Array r0 a-unsafeSlice s t = Array (V.fromList [unsafeIndex t i | i <- sequence s])+unsafeSlice ::+ (Container c, IsList (c a), Item (c a) ~ a, Dimensions r, Dimensions r0)+ => [[Int]]+ -> Array c r a+ -> Array c r0 a+unsafeSlice s t = Array (fromList [unsafeIndex t i | i <- sequence s]) -- | Slice xs = Map Length xs type family Slice (xss :: [[Nat]]) :: [Nat] where- Slice xss = Map LengthSym0 xss+ Slice xss = Data.Promotion.Prelude.Map LengthSym0 xss -- | AllLT xs n = All (n >) xs-data AllLTSym0 (a :: TyFun [Nat] (TyFun Nat Bool -> Type))+data AllLTSym0 (a :: S.TyFun [Nat] (S.TyFun Nat Bool -> Type)) -data AllLTSym1 (l :: [Nat]) (a :: TyFun Nat Bool)+data AllLTSym1 (l :: [Nat]) (a :: S.TyFun Nat Bool) -type instance Apply AllLTSym0 l = AllLTSym1 l+type instance S.Apply AllLTSym0 l = AllLTSym1 l -type instance Apply (AllLTSym1 l) n = All ((:>$$) n) l+type instance S.Apply (AllLTSym1 l) n =+ Data.Promotion.Prelude.All ((S.:>$$) n) l -- | ----- >>> slice (Proxy :: Proxy '[ '[0,1],'[2],'[1,2]]) a+-- todo: an ambiguous type variable has snucjk in here somewhere+--+-- > slice (Proxy :: Proxy '[ '[0,1],'[2],'[1,2]]) a -- [[[10, 11]], -- [[22, 23]]]+{-+todo:+ • Expected kind ‘[[Nat]]’, but ‘s’ has kind ‘[Nat]’+ • In the first argument of ‘Slice’, namely ‘s’+ In the first argument of ‘Array’, namely ‘(Slice s)’+ In the type signature:+ slice :: forall c s r a.+ (Container c,+ Dimensions s,+ Dimensions r,+ And (ZipWith AllLTSym0 s r) ~ 'True) =>+ Proxy s -> Array c r a -> Array (Slice s) c a+-}+{- slice ::- forall s r a. (SingI s, SingI r, And (ZipWith AllLTSym0 s r) ~ 'True)+ forall c s r a. (Container c, Dimensions s, Dimensions r, S.And (S.ZipWith AllLTSym0 s r) ~ 'True) => Proxy s- -> Array r a- -> Array (Slice s) a+ -> Array c r a+ -> Array (Slice s) c a+-} slice s_ = unsafeSlice s where s = ((fmap . fmap) fromInteger . fromSing . singByProxy) s_ --- Chunks a vector v into a list of modules whose dimension is each i-chunkItUp :: [V.Vector a] -> Int -> V.Vector a -> [V.Vector a]-chunkItUp acc i v =- if null v- then acc- else let (c, r) = V.splitAt i v- in chunkItUp (c : acc) i r--zipWith :: (a -> a -> a) -> Array s a -> Array s a -> Array s a-zipWith fn (Array a) (Array b) = Array $ V.zipWith fn a b- -- | ----- >>> foldAlong (Proxy :: Proxy 1) (\_ -> ([0..3] :: Array '[4] Int)) a+-- >>> foldAlong (Proxy :: Proxy 1) (\_ -> ([0..3] :: Array [] '[4] Int)) a -- [[0, 1, 2, 3], -- [0, 1, 2, 3]] -- -- todo: resolution of a primitive and a scalar eg -- Expected type: Array '[10] Int -> Array '[] Int -- Actual type: Array '[10] (Array '[] Int) -> Array '[] Int+-- foldAlong ::- forall s vw uvw uw w a.- ( SingI s- , SingI uvw+ forall c s vw uvw uw w a.+ ( Container c+ , KnownNat s+ , Dimensions uvw , uw ~ (Fold s uvw)- , w ~ (Drop 1 vw)+ , w ~ (Data.Promotion.Prelude.Drop 1 vw) , vw ~ (TailModule s uvw) ) => Proxy s- -> (Array vw a -> Array w a)- -> Array uvw a- -> Array uw a+ -> (Array c vw a -> Array c w a)+ -> Array c uvw a+ -> Array c uw a foldAlong s_ f a@(Array v) = Array $- V.concat- (foldl'+ cconcat+ (cfoldl' (\xs x -> let (Array vx) = f (Array x) in vx : xs)@@ -345,23 +469,27 @@ -- | ----- >>> mapAlong (Proxy :: Proxy 0) (\x -> NumHask.Array.zipWith (*) x x) a+-- todo: No instance for (Container (Array [] '[]) error+--+-- > mapAlong (Proxy :: Proxy 0) (\x -> NumHask.Array.zipWith (*) x x) a -- [[[1, 4, 9, 16], -- [25, 36, 49, 64], -- [81, 100, 121, 144]], -- [[169, 196, 225, 256], -- [289, 324, 361, 400], -- [441, 484, 529, 576]]]+-- mapAlong ::- forall s uvw vw a. (SingI s, SingI uvw, vw ~ (HeadModule s uvw))+ forall c s uvw vw a.+ (Container c, KnownNat s, Dimensions uvw, vw ~ (HeadModule s uvw)) => Proxy s- -> (Array vw a -> Array vw a)- -> Array uvw a- -> Array uvw a+ -> (Array c vw a -> Array c vw a)+ -> Array c uvw a+ -> Array c uvw a mapAlong s_ f a@(Array v) = Array $- V.concat- (foldl'+ cconcat+ (cfoldl' (\xs x -> let (Array vx) = f (Array x) in vx : xs)@@ -380,14 +508,21 @@ -- [[13, 14, 15, 16, 13, 14, 15, 16], -- [17, 18, 19, 20, 17, 18, 19, 20], -- [21, 22, 23, 24, 21, 22, 23, 24]]]+-- concatenate ::- forall s r t a. (SingI s, SingI r, SingI t, (IsValidConcat s t r) ~ 'True)+ forall c s r t a.+ ( Container c+ , SingI s+ , Dimensions r+ , Dimensions t+ , (IsValidConcat s t r) ~ 'True+ ) => Proxy s- -> Array r a- -> Array t a- -> Array (Concatenate s t r) a+ -> Array c r a+ -> Array c t a+ -> Array c (Concatenate s t r) a concatenate s_ r@(Array vr) t@(Array vt) =- Array . V.concat $ (concat . reverse . P.transpose) [rm, tm]+ Array . cconcat $ (concat . reverse . P.transpose) [rm, tm] where s = (fromInteger . fromSing . singByProxy) s_ rm = chunkItUp [] (product $ drop s $ shape t) vt@@ -408,15 +543,17 @@ -- [[19, 20], -- [21, 22], -- [23, 24]]]+-- transpose ::- forall s t a. (t ~ Transpose s)- => Array s a- -> Array t a+ forall c s t a. (t ~ Transpose s, Container c, Dimensions s, Dimensions t)+ => Array c s a+ -> Array c t a transpose (Array x) = Array x + -- | ----- >>> let a = [1..24] :: Array '[2,1,3,4,1] Int+-- >>> let a = [1..24] :: Array [] '[2,1,3,4,1] Int -- >>> a -- [[[[[1], -- [2],@@ -449,92 +586,153 @@ -- [[13, 14, 15, 16], -- [17, 18, 19, 20], -- [21, 22, 23, 24]]]+-- squeeze ::- forall s t a. (t ~ Squeeze s)- => Array s a- -> Array t a+ forall c s t a. (t ~ Squeeze s)+ => Array c s a+ -> Array c t a squeeze (Array x) = Array x -instance (SingI r, AdditiveMagma a) => AdditiveMagma (Array r a) where+instance (Dimensions r, Container c, AdditiveMagma a) =>+ AdditiveMagma (Array c r a) where plus = liftR2 plus -instance (SingI r, AdditiveUnital a) => AdditiveUnital (Array r a) where+instance (Dimensions r, Container c, AdditiveUnital a) =>+ AdditiveUnital (Array c r a) where zero = pureRep zero -instance (SingI r, AdditiveAssociative a) =>- AdditiveAssociative (Array r a)+instance (Dimensions r, Container c, AdditiveAssociative a) =>+ AdditiveAssociative (Array c r a) -instance (SingI r, AdditiveCommutative a) =>- AdditiveCommutative (Array r a)+instance (Dimensions r, Container c, AdditiveCommutative a) =>+ AdditiveCommutative (Array c r a) -instance (SingI r, AdditiveInvertible a) => AdditiveInvertible (Array r a) where+instance (Dimensions r, Container c, AdditiveInvertible a) =>+ AdditiveInvertible (Array c r a) where negate = fmapRep negate -instance (SingI r, Additive a) => Additive (Array r a)+instance (Dimensions r, Container c, Additive a) => Additive (Array c r a) -instance (SingI r, AdditiveGroup a) => AdditiveGroup (Array r a)+instance (Dimensions r, Container c, AdditiveGroup a) =>+ AdditiveGroup (Array c r a) -instance (SingI r, MultiplicativeMagma a) =>- MultiplicativeMagma (Array r a) where+instance (Dimensions r, Container c, MultiplicativeMagma a) =>+ MultiplicativeMagma (Array c r a) where times = liftR2 times -instance (SingI r, MultiplicativeUnital a) =>- MultiplicativeUnital (Array r a) where+instance (Dimensions r, Container c, MultiplicativeUnital a) =>+ MultiplicativeUnital (Array c r a) where one = pureRep one -instance (SingI r, MultiplicativeAssociative a) =>- MultiplicativeAssociative (Array r a)+instance (Dimensions r, Container c, MultiplicativeAssociative a) =>+ MultiplicativeAssociative (Array c r a) -instance (SingI r, MultiplicativeCommutative a) =>- MultiplicativeCommutative (Array r a)+instance (Dimensions r, Container c, MultiplicativeCommutative a) =>+ MultiplicativeCommutative (Array c r a) -instance (SingI r, MultiplicativeInvertible a) =>- MultiplicativeInvertible (Array r a) where+instance (Dimensions r, Container c, MultiplicativeInvertible a) =>+ MultiplicativeInvertible (Array c r a) where recip = fmapRep recip -instance (SingI r, Multiplicative a) => Multiplicative (Array r a)+instance (Dimensions r, Container c, Multiplicative a) =>+ Multiplicative (Array c r a) -instance (SingI r, MultiplicativeGroup a) =>- MultiplicativeGroup (Array r a)+instance (Dimensions r, Container c, MultiplicativeGroup a) =>+ MultiplicativeGroup (Array c r a) -instance (SingI r, MultiplicativeMagma a, Additive a) =>- Distribution (Array r a)+instance (Dimensions r, Container c, MultiplicativeMagma a, Additive a) =>+ Distribution (Array c r a) -instance (SingI r, Semiring a) => Semiring (Array r a)+instance (Dimensions r, Container c, Semiring a) => Semiring (Array c r a) -instance (SingI r, Ring a) => Ring (Array r a)+instance (Dimensions r, Container c, Ring a) => Ring (Array c r a) -instance (SingI r, CRing a) => CRing (Array r a)+instance (Dimensions r, Container c, CRing a) => CRing (Array c r a) -instance (SingI r, Field a) => Field (Array r a)+instance (Dimensions r, Container c, Field a) => Field (Array c r a) -instance (SingI r, ExpField a) => ExpField (Array r a) where+instance (Dimensions r, Container c, ExpField a) => ExpField (Array c r a) where exp = fmapRep exp log = fmapRep log -instance (SingI r, BoundedField a) => BoundedField (Array r a) where+instance (Foldable (Array c r), Dimensions r, Container c, BoundedField a) =>+ BoundedField (Array c r a) where isNaN f = or (fmapRep isNaN f) -instance (SingI r, Signed a) => Signed (Array r a) where+instance (Dimensions r, Container c, Signed a) => Signed (Array c r a) where sign = fmapRep sign abs = fmapRep abs -instance (ExpField a) => Normed (Array r a) a where+instance (Functor (Array c r), Foldable (Array c r), ExpField a) =>+ Normed (Array c r a) a where size r = sqrt $ foldr (+) zero $ (** (one + one)) <$> r -instance (SingI r, Epsilon a) => Epsilon (Array r a) where+instance (Foldable (Array c r), Dimensions r, Container c, Epsilon a) =>+ Epsilon (Array c r a) where nearZero f = and (fmapRep nearZero f) aboutEqual a b = and (liftR2 aboutEqual a b) -instance (SingI r, ExpField a) => Metric (Array r a) a where+instance (Foldable (Array c r), Dimensions r, Container c, ExpField a) =>+ Metric (Array c r a) a where distance a b = size (a - b) -instance (SingI r, Integral a) => Integral (Array r a) where+instance (Dimensions r, Container c, Integral a) => Integral (Array c r a) where divMod a b = (d, m) where x = liftR2 divMod a b d = fmap fst x m = fmap snd x -instance (CRing a, Num a, Semiring a, SingI r) => Hilbert (Array r) a where+instance (Foldable (Array c r), CRing a, Semiring a, Dimensions r, Container c) =>+ Hilbert (Array c r) a where a <.> b = sum $ liftR2 (*) a b++instance (Dimensions r, Container c, Additive a) =>+ AdditiveBasis (Array c r) a where+ (.+.) = liftR2 (+)++instance (Dimensions r, Container c, AdditiveGroup a) =>+ AdditiveGroupBasis (Array c r) a where+ (.-.) = liftR2 (-)++instance (Dimensions r, Container c, Multiplicative a) =>+ MultiplicativeBasis (Array c r) a where+ (.*.) = liftR2 (*)++instance (Dimensions r, Container c, MultiplicativeGroup a) =>+ MultiplicativeGroupBasis (Array c r) a where+ (./.) = liftR2 (/)++instance (Dimensions r, Container c, Additive a) =>+ AdditiveModule (Array c r) a where+ (.+) r s = fmap (s +) r+ (+.) s = fmap (s +)++instance (Dimensions r, Container c, AdditiveGroup a) =>+ AdditiveGroupModule (Array c r) a where+ (.-) r s = fmap (\x -> x - s) r+ (-.) s = fmap (\x -> x - s)++instance (Dimensions r, Container c, Multiplicative a) =>+ MultiplicativeModule (Array c r) a where+ (.*) r s = fmap (s *) r+ (*.) s = fmap (s *)++instance (Dimensions r, Container c, MultiplicativeGroup a) =>+ MultiplicativeGroupModule (Array c r) a where+ (./) r s = fmap (/ s) r+ (/.) s = fmap (/ s)++instance (Dimensions r, Container c) => Singleton (Array c r) where+ singleton = pureRep++instance ( Foldable (Array c r)+ , Dimensions r+ , Container c+ , CRing a+ , Multiplicative a+ ) =>+ TensorProduct (Array c r a) where+ (><) m n = tabulate (\i -> index m i *. n)+ timesleft v m = tabulate (\i -> v <.> index m i)+ timesright m v = tabulate (\i -> v <.> index m i)
src/NumHask/Array/Example.hs view
@@ -40,6 +40,7 @@ ) where import NumHask.Array as A+import NumHask.Shape import NumHask.Prelude as P -- $setup@@ -49,17 +50,14 @@ -- >>> :set -XFlexibleContexts -- >>> import NumHask.Array as A -- >>> import GHC.Exts (fromList)--- >>> -- import NumHask.Space hiding (singleton)--- >>> -- import NumHask.Range--- >>> import qualified Data.Vector as V -- $anExample -- construction can be lazy; and zero pads ----- >>> let z = [] :: Array '[2] Int+-- >>> let z = [] :: Array [] '[2] Int -- >>> z -- [0, 0]--- >>> let a = [0..] :: Array '[3,5] Int+-- >>> let a = [0..] :: Array [] '[3,5] Int -- >>> a -- [[0, 1, 2, 3, 4], -- [5, 6, 7, 8, 9],@@ -69,41 +67,41 @@ -- >>> length (shape a) -- dimension -- 2 -- >>> :t a--- a :: Array '[3, 5] Int+-- a :: Array [] '[3, 5] Int -- >>> import qualified Data.Vector as V -- >>> let v = V.fromList [6,7,8] -- >>> :t v -- v :: Num a => V.Vector a -- >>> let b = Array v -- >>> :t b--- b :: Num a => Array r a--- >>> b :: Array '[3] Int+-- b :: Num t => Array V.Vector ds t+-- >>> b :: Array V.Vector '[3] Int -- [6, 7, 8] -- $arrayCreation -- -- >>> -- fixed size arrays are fully shape specified at the type level--- >>> let a = [2, 3, 4] :: Array '[3] Int+-- >>> let a = [2, 3, 4] :: Array [] '[3] Int -- >>> a -- [2, 3, 4]--- >>> [1.2, 3.5, 5.1] :: Array '[3] Double+-- >>> [1.2, 3.5, 5.1] :: Array [] '[3] Double -- [1.2, 3.5, 5.1] -- -- >>> -- lists of lists is not a thing, and need to be flattened -- >>> let ls = [[1.0,2.0,3.0],[4.0,5.0,6.0]] :: [[Double]]--- >>> fromList (concat ls) :: Array '[2,3] Double+-- >>> fromList (concat ls) :: Array [] '[2,3] Double -- [[1.0, 2.0, 3.0], -- [4.0, 5.0, 6.0]] ----- >>> fromList ((\x -> (fromIntegral x) :+ zero) <$> [1,2,3,4]) :: Array '[2,2] (Complex Double)+-- >>> fromList ((\x -> (fromIntegral x) :+ zero) <$> [1,2,3,4]) :: Array [] '[2,2] (Complex Double) -- [[1.0 :+ 0.0, 2.0 :+ 0.0], -- [3.0 :+ 0.0, 4.0 :+ 0.0]]--- >>> let z = [] :: Array '[3,4] Int+-- >>> let z = [] :: Array [] '[3,4] Int -- >>> z -- [[0, 0, 0, 0], -- [0, 0, 0, 0], -- [0, 0, 0, 0]]--- >>> let o = singleton one :: Array '[2,3,4] Int+-- >>> let o = singleton one :: Array [] '[2,3,4] Int -- >>> o -- [[[1, 1, 1, 1], -- [1, 1, 1, 1],@@ -111,30 +109,30 @@ -- [[1, 1, 1, 1], -- [1, 1, 1, 1], -- [1, 1, 1, 1]]]--- >>> let empt = singleton nan :: Array '[2,3] Double+-- >>> let empt = singleton nan :: Array [] '[2,3] Double -- >>> empt -- [[NaN, NaN, NaN], -- [NaN, NaN, NaN]] ----- >>> [10,15 .. 30] :: Array '[4] Int+-- >>> [10,15 .. 30] :: Array [] '[4] Int -- [10, 15, 20, 25]--- >>> [0, 0.3.. 2] :: Array '[7] Double+-- >>> [0, 0.3.. 2] :: Array [] '[7] Double -- [0.0, 0.3, 0.6, 0.8999999999999999, 1.1999999999999997, 1.4999999999999996, 1.7999999999999994] -- -- > todo: fix NumHask.Range grid--- > fromList (grid OuterPos (Range 0 2) 8) :: Array '[9] Double+-- > fromList (grid OuterPos (Range 0 2) 8) :: Array [] '[9] Double -- > [0.0, 0.25, 0.5, 0.75, 1.0, 1.25, 1.5, 1.75, 2.0]--- > let x = fromList (grid OuterPos (Range 0 (2*pi)) 100) :: Array '[101] Double+-- > let x = fromList (grid OuterPos (Range 0 (2*pi)) 100) :: Array [] '[101] Double -- > let f = fmap sin x -- -- $printingArrays--- >>> show ([0..] :: Array '[6] Int) :: Text+-- >>> show ([0..] :: Array [] '[6] Int) :: Text -- "[0, 1, 2, 3, 4, 5]"--- >>> [0..] :: Array '[2,3] Int+-- >>> [0..] :: Array [] '[2,3] Int -- [[0, 1, 2], -- [3, 4, 5]]--- >>> [0..] :: Array '[1,2,3,1] Int+-- >>> [0..] :: Array [] '[1,2,3,1] Int -- [[[[0], -- [1], -- [2]],@@ -144,7 +142,7 @@ -- -- > todo: implement display -- > import Formatting--- > display (left 7 . fixed 2) ", " (fromList $ fromIntegral <$> [0..] :: Array '[100,100] Double)+-- > display (left 7 . fixed 2) ", " (fromList $ fromIntegral <$> [0..] :: Array [] '[100,100] Double) -- > [[ 0.00, 1.00, 2.00 .. 98.00 99.00], -- > [ 100.00, 101.00, 102.00 .. 198.00 199.00], -- > [ 200.00, 201.00, 202.00 .. 298.00 299.00],@@ -155,21 +153,21 @@ -- $basicOperation ----- >>> let a = [20,30,40,50] :: Array '[4] Double--- >>> let b = [0..] :: Array '[4] Double+-- >>> let a = [20,30,40,50] :: Array [] '[4] Double+-- >>> let b = [0..] :: Array [] '[4] Double -- >>> let c = a - b -- >>> c -- [20.0, 29.0, 38.0, 47.0] -- >>> -- todo: resolve potential to polymorph number literals eg b**2 -- >>> b ** (one+one) -- [0.0, 1.0, 4.0, 9.000000000000002]--- >>> 10 *. sin <$> a+-- >>> 10 *. (sin <$> a) -- [9.129452507276277, -9.880316240928618, 7.451131604793488, -2.6237485370392877] -- >>> (<35) <$> a -- [True, True, False, False] ----- >>> let a = [0..] :: Array '[2,3] Int--- >>> let b = [0..] :: Array '[3,2] Int+-- >>> let a = [0..] :: Array [] '[2,3] Int+-- >>> let b = [0..] :: Array [] '[3,2] Int -- >>> a .*. a -- [[0, 1, 4], -- [9, 16, 25]]@@ -184,17 +182,17 @@ -- >>> -- random example skipped -- -- > -- todo: awaiting grid fix--- > let a = singleton one :: Array '[3] Double--- > let b = fromList (grid OuterPos (Range 0 pi) 2) :: Array '[3] Double+-- > let a = singleton one :: Array [] '[3] Double+-- > let b = fromList (grid OuterPos (Range 0 pi) 2) :: Array [] '[3] Double -- > let c = a + b -- > let d = exp . ((zero:+one) *.) $ (:+zero) <$> c -- > d -- [0.5403023058681398 :+ 0.8414709848078965, (-0.8414709848078965) :+ 0.5403023058681398, (-0.5403023058681399) :+ (-0.8414709848078964)] -- > :t d--- d :: Array '[3] (Complex Double)+-- d :: Array [] '[3] (Complex Double) -- -- >>> -- folding--- >>> let a = [0..] :: Array '[2,5] Int+-- >>> let a = [0..] :: Array [] '[2,5] Int -- >>> sum a -- 45 -- >>> minimum a@@ -206,7 +204,7 @@ -- $universalFunctions ----- >>> let a = [0..] :: Array '[3] Double+-- >>> let a = [0..] :: Array [] '[3] Double -- >>> exp <$> a -- [1.0, 2.718281828459045, 7.38905609893065] -- >>> sqrt <$> a@@ -215,21 +213,21 @@ -- $indexingSlicingIterating ----- >>> let a = (\x -> x*x*x) <$> [0..] :: Array '[10] Int+-- >>> let a = (\x -> x*x*x) <$> [0..] :: Array [] '[10] Int -- >>> index a [2] -- 8--- >>> let s = (\i -> index a [i]) <$> [2..5] :: Array '[4] Int+-- >>> let s = (\i -> index a [i]) <$> [2..5] :: Array [] '[4] Int -- >>> s -- [8, 27, 64, 125] -- >>> :t s--- s :: Array '[4] Int+-- s :: Array [] '[4] Int -- >>> -- replace every second number with -1000--- >>> let a' = (tabulate (\[i] -> if i `mod` 2 == 0 then -1000 else (index a [i]))) :: Array '[10] Int+-- >>> let a' = (tabulate (\[i] -> if i `mod` 2 == 0 then -1000 else (index a [i]))) :: Array [] '[10] Int -- >>> a' -- [-1000, 1, -1000, 27, -1000, 125, -1000, 343, -1000, 729] -- -- > -- todo: reverse fix--- > let a'' = (let (n:_) = shape a in tabulate (\[i] -> index a [n-i])) :: Array '[4] Int+-- > let a'' = (let (n:_) = shape a in tabulate (\[i] -> index a [n-i])) :: Array [] '[4] Int -- > a'' -- > [729, -1000, 343, -1000, 125, -1000, 27, -1000, 1, -1000] --
+ src/NumHask/Shape.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++-- | numbers with a shape+module NumHask.Shape+ ( HasShape(..)+ -- * Representable+ -- | Representable has most of what's needed to define numbers that have elements (aka scalars) and a fixed shape.+ , Representable(..)+ ) where++import Data.Functor.Rep++-- | Not everything that has a shape is representable.+--+-- todo: Structure is a useful alternative concept/naming convention+class HasShape f where+ type Shape f+ shape :: f a -> Shape f
stack.yaml view
@@ -1,9 +1,10 @@-resolver: lts-9.3+resolver: nightly-2018-01-18 packages: - '.' extra-deps:- - numhask-0.1.2- # - deepseq-1.4.3.0+ #- numhask-0.1.3+ - dimensions-0.3.2.0+ # - deepseq-1.4.3.0i
test/test.hs view
@@ -1,9 +1,16 @@+{-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -Wall #-} module Main where import NumHask.Prelude+import NumHask.Laws+import NumHask.Array+ import Test.DocTest+import Test.Tasty+ (TestTree, defaultMain, testGroup, localOption)+import Test.Tasty.QuickCheck main :: IO () main = do@@ -11,3 +18,103 @@ doctest ["src/NumHask/Array.hs"] putStrLn ("Example DocTest" :: Text) doctest ["src/NumHask/Array/Example.hs"]+ putStrLn ("ArrayAcc DocTest" :: Text)+ doctest ["src/NumHask/Accelerate.hs"]+ defaultMain tests++tests :: TestTree+tests =+ testGroup+ "NumHask"+ [ testsVInt+ , testsMInt+ , testsVFloat+ , testsMFloat+ ]++testsVInt :: TestTree+testsVInt =+ testGroup+ "Vector [] 6 Int"+ [ testGroup "Additive" $ testLawOf ([] :: [Vector [] 6 Int]) <$> additiveLaws+ , testGroup "Additive Group" $+ testLawOf ([] :: [Vector [] 6 Int]) <$> additiveGroupLaws+ , testGroup "Multiplicative" $+ testLawOf ([] :: [Vector [] 6 Int]) <$> multiplicativeLaws+ , testGroup "Distribution" $+ testLawOf ([] :: [Vector [] 6 Int]) <$> distributionLaws+ , testGroup "Additive Module" $+ testLawOf2 ([] :: [(Vector [] 6 Int, Int)]) <$> additiveModuleLaws+ , testGroup "Additive Group Module" $+ testLawOf2 ([] :: [(Vector [] 6 Int, Int)]) <$> additiveGroupModuleLaws+ , testGroup "Multiplicative Module" $+ testLawOf2 ([] :: [(Vector [] 6 Int, Int)]) <$> multiplicativeModuleLaws+ , testGroup "Hilbert" $+ testLawOf2 ([] :: [(Vector [] 6 Int, Int)]) <$> hilbertLaws+ , testGroup "Tensor product" $+ testLawOf2 ([] :: [(Vector [] 6 Int, Int)]) <$> tensorProductLaws+ , testGroup "Additive Basis" $+ testLawOf ([] :: [Vector [] 6 Int]) <$> additiveBasisLaws+ , testGroup "Additive Group Basis" $+ testLawOf ([] :: [Vector [] 6 Int]) <$> additiveGroupBasisLaws+ , testGroup "Multiplicative Basis" $+ testLawOf ([] :: [Vector [] 6 Int]) <$> multiplicativeBasisLaws+ ]++testsMInt :: TestTree+testsMInt =+ testGroup+ "Matrix [] 4 3 Int"+ [ testGroup "Additive" $ testLawOf ([] :: [Matrix [] 4 3 Int]) <$> additiveLaws+ , testGroup "Additive Group" $+ testLawOf ([] :: [Matrix [] 4 3 Int]) <$> additiveGroupLaws+ , testGroup "Multiplicative (square only)" $+ testLawOf ([] :: [Matrix [] 3 3 Int]) <$> multiplicativeMonoidalLaws+ , testGroup "Additive Module" $+ testLawOf2 ([] :: [(Matrix [] 4 3 Int, Int)]) <$> additiveModuleLaws+ , testGroup "Additive Group Module" $+ testLawOf2 ([] :: [(Matrix [] 4 3 Int, Int)]) <$> additiveGroupModuleLaws+ , testGroup "Multiplicative Module" $+ testLawOf2 ([] :: [(Matrix [] 4 3 Int, Int)]) <$> multiplicativeModuleLaws+ , testGroup "Hilbert" $+ testLawOf2 ([] :: [(Matrix [] 4 3 Int, Int)]) <$> hilbertLaws+ , testGroup "Tensor product" $+ testLawOf2 ([] :: [(Matrix [] 4 3 Int, Int)]) <$> tensorProductLaws+ , testGroup "Additive Basis" $+ testLawOf ([] :: [Matrix [] 4 3 Int]) <$> additiveBasisLaws+ , testGroup "Additive Group Basis" $+ testLawOf ([] :: [Matrix [] 4 3 Int]) <$> additiveGroupBasisLaws+ , testGroup "Multiplicative Basis" $+ testLawOf ([] :: [Matrix [] 4 3 Int]) <$> multiplicativeBasisLaws+ ]++testsVFloat :: TestTree+testsVFloat =+ testGroup+ "Vector 6 Float"+ [ testGroup "MultiplicativeGroup" $+ testLawOf ([] :: [Vector [] 6 Float]) <$> multiplicativeGroupLaws+ , testGroup "Signed" $ testLawOf ([] :: [Vector [] 6 Float]) <$> signedLaws+ , testGroup "Metric" $+ testLawOf ([] :: [Vector [] 6 Float]) <$> metricNaperianFloatLaws+ , testGroup "Exponential Field" $+ testLawOf ([] :: [Vector [] 6 Float]) <$> expFieldNaperianLaws+ , testGroup "Multiplicative Group Module" $+ localOption (QuickCheckTests 1000) .+ testLawOf2 ([] :: [(Vector [] 6 Float, Float)]) <$>+ multiplicativeGroupModuleLawsFail+ , testGroup "Multiplicative Group Basis" $+ testLawOf ([] :: [Vector [] 6 Float]) <$> multiplicativeGroupBasisLaws+ ]++testsMFloat :: TestTree+testsMFloat =+ testGroup+ "Matrix [] 4 3 Float"+ [ testGroup "Multiplicative Group Module" $+ localOption (QuickCheckTests 1000) .+ testLawOf2 ([] :: [(Matrix [] 4 3 Float, Float)]) <$>+ multiplicativeGroupModuleLawsFail+ , testGroup "Multiplicative Group Basis" $+ testLawOf ([] :: [Matrix [] 4 3 Float]) <$> multiplicativeGroupBasisLaws+ ]