diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,10 @@ +0.11.0.0 +=== + +* new operators: indices, sequent, takes, undiag +* Divisive instance for Array +* inverse machinery: chol, invtri + 0.9.2 == * fixes for numhask-0.9 diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,3 +0,0 @@ -import Distribution.Simple - -main = defaultMain diff --git a/numhask-array.cabal b/numhask-array.cabal --- a/numhask-array.cabal +++ b/numhask-array.cabal @@ -1,6 +1,6 @@ -cabal-version: 2.4 +cabal-version: 3.0 name: numhask-array -version: 0.10.2 +version: 0.11.0.0 synopsis: Multi-dimensional arrays. description: This package provides an interface into the [numhask](https://hackage.haskell.org/package/numhask) API, and both type- and value-level shape manipulation routines. @@ -25,41 +25,93 @@ copyright: Tony Day license: BSD-3-Clause license-file: LICENSE -tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.2.5 || ==9.4.4 +tested-with: GHC == 8.10.7 || ==9.2.8 || ==9.4.5 || ==9.6.2 build-type: Simple -extra-source-files: ChangeLog.md +extra-doc-files: ChangeLog.md source-repository head type: git location: https://github.com/tonyday567/numhask-array -library - hs-source-dirs: src - default-extensions: +common ghc2021-stanza + if impl(ghc >=9.2) + default-language: + GHC2021 + if impl(ghc <9.2) + default-language: + Haskell2010 + default-extensions: + BangPatterns + BinaryLiterals + ConstrainedClassMethods + ConstraintKinds + DeriveDataTypeable + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveLift + DeriveTraversable + DoAndIfThenElse + EmptyCase + EmptyDataDecls + EmptyDataDeriving + ExistentialQuantification + ExplicitForAll + FlexibleContexts + FlexibleInstances + ForeignFunctionInterface + GADTSyntax + GeneralisedNewtypeDeriving + HexFloatLiterals + ImplicitPrelude + InstanceSigs + KindSignatures + MonomorphismRestriction + MultiParamTypeClasses + NamedFieldPuns + NamedWildCards + NumericUnderscores + PatternGuards + PolyKinds + PostfixOperators + RankNTypes + RelaxedPolyRec + ScopedTypeVariables + StandaloneDeriving + StarIsType + TraditionalRecordSyntax + TupleSections + TypeApplications + TypeOperators + TypeSynonymInstances + if impl(ghc <9.2) && impl(ghc >=8.10) + default-extensions: + ImportQualifiedPost + StandaloneKindSignatures + +common ghc-options-stanza ghc-options: - -Wall -Wcompat -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wredundant-constraints + -Wall + -Wcompat + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wredundant-constraints + -Widentities + -Wpartial-fields +library + import: ghc2021-stanza + import: ghc-options-stanza + hs-source-dirs: src build-depends: - , adjunctions >=4.0 && <5 - , base >=4.11 && <5 - , distributive >=0.4 && <0.7 - , numhask ^>=0.10 - , vector >=0.10 && <0.14 + , adjunctions >=4.0 && <5 + , base >=4.11 && <5 + , distributive >=0.4 && <0.7 + , numhask >=0.11 && < 0.12 + , vector >=0.10 && <0.14 exposed-modules: NumHask.Array NumHask.Array.Dynamic NumHask.Array.Fixed NumHask.Array.Shape - - default-language: Haskell2010 - -test-suite doctests - type: exitcode-stdio-1.0 - main-is: doctests.hs - hs-source-dirs: test - default-language: Haskell2010 - build-depends: - , base - , QuickCheck diff --git a/src/NumHask/Array.hs b/src/NumHask/Array.hs --- a/src/NumHask/Array.hs +++ b/src/NumHask/Array.hs @@ -1,6 +1,4 @@ -{-# OPTIONS_GHC -Wall #-} - --- | Multi-dimensional arrays for numhask. +-- | Multi-dimensional arrays module NumHask.Array ( -- * Imports -- $imports @@ -38,19 +36,3 @@ -- - provides operators at value and type level to help manipulate shapes. -- -- - provides fixed and dynamic arrays with the same API. --- --- === API of an array language --- --- See for context and a sketch of an intermediate typed array language effort. --- --- The operators that result from using the 'Representable' type - separation of size tracking at compile level, from computational at runtime - ends up looking like [APL](https://en.wikipedia.org/wiki/APL_(programming_language\)). --- --- Matrix multiplication in APL is @+.x@ and in numhask-array is @dot sum (*)@. There is a slight increase in abstraction by explicitly exposing the fold in the algorithm, but the expressions are both very neat and abstracted away from the specialisation of multiplying matrices. --- --- References: --- --- --- --- --- --- diff --git a/src/NumHask/Array/Dynamic.hs b/src/NumHask/Array/Dynamic.hs --- a/src/NumHask/Array/Dynamic.hs +++ b/src/NumHask/Array/Dynamic.hs @@ -1,20 +1,11 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RebindableSyntax #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StrictData #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE NoStarIsType #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} --- | Arrays with a dynamic shape. +-- | Arrays with a dynamic shape (shape only known at runtime). module NumHask.Array.Dynamic ( -- $usage Array (..), @@ -28,10 +19,14 @@ tabulate, -- * Operators + takes, reshape, transpose, - diag, + indices, ident, + sequent, + diag, + undiag, singleton, selects, selectsExcept, @@ -45,6 +40,7 @@ append, reorder, expand, + expandr, apply, contract, dot, @@ -70,7 +66,7 @@ where import Data.List (intercalate) -import qualified Data.Vector as V +import Data.Vector qualified as V import GHC.Show (Show (..)) import NumHask.Array.Shape import NumHask.Prelude as P hiding (product) @@ -170,6 +166,19 @@ tabulate :: () => [Int] -> ([Int] -> a) -> Array a tabulate ds f = Array ds . V.generate (size ds) $ (f . shapen ds) +-- | Takes the top-most elements according to the new dimension. +-- +-- >>> takes [2,2,3] a +-- [[[1, 2, 3], +-- [5, 6, 7]], +-- [[13, 14, 15], +-- [17, 18, 19]]] +takes :: + [Int] -> + Array a -> + Array a +takes ds a = tabulate ds $ \s -> index a s + -- | Reshape an array (with the same number of elements). -- -- >>> reshape [4,3,2] a @@ -198,6 +207,15 @@ transpose :: Array a -> Array a transpose a = tabulate (reverse $ shape a) (index a . reverse) +-- | Indices of an Array. +-- +-- >>> indices [3,3] +-- [[[0,0], [0,1], [0,2]], +-- [[1,0], [1,1], [1,2]], +-- [[2,0], [2,1], [2,2]]] +indices :: [Int] -> Array [Int] +indices ds = tabulate ds id + -- | The identity array. -- -- >>> ident [3,2] @@ -212,6 +230,22 @@ isDiag [x, y] = x == y isDiag (x : y : xs) = x == y && isDiag (y : xs) +-- | An array of sequential Ints +-- +-- >>> sequent [3] +-- [0, 1, 2] +-- +-- >>> sequent [3,3] +-- [[0, 0, 0], +-- [0, 1, 0], +-- [0, 0, 2]] +sequent :: [Int] -> Array Int +sequent ds = tabulate ds go + where + go [] = zero + go [i] = i + go (i : js) = bool zero i (all (i ==) js) + -- | Extract the diagonal of an array. -- -- >>> diag (ident [3,2]) @@ -224,6 +258,21 @@ go [] = throw (NumHaskException "Rank Underflow") go (s' : _) = index a (replicate (rank (shape a)) s') +-- | Expand the array to form a diagonal array +-- +-- >>> undiag 2 (fromFlatList [2] [1,1]) +-- [[1, 0], +-- [0, 1]] +undiag :: + (Additive a) => + Int -> + Array a -> + Array a +undiag r a = tabulate (replicate r (head (shape a))) go + where + go [] = throw (NumHaskException "Rank Underflow") + go xs@(x : xs') = bool zero (index a xs) (all (x ==) xs') + -- | Create an array composed of a single value. -- -- >>> singleton [3,2] one @@ -420,6 +469,19 @@ -- [[1, 2, 3], -- [2, 4, 6], -- [3, 6, 9]] +-- +-- Alternatively, expand can be understood as representing the permutation of element pairs of two arrays, so like the Applicative List instance. +-- +-- >>> i2 = indices [2,2] +-- >>> expand (,) i2 i2 +-- [[[[([0,0],[0,0]), ([0,0],[0,1])], +-- [([0,0],[1,0]), ([0,0],[1,1])]], +-- [[([0,1],[0,0]), ([0,1],[0,1])], +-- [([0,1],[1,0]), ([0,1],[1,1])]]], +-- [[[([1,0],[0,0]), ([1,0],[0,1])], +-- [([1,0],[1,0]), ([1,0],[1,1])]], +-- [[([1,1],[0,0]), ([1,1],[0,1])], +-- [([1,1],[1,0]), ([1,1],[1,1])]]]] expand :: (a -> b -> c) -> Array a -> @@ -429,9 +491,29 @@ where r = rank (shape a) +-- | Like expand, but permutes the first array first, rather than the second. +-- +-- >>> expand (,) v (fmap (+3) v) +-- [[(1,4), (1,5), (1,6)], +-- [(2,4), (2,5), (2,6)], +-- [(3,4), (3,5), (3,6)]] +-- +-- >>> expandr (,) v (fmap (+3) v) +-- [[(1,4), (2,4), (3,4)], +-- [(1,5), (2,5), (3,5)], +-- [(1,6), (2,6), (3,6)]] +expandr :: + (a -> b -> c) -> + Array a -> + Array b -> + Array c +expandr f a b = tabulate ((++) (shape a) (shape b)) (\i -> f (index a (drop r i)) (index b (take r i))) + where + r = rank (shape a) + -- | Apply an array of functions to each array of values. -- --- This is in the spirit of the applicative functor operation (<*>). +-- This is in the spirit of the applicative functor operation (\<*\>). -- -- > expand f a b == apply (fmap f a) b -- @@ -439,6 +521,8 @@ -- [[1, 2, 3], -- [2, 4, 6], -- [3, 6, 9]] +-- +-- Dynamic arrays can't be Applicatives because there is no 'pure' (Shape is not known at compile-time). -- -- >>> let b = fromFlatList [2,3] [1..6] :: Array Int -- >>> contract sum [1,2] (apply (fmap (*) b) (transpose b)) diff --git a/src/NumHask/Array/Fixed.hs b/src/NumHask/Array/Fixed.hs --- a/src/NumHask/Array/Fixed.hs +++ b/src/NumHask/Array/Fixed.hs @@ -1,26 +1,13 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedLists #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RebindableSyntax #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE NoStarIsType #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} --- | Arrays with a fixed shape. +-- | Arrays with a fixed shape (known shape at compile time). module NumHask.Array.Fixed ( -- $usage Array (..), @@ -34,10 +21,11 @@ takes, reshape, transpose, - diag, - undiag, + indices, ident, sequent, + diag, + undiag, singleton, selects, selectsExcept, @@ -51,7 +39,7 @@ append, reorder, expand, - expand', + expandr, apply, contract, dot, @@ -63,7 +51,6 @@ -- -- Scalar specialisations - Scalar, fromScalar, toScalar, @@ -85,7 +72,6 @@ safeRow, mmult, chol, - inv, invtri, ) where @@ -94,11 +80,11 @@ import Data.Functor.Rep import Data.List ((!!)) import Data.Proxy -import qualified Data.Vector as V +import Data.Vector qualified as V import GHC.Exts (IsList (..)) import GHC.Show (Show (..)) import GHC.TypeLits -import qualified NumHask.Array.Dynamic as D +import NumHask.Array.Dynamic qualified as D import NumHask.Array.Shape import NumHask.Prelude as P hiding (sequence, toList) @@ -115,6 +101,7 @@ -- >>> import Data.Functor.Rep -- >>> let s = [1] :: Array ('[] :: [Nat]) Int -- scalar -- >>> let v = [1,2,3] :: Array '[3] Int -- vector +-- >>> let t = [0..3] :: Array '[2,2] Int -- square matrix -- >>> let m = [0..11] :: Array '[3,4] Int -- matrix -- >>> let a = [1..24] :: Array '[2,3,4] Int @@ -146,6 +133,7 @@ -- -- >>> [1,2,3] :: Array '[2,2] Int -- *** Exception: NumHaskException {errorMessage = "shape mismatch"} +-- [[ newtype Array s a = Array {unArray :: V.Vector a} deriving (Eq, Ord, Functor, Foldable, Generic, Traversable) instance (HasShape s, Show a) => Show (Array s a) where @@ -199,32 +187,27 @@ negate = fmapRep negate instance - (HasShape s, Multiplicative a) => - MultiplicativeAction (Array s a) a + (Multiplicative a) => + MultiplicativeAction (Array s a) where - (.*) s r = fmap (s *) r - {-# INLINE (.*) #-} + type Scalar (Array s a) = a + (|*) r s = fmap (s *) r -instance - (HasShape s, Additive a) => - AdditiveAction (Array s a) a - where - (.+) s r = fmap (s +) r - {-# INLINE (.+) #-} +instance (Additive a) => AdditiveAction (Array s a) where + type AdditiveScalar (Array s a) = a + (|+) r s = fmap (s +) r instance - (HasShape s, Subtractive a) => - SubtractiveAction (Array s a) a + (Subtractive a) => + SubtractiveAction (Array s a) where - (.-) s r = fmap (s -) r - {-# INLINE (.-) #-} + (|-) r s = fmap (\x -> x - s) r instance - (HasShape s, Divisive a) => - DivisiveAction (Array s a) a + (Divisive a) => + DivisiveAction (Array s a) where - (./) s r = fmap (s /) r - {-# INLINE (./) #-} + (|/) r s = fmap (/ s) r instance (HasShape s, JoinSemiLattice a) => JoinSemiLattice (Array s a) where (\/) = liftR2 (\/) @@ -232,7 +215,7 @@ instance (HasShape s, MeetSemiLattice a) => MeetSemiLattice (Array s a) where (/\) = liftR2 (/\) -instance (HasShape s, Subtractive a, Epsilon a, Ord a) => Epsilon (Array s a) where +instance (HasShape s, Subtractive a, Epsilon a) => Epsilon (Array s a) where epsilon = singleton epsilon instance @@ -277,6 +260,22 @@ r with (D.Array _ v) f = f (Array v) +-- | Takes the top-most elements according to the new dimension. +-- +-- >>> takes a :: Array '[2,2,3] Int +-- [[[1, 2, 3], +-- [5, 6, 7]], +-- [[13, 14, 15], +-- [17, 18, 19]]] +takes :: + forall s s' a. + ( HasShape s, + HasShape s' + ) => + Array s a -> + Array s' a +takes a = tabulate $ \s -> index a s + -- | Reshape an array (with the same number of elements). -- -- >>> reshape a :: Array '[4,3,2] Int @@ -312,6 +311,15 @@ transpose :: forall a s. (HasShape s, HasShape (Reverse s)) => Array s a -> Array (Reverse s) a transpose a = tabulate (index a . reverse) +-- | Indices of an Array. +-- +-- >>> indices :: Array '[3,3] [Int] +-- [[[0,0], [0,1], [0,2]], +-- [[1,0], [1,1], [1,2]], +-- [[2,0], [2,1], [2,2]]] +indices :: forall s. (HasShape s) => Array s [Int] +indices = tabulate id + -- | The identity array. -- -- >>> ident :: Array '[3,2] Int @@ -326,16 +334,21 @@ isDiag [x, y] = x == y isDiag (x : y : xs) = x == y && isDiag (y : xs) --- | A sequential array of Ints +-- | An array of sequential Ints -- -- >>> sequent :: Array '[3] Int -- [0, 1, 2] +-- +-- >>> sequent :: Array '[3,3] Int +-- [[0, 0, 0], +-- [0, 1, 0], +-- [0, 0, 2]] sequent :: forall s. (HasShape s) => Array s Int sequent = tabulate go where go [] = zero go [i] = i - go (i : j : _) = bool zero i (i == j) + go (i : js) = bool zero i (all (i ==) js) -- | Extract the diagonal of an array. -- @@ -354,6 +367,24 @@ go (s' : _) = index a (replicate (length ds) s') ds = shapeVal (toShape @s) +-- | Expand the array to form a diagonal array +-- +-- >>> undiag ([1,1] :: Array '[2] Int) +-- [[1, 0], +-- [0, 1]] +undiag :: + forall a s. + ( HasShape s, + Additive a, + HasShape ((++) s s) + ) => + Array s a -> + Array ((++) s s) a +undiag a = tabulate go + where + go [] = throw (NumHaskException "Rank Underflow") + go xs@(x : xs') = bool zero (index a xs) (all (x ==) xs') + -- | Create an array composed of a single value. -- -- >>> singleton one :: Array '[3,2] Int @@ -436,7 +467,7 @@ -- -- >>> let e = extracts (Proxy :: Proxy '[1,2]) a -- >>> :t e --- e :: Array '[3, 4] (Array '[2] Int) +-- e :: Array [3, 4] (Array '[2] Int) extracts :: forall ds st si so a. ( HasShape st, @@ -457,7 +488,7 @@ -- -- >>> let e = extractsExcept (Proxy :: Proxy '[1,2]) a -- >>> :t e --- e :: Array '[2] (Array '[3, 4] Int) +-- e :: Array '[2] (Array [3, 4] Int) extractsExcept :: forall ds st si so a. ( HasShape st, @@ -479,12 +510,12 @@ -- >>> let e = extracts (Proxy :: Proxy '[1,0]) a -- -- >>> :t e --- e :: Array '[3, 2] (Array '[4] Int) +-- e :: Array [3, 2] (Array '[4] Int) -- -- >>> let j = joins (Proxy :: Proxy '[1,0]) e -- -- >>> :t j --- j :: Array '[2, 3, 4] Int +-- j :: Array [2, 3, 4] Int -- -- >>> a == j -- True @@ -507,7 +538,7 @@ -- | Maps a function along specified dimensions. -- -- >>> :t maps (transpose) (Proxy :: Proxy '[1]) a --- maps (transpose) (Proxy :: Proxy '[1]) a :: Array '[4, 3, 2] Int +-- maps (transpose) (Proxy :: Proxy '[1]) a :: Array [4, 3, 2] Int maps :: forall ds st st' si si' so a b. ( HasShape st, @@ -530,7 +561,7 @@ -- | Concatenate along a dimension. -- -- >>> :t concatenate (Proxy :: Proxy 1) a a --- concatenate (Proxy :: Proxy 1) a a :: Array '[2, 6, 4] Int +-- concatenate (Proxy :: Proxy 1) a a :: Array [2, 6, 4] Int concatenate :: forall a s0 s1 d s. ( CheckConcatenate d s0 s1 s, @@ -598,7 +629,7 @@ -- -- >>> :t append (Proxy :: Proxy 0) a -- append (Proxy :: Proxy 0) a --- :: Array '[3, 4] Int -> Array '[3, 3, 4] Int +-- :: Array [3, 4] Int -> Array [3, 3, 4] Int append :: forall a d s s'. ( DropIndex s d ~ s', @@ -619,7 +650,7 @@ -- -- >>> let r = reorder (Proxy :: Proxy '[2,0,1]) a -- >>> :t r --- r :: Array '[4, 2, 3] Int +-- r :: Array [4, 2, 3] Int reorder :: forall a ds s. ( HasShape ds, @@ -640,7 +671,7 @@ -- For context, if the function is multiply, and the arrays are tensors, -- then this can be interpreted as a tensor product. -- --- https://en.wikipedia.org/wiki/Tensor_product +-- < https://en.wikipedia.org/wiki/Tensor_product> -- -- The concept of a tensor product is a dense crossroad, and a complete treatment is elsewhere. To quote: -- @@ -650,6 +681,19 @@ -- [[1, 2, 3], -- [2, 4, 6], -- [3, 6, 9]] +-- +-- Alternatively, expand can be understood as representing the permutation of element pairs of two arrays, so like the Applicative List instance. +-- +-- >>> i2 = indices :: Array '[2,2] [Int] +-- >>> expand (,) i2 i2 +-- [[[[([0,0],[0,0]), ([0,0],[0,1])], +-- [([0,0],[1,0]), ([0,0],[1,1])]], +-- [[([0,1],[0,0]), ([0,1],[0,1])], +-- [([0,1],[1,0]), ([0,1],[1,1])]]], +-- [[[([1,0],[0,0]), ([1,0],[0,1])], +-- [([1,0],[1,0]), ([1,0],[1,1])]], +-- [[([1,1],[0,0]), ([1,1],[0,1])], +-- [([1,1],[1,0]), ([1,1],[1,1])]]]] expand :: forall s s' a b c. ( HasShape s, @@ -664,7 +708,18 @@ where r = rank (shape a) -expand' :: +-- | Like expand, but permutes the first array first, rather than the second. +-- +-- >>> expand (,) v (v |+ 3) +-- [[(1,4), (1,5), (1,6)], +-- [(2,4), (2,5), (2,6)], +-- [(3,4), (3,5), (3,6)]] +-- +-- >>> expandr (,) v (v |+ 3) +-- [[(1,4), (2,4), (3,4)], +-- [(1,5), (2,5), (3,5)], +-- [(1,6), (2,6), (3,6)]] +expandr :: forall s s' a b c. ( HasShape s, HasShape s', @@ -674,13 +729,13 @@ Array s a -> Array s' b -> Array ((++) s s') c -expand' f a b = tabulate (\i -> f (index a (drop r i)) (index b (take r i))) +expandr f a b = tabulate (\i -> f (index a (drop r i)) (index b (take r i))) where r = rank (shape a) -- | Apply an array of functions to each array of values. -- --- This is in the spirit of the applicative functor operation (<*>). +-- This is in the spirit of the applicative functor operation (\<*\>). -- -- > expand f a b == apply (fmap f a) b -- @@ -689,14 +744,14 @@ -- [2, 4, 6], -- [3, 6, 9]] -- --- Arrays can't be applicative functors in haskell because the changes in shape are reflected in the types. +-- Fixed Arrays can't be applicative functors because the changes in shape are reflected in the types. -- -- > :t apply --- apply --- :: (HasShape s, HasShape s', HasShape (s ++ s')) => --- Array s (a -> b) -> Array s' a -> Array (s ++ s') b +-- > apply +-- > :: (HasShape s, HasShape s', HasShape (s ++ s')) => +-- > Array s (a -> b) -> Array s' a -> Array (s ++ s') b -- > :t (<*>) --- (<*>) :: Applicative f => f (a -> b) -> f a -> f b +-- > (<*>) :: Applicative f => f (a -> b) -> f a -> f b -- -- >>> let b = [1..6] :: Array '[2,3] Int -- >>> contract sum (Proxy :: Proxy '[1,2]) (apply (fmap (*) b) (transpose b)) @@ -767,24 +822,31 @@ -- >>> dot sum (*) b v -- [14, 32] -- --- dot allows operation on mis-shaped matrices: --- --- >>> let m23 = [1..6] :: Array '[2,3] Int --- >>> let m12 = [1,2] :: Array '[1,2] Int --- >>> shape $ dot sum (*) m23 m12 --- [2,2] +-- Array elements don't have to be numbers: -- --- the algorithm ignores excess positions within the contracting dimension(s): +-- >>> x1 = (show <$> [1..4]) :: Array '[2,2] String +-- >>> x2 = (show <$> [5..8]) :: Array '[2,2] String +-- >>> x1 +-- [["1", "2"], +-- ["3", "4"]] -- --- m23 shape: 2 3 +-- >>> x2 +-- [["5", "6"], +-- ["7", "8"]] -- --- m12 shape: 1 2 +-- >>> import Data.List (intercalate) +-- >>> dot (intercalate "+" . toList) (\a b -> a <> "*" <> b) x1 x2 +-- [["1*5+2*7", "1*6+2*8"], +-- ["3*5+4*7", "3*6+4*8"]] -- --- res shape: 2 2 +-- 'dot' allows operation on mis-shaped matrices. The algorithm ignores excess positions within the contracting dimension(s): -- --- FIXME: work out whether this is a feature or a bug... +-- >>> let m23 = [1..6] :: Array '[2,3] Int +-- >>> let m12 = [1,2] :: Array '[1,2] Int +-- >>> shape $ dot sum (*) m23 m12 +-- [2,2] -- --- find instances of a vector in a matrix +-- Find instances of a vector in a matrix -- -- >>> let cs = fromList ("abacbaab" :: [Char]) :: Array '[4,2] Char -- >>> let v = fromList ("ab" :: [Char]) :: Vector 2 Char @@ -863,7 +925,7 @@ -- -- >>> let s = slice (Proxy :: Proxy '[[0,1],[0,2],[1,2]]) a -- >>> :t s --- s :: Array '[2, 2, 2] Int +-- s :: Array [2, 2, 2] Int -- -- >>> s -- [[[2, 3], @@ -893,15 +955,6 @@ go s = index a (zipWith (!!) pss' s) pss' = natValss pss -takes :: - forall s s' a. - ( HasShape s, - HasShape s' - ) => - Array s a -> - Array s' a -takes a = tabulate $ \s -> index a s - -- | Remove single dimensions. -- -- >>> let a = [1..24] :: Array '[2,1,3,4,1] Int @@ -950,11 +1003,6 @@ -- $scalar -- Scalar specialisations --- | --- --- An Array '[] a despite being a Scalar is never-the-less a one-element vector under the hood. Unification of representation is unexplored. -type Scalar a = Array ('[] :: [Nat]) a - -- | Unwrapping scalars is probably a performance bottleneck. -- -- >>> let s = [3] :: Array ('[] :: [Nat]) Int @@ -973,6 +1021,7 @@ -- | type Vector s a = Array '[s] a +-- | Vector specialisation of 'sequent' sequentv :: forall n. (KnownNat n) => Vector n Int sequentv = sequent @@ -1005,7 +1054,7 @@ where recip a = invtri (transpose (chol a)) * invtri (chol a) --- | inverse of a triangular matrix +-- | matrix. invtri :: forall a n. (KnownNat n, ExpField a, Eq a) => Array '[n, n] a -> Array '[n, n] a invtri a = sum (fmap (l ^) (sequentv :: Vector n Int)) * ti where @@ -1013,25 +1062,9 @@ tl = a - undiag (diag a) l = negate (ti * tl) --- | Expand the array to form a diagonal array --- --- >>> undiag ([1,1] :: Array '[2] Int) --- [[1, 0], --- [0, 1]] -undiag :: - forall a s. - ( HasShape s, - Additive a, - HasShape ((++) s s) - ) => - Array s a -> - Array ((++) s s) a -undiag a = tabulate go - where - go [] = throw (NumHaskException "Rank Underflow") - go xs@(x : xs') = bool zero (index a xs) (all (x ==) xs') - -- | cholesky decomposition +-- +-- Uses the algorithm. chol :: (KnownNat n, ExpField a) => Array '[n, n] a -> Array '[n, n] a chol a = let l = diff --git a/src/NumHask/Array/Shape.hs b/src/NumHask/Array/Shape.hs --- a/src/NumHask/Array/Shape.hs +++ b/src/NumHask/Array/Shape.hs @@ -1,19 +1,7 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE RebindableSyntax #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE NoStarIsType #-} -{-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} {-# OPTIONS_GHC -fno-warn-unused-top-binds #-} @@ -51,15 +39,19 @@ posRelative, PosRelative, PosRelativeGo, + DecMap, addIndexes, AddIndexes, AddIndexesGo, dropIndexes, DropIndexes, + DropIndexesGo, takeIndexes, TakeIndexes, exclude, Exclude, + Enumerate, + EnumerateGo, concatenate', Concatenate, CheckConcatenate, diff --git a/test/doctests.hs b/test/doctests.hs deleted file mode 100644 --- a/test/doctests.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Main where - -main :: IO () -main = do - putStrLn "This test-suite exists only to add dependencies" - putStrLn "To run doctests: " - putStrLn " cabal build all --enable-tests" - putStrLn " cabal-docspec"