packages feed

numhask-array (empty) → 0.0.1

raw patch · 9 files changed

+1042/−0 lines, 9 filesdep +adjunctionsdep +basedep +distributivesetup-changed

Dependencies added: adjunctions, base, distributive, doctest, ghc-typelits-natnormalise, numhask, protolude, singletons, typelits-witnesses, vector

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Tony Day (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Tony Day nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ numhask-array.cabal view
@@ -0,0 +1,79 @@+name: numhask-array+version: 0.0.1+synopsis:+  See readme.md+description:+  See readme.md for description.+category:+  project+homepage:+  https://github.com/tonyday567/numhask-array+license:+  BSD3+license-file:+  LICENSE+author:+  Tony Day+maintainer:+  tonyday567@gmail.com+copyright:+  Tony Day+build-type:+  Simple+cabal-version:+  >=1.14+extra-source-files:+  readme.md+  stack.yaml+library+  default-language:+    Haskell2010+  ghc-options:+  hs-source-dirs:      +    src+  exposed-modules:+    NumHask.Array+    NumHask.Array.Constraints+    NumHask.Array.Example+  other-modules:++  build-depends:+    base >= 4.7 && < 5,+    numhask >= 0.1.2 && < 0.2,+    adjunctions >= 4.0 && < 5,+    distributive >= 0.4 && < 0.6,+    ghc-typelits-natnormalise >= 0.4 && < 0.6,+    protolude >= 0.1 && < 0.3,+    singletons >= 2.0 && < 3,+    typelits-witnesses >= 0.2 && < 0.3,+    vector >= 0.10 && < 0.13+  default-extensions:+    NegativeLiterals,+    NoImplicitPrelude,+    OverloadedStrings,+    UnicodeSyntax++test-suite test+  default-language:+    Haskell2010+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    test+  main-is:+    test.hs+  build-depends:+    base >= 4.7 && < 5,+    doctest,+    numhask >= 0.1.2 && < 0.2+  default-extensions:+    NegativeLiterals,+    NoImplicitPrelude,+    OverloadedStrings,+    UnicodeSyntax++source-repository head+  type:+    git+  location:+    https://github.com/tonyday567/numhask-array
+ readme.md view
@@ -0,0 +1,17 @@+numhask-array+===++[![Build Status](https://travis-ci.org/tonyday567/numhask-array.png)](https://travis-ci.org/tonyday567/numhask-array) [![Hackage](https://img.shields.io/hackage/v/numhask-array.svg)](https://hackage.haskell.org/package/numhask-array) [![lts](https://www.stackage.org/package/numhask-array/badge/lts)](http://stackage.org/lts/package/numhask-array) [![nightly](https://www.stackage.org/package/numhask-array/badge/nightly)](http://stackage.org/nightly/package/numhask-array) ++An experimental array with:++- shape specified at the type level in n-dimensions+- a [vector](https://www.stackage.org/package/vector) backend+- Representable instances+- [numhask](https://www.stackage.org/package/numhask) heirarchy instances++See [Examples](src/NumHask/Array/Example.hs) for the emergent API.++++
+ src/NumHask/Array.hs view
@@ -0,0 +1,525 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- | safe-typed n-dimensional arrays+module NumHask.Array+  ( Array(..)+  , SomeArray(..)+  , row+  , col+  , slice+  , index+  , foldAlong+  , mapAlong+  , concatenate+  , zipWith+  , transpose+  , squeeze+  , (><)+  , mmult+  , fromList+  ) where++import Data.Distributive+import Data.Functor.Rep+import Data.Promotion.Prelude+import Data.Singletons+import Data.Singletons.Prelude+import Data.Singletons.TypeLits+import GHC.Exts+import GHC.Show+import NumHask.Array.Constraints+import NumHask.Prelude hiding (All, Map, (><), mmult, show, row, col, zipWith, transpose)+import qualified Data.Vector as V+import qualified NumHask.Prelude as P++-- $setup+-- >>> :set -XDataKinds+-- >>> :set -XOverloadedLists+-- >>> :set -XTypeFamilies+-- >>> let a = [1..24] :: Array '[2,3,4] Int+-- >>> let v = [1,2,3] :: Array '[3] Int++-- | an n-dimensional array where shape is specified at the type level+-- The main purpose of this, beyond safe typing, is to supply the Representable instance with an initial object.+--+-- >>> 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]]]+newtype Array (r :: [Nat]) a = Array (V.Vector a) deriving (Functor, Eq, Foldable)++-- | an n-dimensional array where shape is specified at the value level+data SomeArray a =+  SomeArray [Int]+            (V.Vector a)+  deriving (Functor, Eq, Foldable)++-- | convert a 'Array' to a 'SomeArray', losing the type level shape+someArray :: (SingI r) => Array (r :: [Nat]) a -> SomeArray a+someArray n@(Array v) = SomeArray (shape n) v++instance forall (r :: [Nat]). (SingI r) => HasShape (Array r) where+  type Shape (Array r) = [Int]+  shape _ = fmap fromIntegral (fromSing (sing :: Sing r))++-- | convert from n-dim shape index to a flat index+--+-- >>> ind [2,3,4] [1,1,1]+-- 17+ind :: [Int] -> [Int] -> Int+ind ns xs = sum $ P.zipWith (*) xs (drop 1 $ scanr (*) 1 ns)++-- | convert from a flat index to a shape index+--+-- >>> unind [2,3,4] 17+-- [1,1,1]+unind :: [Int] -> Int -> [Int]+unind ns x =+  fst $+  foldr+    (\a (acc, r) ->+       let (d, m) = divMod r a+       in (m : acc, d))+    ([], x)+    ns++instance forall r. (SingI r) => Distributive (Array (r :: [Nat])) where+  distribute f =+    Array $ V.generate n $ \i -> fmap (\(Array v) -> V.unsafeIndex v i) f+    where+      n =+        case (sing :: Sing r) of+          SNil -> 1+          (SCons x xs) -> product $ fromInteger <$> (fromSing x : fromSing xs)++instance forall (r :: [Nat]). (SingI r) => Representable (Array r) where+  type Rep (Array r) = [Int]+  tabulate f = Array $ V.generate (product ns) (f . unind ns)+    where+      ns =+        case (sing :: Sing r) of+          SNil -> []+          (SCons x xs) -> fromIntegral <$> (fromSing x : fromSing xs)+  index (Array xs) rs = xs V.! ind ns rs+    where+      ns =+        case (sing :: Sing r) of+          SNil -> []+          (SCons x xs') -> fromIntegral <$> (fromSing x : fromSing xs')++-- | from flat list+instance (SingI r, Num a) => IsList (Array (r :: [Nat]) a) where+  type Item (Array r a) = a+  fromList l = Array $ V.fromList $ take n $ l ++ repeat 0+    where+      n =+        case (sing :: Sing r) of+          SNil -> 1+          (SCons x xs') ->+            product $ fromIntegral <$> (fromSing x : fromSing xs')+  toList (Array v) = V.toList v++instance (Show a) => Show (SomeArray a) where+  show r@(SomeArray l _) = go (length l) r+    where+      go n r'@(SomeArray l' v') =+        case length l' of+          0 -> show $ V.head v'+          1 -> "[" ++ intercalate ", " (show <$> GHC.Exts.toList v') ++ "]"+          x ->+            "[" +++            intercalate+              (",\n" ++ replicate (n - x + 1) ' ')+              (go n <$> flatten1 r') +++            "]"++-- | convert the top layer of a SomeArray to a [SomeArray]+flatten1 :: SomeArray a -> [SomeArray a]+flatten1 (SomeArray rep v) =+  (\s -> SomeArray (drop 1 rep) (V.unsafeSlice (s * l) l v)) <$> ss+  where+    (n, l) =+      case rep of+        [] -> (0, 1)+        x:r -> (x, product r)+    ss = take n [0 ..]++instance (Show a, SingI r) => Show (Array (r :: [Nat]) a) where+  show = show . someArray++-- ** Operations+-- | outer product+--+-- todo: reconcile with numhask version+--+-- >>> v >< v+-- [[1, 2, 3],+--  [2, 4, 6],+--  [3, 6, 9]]+(><) ::+     forall (r :: [Nat]) (s :: [Nat]) a.+     (CRing a, SingI r, SingI s, SingI (r :++ s))+  => Array r a+  -> Array s a+  -> Array (r :++ s) a+(><) m n = tabulate (\i -> index m (take dimm i) * index n (drop dimm i))+  where+    dimm = length (shape m)++-- | matrix multiplication for a '2-Array'+--+-- >>> let a = [1, 2, 3, 4] :: Array '[2, 2] Int+-- >>> let b = [5, 6, 7, 8] :: Array '[2, 2] Int+-- >>> a+-- [[1, 2],+--  [3, 4]]+-- >>> b+-- [[5, 6],+--  [7, 8]]+-- >>> mmult a b+-- [[19, 22],+--  [43, 50]]+mmult ::+     forall m n k a.+     (Semiring a, Num a, CRing a, KnownNat m, KnownNat n, KnownNat k)+  => Array '[ m, k] a+  -> Array '[ k, n] a+  -> Array '[ m, n] a+mmult x y = tabulate (\[i, j] -> unsafeRow i x <.> unsafeCol j y)++-- | extract the row of a matrix+row ::+     forall i a m n. (KnownNat m, KnownNat n, KnownNat i, (i :< m) ~ 'True)+  => Proxy i+  -> Array '[ m, n] a+  -> Array '[ n] a+row i_ = unsafeRow i+  where+    i = (fromIntegral . fromSing . singByProxy) i_++unsafeRow ::+     forall a m n. (KnownNat m, KnownNat n)+  => Int+  -> Array '[ m, n] a+  -> Array '[ n] a+unsafeRow i t@(Array a) = Array $ V.unsafeSlice (i * n) n a+  where+    [_, n] = shape t++-- | extract the column of a matrix+col ::+     forall j a m n. (KnownNat m, KnownNat n, KnownNat j, (j :< n) ~ 'True)+  => Proxy j+  -> Array '[ m, n] a+  -> Array '[ m] a+col j_ = unsafeCol j+  where+    j = (fromIntegral . fromSing . singByProxy) j_++unsafeCol ::+     forall a m n. (KnownNat m, KnownNat n)+  => Int+  -> Array '[ m, n] a+  -> Array '[ m] a+unsafeCol j t@(Array a) = Array $ V.generate m (\x -> a V.! (j + x * n))+  where+    [m, n] = shape t++-- |+--+-- >>> unsafeIndex a [0,2,1]+-- 10+unsafeIndex :: SingI r => Array r a -> [Int] -> a+unsafeIndex t@(Array a) i = a V.! ind (shape t) i++-- |+--+-- >>> unsafeSlice [[0,1],[2],[1,2]] a :: Array '[2,1,2] Int+-- [[[10, 11]],+--  [[22, 23]]]+unsafeSlice :: (SingI r) => [[Int]] -> Array r a -> Array r0 a+unsafeSlice s t = Array (V.fromList [unsafeIndex t i | i <- sequence s])++-- | Slice xs = Map Length xs+type family Slice (xss :: [[Nat]]) :: [Nat] where+  Slice xss = Map LengthSym0 xss++-- | AllLT xs n = All (n >) xs+data AllLTSym0 (a :: TyFun [Nat] (TyFun Nat Bool -> Type))++data AllLTSym1 (l :: [Nat]) (a :: TyFun Nat Bool)++type instance Apply AllLTSym0 l = AllLTSym1 l++type instance Apply (AllLTSym1 l) n = All ((:>$$) n) l++-- |+--+-- >>> slice (Proxy :: Proxy '[ '[0,1],'[2],'[1,2]]) a+-- [[[10, 11]],+--  [[22, 23]]]+slice ::+     forall s r a. (SingI s, SingI r, And (ZipWith AllLTSym0 s r) ~ 'True)+  => Proxy s+  -> Array r a+  -> Array (Slice s) a+slice s_ = unsafeSlice s+  where+    s = ((fmap . fmap) fromInteger . fromSing . singByProxy) s_++-- Chunks a vector v into a list of modules whose dimension is each i+chunkItUp :: [V.Vector a] -> Int -> V.Vector a -> [V.Vector a]+chunkItUp acc i v =+  if null v+    then acc+    else let (c, r) = V.splitAt i v+         in chunkItUp (c : acc) i r++zipWith :: (a -> a -> a) -> Array s a -> Array s a -> Array s a+zipWith fn (Array a) (Array b) = Array $ V.zipWith fn a b++-- |+--+-- >>> foldAlong (Proxy :: Proxy 1) (\_ -> ([0..3] :: Array '[4] Int)) a+-- [[0, 1, 2, 3],+--  [0, 1, 2, 3]]+foldAlong ::+     forall s vw uvw uw w a.+     ( SingI s+     , SingI uvw+     , uw ~ (Fold s uvw)+     , w ~ (Drop 1 vw)+     , vw ~ (TailModule s uvw)+     )+  => Proxy s+  -> (Array vw a -> Array w a)+  -> Array uvw a+  -> Array uw a+foldAlong s_ f a@(Array v) =+  Array $+  V.concat+    (foldl'+       (\xs x ->+          let (Array vx) = f (Array x)+          in vx : xs)+       []+       md)+  where+    s = (fromInteger . fromSing . singByProxy) s_+    md = chunkItUp [] (product $ drop s $ shape a) v++-- |+--+-- >>> mapAlong (Proxy :: Proxy 0) (\x -> NumHask.Array.zipWith (*) x x) a+-- [[[1, 4, 9, 16],+--   [25, 36, 49, 64],+--   [81, 100, 121, 144]],+--  [[169, 196, 225, 256],+--   [289, 324, 361, 400],+--   [441, 484, 529, 576]]]+mapAlong ::+     forall s uvw vw a. (SingI s, SingI uvw, vw ~ (HeadModule s uvw))+  => Proxy s+  -> (Array vw a -> Array vw a)+  -> Array uvw a+  -> Array uvw a+mapAlong s_ f a@(Array v) =+  Array $+  V.concat+    (foldl'+       (\xs x ->+          let (Array vx) = f (Array x)+          in vx : xs)+       []+       md)+  where+    s = (fromInteger . fromSing . singByProxy) s_+    md = chunkItUp [] (product $ drop s $ shape a) v++-- |+--+-- >>> concatenate (Proxy :: Proxy 2) a a+-- [[[1, 2, 3, 4, 1, 2, 3, 4],+--   [5, 6, 7, 8, 5, 6, 7, 8],+--   [9, 10, 11, 12, 9, 10, 11, 12]],+--  [[13, 14, 15, 16, 13, 14, 15, 16],+--   [17, 18, 19, 20, 17, 18, 19, 20],+--   [21, 22, 23, 24, 21, 22, 23, 24]]]+concatenate ::+     forall s r t a. (SingI s, SingI r, SingI t, (IsValidConcat s t r) ~ 'True)+  => Proxy s+  -> Array r a+  -> Array t a+  -> Array (Concatenate s t r) a+concatenate s_ r@(Array vr) t@(Array vt) =+  Array . V.concat $ (concat . reverse . P.transpose) [rm, tm]+  where+    s = (fromInteger . fromSing . singByProxy) s_+    rm = chunkItUp [] (product $ drop s $ shape t) vt+    tm = chunkItUp [] (product $ drop s $ shape r) vr++-- |+--+-- >>> NumHask.Array.transpose 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]]]+transpose ::+     forall s t a. (t ~ Transpose s)+  => Array s a+  -> Array t a+transpose (Array x) = Array x++-- |+--+-- >>> 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 ::+     forall s t a. (t ~ Squeeze s)+  => Array s a+  -> Array t a+squeeze (Array x) = Array x++instance (SingI r, AdditiveMagma a) => AdditiveMagma (Array r a) where+  plus = liftR2 plus++instance (SingI r, AdditiveUnital a) => AdditiveUnital (Array r a) where+  zero = pureRep zero++instance (SingI r, AdditiveAssociative a) =>+         AdditiveAssociative (Array r a)++instance (SingI r, AdditiveCommutative a) =>+         AdditiveCommutative (Array r a)++instance (SingI r, AdditiveInvertible a) => AdditiveInvertible (Array r a) where+  negate = fmapRep negate++instance (SingI r, Additive a) => Additive (Array r a)++instance (SingI r, AdditiveGroup a) => AdditiveGroup (Array r a)++instance (SingI r, MultiplicativeMagma a) =>+         MultiplicativeMagma (Array r a) where+  times = liftR2 times++instance (SingI r, MultiplicativeUnital a) =>+         MultiplicativeUnital (Array r a) where+  one = pureRep one++instance (SingI r, MultiplicativeAssociative a) =>+         MultiplicativeAssociative (Array r a)++instance (SingI r, MultiplicativeCommutative a) =>+         MultiplicativeCommutative (Array r a)++instance (SingI r, MultiplicativeInvertible a) =>+         MultiplicativeInvertible (Array r a) where+  recip = fmapRep recip++instance (SingI r, Multiplicative a) => Multiplicative (Array r a)++instance (SingI r, MultiplicativeGroup a) =>+         MultiplicativeGroup (Array r a)++instance (SingI r, MultiplicativeMagma a, Additive a) =>+         Distribution (Array r a)++instance (SingI r, Semiring a) => Semiring (Array r a)++instance (SingI r, Ring a) => Ring (Array r a)++instance (SingI r, CRing a) => CRing (Array r a)++instance (SingI r, Field a) => Field (Array r a)++instance (SingI r, ExpField a) => ExpField (Array r a) where+  exp = fmapRep exp+  log = fmapRep log++instance (SingI r, BoundedField a) => BoundedField (Array r a) where+  isNaN f = or (fmapRep isNaN f)++instance (SingI r, Signed a) => Signed (Array r a) where+  sign = fmapRep sign+  abs = fmapRep abs++instance (ExpField a) => Normed (Array r a) a where+  size r = sqrt $ foldr (+) zero $ (** (one + one)) <$> r++instance (SingI r, Epsilon a) => Epsilon (Array r a) where+  nearZero f = and (fmapRep nearZero f)+  aboutEqual a b = and (liftR2 aboutEqual a b)++instance (SingI r, ExpField a) => Metric (Array r a) a where+  distance a b = size (a - b)++instance (SingI r, Integral a) => Integral (Array r a) where+  divMod a b = (d, m)+    where+      x = liftR2 divMod a b+      d = fmap fst x+      m = fmap snd x++instance (CRing a, Num a, Semiring a, SingI r) => Hilbert (Array r) a where+  a <.> b = sum $ liftR2 (*) a b
+ src/NumHask/Array/Constraints.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module NumHask.Array.Constraints+  ( IsValidConcat+  , Squeeze+  , Concatenate+  , IsValidTranspose+  , DimShuffle+  , dimShuffle+  , Fold+  , FoldAlong+  , TailModule+  , HeadModule+  , Transpose+  ) where++import Data.Singletons.Prelude hiding (Max)+import Data.Singletons.Prelude.List+       ((:!!$), Drop, Filter, Head, Insert,+        Length, Minimum, SplitAt, Sum, Take, ZipWith,)+import Data.Singletons.Prelude.Tuple (Fst, Snd)+import Data.Singletons.TH (promote)+import Data.Singletons.TypeLits (Nat)+import qualified Protolude as P++instance P.Eq Nat where+  x == y = P.not (x P./= y)+  x /= y = P.not (x P.== y)++instance P.Ord Nat where+  x > y = P.not (x P./= y) P.&& P.not (x P.< y)+  x < y = P.not (x P./= y) P.&& P.not (x P.> y)+  x <= y = (x P.== y) P.|| P.not (x P.> y)+  x >= y = (x P.== y) P.|| P.not (x P.< y)++(!!) :: [a] -> Nat -> a+[] !! _ = P.error "Data.Singletons.List.!!: index too large"+(x:xs) !! n =+  if n P.== 0+    then x+    else xs !! (n P.- 1)++type family DropDim d a :: [b] where+  DropDim 0 xs = Drop 1 xs+  DropDim d xs = Take (d :- 1) (Fst (SplitAt d xs)) :++ Snd (SplitAt d xs)++type family IsValidConcat i (a :: [Nat]) (b :: [Nat]) :: P.Bool where+  IsValidConcat _ '[] _ = 'P.False+  IsValidConcat _ _ '[] = 'P.False+  IsValidConcat i a b = And (ZipWith (:==$) (DropDim i a) (DropDim i b))++type family Squeeze (a :: [Nat]) where+  Squeeze '[] = '[]+  Squeeze a = Filter ((:/=$$) 1) a++type family IsValidTranspose (p :: [Nat]) (a :: [Nat]) :: P.Bool where+  IsValidTranspose p a =+    (Minimum p :>= 0) :&& (Minimum a :>= 0) :&& (Sum a :== Sum p) :&& Length p :== Length a++type family Transpose a where+  Transpose a = Reverse a++type family AddDimension (d :: Nat) t :: [Nat] where+  AddDimension d t = Insert d t++type family Concatenate i (a :: [Nat]) (b :: [Nat]) :: [Nat] where+  Concatenate i a b =+    Take i (Fst (SplitAt (i :+ 1) a)) :+++    ('[ Head (Drop i a) :+ Head (Drop i b)]) :+++    Snd (SplitAt (i :+ 1) b)++-- | Reduces axis i in shape s.  Maintains singlton dimension+type family FoldAlong i (s :: [Nat]) where+  FoldAlong _ '[] = '[]+  FoldAlong d xs = Take d (Fst (SplitAt (d :+ 1) xs)) :++ '[ 1] :++ Snd (SplitAt (d :+ 1) xs)++-- | Reduces axis i in shape s. Does not maintain singlton dimension.+type family Fold i (s :: [Nat]) where+  Fold _ '[] = '[]+  Fold d xs = Take d (Fst (SplitAt (d :+ 1) xs)) :++ Snd (SplitAt (d :+ 1) xs)++type family TailModule i (s :: [Nat]) where+  TailModule _ '[] = '[]+  TailModule d xs = (Snd (SplitAt d xs))++type family HeadModule i (s :: [Nat]) where+  HeadModule _ '[] = '[]+  HeadModule d xs = (Fst (SplitAt d xs))++$(promote+    [d|+  dimShuffle :: P.Eq a => [a] -> [Nat] -> [a]+  dimShuffle _ [] = []+  dimShuffle [] _ = []+  dimShuffle (x : xs) (b : bs)+    = if b P.== 0 then x : dimShuffle xs bs else+        (xs !! (b P.- 1)) : dimShuffle xs bs+  |])
+ src/NumHask/Array/Example.hs view
@@ -0,0 +1,253 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}++-- | Experimental api following https://pechersky.github.io/haskell-numpy-docs/quickstart.basics.html+module NumHask.Array.Example+ (+    -- * The Basics+    -- $setup++    -- ** An Example+    -- $anExample++    -- ** Array Creation+    -- $arrayCreation++    -- ** Printing Arrays+    -- $printingArrays++    -- ** Universal Functions+    -- $universalFunctions++    -- ** Indexing, Slicing and Iterating+    -- $indexingSlicingIterating++    -- * Shape Manipulation+    -- $shapeManipulation++    -- * Fancy indexing and index tricks+    -- $fancyIndexing++    -- * Linear Algebra+    -- $linearAlgebra++    -- * Tricks and Tips+    -- $tricksTips+    +  ) where++import NumHask.Array as A+import NumHask.Prelude as P++-- $setup+-- >>> :set -XDataKinds+-- >>> :set -XOverloadedLists+-- >>> :set -XNoImplicitPrelude+-- >>> :set -XFlexibleContexts+-- >>> import NumHask.Array as A+-- >>> import GHC.Exts (fromList)+-- >>> -- import NumHask.Space hiding (singleton)+-- >>> -- import NumHask.Range+-- >>> import qualified Data.Vector as V++-- $anExample+-- construction can be lazy; and zero pads+--+-- >>> let z = [] :: Array '[2] Int+-- >>> z+-- [0, 0]+-- >>> let a = [0..] :: Array '[3,5] Int+-- >>> a+-- [[0, 1, 2, 3, 4],+--  [5, 6, 7, 8, 9],+--  [10, 11, 12, 13, 14]]+-- >>> shape a+-- [3,5]+-- >>> length (shape a) -- dimension+-- 2+-- >>> :t a+-- a :: Array '[3, 5] Int+-- >>> import qualified Data.Vector as V+-- >>> let v = V.fromList [6,7,8]+-- >>> :t v+-- v :: Num a => V.Vector a+-- >>> let b = Array v+-- >>> :t b+-- b :: Num a => Array r a+-- >>> b :: Array '[3] Int+-- [6, 7, 8]++-- $arrayCreation+--+-- >>> -- fixed size arrays are fully shape specified at the type level+-- >>> let a = [2, 3, 4] :: Array '[3] Int+-- >>> a+-- [2, 3, 4]+-- >>> [1.2, 3.5, 5.1] :: Array '[3] Double+-- [1.2, 3.5, 5.1]+--+-- >>> -- lists of lists is not a thing, and need to be flattened+-- >>> let ls = [[1.0,2.0,3.0],[4.0,5.0,6.0]] :: [[Double]]+-- >>> fromList (concat ls) :: Array '[2,3] Double+-- [[1.0, 2.0, 3.0],+--  [4.0, 5.0, 6.0]]+--+-- >>> fromList ((\x -> (fromIntegral x) :+ zero) <$> [1,2,3,4]) :: Array '[2,2] (Complex Double)+-- [[1.0 :+ 0.0, 2.0 :+ 0.0],+--  [3.0 :+ 0.0, 4.0 :+ 0.0]]+-- >>> let z = [] :: Array '[3,4] Int+-- >>> z+-- [[0, 0, 0, 0],+--  [0, 0, 0, 0],+--  [0, 0, 0, 0]]+-- >>> let o = singleton one :: Array '[2,3,4] Int+-- >>> o+-- [[[1, 1, 1, 1],+--   [1, 1, 1, 1],+--   [1, 1, 1, 1]],+--  [[1, 1, 1, 1],+--   [1, 1, 1, 1],+--   [1, 1, 1, 1]]]+-- >>> let empt = singleton nan :: Array '[2,3] Double+-- >>> empt+-- [[NaN, NaN, NaN],+--  [NaN, NaN, NaN]]+--+-- >>>  [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]+--+-- > todo: fix NumHask.Range grid+-- > fromList (grid OuterPos (Range 0 2) 8) :: Array '[9] Double+-- > [0.0, 0.25, 0.5, 0.75, 1.0, 1.25, 1.5, 1.75, 2.0]+-- > let x = fromList (grid OuterPos (Range 0 (2*pi)) 100) :: Array '[101] Double+-- > let f = fmap sin x+--++-- $printingArrays+-- >>> show ([0..] :: Array '[6] Int) :: Text+-- "[0, 1, 2, 3, 4, 5]"+-- >>> [0..] :: Array '[2,3] Int+-- [[0, 1, 2],+--  [3, 4, 5]]+-- >>> [0..] :: Array '[1,2,3,1] Int+-- [[[[0],+--    [1],+--    [2]],+--   [[3],+--    [4],+--    [5]]]]+--+-- > todo: implement display+-- > import Formatting+-- > display (left 7 . fixed 2) ", " (fromList $ fromIntegral <$> [0..] :: Array '[100,100] Double)+-- > [[   0.00,    1.00,    2.00 ..   98.00   99.00],+-- >  [ 100.00,  101.00,  102.00 ..  198.00  199.00],+-- >  [ 200.00,  201.00,  202.00 ..  298.00  299.00],+-- >  ..+-- >  [9800.00, 9801.00, 9802.00 .. 9898.00 9899.00],+-- >  [9900.00, 9901.00, 9902.00 .. 9998.00 9999.00]]+--++-- $basicOperation+--+-- >>> let a = [20,30,40,50] :: Array '[4] Double+-- >>> let b = [0..] :: Array '[4] Double+-- >>> let c = a - b+-- >>> c+-- [20.0, 29.0, 38.0, 47.0]+-- >>> -- todo: resolve potential to polymorph number literals eg b**2+-- >>> b ** (one+one)+-- [0.0, 1.0, 4.0, 9.000000000000002]+-- >>> 10 *. sin <$> a+-- [9.129452507276277, -9.880316240928618, 7.451131604793488, -2.6237485370392877]+-- >>> (<35) <$> a+-- [True, True, False, False]+--+-- >>> let a = [0..] :: Array '[2,3] Int+-- >>> let b = [0..] :: Array '[3,2] Int+-- >>> a .*. a+-- [[0, 1, 4],+--  [9, 16, 25]]+-- >>> -- todo: resolve NumHask.Array and NumHask.Matrix operation names+-- >>> a `NumHask.Array.mmult` b+-- [[10, 13],+--  [28, 40]]+-- >>> a .* 2+-- [[0, 2, 4],+--  [6, 8, 10]]+--+-- >>> -- random example skipped+--+-- > -- todo: awaiting grid fix+-- > let a = singleton one :: Array '[3] Double+-- > let b = fromList (grid OuterPos (Range 0 pi) 2) :: Array '[3] Double+-- > let c = a + b+-- > let d = exp . ((zero:+one) *.) $ (:+zero) <$> c+-- > d+-- [0.5403023058681398 :+ 0.8414709848078965, (-0.8414709848078965) :+ 0.5403023058681398, (-0.5403023058681399) :+ (-0.8414709848078964)]+-- > :t d+-- d :: Array '[3] (Complex Double)+--+-- >>> -- folding+-- >>> let a = [0..] :: Array '[2,5] Int+-- >>> sum a+-- 45+-- >>> minimum a+-- 0+-- >>> maximum a+-- 9+-- >>> -- todo: scanAlong+--++-- $universalFunctions+--+-- >>> let a = [0..] :: Array '[3] Double+-- >>> exp <$> a+-- [1.0, 2.718281828459045, 7.38905609893065]+-- >>> sqrt <$> a+-- [0.0, 1.0, 1.4142135623730951]+--++-- $indexingSlicingIterating+--+-- >>> let a = (\x -> x*x*x) <$> [0..] :: Array '[10] Int+-- >>> index a [2]+-- 8+-- >>> let s = (\i -> index a [i]) <$> [2..5] :: Array '[4] Int+-- >>> s+-- [8, 27, 64, 125]+-- >>> :t s+-- s :: Array '[4] Int+-- >>> -- replace every second number with -1000+-- >>> let a' = (tabulate (\[i] -> if i `mod` 2 == 0 then -1000 else (index a [i]))) :: Array '[10] Int+-- >>> a'+-- [-1000, 1, -1000, 27, -1000, 125, -1000, 343, -1000, 729]+--+-- > -- todo: reverse fix+-- > let a'' = (let (n:_) = shape a in tabulate (\[i] -> index a [n-i])) :: Array '[4] Int+-- > a''+-- > [729, -1000, 343, -1000, 125, -1000, 27, -1000, 1, -1000]+--+-- > -- todo: slicing api++-- $shapeManipulation+--+-- > -- todo:++-- $fancyIndexing+--+-- > -- todo:++-- $linearAlgebra+--+-- > -- todo:++-- $tricksTips+--+-- > -- todo:+
+ stack.yaml view
@@ -0,0 +1,8 @@+resolver: lts-9.3++packages:+  - '.'++extra-deps:+  - numhask-0.1.2+
+ test/test.hs view
@@ -0,0 +1,13 @@+{-# OPTIONS_GHC -Wall #-}++module Main where++import NumHask.Prelude+import Test.DocTest++main :: IO ()+main = do+  putStrLn ("Array DocTest" :: Text)+  doctest ["src/NumHask/Array.hs"]+  putStrLn ("Example DocTest" :: Text)+  doctest ["src/NumHask/Array/Example.hs"]