packages feed

numhask-array 0.2.1.0 → 0.3

raw patch · 7 files changed

+301/−329 lines, 7 filesdep +hedgehogdep +numhask-hedgehogdep −QuickCheckdep −tastydep −tasty-quickcheckdep ~basedep ~dimensionsdep ~distributive

Dependencies added: hedgehog, numhask-hedgehog

Dependencies removed: QuickCheck, tasty, tasty-quickcheck

Dependency ranges changed: base, dimensions, distributive, doctest, numhask-array, numhask-prelude, protolude, singletons

Files

numhask-array.cabal view
@@ -1,69 +1,87 @@-name:           numhask-array-version:        0.2.1.0-synopsis:       n-dimensional arrays-description:    n-dimensional arrays founded on numhask.-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.4.1-build-type:     Simple-cabal-version:  >= 1.18--extra-source-files:-    stack.yaml-+name: numhask-array+version: 0.3+synopsis:+  n-dimensional arrays+description:+  n-dimensional arrays founded on numhask.+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.4.1+build-type:+  Simple+cabal-version:+  1.18 source-repository head-  type: git-  location: https://github.com/tonyday567/numhask-array-+  type:+    git+  location:+    https://github.com/tonyday567/numhask+  subdir:+    numhask-array library   hs-source-dirs:-      src-  default-extensions: NegativeLiterals NoImplicitPrelude OverloadedStrings UnicodeSyntax+    src+  default-extensions:+    NegativeLiterals+    NoImplicitPrelude+    OverloadedStrings+    UnicodeSyntax   ghc-options:-      -Wall-      -Wcompat-      -Wincomplete-record-updates-      -Wincomplete-uni-patterns-      -Wredundant-constraints+    -Wall+    -Wcompat+    -Wincomplete-record-updates+    -Wincomplete-uni-patterns+    -Wredundant-constraints   build-depends:-      QuickCheck >= 2.0 && < 2.12+      base >=4.11 && <5     , adjunctions >=4.0 && <5-    , base >=4.11 && <4.12     , deepseq >=1.4.2.0 && <2-    , dimensions >=0.3.2.0 && <0.4-    , distributive >=0.4 && <0.6-    , numhask-prelude >=0.0 && <0.1-    , protolude >=0.1 && <0.3-    , singletons >=2.0 && <2.5+    , dimensions >=1.0 && <1.1+    , distributive >=0.4 && <0.7+    , numhask-prelude >=0.3 && <0.4+    , protolude >=0.2 && <0.3+    , singletons >=2.0 && <2.6     , vector >=0.10 && <0.13   exposed-modules:-      NumHask.Array-      NumHask.Array.Constraints-      NumHask.Array.Example-      NumHask.Shape-  other-modules:-      Paths_numhask_array+    NumHask.Array+    NumHask.Array.Constraints+    NumHask.Array.Example+    NumHask.Shape   default-language: Haskell2010- test-suite test-  type: exitcode-stdio-1.0-  main-is: test.hs+  type:+    exitcode-stdio-1.0+  main-is:+    test.hs   hs-source-dirs:-      test-  default-extensions: NegativeLiterals NoImplicitPrelude OverloadedStrings UnicodeSyntax+    test+  default-extensions:+    NegativeLiterals+    NoImplicitPrelude+    OverloadedStrings+    UnicodeSyntax   build-depends:-      base >=4.11 && <4.12-    , doctest-    , numhask-array-    , numhask-prelude >=0.0 && <0.1-    , tasty-    , tasty-quickcheck-  other-modules:-      Paths_numhask_array+      base >=4.11 && <5+    , doctest >=0.13 && <0.17+    , dimensions >=1.0 && <1.1+    , numhask-array >=0.3 && <0.4+    , numhask-prelude >=0.3 && <0.4+    , numhask-hedgehog >=0.3 && <0.4+    , hedgehog >=0.5 && <1.1+    , adjunctions >=4.0 && <5   default-language: Haskell2010
src/NumHask/Array.hs view
@@ -1,13 +1,8 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}@@ -15,7 +10,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-}@@ -28,15 +22,15 @@ import GHC.Exts (IsList(..)) import GHC.Show (Show(..)) import NumHask.Error (impossible)-import NumHask.Array.Constraints (Fold, HeadModule, TailModule, IsValidConcat, Concatenate, Transpose, Squeeze)+import NumHask.Array.Constraints+  (Fold, HeadModule, TailModule, IsValidConcat, Concatenate, Transpose, Squeeze) import NumHask.Prelude as P import NumHask.Shape (HasShape(..)) import Numeric.Dimensions as D import qualified Data.Singletons.Prelude as S import qualified Data.Vector as V-import qualified Test.QuickCheck as QC --- $setup+-- $setup  -- >>> :set -XDataKinds -- >>> :set -XOverloadedLists -- >>> :set -XTypeFamilies@@ -63,19 +57,25 @@ instance NFData (Array c ds t) where   rnf a = seq a () +{- -- | 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+  ( FixedDims xds ds   , Dimensions ds) =>   SomeArray (Array c ds t) +-}++instance (Dimensions r) => HasShape (Array c (r :: [Nat])) where+  type Shape (Array c r) = [Int]+  shape _ = fmap fromIntegral (listDims $ dims @Nat @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 :: (Dimensions ds) => Array c (ds :: [Nat]) 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@@ -118,23 +118,26 @@   cfoldr = foldr   cconcat = mconcat -instance (Eq (c t), Dimensions ds) => Eq (Array c ds t) where+instance (Eq (c t), Dimensions ds) => Eq (Array c (ds :: [Nat]) t) where     (Array a) == (Array b) = a == b -dimList :: Dim ds -> [Int]-dimList D = []+{-+dimList :: Dims ds -> [Int]+dimList U = [] dimList (d :* ds) = dimList d ++ dimList ds-dimList (Dn :: Dim m) = [dimVal' @m]-dimList (Dx (Dn :: Dim m)) = [dimVal' @m]+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@@ -159,33 +162,33 @@     ns  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+  Data.Distributive.Distributive (Array c (r :: [Nat])) where+  distribute f = Array $ generate (fromIntegral n) $ \i -> fmap (\(Array v) -> idx v i) f     where-      n = dimVal $ dim @r+      n = totalDim $ dims @Nat @r  instance forall r c. (Dimensions r, Container c) =>-  Representable (Array c r) where+  Representable (Array c (r :: [Nat])) where   type Rep (Array c r) = [Int]-  tabulate f = Array $ generate (product ns) (f . unind ns)+  tabulate f = Array $ generate (fromIntegral $ product ns) (f . unind (fmap fromIntegral ns))     where-      ns = dimList $ dim @r-  index (Array xs) rs = xs `idx` ind ns rs+      ns = listDims $ dims @Nat @r+  index (Array xs) rs = xs `idx` ind (fmap fromIntegral ns) rs     where-      ns = dimList $ dim @r+      ns = listDims $ dims @Nat @r  -- | from flat list instance     ( Item (Array c r a) ~ Item (c a)     , Dimensions r-    , AdditiveUnital a+    , Additive a     , IsList (c a)     ) =>-    IsList (Array c r a) where+    IsList (Array c (r :: [Nat]) a) where   type Item (Array c r a) = a   fromList l = Array $ fromList $ take n $ l ++ repeat zero     where-      n = dimVal (dim @r)+      n = fromIntegral $ totalDim (dims @_ @r)   toList (Array v) = GHC.Exts.toList v  instance (Show a, Show (Item (c a)), Container c, IsList (c a)) => Show (AnyArray c a) where@@ -213,21 +216,23 @@         x:r -> (x, product r)     ss = take n [0 ..] -instance (Show a, Show (Item (c a)), IsList (c a), Container c, Dimensions ds) => Show (Array c ds a) where+instance (Show a, Show (Item (c a)), IsList (c a), Container c, Dimensions ds)+  => Show (Array c (ds :: [Nat]) a) where   show = GHC.Show.show . anyArray  type Vector c n = Array c '[ n]  type Matrix c m n = Array c '[ m, n] +{- instance   ( IsList (c a)   , Item (c a) ~ a+  , Container c   , KnownNat n-  , AdditiveUnital (Vector c n a)+  , Unital (Sum (Vector c n a))   , QC.Arbitrary a-  , AdditiveUnital a-  ) =>+  , Additive a) =>   QC.Arbitrary (Vector c n a) where   arbitrary = QC.frequency [(1, pure zero), (9, fromList <$> QC.vector n)]     where@@ -236,18 +241,18 @@ instance   ( IsList (c a)   , Item (c a) ~ a-  , AdditiveUnital (Matrix c m n a)+  , Additive (Matrix c m n a)+  , Container c   , KnownNat m   , KnownNat n   , QC.Arbitrary a-  , AdditiveUnital a-  ) =>+  , Additive a) =>   QC.Arbitrary (Matrix c m n a) where   arbitrary = QC.frequency [(1, pure zero), (9, fromList <$> QC.vector (m * n))]     where       n = fromInteger $ P.natVal (Proxy :: Proxy n)       m = fromInteger $ P.natVal (Proxy :: Proxy m)-+-}  -- ** Operations -- | outer product@@ -260,7 +265,7 @@ --  [3, 6, 9]] (><) :: forall c (r :: [Nat]) (s :: [Nat]) a.   ( Container c-  , CRing a+  , CommutativeRing a   , Dimensions r   , Dimensions s   , Dimensions ((D.++) r s))@@ -288,13 +293,13 @@ --  [43, 50]] -- mmult :: forall c m n k a.-  ( Hilbert (Vector c k) a+  ( Hilbert (Vector c k a)   , Dimensions '[ m, k]   , Dimensions '[ k, n]   , Dimensions '[ m, n]   , Container c   )-  => Matrix c m k a+  => Matrix c (m :: Nat) (k :: Nat) a   -> Matrix c k n a   -> Matrix c m n a mmult x y = tabulate go@@ -318,7 +323,7 @@  rank2Shape   :: Dimensions '[ m, n]-  => Matrix c m n a+  => Matrix c (m :: Nat) (n :: Nat) a   -> (Int, Int) rank2Shape t =   case shape t of@@ -329,12 +334,21 @@   ( Container c   , Dimensions '[ m, n])   => Int-  -> Matrix c m n a+  -> Matrix c (m :: Nat) (n :: Nat) a   -> Vector c n a unsafeRow i t@(Array a) = Array $ cslice (i * n) n a   where     (_, n) = rank2Shape t +unsafeCol ::+     forall c a m n. (Container c, Dimensions '[ m, n])+  => Int+  -> Matrix c (m :: Nat) (n :: Nat) a+  -> Vector c m a+unsafeCol j t@(Array a) = Array $ generate m (\x -> a `idx` (j + x * n))+  where+    (m, n) = rank2Shape t+ -- | extract the column of a matrix col :: forall c j a m n.   ( Dimensions '[ m, n]@@ -349,20 +363,12 @@   where     j = (fromIntegral . S.fromSing . S.singByProxy) j_ -unsafeCol ::-     forall c a m n. (Container c, Dimensions '[ m, n])-  => Int-  -> 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) = rank2Shape t  -- | -- -- >>> unsafeIndex a [0,2,1] -- 10-unsafeIndex :: (Container c, Dimensions r) => Array c r a -> [Int] -> a+unsafeIndex :: (Container c, Dimensions r) => Array c (r :: [Nat]) a -> [Int] -> a unsafeIndex t@(Array a) i = a `idx` ind (shape t) i  -- |@@ -373,8 +379,8 @@ unsafeSlice ::      (Container c, IsList (c a), Item (c a) ~ a, Dimensions r, Dimensions r0)   => [[Int]]-  -> Array c r a-  -> Array c r0 a+  -> Array c (r :: [Nat]) a+  -> Array c (r0 :: [Nat]) a unsafeSlice s t = Array (fromList [unsafeIndex t i | i <- sequence s])  -- |@@ -523,8 +529,8 @@ -- transpose ::      forall c s t a. (t ~ Transpose s, Container c, Dimensions s, Dimensions t)-  => Array c s a-  -> Array c t a+  => Array c (s :: [Nat]) a+  -> Array c (t :: [Nat]) a transpose (Array x) = Array x  -- |@@ -569,99 +575,65 @@   -> Array c t a squeeze (Array x) = Array x -instance (Dimensions r, Container c, AdditiveMagma a) =>-         AdditiveMagma (Array c r a) where-  plus = liftR2 plus--instance (Dimensions r, Container c, AdditiveUnital a) =>-         AdditiveUnital (Array c r a) where+instance (Dimensions r, Container c, Additive a) =>+  Additive (Array c (r :: [Nat]) a) where+  a + b = liftR2 (+) a b   zero = pureRep zero -instance (Dimensions r, Container c, AdditiveAssociative a) =>-         AdditiveAssociative (Array c r a)--instance (Dimensions r, Container c, AdditiveCommutative a) =>-         AdditiveCommutative (Array c r a)--instance (Dimensions r, Container c, AdditiveInvertible a) =>-         AdditiveInvertible (Array c r a) where+instance (Dimensions r, Container c, Subtractive a) =>+  Subtractive (Array c (r :: [Nat]) a) where   negate = fmapRep negate -instance (Dimensions r, Container c, Additive a) => Additive (Array c r a)--instance (Dimensions r, Container c, AdditiveGroup a) =>-         AdditiveGroup (Array c r a)--instance (Dimensions r, Container c, MultiplicativeMagma a) =>-         MultiplicativeMagma (Array c r a) where-  times = liftR2 times+instance (Dimensions r, Container c, Multiplicative a) =>+  Multiplicative (Array c (r :: [Nat]) a) where+  a * b = liftR2 (*) a b -instance (Dimensions r, Container c, MultiplicativeUnital a) =>-         MultiplicativeUnital (Array c r a) where   one = pureRep one -instance (Dimensions r, Container c, MultiplicativeAssociative a) =>-         MultiplicativeAssociative (Array c r a)--instance (Dimensions r, Container c, MultiplicativeCommutative a) =>-         MultiplicativeCommutative (Array c r a)--instance (Dimensions r, Container c, MultiplicativeInvertible a) =>-         MultiplicativeInvertible (Array c r a) where+instance (Dimensions r, Container c, Divisive a) =>+  Divisive (Array c (r :: [Nat]) a) where   recip = fmapRep recip -instance (Dimensions r, Container c, Multiplicative a) =>-         Multiplicative (Array c r a)--instance (Dimensions r, Container c, MultiplicativeGroup a) =>-         MultiplicativeGroup (Array c r a)--instance (Dimensions r, Container c, MultiplicativeMagma a, Additive a) =>-         Distribution (Array c r a)--instance (Dimensions r, Container c, Semiring a) => Semiring (Array c r a)--instance (Dimensions r, Container c, Ring a) => Ring (Array c r a)--instance (Dimensions r, Container c, CRing a) => CRing (Array c r a)+instance (Dimensions r, Container c, Multiplicative a, Additive a) =>+  P.Distributive (Array c (r :: [Nat]) a) -instance (Dimensions r, Container c, Semifield a) => Semifield (Array c r a)+instance (Dimensions r, Container c, IntegralDomain a) => IntegralDomain (Array c (r :: [Nat]) a) -instance (Dimensions r, Container c, Field a) => Field (Array c r a)+instance (Dimensions r, Container c, Field a) => Field (Array c (r :: [Nat]) a) -instance (Dimensions r, Container c, ExpField a) => ExpField (Array c r a) where+instance (Dimensions r, Container c, ExpField a) => ExpField (Array c (r :: [Nat]) a) where   exp = fmapRep exp   log = fmapRep log  instance (Foldable (Array c r), Dimensions r, Container c, UpperBoundedField a) =>-         UpperBoundedField (Array c r a) where-  isNaN f = or (fmapRep isNaN f)+         UpperBoundedField (Array c (r :: [Nat]) a) where+  isNaN = foldl' (||) False . fmapRep isNaN  instance (Foldable (Array c r), Dimensions r, Container c, LowerBoundedField a) =>-         LowerBoundedField (Array c r a)+         LowerBoundedField (Array c (r :: [Nat]) a) -instance (Dimensions r, Container c, Signed a) => Signed (Array c r a) where+instance (Dimensions r, Container c, Multiplicative a, Signed a)+  => Signed (Array c (r :: [Nat]) a) where   sign = fmapRep sign   abs = fmapRep abs -instance (Functor (Array c r), Foldable (Array c r), Normed a a, ExpField a) =>-         Normed (Array c r a) a where+instance (Functor (Array c r), Foldable (Array c r), Additive (Array c r a), Normed a a, ExpField a) =>+         Normed (Array c (r :: [Nat]) a) a where   normL1 r = foldr (+) zero $ normL1 <$> r   normL2 r = sqrt $ foldr (+) zero $ (** (one + one)) <$> r-  normLp p r = (** (one / p)) $ foldr (+) zero $ (** p) . normL1 <$> r  instance (Eq (c a), Foldable (Array c r), Dimensions r, Container c, Epsilon a) =>-         Epsilon (Array c r a) where+         Epsilon (Array c (r :: [Nat]) a) where+  epsilon = tabulate (const epsilon)   nearZero f = and (fmapRep nearZero f)   aboutEqual a b = and (liftR2 aboutEqual a b) -instance (Foldable (Array c r), Dimensions r, Container c, ExpField a, Normed a a) =>-         Metric (Array c r a) a where+instance (Foldable (Array c r), Dimensions r, Container c, ExpField a, Subtractive a, Normed a a) =>+         Metric (Array c (r :: [Nat]) a) a where   distanceL1 a b = normL1 (a - b)   distanceL2 a b = normL2 (a - b)-  distanceLp p a b = normLp p (a - b) -instance (Dimensions r, Container c, Integral a) => Integral (Array c r a) where+instance (Dimensions r, Container c, Integral a) => Integral (Array c (r :: [Nat]) a) where   divMod a b = (d, m)     where       x = liftR2 divMod a b@@ -673,56 +645,63 @@       q = fmap fst x       r = fmap snd x -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 (-)+type instance Actor (Array c r a) = a  instance (Dimensions r, Container c, Multiplicative a) =>-         MultiplicativeBasis (Array c r) a where+  HadamardMultiplication (Array c (r :: [Nat])) a where   (.*.) = liftR2 (*) -instance (Dimensions r, Container c, MultiplicativeGroup a) =>-         MultiplicativeGroupBasis (Array c r) a where+instance (Dimensions r, Container c, Divisive a) =>+  HadamardDivision (Array c (r :: [Nat])) a where   (./.) = liftR2 (/) -instance (Container c, Additive a) =>-         AdditiveModule (Array c (r::[Nat])) a where+instance (Dimensions r, Container c, Additive a) =>+  AdditiveAction (Array c (r::[Nat]) a) where   (.+) r s = fmap (s +) r   (+.) s = fmap (s +) -instance (Container c, AdditiveGroup a) =>-         AdditiveGroupModule (Array c (r::[Nat])) a where+instance (Dimensions r, Container c, Subtractive a) =>+  SubtractiveAction (Array c (r::[Nat]) a) where   (.-) r s = fmap (\x -> x - s) r   (-.) s = fmap (\x -> x - s) -instance (Container c, Multiplicative a) =>-         MultiplicativeModule (Array c (r :: [Nat])) a where-  (.*) r s = fmap (s *) r+instance (Dimensions r, Container c, Multiplicative a) =>+  MultiplicativeAction (Array c (r :: [Nat]) a) where+  (.*) r s = fmap (* s) r   (*.) s = fmap (s *) -instance (Container c, MultiplicativeGroup a) =>-         MultiplicativeGroupModule (Array c (r::[Nat])) a where+instance (Dimensions r, Container c, Divisive a) =>+  DivisiveAction (Array c (r::[Nat]) a) where   (./) r s = fmap (/ s) r   (/.) s = fmap (/ s) -instance (Dimensions r, Container c) => Singleton (Array c r) where-  singleton = pureRep+instance forall a c r. (Actor (Array c r a) ~ a, Foldable (Array c r), P.Distributive a, CommutativeRing a, Semiring a, Dimensions r, Container c) =>+  Hilbert (Array c (r :: [Nat]) a) where+  a <.> b = sum $ liftR2 (*) a b -instance ( Foldable (Array c r)-         , Dimensions r-         , Container c-         , CRing a-         , Multiplicative a-         ) =>-         TensorProduct (Array c r a) where+instance+  ( Foldable (Array c r)+  , Dimensions r+  , Container c+  , CommutativeRing a+  , Multiplicative a+  ) =>+  TensorProduct (Array c (r :: [Nat]) 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)++instance (Eq (c a), Container c, Dimensions r, JoinSemiLattice a) => JoinSemiLattice (Array c (r :: [Nat]) a) where+  (\/) = liftR2 (\/)++instance (Eq (c a), Container c, Dimensions r, MeetSemiLattice a) => MeetSemiLattice (Array c (r :: [Nat]) a) where+  (/\) = liftR2 (/\)++instance (Eq (c a), Container c, Dimensions r, BoundedJoinSemiLattice a) => BoundedJoinSemiLattice (Array c (r :: [Nat]) a) where+  bottom = pureRep bottom++instance (Eq (c a), Container c, Dimensions r, BoundedMeetSemiLattice a) => BoundedMeetSemiLattice (Array c (r :: [Nat]) a) where+  top = pureRep top++singleton :: (Dimensions r, Container c) => a -> Array c (r :: [Nat]) a+singleton a = tabulate (const a)
src/NumHask/Array/Constraints.hs view
@@ -81,5 +81,3 @@ type family HeadModule i (s :: [Nat]) where   HeadModule _ '[] = '[]   HeadModule d xs = (Fst (SplitAt d xs))--
src/NumHask/Array/Example.hs view
@@ -6,7 +6,7 @@  -- | Experimental api following https://pechersky.github.io/haskell-numpy-docs/quickstart.basics.html module NumHask.Array.Example- (+  (     -- * The Basics     -- $setup @@ -36,8 +36,8 @@      -- * Tricks and Tips     -- $tricksTips-    -  ) where+  )+where  import NumHask.Shape import NumHask.Prelude as P@@ -100,7 +100,7 @@ -- [[0, 0, 0, 0], --  [0, 0, 0, 0], --  [0, 0, 0, 0]]--- >>> let o = singleton one :: Array [] '[2,3,4] Int+-- >>> let o = A.singleton one :: Array [] '[2,3,4] Int -- >>> o -- [[[1, 1, 1, 1], --   [1, 1, 1, 1],@@ -108,7 +108,7 @@ --  [[1, 1, 1, 1], --   [1, 1, 1, 1], --   [1, 1, 1, 1]]]--- >>> let empt = singleton nan :: Array [] '[2,3] Double+-- >>> let empt = A.singleton nan :: Array [] '[2,3] Double -- >>> empt -- [[NaN, NaN, NaN], --  [NaN, NaN, NaN]]@@ -116,7 +116,7 @@ -- >>>  [10,15 .. 30] :: Array [] '[4] Int -- [10, 15, 20, 25] -- >>> [0, 0.3.. 2] :: Array [] '[7] Double--- [0.0, 0.3, 0.6, 0.8999999999999999, 1.1999999999999997, 1.4999999999999996, 1.7999999999999994]+-- [0.0, 0.3, 0.6, 0.8999999999999999, 1.2, 1.5, 1.7999999999999998] -- -- > todo: fix NumHask.Range grid -- > fromList (grid OuterPos (Range 0 2) 8) :: Array [] '[9] Double
src/NumHask/Shape.hs view
@@ -9,7 +9,8 @@     -- * Representable     -- | Representable has most of what's needed to define numbers that have elements (aka scalars) and a fixed shape.   , Representable(..)-  ) where+  )+where  import Data.Functor.Rep
− stack.yaml 
@@ -1,9 +0,0 @@-resolver: nightly-2018-05-06--packages:-  - .-  - ../numhask-  - ../numhask-prelude--extra-deps:-  - dimensions-0.3.2.0 # not on stack
test/test.hs view
@@ -1,120 +1,105 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}  module Main where -import NumHask.Prelude-import NumHask.Laws+import Data.Functor.Rep+import GHC.Exts (IsList(..)) import NumHask.Array-+import NumHask.Hedgehog+import NumHask.Prelude as P+import Numeric.Dimensions as D import Test.DocTest-import Test.Tasty-       (TestTree, defaultMain, testGroup, localOption)-import Test.Tasty.QuickCheck+import qualified Hedgehog as H+import qualified NumHask.Hedgehog.Prop.Space as I+import qualified Prelude +genAIntegral :: forall a m r. (H.MonadGen m, Dimensions r, Additive a, Bounded a, ToInteger a, FromInteger a) => m (Array [] (r :: [Nat]) a)+genAIntegral = fromList <$> replicateM (fromIntegral n) integral_+  where+    n = totalDim $ dims @Nat @r++genARational :: forall a m r. (H.MonadGen m, Dimensions r, Field a, Subtractive a, ToRatio a, FromRatio a) => m (Array [] (r :: [Nat]) a)+genARational = fromList <$> replicateM (fromIntegral n) negUniform+  where+    n = totalDim $ dims @Nat @r+ main :: IO () main = do-  putStrLn ("Array DocTest" :: Text)+  putStrLn ("Array DocTest turned on" :: Text)   doctest ["src/NumHask/Array.hs"]-  putStrLn ("Example DocTest" :: Text)+  putStrLn ("Example DocTest turned on" :: Text)   doctest ["src/NumHask/Array/Example.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-    ]+  bVInt <- assertProps "Vector Int 6" (Prelude.fromInteger 100)+    (genAIntegral :: H.Gen (Vector [] 6 Int)) integralProps'+  bMInt <- assertProps "Matrix [] '[3,4] Int" (Prelude.fromInteger 100)+    (genAIntegral :: H.Gen (Array [] '[3,4] Int)) integralProps'+  -- bVFloat <- assertProps "Vector Float 6" (Prelude.fromInteger 100)+  --  (genARational :: H.Gen (Vector [] 6 Float)) (fieldProps' acc)+  bMFloat <- assertProps "Array [] '[3,4] Float" (Prelude.fromInteger 100)+    (genARational :: H.Gen (Array [] '[3,4] Float)) (fieldProps' acc)+  unless (bVInt && bMInt && bMFloat)+    exitFailure+  where+    acc = tabulate (const 1.0) -testsVFloat :: TestTree-testsVFloat =-  testGroup-    "Vector 6 Float"-    [ testGroup "MultiplicativeGroup" $-      testLawOf ([] :: [Vector [] 6 Float]) <$> multiplicativeGroupLaws_-    , testGroup "Signed" $ testLawOf ([] :: [Vector [] 6 Float]) <$> signedLaws-    , testGroup "Normed" $-      testLawOf2 ([] :: [(Vector [] 6 Float, Float)]) <$> normedLaws-    , testGroup "Metric" $-      testLawOf2 ([] :: [(Vector [] 6 Float, Float)]) <$> metricRationalLaws-    , testGroup "Exponential Field" $-      testLawOf ([] :: [Vector [] 6 Float]) <$> expFieldContainerLaws-    , testGroup "Multiplicative Group Module" $-      localOption (QuickCheckTests 1000) .-      testLawOf2 ([] :: [(Vector [] 6 Float, Float)]) <$>-      multiplicativeGroupModuleLawsFail-    , testGroup "Multiplicative Group Basis" $-      testLawOf ([] :: [Vector [] 6 Float]) <$> multiplicativeGroupBasisLaws-    ]+integralProps'+  :: forall a.+  ( Show a+  , Eq a+  , Distributive a+  , Subtractive a+  , Signed a+  )+  => H.Gen a+  -> [(H.PropertyName, H.Property)]+integralProps' g = mconcat $+  (\x -> x g) <$>+  [ isAdditive+  , isSubtractive+  , isMultiplicative+  , \x -> [("distributive", isDistributive zero (+) (*) x)]+  , \x -> [("signed", NumHask.Hedgehog.isSigned x)]+  ] -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-    ]+-- | field laws+fieldProps'+  :: forall a.+  ( Show a+  , Epsilon a+  , Lattice a+  , LowerBoundedField a+  , BoundedJoinSemiLattice a+  , BoundedMeetSemiLattice a+  , Signed a+  )+  => a+  -> H.Gen a+  -> [(H.PropertyName, H.Property)]+fieldProps' acc g = mconcat $+  (\x -> x g) <$>+  [ I.isAdditive acc+  , \x -> [("subtractive", I.isSubtractive acc x)]+  , I.isMultiplicative acc+  , \x -> [("distributive", I.isDistributiveTimesPlus one x)]+  , \x -> [("divisive", I.isDivisive one x)]+  , \x -> [("signed", I.isSigned one x)]+  ]