numhask-array 0.7.0 → 0.11.1.0
raw patch · 12 files changed
Files
- ChangeLog.md +32/−0
- LICENSE +1/−1
- Setup.hs +0/−2
- numhask-array.cabal +62/−78
- readme.md +0/−36
- src/NumHask/Array.hs +14/−7
- src/NumHask/Array/Dynamic.hs +153/−25
- src/NumHask/Array/Fixed.hs +288/−65
- src/NumHask/Array/HMatrix.hs +0/−741
- src/NumHask/Array/Shape.hs +19/−36
- stack.yaml +0/−8
- test/test.hs +0/−19
+ ChangeLog.md view
@@ -0,0 +1,32 @@++0.11.1+===++* bump numhask-0.12++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++0.9.1+===+* GHC 9.0.1 support+* API fixes++0.8.0+=====++* GHC 8.10.2 support+* Removed hmatrix support. See [numhask-hmatrix](https://github.com/tonyday567/numhask-hmatrix)++0.7.0+=====++* GHC 8.10.1 support
LICENSE view
@@ -1,4 +1,4 @@-Copyright Tony Day (c) 2016+Copyright (c) 2016, Tony Day All rights reserved.
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
numhask-array.cabal view
@@ -1,82 +1,66 @@-cabal-version: 2.4-name: numhask-array-version: 0.7.0-synopsis:- n-dimensional arrays+cabal-version: 3.0+name: numhask-array+version: 0.11.1.0+license: BSD-3-Clause+license-file: LICENSE+copyright: Tony Day (c) 2016+category: math+author: Tony Day+maintainer: tonyday567@gmail.com+homepage: https://github.com/tonyday567/numhask-array#readme+bug-reports: https://github.com/tonyday567/numhask-array/issues+synopsis: Multi-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:- BSD-3-Clause-license-file:- LICENSE+ This package provides an interface into the [numhask](https://hackage.haskell.org/package/numhask) API, and both type- and value-level shape manipulation routines.++ == Usage++ >>> {-# LANGUAGE RebindableSyntax #-}+ >>> import NumHask.Prelude+ >>> import NumHask.Array++ In situations where shape is only known at runtime, a clear module configuration is:++ >>> import NumHask.Array.Shape+ >>> import qualified NumHask.Array.Fixed as F+ >>> import qualified NumHask.Array.Dynamic as D++build-type: Simple tested-with:- GHC==8.10.1-build-type:- Simple-extra-source-files:- readme.md- stack.yaml+ , GHC == 9.10.1+ , GHC == 9.8.2+ , GHC == 9.6.5+extra-doc-files: ChangeLog.md+ source-repository head- type:- git- location:- https://github.com/tonyday567/numhask-array+ type: git+ location: https://github.com/tonyday567/numhask-array++common ghc-options-stanza+ ghc-options:+ -Wall+ -Wcompat+ -Widentities+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wpartial-fields+ -Wredundant-constraints++common ghc2021-stanza+ default-language: GHC2021+ library- hs-source-dirs:- src- default-extensions:- NegativeLiterals- NoImplicitPrelude- OverloadedStrings- UnicodeSyntax- ghc-options:- -Wall- -Wcompat- -Wincomplete-record-updates- -Wincomplete-uni-patterns- -Wredundant-constraints- build-depends:- base >=4.11 && <5,- adjunctions >=4.0 && <5,- deepseq >=1.4.2.0 && <2,- distributive >=0.4 && <0.7,- numhask >= 0.6 && <0.7,- vector >=0.10 && <0.13,- hmatrix >= 0.18- exposed-modules:- NumHask.Array- NumHask.Array.HMatrix- NumHask.Array.Fixed- NumHask.Array.Dynamic- NumHask.Array.Shape- default-language: Haskell2010-test-suite test- type:- exitcode-stdio-1.0- main-is:- test.hs- hs-source-dirs:- test- default-extensions:- NegativeLiterals- NoImplicitPrelude- OverloadedStrings- UnicodeSyntax- build-depends:- base >=4.11 && <5,- doctest >=0.13 && <0.17,- numhask-array,- numhask >=0.6 && <0.7,- default-language: Haskell2010+ import: ghc-options-stanza+ import: ghc2021-stanza+ hs-source-dirs: src+ build-depends:+ , adjunctions >=4.0 && <5+ , base >=4.14 && <5+ , distributive >=0.4 && <0.7+ , numhask >=0.11 && <0.13+ , vector >=0.12.3 && <0.14+ exposed-modules:+ NumHask.Array+ NumHask.Array.Dynamic+ NumHask.Array.Fixed+ NumHask.Array.Shape
− readme.md
@@ -1,36 +0,0 @@-numhask-array-===--[](https://travis-ci.org/tonyday567/numhask) -[](https://hackage.haskell.org/package/numhask-array) --Arrays are higher-kinded numbers that can be indexed into with an Int list. Higher-kinded numbers are things with a non-primitive type that we wish to use the usual numerical operators on (+,-,*,/,abs).--This is an experimental library that:-- allows shape to be specified at both the type and value level.-- provides operators at value and type level to help manipulate shapes.-- Provides fixed and dynamic arrays with the same API.--Performance experiments are located in [numhask-bench](https://github.com/tonyday567/numhask-bench)--Usefulness of the array language that results from this treatment is yet to be explored.--API of an array language------https://en.wikipedia.org/wiki/APL_(programming_language)--See http://hiperfit.dk/pdf/array14_final.pdf 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.--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------https://blog.plover.com/prog/apl-matrix-product.html--https://en.wikipedia.org/wiki/Tensor_contraction--https://en.wikipedia.org/wiki/Tensor_(intrinsic_definition)#Definition:_Tensor_Product_of_Vector_Spaces
src/NumHask/Array.hs view
@@ -1,10 +1,10 @@-{-# OPTIONS_GHC -Wall #-}---- | Numbers that can be indexed into with an Int list.+-- | Multi-dimensional arrays module NumHask.Array ( -- * Imports- -- -- $imports++ -- * Overview+ -- $overview module NumHask.Array.Shape, module NumHask.Array.Fixed, )@@ -24,8 +24,15 @@ -- > import NumHask.Array.Shape -- > import qualified NumHask.Array.Fixed as F -- > import qualified NumHask.Array.Dynamic as D++-- $overview ----- A hmatrix instance of Array is also provided for performance purposes:+-- 'Array's are higher-kinded numbers that can be indexed into with an @[Int]@. Higher-kinded numbers are things with a non-primitive type that we wish to use the usual numerical operators on: '+','-','*','/','abs','tan' and so on. ----- > import NumHask.Array.Shape--- > import qualified NumHask.Array.HMatrix as H+-- The design of numhask-array:+--+-- - allows shape to be specified at both the type and value level.+--+-- - provides operators at value and type level to help manipulate shapes.+--+-- - provides fixed and dynamic arrays with the same API.
src/NumHask/Array/Dynamic.hs view
@@ -1,41 +1,37 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE NoStarIsType #-}-{-# OPTIONS_GHC -Wno-redundant-constraints #-}+{-# OPTIONS_GHC -Wno-x-partial #-} {-# 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- ( -- $setup+ ( -- $usage Array (..), -- * Conversion fromFlatList,+ toFlatList, -- * representable replacements index, tabulate, -- * Operators+ takes, reshape, transpose,- diag,+ indices, ident,+ sequent,+ diag,+ undiag, singleton, selects, selectsExcept, folds, extracts,+ extractsExcept, joins, maps, concatenate,@@ -43,6 +39,8 @@ append, reorder, expand,+ expandr,+ apply, contract, dot, mult,@@ -50,12 +48,14 @@ squeeze, -- * Scalar+ -- -- Scalar specialisations fromScalar, toScalar, -- * Matrix+ -- -- Matrix specialisations. col,@@ -64,22 +64,40 @@ ) where -import Data.List ((!!))-import qualified Data.Vector as V+import Data.List (intercalate)+import Data.Vector qualified as V import GHC.Show (Show (..)) import NumHask.Array.Shape-import NumHask.Prelude as P hiding (product, transpose)+import NumHask.Prelude as P hiding (product) -- $setup -- >>> :set -XDataKinds -- >>> :set -XOverloadedLists -- >>> :set -XTypeFamilies -- >>> :set -XFlexibleContexts+-- >>> :set -XRebindableSyntax+-- >>> import NumHask.Prelude+-- >>> import NumHask.Array.Dynamic+-- >>> import NumHask.Array.Shape -- >>> let s = fromFlatList [] [1] :: Array Int -- >>> let a = fromFlatList [2,3,4] [1..24] :: Array Int -- >>> let v = fromFlatList [3] [1,2,3] :: Array Int -- >>> let m = fromFlatList [3,4] [0..11] :: Array Int +-- $usage+-- >>> :set -XDataKinds+-- >>> :set -XOverloadedLists+-- >>> :set -XTypeFamilies+-- >>> :set -XFlexibleContexts+-- >>> :set -XRebindableSyntax+-- >>> import NumHask.Prelude+-- >>> import NumHask.Array.Dynamic+-- >>> import NumHask.Array.Shape+-- >>> let s = fromFlatList [] [1] :: Array Int+-- >>> let a = fromFlatList [2,3,4] [1..24] :: Array Int+-- >>> let v = fromFlatList [3] [1,2,3] :: Array Int+-- >>> let m = fromFlatList [3,4] [0..11] :: Array Int+ -- | a multidimensional array with a value-level shape -- -- >>> let a = fromFlatList [2,3,4] [1..24] :: Array Int@@ -90,9 +108,8 @@ -- [[13, 14, 15, 16], -- [17, 18, 19, 20], -- [21, 22, 23, 24]]]-data Array a- = Array {shape :: [Int], unArray :: V.Vector a}- deriving (Eq, Ord, NFData, Generic)+data Array a = Array {shape :: [Int], unArray :: V.Vector a}+ deriving (Eq, Ord, Generic) instance Functor Array where fmap f (Array s a) = Array s (V.map f a)@@ -109,7 +126,7 @@ where go n a'@(Array l' m) = case length l' of- 0 -> maybe (throw (NumHaskException "empty scalar")) GHC.Show.show (head m)+ 0 -> GHC.Show.show (V.head m) 1 -> "[" ++ intercalate ", " (GHC.Show.show <$> V.toList m) ++ "]" x -> "["@@ -148,6 +165,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@@ -176,20 +206,45 @@ 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] -- [[1, 0], -- [0, 1], -- [0, 0]]-ident :: (Num a) => [Int] -> Array a-ident ds = tabulate ds (bool 0 1 . isDiag)+ident :: (Additive a, Multiplicative a) => [Int] -> Array a+ident ds = tabulate ds (bool zero one . isDiag) where isDiag [] = True isDiag [_] = True 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])@@ -202,6 +257,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@@ -398,6 +468,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 ->@@ -407,6 +490,51 @@ 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 (\<*\>).+--+-- > expand f a b == apply (fmap f a) b+--+-- >>> apply ((*) <$> v) v+-- [[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))+-- [[14, 32],+-- [32, 77]]+apply ::+ Array (a -> b) ->+ Array a ->+ Array b+apply f a = tabulate ((++) (shape f) (shape a)) (\i -> index f (take r i) (index a (drop r i)))+ where+ r = rank (shape f)+ -- | Contract an array by applying the supplied (folding) function on diagonal elements of the dimensions. -- -- This generalises a tensor contraction by allowing the number of contracting diagonals to be other than 2, and allowing a binary operator other than multiplication.@@ -523,7 +651,7 @@ -- | Convert a number to a scalar. -- -- >>> :t toScalar 2--- toScalar 2 :: Num a => Array a+-- toScalar 2 :: FromInteger a => Array a toScalar :: a -> Array a toScalar a = fromFlatList [] [a]
src/NumHask/Array/Fixed.hs view
@@ -1,24 +1,12 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE NoStarIsType #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-}-{-# 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- ( -- $setup+ ( -- $usage Array (..), -- * Conversion@@ -27,15 +15,20 @@ toDynamic, -- * Operators+ takes, reshape, transpose,- diag,+ indices, ident,+ sequent,+ diag,+ undiag, singleton, selects, selectsExcept, folds, extracts,+ extractsExcept, joins, maps, concatenate,@@ -43,6 +36,8 @@ append, reorder, expand,+ expandr,+ apply, contract, dot, mult,@@ -50,18 +45,21 @@ squeeze, -- * Scalar+ -- -- Scalar specialisations- Scalar, fromScalar, toScalar, -- * Vector+ -- -- Vector specialisations. Vector,+ sequentv, -- * Matrix+ -- -- Matrix specialisations. Matrix,@@ -70,35 +68,58 @@ safeCol, safeRow, mmult,+ chol,+ invtri, ) where -import Control.Category (id) import Data.Distributive (Distributive (..)) import Data.Functor.Rep-import Data.List ((!!))-import qualified Data.Vector as V+import Data.Proxy+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 (identity, transpose)+import NumHask.Prelude as P hiding (sequence, toList) -- $setup+-- -- >>> :set -XDataKinds -- >>> :set -XOverloadedLists -- >>> :set -XTypeFamilies -- >>> :set -XFlexibleContexts+-- >>> :set -XRebindableSyntax+-- >>> import NumHask.Prelude+-- >>> import GHC.TypeLits (Nat)+-- >>> import Data.Proxy+-- >>> 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 --- | a multidimensional array with a type-level shape+-- $usage --+-- >>> :set -XDataKinds+-- >>> :set -XOverloadedLists+-- >>> :set -XTypeFamilies+-- >>> :set -XFlexibleContexts+-- >>> :set -XRebindableSyntax+-- >>> import NumHask.Prelude+-- >>> import NumHask.Array.Fixed+-- >>> import GHC.TypeLits (Nat)+-- >>> let s = [1] :: Array ('[] :: [Nat]) Int -- scalar+-- >>> let v = [1,2,3] :: Array '[3] Int -- vector+-- >>> let m = [0..11] :: Array '[3,4] Int -- matrix -- >>> let a = [1..24] :: Array '[2,3,4] Int--- >>> a++-- | a multidimensional array with a type-level shape+--+-- >>> :set -XDataKinds+-- >>> [1..24] :: Array '[2,3,4] Int -- [[[1, 2, 3, 4], -- [5, 6, 7, 8], -- [9, 10, 11, 12]],@@ -107,8 +128,9 @@ -- [21, 22, 23, 24]]] -- -- >>> [1,2,3] :: Array '[2,2] Int--- [[*** Exception: NumHaskException {errorMessage = "shape mismatch"}-newtype Array s a = Array {unArray :: V.Vector a} deriving (Eq, Ord, NFData, Functor, Foldable, Generic, Traversable)+-- *** 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 show a = GHC.Show.show (toDynamic a)@@ -160,18 +182,29 @@ where negate = fmapRep negate -type instance Actor (Array s a) = a- instance- (HasShape s, Multiplicative a) =>+ (Multiplicative a) => MultiplicativeAction (Array s a) where- (.*) r s = fmap (* s) r- {-# INLINE (.*) #-}+ type Scalar (Array s a) = a+ (|*) r s = fmap (s *) r - (*.) s = fmap (s *)- {-# INLINE (*.) #-}+instance (Additive a) => AdditiveAction (Array s a) where+ type AdditiveScalar (Array s a) = a+ (|+) r s = fmap (s +) r +instance+ (Subtractive a) =>+ SubtractiveAction (Array s a)+ where+ (|-) r s = fmap (\x -> x - s) r++instance+ (Divisive a) =>+ DivisiveAction (Array s a)+ where+ (|/) r s = fmap (/ s) r+ instance (HasShape s, JoinSemiLattice a) => JoinSemiLattice (Array s a) where (\/) = liftR2 (\/) @@ -181,8 +214,6 @@ instance (HasShape s, Subtractive a, Epsilon a) => Epsilon (Array s a) where epsilon = singleton epsilon - nearZero (Array a) = all nearZero a- instance ( HasShape s ) =>@@ -210,10 +241,11 @@ -- | convert to a dynamic array with shape at the value level. toDynamic :: (HasShape s) => Array s a -> D.Array a-toDynamic a = D.fromFlatList (shape a) (P.toList a)+toDynamic a = D.fromFlatList (shape a) (toList a) -- | Use a dynamic array in a fixed context. --+-- >>> import qualified NumHask.Array.Dynamic as D -- >>> with (D.fromFlatList [2,3,4] [1..24]) (selects (Proxy :: Proxy '[0,1]) [1,1] :: Array '[2,3,4] Int -> Array '[4] Int) -- [17, 18, 19, 20] with ::@@ -224,6 +256,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@@ -259,6 +307,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@@ -273,6 +330,22 @@ isDiag [x, y] = x == y isDiag (x : y : xs) = x == y && isDiag (y : xs) +-- | 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 : js) = bool zero i (all (i ==) js)+ -- | Extract the diagonal of an array. -- -- >>> diag (ident :: Array '[3,2] Int)@@ -290,6 +363,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@@ -372,7 +463,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,@@ -393,7 +484,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,@@ -415,12 +506,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@@ -443,7 +534,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,@@ -466,7 +557,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,@@ -534,7 +625,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',@@ -555,7 +646,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,@@ -576,7 +667,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: --@@ -586,6 +677,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,@@ -600,6 +704,68 @@ where r = rank (shape a) +-- | 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',+ HasShape ((++) s s')+ ) =>+ (a -> b -> c) ->+ Array s a ->+ Array s' b ->+ Array ((++) s s') c+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 (\<*\>).+--+-- > expand f a b == apply (fmap f a) b+--+-- >>> apply ((*) <$> v) v+-- [[1, 2, 3],+-- [2, 4, 6],+-- [3, 6, 9]]+--+-- 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+-- > :t (<*>)+-- > (<*>) :: 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))+-- [[14, 32],+-- [32, 77]]+apply ::+ forall s s' a b.+ ( HasShape s,+ HasShape s',+ HasShape ((++) s s')+ ) =>+ Array s (a -> b) ->+ Array s' a ->+ Array ((++) s s') b+apply f a = tabulate (\i -> index f (take r i) (index a (drop r i)))+ where+ r = rank (shape f)+ -- | Contract an array by applying the supplied (folding) function on diagonal elements of the dimensions. -- -- This generalises a tensor contraction by allowing the number of contracting diagonals to be other than 2, and allowing a binary operator other than multiplication.@@ -652,24 +818,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@@ -748,7 +921,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],@@ -826,11 +999,6 @@ -- $scalar -- Scalar specialisations --- | <https://en.wikipedia.org/wiki/Scalarr_(mathematics) Wiki Scalar>------ 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@@ -842,13 +1010,17 @@ -- | Convert a number to a scalar. -- -- >>> :t toScalar 2--- toScalar 2 :: Num a => Array '[] a+-- toScalar 2 :: FromInteger a => Array '[] a toScalar :: (HasShape ('[] :: [Nat])) => a -> Array ('[] :: [Nat]) a toScalar a = fromList [a] -- | <https://en.wikipedia.org/wiki/Vector_(mathematics_and_physics) Wiki Vector> type Vector s a = Array '[s] a +-- | Vector specialisation of 'sequent'+sequentv :: forall n. (KnownNat n) => Vector n Int+sequentv = sequent+ -- | <https://en.wikipedia.org/wiki/Matrix_(mathematics) Wiki Matrix> type Matrix m n a = Array '[m, n] a @@ -864,6 +1036,57 @@ (*) = mmult one = ident++instance+ ( Multiplicative a,+ P.Distributive a,+ Subtractive a,+ Eq a,+ ExpField a,+ KnownNat m,+ HasShape '[m, m]+ ) =>+ Divisive (Matrix m m a)+ where+ recip a = invtri (transpose (chol a)) * invtri (chol a)++-- | <https://math.stackexchange.com/questions/1003801/inverse-of-an-invertible-upper-triangular-matrix-of-order-3 Inverse of a triangular> 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+ ti = undiag (fmap recip (diag a))+ tl = a - undiag (diag a)+ l = negate (ti * tl)++-- | cholesky decomposition+--+-- Uses the <https://en.wikipedia.org/wiki/Cholesky_decomposition#The_Cholesky_algorithm Cholesky-Crout> algorithm.+chol :: (KnownNat n, ExpField a) => Array '[n, n] a -> Array '[n, n] a+chol a =+ let l =+ tabulate+ ( \[i, j] ->+ bool+ ( one+ / index l [j, j]+ * ( index a [i, j]+ - sum+ ( (\k -> index l [i, k] * index l [j, k])+ <$> ([zero .. (j - one)] :: [Int])+ )+ )+ )+ ( sqrt+ ( index a [i, i]+ - sum+ ( (\k -> index l [j, k] ^ 2)+ <$> ([zero .. (j - one)] :: [Int])+ )+ )+ )+ (i == j)+ )+ in l -- | Extract specialised to a matrix. --
− src/NumHask/Array/HMatrix.hs
@@ -1,741 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE NoStarIsType #-}-{-# OPTIONS_GHC -Wno-redundant-constraints #-}-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}---- | Arrays with a fixed shape, with a HMatrix representation.-module NumHask.Array.HMatrix- ( -- $setup- Array (..),-- -- * Representation- --- -- With no functor instance, we instead supply the representable API- index,- tabulate,-- -- * Conversion- shape,- toDynamic,- toFixed,- fromFixed,-- -- * Operators- reshape,- transpose,- diag,- ident,- singleton,- selects,- selectsExcept,- folds,- concatenate,- insert,- append,- reorder,- expand,- slice,- squeeze,-- -- * Scalar- --- -- Scalar specialisations- Scalar,- fromScalar,- toScalar,-- -- * Vector- --- -- Vector specialisations.- Vector,-- -- * Matrix- --- -- Matrix specialisations.- Matrix,- col,- row,- safeCol,- safeRow,- mmult,- )-where--import Data.List ((!!))-import qualified Data.Vector as V-import GHC.Exts (IsList (..))-import GHC.TypeLits-import qualified NumHask.Array.Dynamic as D-import qualified NumHask.Array.Fixed as F-import NumHask.Array.Shape-import NumHask.Prelude as P hiding (transpose)-import qualified Numeric.LinearAlgebra as H-import qualified Numeric.LinearAlgebra.Devel as H-import qualified Prelude---- $setup--- >>> :set -XDataKinds--- >>> :set -XOverloadedLists--- >>> :set -XTypeFamilies--- >>> :set -XFlexibleContexts--- >>> let s = [1] :: Array ('[] :: [Nat]) Int -- scalar--- >>> let v = [1,2,3] :: Array '[3] Int -- vector--- >>> let m = [0..11] :: Array '[3,4] Int -- matrix--- >>> let a = [1..24] :: Array '[2,3,4] Int---- | a multidimensional array with a type-level shape------ >>> let a = [1..24] :: Array '[2,3,4] Int--- >>> a--- [[[1, 2, 3, 4],--- [5, 6, 7, 8],--- [9, 10, 11, 12]],--- [[13, 14, 15, 16],--- [17, 18, 19, 20],--- [21, 22, 23, 24]]]------ >>> [1,2,3] :: Array '[2,2] Int--- [[*** Exception: NumHaskException {errorMessage = "shape mismatch"}-newtype Array s a = Array {unArray :: H.Matrix a}- deriving (Show, NFData, Generic)--instance- ( Additive a,- HasShape s,- H.Container H.Vector a,- Num a- ) =>- Additive (Array s a)- where- (+) (Array x1) (Array x2) = Array $ H.add x1 x2-- zero = Array $ H.konst zero (n, m)- where- s = shapeVal (toShape @s)- [n, m] = s--instance- ( Multiplicative a,- HasShape s,- H.Container H.Vector a,- Num (H.Vector a),- Num a- ) =>- Multiplicative (Array s a)- where- (*) (Array x1) (Array x2) = Array $ H.liftMatrix2 (Prelude.*) x1 x2-- one = Array $ H.konst one (n, m)- where- s = shapeVal (toShape @s)- [n, m] = s--type instance Actor (Array s a) = a---- (<.>) (Array a) (Array b) = H.sumElements $ H.liftMatrix2 (Prelude.*) a b--instance- ( HasShape s,- Multiplicative a,- H.Container H.Vector a,- Num a- ) =>- MultiplicativeAction (Array s a)- where- (.*) (Array r) s = Array $ H.cmap (* s) r- {-# INLINE (.*) #-}-- (*.) s (Array r) = Array $ H.cmap (s *) r- {-# INLINE (*.) #-}--type instance Actor (Array s a) = a---- | from flat list-instance- ( HasShape s,- H.Element a- ) =>- IsList (Array s a)- where- type Item (Array s a) = a-- fromList l =- bool- (throw (NumHaskException "shape mismatch"))- (Array $ H.reshape n $ H.fromList l)- ((length l == 1 && null s) || (length l == size s))- where- s = shapeVal (toShape @s)- n = Prelude.last s-- toList (Array v) = H.toList $ H.flatten v---- | Get shape of an Array as a value.------ >>> shape a--- [2,3,4]-shape :: forall a s. (HasShape s) => Array s a -> [Int]-shape _ = shapeVal $ toShape @s-{-# INLINE shape #-}---- | Convert to a dynamic array.-toDynamic :: (HasShape s, H.Element a) => Array s a -> D.Array a-toDynamic a@(Array h) = D.fromFlatList (shape a) (mconcat $ H.toLists h)---- | Convert to a fixed array.-toFixed :: (HasShape s, H.Element a) => Array s a -> F.Array s a-toFixed (Array h) = fromList (mconcat $ H.toLists h)---- | Convert from a fixed array.-fromFixed :: (HasShape s, H.Element a) => F.Array s a -> Array s a-fromFixed a = fromList (P.toList a)---- | with no fmap, we supply the representable API-index ::- forall s a.- ( HasShape s,- H.Element a,- H.Container H.Vector a- ) =>- Array s a ->- [Int] ->- a-index (Array v) i = H.flatten v `H.atIndex` flatten s i- where- s = shapeVal (toShape @s)---- | tabulate an array with a generating function------ >>> tabulate [2,3,4] ((1+) . flatten [2,3,4]) == a--- True-tabulate ::- forall s a.- ( HasShape s,- H.Element a- ) =>- ([Int] -> a) ->- Array s a-tabulate f =- fromList (V.toList $ V.generate (size s) (f . shapen s))- where- s = shapeVal (toShape @s)---- | Reshape an array (with the same number of elements).------ >>> reshape a :: Array '[4,3,2] Int--- [[[1, 2],--- [3, 4],--- [5, 6]],--- [[7, 8],--- [9, 10],--- [11, 12]],--- [[13, 14],--- [15, 16],--- [17, 18]],--- [[19, 20],--- [21, 22],--- [23, 24]]]-reshape ::- forall a s s'.- ( Size s ~ Size s',- HasShape s,- HasShape s',- H.Container H.Vector a- ) =>- Array s a ->- Array s' a-reshape a = tabulate (index a . shapen s . flatten s')- where- s = shapeVal (toShape @s)- s' = shapeVal (toShape @s')---- | Reverse indices eg transposes the element A/ijk/ to A/kji/.------ >>> index (transpose a) [1,0,0] == index a [0,0,1]--- True-transpose :: forall a s. (H.Element a, H.Container H.Vector a, HasShape s, HasShape (Reverse s)) => Array s a -> Array (Reverse s) a-transpose a = tabulate (index a . reverse)---- | The identity array.------ >>> ident :: Array '[3,2] Int--- [[1, 0],--- [0, 1],--- [0, 0]]-ident :: forall a s. (H.Element a, H.Container H.Vector a, HasShape s, Additive a, Multiplicative a) => Array s a-ident = tabulate (bool zero one . isDiag)- where- isDiag [] = True- isDiag [_] = True- isDiag [x, y] = x == y- isDiag (x : y : xs) = x == y && isDiag (y : xs)---- | Extract the diagonal of an array.------ >>> diag (ident :: Array '[3,2] Int)--- [1, 1]-diag ::- forall a s.- ( HasShape s,- HasShape '[Minimum s],- H.Element a,- H.Container H.Vector a- ) =>- Array s a ->- Array '[Minimum s] a-diag a = tabulate go- where- go [] = throw (NumHaskException "Rank Underflow")- go (s' : _) = index a (replicate (length ds) s')- ds = shapeVal (toShape @s)---- | Create an array composed of a single value.------ >>> singleton one :: Array '[3,2] Int--- [[1, 1],--- [1, 1],--- [1, 1]]-singleton :: (H.Element a, H.Container H.Vector a, HasShape s) => a -> Array s a-singleton a = tabulate (const a)---- | Select an array along dimensions.------ >>> let s = selects (Proxy :: Proxy '[0,1]) [1,1] a--- >>> :t s--- s :: Array '[4] Int------ >>> s--- [17, 18, 19, 20]-selects ::- forall ds s s' a.- ( HasShape s,- HasShape ds,- HasShape s',- s' ~ DropIndexes s ds,- H.Element a,- H.Container H.Vector a- ) =>- Proxy ds ->- [Int] ->- Array s a ->- Array s' a-selects _ i a = tabulate go- where- go s = index a (addIndexes s ds i)- ds = shapeVal (toShape @ds)---- | Select an index /except/ along specified dimensions.------ >>> let s = selectsExcept (Proxy :: Proxy '[2]) [1,1] a--- >>> :t s--- s :: Array '[4] Int------ >>> s--- [17, 18, 19, 20]-selectsExcept ::- forall ds s s' a.- ( HasShape s,- HasShape ds,- HasShape s',- s' ~ TakeIndexes s ds,- H.Element a,- H.Container H.Vector a- ) =>- Proxy ds ->- [Int] ->- Array s a ->- Array s' a-selectsExcept _ i a = tabulate go- where- go s = index a (addIndexes i ds s)- ds = shapeVal (toShape @ds)---- | Fold along specified dimensions.------ >>> folds sum (Proxy :: Proxy '[1]) a--- [68, 100, 132]-folds ::- forall ds st si so a b.- ( HasShape st,- HasShape ds,- HasShape si,- HasShape so,- si ~ DropIndexes st ds,- so ~ TakeIndexes st ds,- H.Element a,- H.Container H.Vector a,- H.Element b,- H.Container H.Vector b- ) =>- (Array si a -> b) ->- Proxy ds ->- Array st a ->- Array so b-folds f d a = tabulate go- where- go s = f (selects d s a)---- | Concatenate along a dimension.------ >>> :t concatenate (Proxy :: Proxy 1) a a--- concatenate (Proxy :: Proxy 1) a a :: Array '[2, 6, 4] Int-concatenate ::- forall a s0 s1 d s.- ( CheckConcatenate d s0 s1 s,- Concatenate d s0 s1 ~ s,- HasShape s0,- HasShape s1,- HasShape s,- KnownNat d,- H.Element a,- H.Container H.Vector a- ) =>- Proxy d ->- Array s0 a ->- Array s1 a ->- Array s a-concatenate _ s0 s1 = tabulate go- where- go s =- bool- (index s0 s)- ( index- s1- ( addIndex- (dropIndex s d)- d- ((s !! d) - (ds0 !! d))- )- )- ((s !! d) >= (ds0 !! d))- ds0 = shapeVal (toShape @s0)- d = fromIntegral $ natVal @d Proxy---- | Insert along a dimension at a position.------ >>> insert (Proxy :: Proxy 2) (Proxy :: Proxy 0) a ([100..105])--- [[[100, 1, 2, 3, 4],--- [101, 5, 6, 7, 8],--- [102, 9, 10, 11, 12]],--- [[103, 13, 14, 15, 16],--- [104, 17, 18, 19, 20],--- [105, 21, 22, 23, 24]]]-insert ::- forall a s s' d i.- ( DropIndex s d ~ s',- CheckInsert d i s,- KnownNat i,- KnownNat d,- HasShape s,- HasShape s',- HasShape (Insert d s),- H.Element a,- H.Container H.Vector a- ) =>- Proxy d ->- Proxy i ->- Array s a ->- Array s' a ->- Array (Insert d s) a-insert _ _ a b = tabulate go- where- go s- | s !! d == i = index b (dropIndex s d)- | s !! d < i = index a s- | otherwise = index a (decAt d s)- d = fromIntegral $ natVal @d Proxy- i = fromIntegral $ natVal @i Proxy---- | Insert along a dimension at the end.------ >>> :t append (Proxy :: Proxy 0) a--- append (Proxy :: Proxy 0) a--- :: Array '[3, 4] Int -> Array '[3, 3, 4] Int-append ::- forall a d s s'.- ( DropIndex s d ~ s',- CheckInsert d (Dimension s d - 1) s,- KnownNat (Dimension s d - 1),- KnownNat d,- HasShape s,- HasShape s',- HasShape (Insert d s),- H.Element a,- H.Container H.Vector a- ) =>- Proxy d ->- Array s a ->- Array s' a ->- Array (Insert d s) a-append d = insert d (Proxy :: Proxy (Dimension s d - 1))---- | Change the order of dimensions.------ >>> let r = reorder (Proxy :: Proxy '[2,0,1]) a--- >>> :t r--- r :: Array '[4, 2, 3] Int-reorder ::- forall a ds s.- ( HasShape ds,- HasShape s,- HasShape (Reorder s ds),- CheckReorder ds s,- H.Element a,- H.Container H.Vector a- ) =>- Proxy ds ->- Array s a ->- Array (Reorder s ds) a-reorder _ a = tabulate go- where- go s = index a (addIndexes [] ds s)- ds = shapeVal (toShape @ds)---- | Product two arrays using the supplied binary function.------ 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------ The concept of a tensor product is a dense crossroad, and a complete treatment is elsewhere. To quote:------ ... the tensor product can be extended to other categories of mathematical objects in addition to vector spaces, such as to matrices, tensors, algebras, topological vector spaces, and modules. In each such case the tensor product is characterized by a similar universal property: it is the freest bilinear operation. The general concept of a "tensor product" is captured by monoidal categories; that is, the class of all things that have a tensor product is a monoidal category.------ >>> expand (*) v v--- [[1, 2, 3],--- [2, 4, 6],--- [3, 6, 9]]-expand ::- forall s s' a b c.- ( HasShape s,- HasShape s',- HasShape ((++) s s'),- H.Element a,- H.Container H.Vector a,- H.Element b,- H.Container H.Vector b,- H.Element c- ) =>- (a -> b -> c) ->- Array s a ->- Array s' b ->- Array ((++) s s') c-expand f a b = tabulate (\i -> f (index a (take r i)) (index b (drop r i)))- where- r = rank (shape a)---- | Select elements along positions in every dimension.------ >>> let s = slice (Proxy :: Proxy '[[0,1],[0,2],[1,2]]) a--- >>> :t s--- s :: Array '[2, 2, 2] Int------ >>> s--- [[[2, 3],--- [10, 11]],--- [[14, 15],--- [22, 23]]]------ >>> let s = squeeze $ slice (Proxy :: Proxy '[ '[0], '[0], '[0]]) a--- >>> :t s--- s :: Array '[] Int------ >>> s--- 1-slice ::- forall (pss :: [[Nat]]) s s' a.- ( HasShape s,- HasShape s',- KnownNatss pss,- KnownNat (Rank pss),- s' ~ Ranks pss,- H.Element a,- H.Container H.Vector a- ) =>- Proxy pss ->- Array s a ->- Array s' a-slice pss a = tabulate go- where- go s = index a (zipWith (!!) pss' s)- pss' = natValss pss---- | Remove single dimensions.------ >>> let a = [1..24] :: Array '[2,1,3,4,1] Int--- >>> a--- [[[[[1],--- [2],--- [3],--- [4]],--- [[5],--- [6],--- [7],--- [8]],--- [[9],--- [10],--- [11],--- [12]]]],--- [[[[13],--- [14],--- [15],--- [16]],--- [[17],--- [18],--- [19],--- [20]],--- [[21],--- [22],--- [23],--- [24]]]]]--- >>> squeeze a--- [[[1, 2, 3, 4],--- [5, 6, 7, 8],--- [9, 10, 11, 12]],--- [[13, 14, 15, 16],--- [17, 18, 19, 20],--- [21, 22, 23, 24]]]------ >>> squeeze ([1] :: Array '[1,1] Double)--- 1.0-squeeze ::- forall s t a.- (t ~ Squeeze s) =>- Array s a ->- Array t a-squeeze (Array x) = Array x---- $scalar--- Scalar specialisations---- | <https://en.wikipedia.org/wiki/Scalarr_(mathematics) Wiki Scalar>------ 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--- >>> fromScalar s--- 3-fromScalar :: (H.Element a, H.Container H.Vector a, HasShape ('[] :: [Nat])) => Array ('[] :: [Nat]) a -> a-fromScalar a = index a ([] :: [Int])---- | Convert a number to a scalar.------ >>> :t toScalar 2--- toScalar 2 :: Num a => Array '[] a-toScalar :: (H.Element a, H.Container H.Vector a, HasShape ('[] :: [Nat])) => a -> Array ('[] :: [Nat]) a-toScalar a = fromList [a]---- | <https://en.wikipedia.org/wiki/Vector_(mathematics_and_physics) Wiki Vector>-type Vector s a = Array '[s] a---- | <https://en.wikipedia.org/wiki/Matrix_(mathematics) Wiki Matrix>-type Matrix m n a = Array '[m, n] a--instance- ( Multiplicative a,- P.Distributive a,- Subtractive a,- H.Numeric a,- KnownNat m,- HasShape '[m, m],- H.Element a,- H.Container H.Vector a- ) =>- Multiplicative (Matrix m m a)- where- (*) = mmult-- one = ident---- | Extract specialised to a matrix.------ >>> row 1 m--- [4, 5, 6, 7]-row :: forall m n a. (H.Element a, H.Container H.Vector a, KnownNat m, KnownNat n, HasShape '[m, n]) => Int -> Matrix m n a -> Vector n a-row i (Array a) = fromList $ H.toList $ H.subVector (i * n) n (H.flatten a)- where- n = fromIntegral $ natVal @n Proxy---- | Row extraction checked at type level.------ >>> safeRow (Proxy :: Proxy 1) m--- [4, 5, 6, 7]------ >>> safeRow (Proxy :: Proxy 3) m--- ...--- ... index outside range--- ...-safeRow :: forall m n a j. (H.Element a, H.Container H.Vector a, 'True ~ CheckIndex j m, KnownNat j, KnownNat m, KnownNat n, HasShape '[m, n]) => Proxy j -> Matrix m n a -> Vector n a-safeRow _j (Array a) = fromList $ H.toList $ H.subVector (j * n) n (H.flatten a)- where- n = fromIntegral $ natVal @n Proxy- j = fromIntegral $ natVal @j Proxy---- | Extract specialised to a matrix.------ >>> col 1 m--- [1, 5, 9]-col :: forall m n a. (H.Element a, H.Container H.Vector a, KnownNat m, KnownNat n, HasShape '[m, n]) => Int -> Matrix m n a -> Vector n a-col i (Array a) = Array $ H.takeColumns i a---- | Column extraction checked at type level.------ >>> safeCol (Proxy :: Proxy 1) m--- [1, 5, 9]------ >>> safeCol (Proxy :: Proxy 4) m--- ...--- ... index outside range--- ...-safeCol :: forall m n a j. (H.Element a, H.Container H.Vector a, 'True ~ CheckIndex j n, KnownNat j, KnownNat m, KnownNat n, HasShape '[m, n]) => Proxy j -> Matrix m n a -> Vector n a-safeCol _j (Array a) = Array $ H.takeColumns j a- where- j = fromIntegral $ natVal @j Proxy---- | Matrix multiplication.------ This is dot sum (*) specialised to matrices------ >>> 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.- ( KnownNat k,- KnownNat m,- KnownNat n,- HasShape [m, n],- Ring a,- H.Numeric a- ) =>- Array [m, k] a ->- Array [k, n] a ->- Array [m, n] a-mmult (Array x) (Array y) = Array $ x H.<> y
src/NumHask/Array/Shape.hs view
@@ -1,20 +1,7 @@-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeInType #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE NoStarIsType #-}-{-# OPTIONS_GHC -Wall #-} -- | Functions for manipulating shape. The module tends to supply equivalent functionality at type-level and value-level with functions of the same name (except for capitalization). module NumHask.Array.Shape@@ -50,15 +37,19 @@ posRelative, PosRelative, PosRelativeGo,+ DecMap, addIndexes, AddIndexes, AddIndexesGo, dropIndexes, DropIndexes,+ DropIndexesGo, takeIndexes, TakeIndexes, exclude, Exclude,+ Enumerate,+ EnumerateGo, concatenate', Concatenate, CheckConcatenate,@@ -76,11 +67,20 @@ ) where -import Data.List ((!!))+import Data.Proxy import Data.Type.Bool+import Data.Type.Equality import GHC.TypeLits as L import NumHask.Prelude as P hiding (Last, minimum) +-- $setup+-- >>> :set -XDataKinds+-- >>> :set -XOverloadedLists+-- >>> :set -XTypeFamilies+-- >>> :set -XFlexibleContexts+-- >>> :set -XRebindableSyntax+-- >>> import NumHask.Prelude+ -- | The Shape type holds a [Nat] at type level and the equivalent [Int] at value level. -- Using [Int] as the index for an array nicely represents the practical interests and constraints downstream of this high-level API: densely-packed numbers (reals or integrals), indexed and layered. newtype Shape (s :: [Nat]) = Shape {shapeVal :: [Int]} deriving (Show)@@ -168,7 +168,7 @@ checkIndexes is n = all (`checkIndex` n) is type family CheckIndexes (i :: [Nat]) (n :: Nat) :: Bool where- CheckIndexes '[] n = 'True+ CheckIndexes '[] _ = 'True CheckIndexes (i : is) n = CheckIndex i n && CheckIndexes is n -- | dimension i is the i'th dimension of a Shape@@ -201,19 +201,11 @@ Drop 0 xs = xs Drop n (_ : xs) = Drop (n - 1) xs -type family Tail (a :: [k]) :: [k] where- Tail '[] = L.TypeError ('Text "No tail")- Tail (_ : xs) = xs- type family Init (a :: [k]) :: [k] where Init '[] = L.TypeError ('Text "No init") Init '[_] = '[] Init (x : xs) = x : Init xs -type family Head (a :: [k]) :: k where- Head '[] = L.TypeError ('Text "No head")- Head (x : _) = x- type family Last (a :: [k]) :: k where Last '[] = L.TypeError ('Text "No last") Last '[x] = x@@ -322,7 +314,7 @@ (s !! i) ': TakeIndexes s is type family (a :: [k]) !! (b :: Nat) :: k where- (!!) '[] i = L.TypeError ('Text "Index Underflow")+ (!!) '[] _ = L.TypeError ('Text "Index Underflow") (!!) (x : _) 0 = x (!!) (_ : xs) i = (!!) xs (i - 1) @@ -397,8 +389,8 @@ ~ 'True -- | remove 1's from a list-squeeze' :: (Eq a, Num a) => [a] -> [a]-squeeze' = filter (/= 1)+squeeze' :: (Eq a, Multiplicative a) => [a] -> [a]+squeeze' = filter (/= one) type family Squeeze (a :: [Nat]) where Squeeze '[] = '[]@@ -423,19 +415,10 @@ SFilter 'FMin p (x ': xs) = If (Cmp x p == 'LT) (x ': SFilter 'FMin p xs) (SFilter 'FMin p xs) SFilter 'FMax p (x ': xs) = If (Cmp x p == 'GT || Cmp x p == 'EQ) (x ': SFilter 'FMax p xs) (SFilter 'FMax p xs) -type family Zip lst lst' where- Zip lst lst' = ZipWith '(,) lst lst' -- Implemented as TF because #11375- type family ZipWith f lst lst' where ZipWith f '[] lst = '[] ZipWith f lst '[] = '[] ZipWith f (l ': ls) (n ': ns) = f l n ': ZipWith f ls ns--type family Fst a where- Fst '(a, _) = a--type family Snd a where- Snd '(_, a) = a type family FMap f lst where FMap f '[] = '[]
− stack.yaml
@@ -1,8 +0,0 @@-resolver: nightly-2020-06-25--packages:- - .--extra-deps:- - numhask-0.6.0-
− test/test.hs
@@ -1,19 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# OPTIONS_GHC -Wall #-}--module Main where--import NumHask.Prelude as P-import Test.DocTest--main :: IO ()-main = do- putStrLn ("NumHask.Array.Fixed DocTest turned on" :: Text)- doctest ["src/NumHask/Array/Fixed.hs"]- putStrLn ("NumHask.Array.Shape DocTest turned on" :: Text)- doctest ["src/NumHask/Array/Shape.hs"]- putStrLn ("NumHask.Array.Dynamic DocTest turned on" :: Text)- doctest ["src/NumHask/Array/Dynamic.hs"]