easytensor 0.1.0.0 → 0.2.0.0

raw patch · 51 files changed

+6862/−2695 lines, 51 filesdep +Cabaldep +QuickCheckdep +dimensionsdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: Cabal, QuickCheck, dimensions, time

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• LICENSE +22/−5
• app/Main.hs +0/−112
• bench/misc.hs +77/−0
• bench/subspacefolds.hs +67/−0
• easytensor.cabal +77/−25
• src/Numeric/Array.hs +33/−0
• src/Numeric/Array/ElementWise.hs +312/−0
• src/Numeric/Array/Family.hs +422/−0
• src/Numeric/Array/Family/Array.h +305/−0
• src/Numeric/Array/Family/ArrayD.hs +408/−0
• src/Numeric/Array/Family/ArrayF.hs +412/−0
• src/Numeric/Array/Family/ArrayI.hs +95/−0
• src/Numeric/Array/Family/ArrayI16.hs +96/−0
• src/Numeric/Array/Family/ArrayI32.hs +96/−0
• src/Numeric/Array/Family/ArrayI64.hs +96/−0
• src/Numeric/Array/Family/ArrayI8.hs +96/−0
• src/Numeric/Array/Family/ArrayW.hs +89/−0
• src/Numeric/Array/Family/ArrayW16.hs +90/−0
• src/Numeric/Array/Family/ArrayW32.hs +90/−0
• src/Numeric/Array/Family/ArrayW64.hs +90/−0
• src/Numeric/Array/Family/ArrayW8.hs +90/−0
• src/Numeric/Array/Family/FloatX2.hs +321/−0
• src/Numeric/Array/Family/FloatX3.hs +294/−0
• src/Numeric/Array/Family/FloatX4.hs +329/−0
• src/Numeric/Commons.hs +141/−138
• src/Numeric/DataFrame.hs +43/−0
• src/Numeric/DataFrame/Contraction.hs +535/−0
• src/Numeric/DataFrame/IO.hs +128/−0
• src/Numeric/DataFrame/Inference.hs +140/−0
• src/Numeric/DataFrame/Mutable.hs +223/−0
• src/Numeric/DataFrame/ST.hs +130/−0
• src/Numeric/DataFrame/Shape.hs +265/−0
• src/Numeric/DataFrame/SubSpace.hs +360/−0
• src/Numeric/DataFrame/Type.hs +270/−0
• src/Numeric/EasyTensor.hs +0/−557
• src/Numeric/Matrix.hs +57/−42
• src/Numeric/Matrix/Base/FloatXNM.hs +0/−565
• src/Numeric/Matrix/Class.hs +0/−265
• src/Numeric/Matrix/Family.hs +0/−29
• src/Numeric/Matrix/Type.hs +49/−0
• src/Numeric/Scalar.hs +35/−0
• src/Numeric/Tensor.hs +0/−290
• src/Numeric/Vector.hs +150/−38
• src/Numeric/Vector/Base/FloatX2.hs +0/−257
• src/Numeric/Vector/Base/FloatXN.hs +0/−268
• src/Numeric/Vector/Class.hs +0/−70
• src/Numeric/Vector/Family.hs +0/−32
• test/Numeric/DataFrame/Arbitraries.hs +140/−0
• test/Numeric/DataFrame/BasicTest.hs +86/−0
• test/Numeric/DataFrame/SubSpaceTest.hs +77/−0
• test/Spec.hs +26/−2

@@ -1,7 +1,24 @@-Copyright (c) 2016 Artem M. Chirkin--Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:+Copyright (c) 2017, Artem M. Chirkin+All rights reserved. -The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.+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 the copyright holder nor the+      names of its contributors may be used to endorse or promote products+      derived from this software without specific prior written permission. -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+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 COPYRIGHT HOLDER 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.

@@ -1,112 +0,0 @@--{-# LANGUAGE DataKinds #-}-module Main where-----import qualified Numeric.Tensor as T-import Numeric.Commons--- import Numeric.Vector ((<:>))--- import qualified Numeric.Vector as V--- import qualified Numeric.Matrix as M-import Numeric.EasyTensor--import Foreign.Storable-import Foreign.Ptr-import Foreign.Marshal---main :: IO ()-main = do-  putStrLn "Hello world!"-  print (two + vec2 3 4)-  print (two + vec2 3 4 + 5)-  print (two <:> two == two <:> x)-  print (two <:> two == two <:> two)-  print (two <:> x)-  print x-  print (x < two)-  print (fromBytes (toBytes x) + two / 7 + 5)-  print ((x <:> two * 3 <:> two) / 4.2 <:> x)-  putStrLn "Done pure!"-  ptr <- mallocArray 3-  poke ptr x-  pokeElemOff ptr 1 5-  pokeByteOff ptr 16 two-  peek ptr >>= print-  peekByteOff ptr 8 >>= (print :: Vec2f -> IO ())-  peek (plusPtr ptr 8 :: Ptr Vec2f) >>= print-  peekElemOff ptr 2 >>= print-  peek (plusPtr ptr 16 :: Ptr Vec2f) >>= print-  peekByteOff ptr 0 >>= (print :: Vec Float 6 -> IO ())-  peekByteOff ptr 4 >>= (print :: Vec Float 3 -> IO ())-  putStrLn "Done IO!"---  putStrLn "Matrices..."-  print $ index 1 2 m1-  print m1-  putStrLn (show (index 1 1 m1) ++ " " ++ show (index 1 2 m1) )-  putStrLn (show (index 2 1 m1) ++ " " ++ show (index 2 2 m1) )-  print (indexCol 1 m1)-  print (indexCol 2 m1)-  print (indexRow 1 m1)-  print (indexRow 2 m1)-  print (indexRow 3 m1)---  print (M.indexMat 2 4 m1)---  print (M.indexCol 4 m1 :: V.Vec2f)--  putStrLn "Matrix products"-  print y2--  putStrLn "EasyTensor"---  print a---  print b---  print c---  print d---  print (a %* c)-  print (two <:> x <:> 7 / x)-  print m32-  print m33---  print x3---  print v3---  print (v3 // 4)---  print (10 \\ 4 :: Tensor Double 1 1)---  print $ a %* c---  print $ transpose x3 %* m32-  putStrLn "m33"-  print m33-  putStrLn "determinants"-  print (2 * eye :: Tensor Float 5 5)-  print $ det (2 * eye :: Tensor Float 5 5)-  print m33-  print $ det m33-  print $ two <:> x-  print $ det (two <:> x)-  print (x3 <:> (m33 %* x3) <:> (m33 %* x3))-  print $ det (x3 <:> (m33 %* x3) <:> (m33 %* x3))-  putStrLn "Inverse"-  print m33-  print (inverse m33)-  print $ inverse m33 %* m33-  print $ m33 %* inverse m33-  print (2 * eye :: Tensor Float 5 5)-  print $ inverse (2 * eye :: Tensor Float 5 5)-  print $ (2 * eye :: Tensor Float 5 5) * inverse (2 * eye :: Tensor Float 5 5)-  print (x3 <:> v3 <:> v3)-  print $ inverse (x3 <:> v3 <:> v3)-  print $ (x3 <:> v3 <:> v3) %* inverse (x3 <:> v3 <:> v3)-  where-    two = vec2 2 2.001 :: Vec2f-    x = two / vec2 3.2 (-2)-    m1 = fromBytes (toBytes (two <:> x <:> 7 / x)) :: Mat Float 3 2-    m32 = m1-    x2 = 7 :: Vec2f-    x3 = 9 :: Vec3f-    y2 = m32 %* x2-    m33 = m32 <:> 17-    v3 = m33 %* x3----    a = 1 :: Tensor Float 2 2---    b = 3 :: Tensor Float 1 1---    c = 4 :: Tensor Float 2 1---    d = 5 :: Tensor Float 1 2

@@ -0,0 +1,77 @@+{-# LANGUAGE DataKinds        #-}+{-# LANGUAGE GADTs            #-}+{-# LANGUAGE KindSignatures   #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators    #-}++module Main (main) where++import           Numeric.DataFrame+import           Numeric.Dimensions++++main :: IO ()+main = do+    putStrLn "Hello world!"+    print (Dn @3 :* Dn @2 :* (D :: Dim ('[] :: [Nat])))++    print (fromList [vec2 1 0, vec2 2 3, vec2 3 4, vec2 5 6] :: DataFrame Int '[N 2, XN 2])+    print (fromList [vec4 1 0 2 11, vec4 2 22 3 0, vec4 3 4 0 0] :: DataFrame Double '[N 4, XN 2])+    print (fromList [vec2 0 0, vec2 2 22, vec2 2 22] :: DataFrame Float '[N 2, XN 2])+    print (fromList [0, 1, 3, 5, 7] :: DataFrame Float '[XN 2])+    print (fromList [9, 13, 2] :: DataFrame Float '[N 5, N 2, XN 2])+    print $ vec2 1 1 %* mat22 (vec2 1 1) (vec2 2 (3 :: Float))+    print (toList (42 :: DataFrame Int '[4,3,2]))+    -- Seems like I have to specify known dimension explicitly,+    -- because the inference process within the pattern match+    -- cannot escape the case expression.+    -- On the other hand, if I type wrong dimension it will throw a nice type-level error.+    () <- case fromList [10, 100, 1000] :: DataFrame Double '[N 4, N 2, XN 2] of+                    -- Amazing inference!+                    -- m :: KnownNat k => DataFrame '[4,2,k]+        SomeDataFrame m -> print $ vec4 1 2.25 3 0.162 %* m+    putStrLn "Constructing larger matrices"+    let x :: DataFrame Double '[2,5,4]+        x =   transpose ( (56707.4   <::> 73558.41  <+:> 47950.074  <+:> 83394.61  <+:> 25611.629 )+                     <::> (53704.516 <::> -3277.478 <+:> 99479.92   <+:> 18915.17  <+:> 59666.938 ) )+         <::> transpose ( (-3035.543 <::> 15831.447 <+:> 73256.625  <+:> 80709.38  <+:> 72695.04  )+                     <::> (50932.49  <::> 7865.496  <+:> -4050.5957 <+:> 99839.41  <+:> 10834.297 ) )+         <+:> transpose ( (21961.227 <::> 29640.914 <+:> 39657.19   <+:> 81469.64  <+:> 17815.506 )+                     <::> (-8484.239 <::> 16877.531 <+:> 65145.742  <+:> 80219.67  <+:> 81508.87  ) )+         <+:> transpose ( (53105.71  <::> 16255.646 <+:> 23324.957  <+:> -4438.164 <+:> 35369.824 )+                     <::> (67930.45  <::> 8950.834  <+:> 64451.71   <+:> 76685.57  <+:> 6728.465  ) )+        y :: DataFrame Double '[3,7]+        y = transpose $+               (70096.85  <::> 34332.492 <+:> 3642.8867 <+:> 25242.25  <+:> 59776.234 <+:> 12092.57 <+:> 10708.498)+          <::> (46447.965 <::> 37145.668 <+:> 56899.656 <+:> 85367.56  <+:> 15872.262 <+:> 87466.24 <+:> 82506.76 )+          <+:> (50458.848 <::> 31650.453 <+:> 71432.78  <+:> 53073.203 <+:> 59267.883 <+:> 82369.89 <+:> 78171.56 )+        z = ewgen x :: DataFrame Double '[2,5,4,3,7]+    print $ ewfoldl @_ @'[2] (+) 10 z+    print $ ewfoldr @_ @'[2,5] (+) 0 z + 10+    print $ ewfoldl (+) 10 z - ewfoldr @_ @'[2,5,4] (+) 0 z - 10++    -- We can map arbitrary prefix dimension over the dataframe,+    -- indexing by suffix dimensions.+    -- At the same time, we can transform underlying element type+    --  or prefix dimensionality.+    -- For example, we can do tensor produt of every sub-tensor.+    putStrLn "\nConversions between element types and frame sizes."+    print $ iwmap @Int @'[2,2] @'[7] @_+                  (\(i:!Z) v -> fromScalar . (scalar i +) . round+                                     $ vec3 0.02 (-0.01) 0.001 %* v+                  ) y++    -- Using elementWise function we can apply arbitrary applicative functors+    -- over subtensors.+    -- This means we can even do arbitrary IO for each subtensor+    -- indexed by suffix dimensions.+    putStrLn "\nWelement-wise IO!"+    rVec <- elementWise @Double @_ @'[4] @_+              (\v -> print v >> return (sqrt . trace $ v %* transpose v)) x+    putStrLn "\nTraces for each matrix element:"+    print rVec++    -- Updating existing frames+    print $ update (2:!Z) (scalar 777) rVec+    print $ update (2:!3:!Z) (vec2 999 999) x

@@ -0,0 +1,67 @@+{-# LANGUAGE DataKinds        #-}+{-# LANGUAGE GADTs            #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators    #-}++module Main (main) where++import           Data.Maybe (fromMaybe)+import           Data.Time.Clock++import           Numeric.DataFrame+import           Numeric.Dimensions+++type DList = [6,8,10,7,35,8,12] -- [6,26,8,10,35,8,12]++main :: IO ()+main = do+    t0 <- getCurrentTime+    putStrLn $ "\nStarting benchmarks, current time is " ++ show t0+    let df = iwgen @Float @'[] @DList (fromIntegral . fromEnum)+    t1 <- df `seq` getCurrentTime+    seq t1 putStrLn $ "Created DataFrame, elapsed time is " ++ show (diffUTCTime t1 t0)++    putStrLn "\nRunning a ewfoldl on scalar elements..."+    let rezEwf = ewfoldl @Float @'[] @DList (\a x -> let z = fromMaybe x a + fromMaybe 0 a / (x+1) in z `seq` return z) (Just 1)  df+    t2 <- rezEwf `seq` getCurrentTime+    print rezEwf+    seq t2 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t2 t1)++    putStrLn "\nRunning a iwfoldl on scalar elements (not using idx)..."+    let rezIwf = iwfoldl @Float @'[] @DList (\_ a x -> a +  a / (x+1)) 1 df+    t3 <- rezIwf `seq` getCurrentTime+    print rezIwf+    seq t3 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t3 t2)++    putStrLn "\nRunning a iwfoldr on scalar elements (using fromEnum idx)..."+    let rezIwf2 = iwfoldr @Float @'[] @DList (\i x a -> let z = fromMaybe 0 a + x / ((1+) . fromIntegral $ fromEnum i) in z `seq` return z) (Just 0) df+    t4 <- rezIwf2 `seq` getCurrentTime+    print rezIwf2+    seq t4 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t4 t3)++    putStrLn "\nRunning a iwfoldl on scalar elements (enforcing idx)..."+    let rezIwf3 = iwfoldl @Float @'[] @DList (\i a x -> i `seq` let z = fromMaybe 0 a + fromMaybe x a / (x+1) in z `seq` return z) (Just 1) df+    t5 <- rezIwf3 `seq` getCurrentTime+    print rezIwf3+    seq t5 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t5 t4)++    putStrLn "\nRunning a ewfoldl on vector5 elements..."+    let rezEwv1 = ewfoldl @Float @'[Head DList] @(Tail DList)+                          (\a x -> return $! fromMaybe 2 a + fromMaybe 0 a / (1 + iwgen @_ @'[] (\(i:!Z) -> (i+1):!Z !. x )) )+                          (Just (3 :: DataFrame Float '[5])) df+    t6 <- rezEwv1 `seq` getCurrentTime+    print rezEwv1+    seq t6 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t6 t5)++    putStrLn "\nRunning a ewfoldr on vector3 elements..."+    let rezEwv2 = ewfoldr @Float @'[Head DList] @(Tail DList)+                          (\x a -> return $! fromMaybe 2 a + fromMaybe 1 a / (1 + iwgen @_ @'[] (\(i:!Z) -> (i+1):!Z !. x )))+                          (Just (3 :: DataFrame Float '[3])) df+    t7 <- rezEwv2 `seq` getCurrentTime+    print rezEwv2+    seq t7 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t7 t6)+++    putStrLn "Checking indexes"+    print $ 1:!1:!3:!1:!Z !. df

@@ -1,5 +1,5 @@ name: easytensor-version: 0.1.0.0+version: 0.2.0.0 cabal-version: >=1.20 build-type: Simple license: MIT@@ -13,60 +13,112 @@     Features dimensionality type-checking for all operations.     Generic n-dimensional versions are implemented using low-level prim ops.     Allows ad-hoc replacement with fixed low-dimensionality vectors and matrices without changing user interface.-    Please see README.md category: Math, Geometry author: Artem Chirkin+extra-source-files:+    src/Numeric/Array/Family/Array.h  source-repository head     type: git     location: https://github.com/achirkin/easytensor.git+    subdir: easytensor + flag unsafeindices     description:         Disable bound checks when accessing elements of a tensor/matrix/vector.     default: False + library      if flag(unsafeindices)         cpp-options: -DUNSAFE_INDICES     exposed-modules:-        Numeric.EasyTensor-        Numeric.Tensor         Numeric.Commons+        Numeric.DataFrame+        Numeric.DataFrame.IO+        Numeric.DataFrame.ST+        Numeric.Matrix+        Numeric.Vector+        Numeric.Scalar     build-depends:         base >=4.9 && <5,-        ghc-prim >=0.5+        ghc-prim >=0.5,+        dimensions -any     default-language: Haskell2010     hs-source-dirs: src     other-modules:-        Numeric.Matrix-        Numeric.Matrix.Base.FloatXNM-        Numeric.Matrix.Class-        Numeric.Matrix.Family-        Numeric.Vector-        Numeric.Vector.Base.FloatX2-        Numeric.Vector.Base.FloatXN-        Numeric.Vector.Class-        Numeric.Vector.Family-    ghc-options: -Wall -fwarn-tabs+        Numeric.Array.Family.ArrayF+        Numeric.Array.Family.ArrayD+        Numeric.Array.Family.ArrayI+        Numeric.Array.Family.ArrayI8+        Numeric.Array.Family.ArrayI16+        Numeric.Array.Family.ArrayI32+        Numeric.Array.Family.ArrayI64+        Numeric.Array.Family.ArrayW+        Numeric.Array.Family.ArrayW8+        Numeric.Array.Family.ArrayW16+        Numeric.Array.Family.ArrayW32+        Numeric.Array.Family.ArrayW64+        Numeric.Array.Family.FloatX2+        Numeric.Array.Family.FloatX3+        Numeric.Array.Family.FloatX4+        Numeric.Array.Family+        Numeric.Array.ElementWise+        Numeric.Array+        Numeric.DataFrame.SubSpace+        Numeric.DataFrame.Contraction+        Numeric.DataFrame.Mutable+        Numeric.DataFrame.Type+        Numeric.DataFrame.Inference+        Numeric.DataFrame.Shape+        Numeric.Matrix.Type+    ghc-options: -Wall -fwarn-tabs -O2 -executable easytensor-exe-    main-is: Main.hs+test-suite et-test++    type: detailed-0.9+    test-module: Spec+    other-modules:+        Numeric.DataFrame.Arbitraries+        Numeric.DataFrame.SubSpaceTest+        Numeric.DataFrame.BasicTest     build-depends:         base -any,+        Cabal >=1.20,+        QuickCheck -any,         easytensor -any,-        ghc-prim >=0.5+        dimensions -any     default-language: Haskell2010-    hs-source-dirs: app-    ghc-options: -Wall -fwarn-tabs -threaded -rtsopts -with-rtsopts=-N+    hs-source-dirs: test+    ghc-options: -Wall -fwarn-tabs -O2 -test-suite easytensor-test+++benchmark et-bench-misc+     type: exitcode-stdio-1.0-    main-is: Spec.hs+    main-is: misc.hs     build-depends:         base -any,-        easytensor -any+        easytensor -any,+        dimensions -any     default-language: Haskell2010-    hs-source-dirs: test-    ghc-options: -Wall -fwarn-tabs -threaded -rtsopts -with-rtsopts=-N+    hs-source-dirs: bench+    ghc-options: -Wall -fwarn-tabs -O2++++benchmark et-bench-spfolds++    type: exitcode-stdio-1.0+    main-is: subspacefolds.hs+    build-depends:+        base -any,+        easytensor -any,+        dimensions -any,+        time -any+    default-language: Haskell2010+    hs-source-dirs: bench+    ghc-options: -Wall -fwarn-tabs -O2

@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+-- Low-level implementations of data frames+--+-----------------------------------------------------------------------------++module Numeric.Array+  ( module Numeric.Array.Family+  ) where++import           Numeric.Array.Family+import           Numeric.Array.Family.ArrayD    ()+import           Numeric.Array.Family.ArrayF    ()+import           Numeric.Array.Family.ArrayI    ()+import           Numeric.Array.Family.ArrayI8   ()+import           Numeric.Array.Family.ArrayI16  ()+import           Numeric.Array.Family.ArrayI32  ()+import           Numeric.Array.Family.ArrayI64  ()+import           Numeric.Array.Family.ArrayW    ()+import           Numeric.Array.Family.ArrayW8   ()+import           Numeric.Array.Family.ArrayW16  ()+import           Numeric.Array.Family.ArrayW32  ()+import           Numeric.Array.Family.ArrayW64  ()++import           Numeric.Array.Family.FloatX2   ()+import           Numeric.Array.Family.FloatX3   ()+import           Numeric.Array.Family.FloatX4   ()

@@ -0,0 +1,312 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE Rank2Types             #-}+{-# LANGUAGE Strict                #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.ElementWise+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.ElementWise+  ( ElementWise (..)+  ) where++import           Data.Int  (Int16, Int32, Int64, Int8)+import           Data.Word (Word16, Word32, Word64, Word8)++-- | Access elements.+--   i is an index type+--   x is an element+--   t is a container type+class ElementWise i x t | t -> x i where+  -- | Index a container+  (!)   :: t -> i -> x+  -- | map all elements with index+  ewmap :: (i -> x -> x) -> t -> t+  -- | generate data from elements+  ewgen :: (i -> x) -> t+  -- | generate data from elements in applicative functor+  ewgenA :: forall f . Applicative f => (i -> f x) -> f t+  -- | fold all element with index+  ewfoldl :: (i -> a -> x -> a) -> a -> t -> a+  -- | fold all element with index+  ewfoldr :: (i -> x -> a -> a) -> a -> t -> a+  -- | Apply an applicative functor on each element (Lens-like traversal)+  elementWise :: forall f . Applicative f => (x -> f x) -> t -> f t+  -- | Apply an applicative functor on each element with its index+  --     (Lens-like indexed traversal)+  indexWise :: forall f . Applicative f => (i -> x -> f x) -> t -> f t+  -- | Fill a container with a single value+  broadcast :: x -> t+  -- | Update a single element+  update :: i -> x -> t -> t+++instance ElementWise Int Float Float where+  (!) x _ = x+  {-# INLINE (!) #-}+  ewmap f = f 1+  {-# INLINE ewmap #-}+  ewgen f   = f 1+  {-# INLINE ewgen #-}+  ewgenA f  = f 1+  {-# INLINE ewgenA #-}+  ewfoldl f = f 1+  {-# INLINE ewfoldl #-}+  ewfoldr f x0 x = f 1 x x0+  {-# INLINE ewfoldr #-}+  elementWise = id+  {-# INLINE elementWise #-}+  indexWise f = f 1+  {-# INLINE indexWise #-}+  broadcast = id+  {-# INLINE broadcast #-}+  update _ = const+  {-# INLINE update #-}++++instance ElementWise Int Double Double where+  (!) x _ = x+  {-# INLINE (!) #-}+  ewmap f = f 1+  {-# INLINE ewmap #-}+  ewgen f   = f 1+  {-# INLINE ewgen #-}+  ewgenA f  = f 1+  {-# INLINE ewgenA #-}+  ewfoldl f = f 1+  {-# INLINE ewfoldl #-}+  ewfoldr f x0 x = f 1 x x0+  elementWise = id+  {-# INLINE elementWise #-}+  indexWise f = f 1+  {-# INLINE indexWise #-}+  broadcast = id+  {-# INLINE broadcast #-}+  update _ = const+  {-# INLINE update #-}+++instance ElementWise Int Int Int where+  (!) x _ = x+  {-# INLINE (!) #-}+  ewmap f = f 1+  {-# INLINE ewmap #-}+  ewgen f   = f 1+  {-# INLINE ewgen #-}+  ewgenA f  = f 1+  {-# INLINE ewgenA #-}+  ewfoldl f = f 1+  {-# INLINE ewfoldl #-}+  ewfoldr f x0 x = f 1 x x0+  elementWise = id+  {-# INLINE elementWise #-}+  indexWise f = f 1+  {-# INLINE indexWise #-}+  broadcast = id+  {-# INLINE broadcast #-}+  update _ = const+  {-# INLINE update #-}+++instance ElementWise Int Int8 Int8 where+  (!) x _ = x+  {-# INLINE (!) #-}+  ewmap f = f 1+  {-# INLINE ewmap #-}+  ewgen f   = f 1+  {-# INLINE ewgen #-}+  ewgenA f  = f 1+  {-# INLINE ewgenA #-}+  ewfoldl f = f 1+  {-# INLINE ewfoldl #-}+  ewfoldr f x0 x = f 1 x x0+  elementWise = id+  {-# INLINE elementWise #-}+  indexWise f = f 1+  {-# INLINE indexWise #-}+  broadcast = id+  {-# INLINE broadcast #-}+  update _ = const+  {-# INLINE update #-}++instance ElementWise Int Int16 Int16 where+  (!) x _ = x+  {-# INLINE (!) #-}+  ewmap f = f 1+  {-# INLINE ewmap #-}+  ewgen f   = f 1+  {-# INLINE ewgen #-}+  ewgenA f  = f 1+  {-# INLINE ewgenA #-}+  ewfoldl f = f 1+  {-# INLINE ewfoldl #-}+  ewfoldr f x0 x = f 1 x x0+  elementWise = id+  {-# INLINE elementWise #-}+  indexWise f = f 1+  {-# INLINE indexWise #-}+  broadcast = id+  {-# INLINE broadcast #-}+  update _ = const+  {-# INLINE update #-}++instance ElementWise Int Int32 Int32 where+  (!) x _ = x+  {-# INLINE (!) #-}+  ewmap f = f 1+  {-# INLINE ewmap #-}+  ewgen f   = f 1+  {-# INLINE ewgen #-}+  ewgenA f  = f 1+  {-# INLINE ewgenA #-}+  ewfoldl f = f 1+  {-# INLINE ewfoldl #-}+  ewfoldr f x0 x = f 1 x x0+  elementWise = id+  {-# INLINE elementWise #-}+  indexWise f = f 1+  {-# INLINE indexWise #-}+  broadcast = id+  {-# INLINE broadcast #-}+  update _ = const+  {-# INLINE update #-}+++instance ElementWise Int Int64 Int64 where+  (!) x _ = x+  {-# INLINE (!) #-}+  ewmap f = f 1+  {-# INLINE ewmap #-}+  ewgen f   = f 1+  {-# INLINE ewgen #-}+  ewgenA f  = f 1+  {-# INLINE ewgenA #-}+  ewfoldl f = f 1+  {-# INLINE ewfoldl #-}+  ewfoldr f x0 x = f 1 x x0+  elementWise = id+  {-# INLINE elementWise #-}+  indexWise f = f 1+  {-# INLINE indexWise #-}+  broadcast = id+  {-# INLINE broadcast #-}+  update _ = const+  {-# INLINE update #-}+++instance ElementWise Int Word Word where+  (!) x _ = x+  {-# INLINE (!) #-}+  ewmap f = f 1+  {-# INLINE ewmap #-}+  ewgen f   = f 1+  {-# INLINE ewgen #-}+  ewgenA f  = f 1+  {-# INLINE ewgenA #-}+  ewfoldl f = f 1+  {-# INLINE ewfoldl #-}+  ewfoldr f x0 x = f 1 x x0+  elementWise = id+  {-# INLINE elementWise #-}+  indexWise f = f 1+  {-# INLINE indexWise #-}+  broadcast = id+  {-# INLINE broadcast #-}+  update _ = const+  {-# INLINE update #-}+++instance ElementWise Int Word8 Word8 where+  (!) x _ = x+  {-# INLINE (!) #-}+  ewmap f = f 1+  {-# INLINE ewmap #-}+  ewgen f   = f 1+  {-# INLINE ewgen #-}+  ewgenA f  = f 1+  {-# INLINE ewgenA #-}+  ewfoldl f = f 1+  {-# INLINE ewfoldl #-}+  ewfoldr f x0 x = f 1 x x0+  elementWise = id+  {-# INLINE elementWise #-}+  indexWise f = f 1+  {-# INLINE indexWise #-}+  broadcast = id+  {-# INLINE broadcast #-}+  update _ = const+  {-# INLINE update #-}+++instance ElementWise Int Word16 Word16 where+  (!) x _ = x+  {-# INLINE (!) #-}+  ewmap f = f 1+  {-# INLINE ewmap #-}+  ewgen f   = f 1+  {-# INLINE ewgen #-}+  ewgenA f  = f 1+  {-# INLINE ewgenA #-}+  ewfoldl f = f 1+  {-# INLINE ewfoldl #-}+  ewfoldr f x0 x = f 1 x x0+  elementWise = id+  {-# INLINE elementWise #-}+  indexWise f = f 1+  {-# INLINE indexWise #-}+  broadcast = id+  {-# INLINE broadcast #-}+  update _ = const+  {-# INLINE update #-}+++instance ElementWise Int Word32 Word32 where+  (!) x _ = x+  {-# INLINE (!) #-}+  ewmap f = f 1+  {-# INLINE ewmap #-}+  ewgen f   = f 1+  {-# INLINE ewgen #-}+  ewgenA f  = f 1+  {-# INLINE ewgenA #-}+  ewfoldl f = f 1+  {-# INLINE ewfoldl #-}+  ewfoldr f x0 x = f 1 x x0+  elementWise = id+  {-# INLINE elementWise #-}+  indexWise f = f 1+  {-# INLINE indexWise #-}+  broadcast = id+  {-# INLINE broadcast #-}+  update _ = const+  {-# INLINE update #-}+++instance ElementWise Int Word64 Word64 where+  (!) x _ = x+  {-# INLINE (!) #-}+  ewmap f = f 1+  {-# INLINE ewmap #-}+  ewgen f   = f 1+  {-# INLINE ewgen #-}+  ewgenA f  = f 1+  {-# INLINE ewgenA #-}+  ewfoldl f = f 1+  {-# INLINE ewfoldl #-}+  ewfoldr f x0 x = f 1 x x0+  elementWise = id+  {-# INLINE elementWise #-}+  indexWise f = f 1+  {-# INLINE indexWise #-}+  broadcast = id+  {-# INLINE broadcast #-}+  update _ = const+  {-# INLINE update #-}

@@ -0,0 +1,422 @@+{-# LANGUAGE ConstraintKinds            #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE ExistentialQuantification  #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash                  #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeApplications           #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeFamilyDependencies     #-}+{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE UnboxedTuples              #-}+{-# LANGUAGE StandaloneDeriving         #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.Family+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family+  ( Array+  , ArrayF (..), ArrayD (..)+  , ArrayI (..), ArrayI8 (..), ArrayI16 (..), ArrayI32 (..), ArrayI64 (..)+  , ArrayW (..), ArrayW8 (..), ArrayW16 (..), ArrayW32 (..), ArrayW64 (..)+  , Scalar (..)+  , FloatX2 (..), FloatX3 (..), FloatX4 (..)+  , ArrayInstanceInference, ElemType (..), ArraySize (..)+  , ElemTypeInference (..), ArraySizeInference (..), ArrayInstanceEvidence+  , getArrayInstance, ArrayInstance (..), inferArrayInstance+  ) where+++import           Data.Int                  (Int16, Int32, Int64, Int8)+import           Data.Type.Equality        ((:~:) (..))+import           Data.Word                 (Word16, Word32, Word64, Word8)+import           GHC.Prim                  (ByteArray#, Double#, Float#, Int#,+                                            Word#, unsafeCoerce#)++import           Numeric.Array.ElementWise+import           Numeric.Commons+import           Numeric.TypeLits+import           Numeric.Dimensions++-- | Full collection of n-order arrays+type family Array t (ds :: [Nat]) = v | v -> t ds where+  Array t      '[]          = Scalar t+  Array Float  '[2]         = FloatX2+  Array Float  '[3]         = FloatX3+  Array Float  '[4]         = FloatX4+  Array Float  (d ': ds)    = ArrayF   (d ': ds)+  Array Double (d ': ds)    = ArrayD   (d ': ds)+  Array Int    (d ': ds)    = ArrayI   (d ': ds)+  Array Int8   (d ': ds)    = ArrayI8  (d ': ds)+  Array Int16  (d ': ds)    = ArrayI16 (d ': ds)+  Array Int32  (d ': ds)    = ArrayI32 (d ': ds)+  Array Int64  (d ': ds)    = ArrayI64 (d ': ds)+  Array Word   (d ': ds)    = ArrayW   (d ': ds)+  Array Word8  (d ': ds)    = ArrayW8  (d ': ds)+  Array Word16 (d ': ds)    = ArrayW16 (d ': ds)+  Array Word32 (d ': ds)    = ArrayW32 (d ': ds)+  Array Word64 (d ': ds)    = ArrayW64 (d ': ds)+++-- | Specialize scalar type without any arrays+newtype Scalar t = Scalar { _unScalar :: t }+  deriving ( Bounded, Enum, Eq, Integral+           , Num, Fractional, Floating, Ord, Read, Real, RealFrac, RealFloat)+instance Show t => Show (Scalar t) where+  show (Scalar t) = "{ " ++ show t ++ " }"++type instance ElemRep  (Scalar t) = ElemRep t+type instance ElemPrim (Scalar Float ) = Float#+type instance ElemPrim (Scalar Double) = Double#+type instance ElemPrim (Scalar Int   ) = Int#+type instance ElemPrim (Scalar Int8  ) = Int#+type instance ElemPrim (Scalar Int16 ) = Int#+type instance ElemPrim (Scalar Int32 ) = Int#+type instance ElemPrim (Scalar Int64 ) = Int#+type instance ElemPrim (Scalar Word  ) = Word#+type instance ElemPrim (Scalar Word8 ) = Word#+type instance ElemPrim (Scalar Word16) = Word#+type instance ElemPrim (Scalar Word32) = Word#+type instance ElemPrim (Scalar Word64) = Word#++deriving instance PrimBytes (Scalar Float)+deriving instance PrimBytes (Scalar Double)+deriving instance PrimBytes (Scalar Int)+deriving instance PrimBytes (Scalar Int8)+deriving instance PrimBytes (Scalar Int16)+deriving instance PrimBytes (Scalar Int32)+deriving instance PrimBytes (Scalar Int64)+deriving instance PrimBytes (Scalar Word)+deriving instance PrimBytes (Scalar Word8)+deriving instance PrimBytes (Scalar Word16)+deriving instance PrimBytes (Scalar Word32)+deriving instance PrimBytes (Scalar Word64)++-- | Indexing over scalars is trivial...+instance ElementWise (Idx ('[] :: [Nat])) t (Scalar t) where+  (!) x _ = _unScalar x+  {-# INLINE (!) #-}+  ewmap f = Scalar . f Z . _unScalar+  {-# INLINE ewmap #-}+  ewgen f = Scalar $ f Z+  {-# INLINE ewgen #-}+  ewgenA f = Scalar <$> f Z+  {-# INLINE ewgenA #-}+  ewfoldl f x0 = f Z x0 . _unScalar+  {-# INLINE ewfoldl #-}+  ewfoldr f x0 x = f Z (_unScalar x) x0+  {-# INLINE ewfoldr #-}+  elementWise f = fmap Scalar . f . _unScalar+  {-# INLINE elementWise #-}+  indexWise f = fmap Scalar . f Z . _unScalar+  {-# INLINE indexWise #-}+  broadcast = Scalar+  {-# INLINE broadcast #-}+  update _ x _ = Scalar x+  {-# INLINE update #-}+++-- * Array implementations.+--   All array implementations have the same structure:+--   Array[Type] (element offset :: Int#) (element length :: Int#)+--                 (content :: ByteArray#)+--   All types can also be instantiated with a single scalar value.+++data ArrayF   (ds :: [Nat]) = ArrayF# Int# Int# ByteArray#+                            | FromScalarF# Float#+data ArrayD   (ds :: [Nat]) = ArrayD# Int# Int# ByteArray#+                            | FromScalarD# Double#+data ArrayI   (ds :: [Nat]) = ArrayI# Int# Int# ByteArray#+                            | FromScalarI# Int#+data ArrayI8  (ds :: [Nat]) = ArrayI8# Int# Int# ByteArray#+                            | FromScalarI8# Int#+data ArrayI16 (ds :: [Nat]) = ArrayI16# Int# Int# ByteArray#+                            | FromScalarI16# Int#+data ArrayI32 (ds :: [Nat]) = ArrayI32# Int# Int# ByteArray#+                            | FromScalarI32# Int#+data ArrayI64 (ds :: [Nat]) = ArrayI64# Int# Int# ByteArray#+                            | FromScalarI64# Int#+data ArrayW   (ds :: [Nat]) = ArrayW# Int# Int# ByteArray#+                            | FromScalarW# Word#+data ArrayW8  (ds :: [Nat]) = ArrayW8# Int# Int# ByteArray#+                            | FromScalarW8# Word#+data ArrayW16 (ds :: [Nat]) = ArrayW16# Int# Int# ByteArray#+                            | FromScalarW16# Word#+data ArrayW32 (ds :: [Nat]) = ArrayW32# Int# Int# ByteArray#+                            | FromScalarW32# Word#+data ArrayW64 (ds :: [Nat]) = ArrayW64# Int# Int# ByteArray#+                            | FromScalarW64# Word#++-- * Specialized types+--   More efficient data types for small fixed-size tensors+data FloatX2 = FloatX2# Float# Float#+data FloatX3 = FloatX3# Float# Float# Float#+data FloatX4 = FloatX4# Float# Float# Float# Float#++-- * Recovering type instances at runtime+--   A combination of `ElemType t` and `ArraySize ds` should+--   define an instance of `Array t ds` unambiguously.+++-- | Keep information about the element type instance+data ElemType t+  = t ~ Float  => ETFloat+  | t ~ Double => ETDouble+  | t ~ Int    => ETInt+  | t ~ Int8   => ETInt8+  | t ~ Int16  => ETInt16+  | t ~ Int32  => ETInt32+  | t ~ Int64  => ETInt64+  | t ~ Word   => ETWord+  | t ~ Word8  => ETWord8+  | t ~ Word16 => ETWord16+  | t ~ Word32 => ETWord32+  | t ~ Word64 => ETWord64++-- | Keep information about the array dimensionality+data ArraySize (ds :: [Nat])+  = ds ~ '[]   => ASScalar+  | ds ~ '[2]  => ASX2+  | ds ~ '[3]  => ASX3+  | ds ~ '[4]  => ASX4+  | forall n . (ds ~ '[n], 5 <= n) => ASXN+  | forall n1 n2 ns . ds ~ (n1 ': n2 ': ns) => ASArray++-- | Keep information about the instance behind Array family+data ArrayInstance t (ds :: [Nat])+  = ( Array t ds ~ Scalar t, ds ~ '[]) => AIScalar+  | forall n ns . ( Array t ds ~ ArrayF   ds, ds ~ (n ': ns), t ~ Float ) => AIArrayF+  | forall n ns . ( Array t ds ~ ArrayD   ds, ds ~ (n ': ns), t ~ Double) => AIArrayD+  | forall n ns . ( Array t ds ~ ArrayI   ds, ds ~ (n ': ns), t ~ Int   ) => AIArrayI+  | forall n ns . ( Array t ds ~ ArrayI8  ds, ds ~ (n ': ns), t ~ Int8  ) => AIArrayI8+  | forall n ns . ( Array t ds ~ ArrayI16 ds, ds ~ (n ': ns), t ~ Int16 ) => AIArrayI16+  | forall n ns . ( Array t ds ~ ArrayI32 ds, ds ~ (n ': ns), t ~ Int32 ) => AIArrayI32+  | forall n ns . ( Array t ds ~ ArrayI64 ds, ds ~ (n ': ns), t ~ Int64 ) => AIArrayI64+  | forall n ns . ( Array t ds ~ ArrayW   ds, ds ~ (n ': ns), t ~ Word  ) => AIArrayW+  | forall n ns . ( Array t ds ~ ArrayW8  ds, ds ~ (n ': ns), t ~ Word8 ) => AIArrayW8+  | forall n ns . ( Array t ds ~ ArrayW16 ds, ds ~ (n ': ns), t ~ Word16) => AIArrayW16+  | forall n ns . ( Array t ds ~ ArrayW32 ds, ds ~ (n ': ns), t ~ Word32) => AIArrayW32+  | forall n ns . ( Array t ds ~ ArrayW64 ds, ds ~ (n ': ns), t ~ Word64) => AIArrayW64+  | ( Array t ds ~ FloatX2, ds ~ '[2], t ~ Float) => AIFloatX2+  | ( Array t ds ~ FloatX3, ds ~ '[3], t ~ Float) => AIFloatX3+  | ( Array t ds ~ FloatX4, ds ~ '[4], t ~ Float) => AIFloatX4++-- | A singleton type used to prove that the given Array family instance+--   has a known instance+type ArrayInstanceEvidence t (ds :: [Nat])+  = Evidence (ArrayInstanceInference t ds)+++class ElemTypeInference t where+    -- | Pattern match against result to get specific element type+    elemTypeInstance  :: ElemType t++class ArraySizeInference ds where+    -- | Pattern match agains result to get actual array dimensionality+    arraySizeInstance :: ArraySize ds+    inferSnocArrayInstance :: (ElemTypeInference t, KnownDim z)+                           => p t ds -> q z -> ArrayInstanceEvidence t (ds +: z)+    inferConsArrayInstance :: (ElemTypeInference t, KnownDim z)+                           => q z -> p t ds -> ArrayInstanceEvidence t (z :+ ds)+    inferInitArrayInstance :: ElemTypeInference t+                           => p t ds -> ArrayInstanceEvidence t (Init ds)+++-- | Use this typeclass constraint in libraries functions if there is a need+--   to select an instance of Array famility at runtime.+--   Combination of `elemTypeInstance` and `arraySizeInstance` allows+--   to bring into typechecker's scope any specific typeclass instance+type ArrayInstanceInference t ds = (ElemTypeInference t, ArraySizeInference ds)++++instance ElemTypeInference Float where+    elemTypeInstance = ETFloat+instance ElemTypeInference Double where+    elemTypeInstance = ETDouble+instance ElemTypeInference Int where+    elemTypeInstance = ETInt+instance ElemTypeInference Int8 where+    elemTypeInstance = ETInt8+instance ElemTypeInference Int16 where+    elemTypeInstance = ETInt16+instance ElemTypeInference Int32 where+    elemTypeInstance = ETInt32+instance ElemTypeInference Int64 where+    elemTypeInstance = ETInt64+instance ElemTypeInference Word where+    elemTypeInstance = ETWord+instance ElemTypeInference Word8 where+    elemTypeInstance = ETWord8+instance ElemTypeInference Word16 where+    elemTypeInstance = ETWord16+instance ElemTypeInference Word32 where+    elemTypeInstance = ETWord32+instance ElemTypeInference Word64 where+    elemTypeInstance = ETWord64++instance ArraySizeInference '[] where+    arraySizeInstance = ASScalar+    {-# INLINE arraySizeInstance #-}+    inferSnocArrayInstance _ _ = Evidence+    {-# INLINE inferSnocArrayInstance #-}+    inferConsArrayInstance _ _ = Evidence+    {-# INLINE inferConsArrayInstance #-}+    inferInitArrayInstance _ = error "Init -- empty type-level list"+    {-# INLINE inferInitArrayInstance #-}++instance KnownDim d => ArraySizeInference '[d] where+    arraySizeInstance = case dimVal' @d of+        0 -> unsafeCoerce# ASScalar+        1 -> unsafeCoerce# ASScalar+        2 -> unsafeCoerce# ASX2+        3 -> unsafeCoerce# ASX3+        4 -> unsafeCoerce# ASX4+        _ -> case (unsafeCoerce# Refl :: (5 <=? d) :~: 'True) of Refl -> ASXN+    {-# INLINE arraySizeInstance #-}+    inferSnocArrayInstance _ _ = Evidence+    {-# INLINE inferSnocArrayInstance #-}+    inferConsArrayInstance _ _ = Evidence+    {-# INLINE inferConsArrayInstance #-}+    inferInitArrayInstance _ = Evidence+    {-# INLINE inferInitArrayInstance #-}++instance KnownDim d1 => ArraySizeInference '[d1, d2] where+    arraySizeInstance = ASArray+    {-# INLINE arraySizeInstance #-}+    inferSnocArrayInstance _ _ = Evidence+    {-# INLINE inferSnocArrayInstance #-}+    inferConsArrayInstance _ _ = Evidence+    {-# INLINE inferConsArrayInstance #-}+    inferInitArrayInstance _ = Evidence+    {-# INLINE inferInitArrayInstance #-}+++instance ArraySizeInference (d1 ': d2 ': d3 ': ds) where+    arraySizeInstance = ASArray+    {-# INLINE arraySizeInstance #-}+    -- I know that for dimensionality > 2 all instances are the same.+    -- Hence this dirty hack should work.+    -- I have to change this when I have customized N*M instances+    inferSnocArrayInstance p q = unsafeCoerce# (inferConsArrayInstance q p)+    {-# INLINE inferSnocArrayInstance #-}+    inferConsArrayInstance _ _ = Evidence+    {-# INLINE inferConsArrayInstance #-}+    -- I know that for dimensionality > 2 all instances are the same.+    -- Hence this dirty hack should work.+    -- I have to change this when I have customized N*M instances+    inferInitArrayInstance p = unsafeCoerce# (inferConsArrayInstance (Proxy @3) p)+    {-# INLINE inferInitArrayInstance #-}++++getArrayInstance :: forall t (ds :: [Nat])+                  . ArrayInstanceInference t ds+                 => ArrayInstance t ds+getArrayInstance = case (elemTypeInstance @t, arraySizeInstance @ds) of+    (ETFloat  , ASScalar) -> AIScalar+    (ETDouble , ASScalar) -> AIScalar+    (ETInt    , ASScalar) -> AIScalar+    (ETInt8   , ASScalar) -> AIScalar+    (ETInt16  , ASScalar) -> AIScalar+    (ETInt32  , ASScalar) -> AIScalar+    (ETInt64  , ASScalar) -> AIScalar+    (ETWord   , ASScalar) -> AIScalar+    (ETWord8  , ASScalar) -> AIScalar+    (ETWord16 , ASScalar) -> AIScalar+    (ETWord32 , ASScalar) -> AIScalar+    (ETWord64 , ASScalar) -> AIScalar++    (ETFloat  , ASX2) -> AIFloatX2+    (ETDouble , ASX2) -> AIArrayD+    (ETInt    , ASX2) -> AIArrayI+    (ETInt8   , ASX2) -> AIArrayI8+    (ETInt16  , ASX2) -> AIArrayI16+    (ETInt32  , ASX2) -> AIArrayI32+    (ETInt64  , ASX2) -> AIArrayI64+    (ETWord   , ASX2) -> AIArrayW+    (ETWord8  , ASX2) -> AIArrayW8+    (ETWord16 , ASX2) -> AIArrayW16+    (ETWord32 , ASX2) -> AIArrayW32+    (ETWord64 , ASX2) -> AIArrayW64++    (ETFloat  , ASX3) -> AIFloatX3+    (ETDouble , ASX3) -> AIArrayD+    (ETInt    , ASX3) -> AIArrayI+    (ETInt8   , ASX3) -> AIArrayI8+    (ETInt16  , ASX3) -> AIArrayI16+    (ETInt32  , ASX3) -> AIArrayI32+    (ETInt64  , ASX3) -> AIArrayI64+    (ETWord   , ASX3) -> AIArrayW+    (ETWord8  , ASX3) -> AIArrayW8+    (ETWord16 , ASX3) -> AIArrayW16+    (ETWord32 , ASX3) -> AIArrayW32+    (ETWord64 , ASX3) -> AIArrayW64++    (ETFloat  , ASX4) -> AIFloatX4+    (ETDouble , ASX4) -> AIArrayD+    (ETInt    , ASX4) -> AIArrayI+    (ETInt8   , ASX4) -> AIArrayI8+    (ETInt16  , ASX4) -> AIArrayI16+    (ETInt32  , ASX4) -> AIArrayI32+    (ETInt64  , ASX4) -> AIArrayI64+    (ETWord   , ASX4) -> AIArrayW+    (ETWord8  , ASX4) -> AIArrayW8+    (ETWord16 , ASX4) -> AIArrayW16+    (ETWord32 , ASX4) -> AIArrayW32+    (ETWord64 , ASX4) -> AIArrayW64++    (ETFloat  , ASXN) -> unsafeCoerce# (AIArrayF :: ArrayInstance Float '[5])+    (ETDouble , ASXN) -> AIArrayD+    (ETInt    , ASXN) -> AIArrayI+    (ETInt8   , ASXN) -> AIArrayI8+    (ETInt16  , ASXN) -> AIArrayI16+    (ETInt32  , ASXN) -> AIArrayI32+    (ETInt64  , ASXN) -> AIArrayI64+    (ETWord   , ASXN) -> AIArrayW+    (ETWord8  , ASXN) -> AIArrayW8+    (ETWord16 , ASXN) -> AIArrayW16+    (ETWord32 , ASXN) -> AIArrayW32+    (ETWord64 , ASXN) -> AIArrayW64++    (ETFloat  , ASArray) -> AIArrayF+    (ETDouble , ASArray) -> AIArrayD+    (ETInt    , ASArray) -> AIArrayI+    (ETInt8   , ASArray) -> AIArrayI8+    (ETInt16  , ASArray) -> AIArrayI16+    (ETInt32  , ASArray) -> AIArrayI32+    (ETInt64  , ASArray) -> AIArrayI64+    (ETWord   , ASArray) -> AIArrayW+    (ETWord8  , ASArray) -> AIArrayW8+    (ETWord16 , ASArray) -> AIArrayW16+    (ETWord32 , ASArray) -> AIArrayW32+    (ETWord64 , ASArray) -> AIArrayW64++-- | Given element type instance and proper dimension list,+--   infer a corresponding array instance+inferArrayInstance :: forall t ds+                    . ( FiniteList ds+                      , KnownDims ds+                      , ElemTypeInference t+                      )+                  => ArrayInstanceEvidence t ds+inferArrayInstance = case tList @_ @ds of+    TLEmpty                          -> Evidence+    TLCons _ TLEmpty                 -> Evidence+    TLCons _ (TLCons _ TLEmpty)      -> Evidence+    TLCons _ (TLCons _ (TLCons _ _)) -> Evidence+++_suppressHlintUnboxedTuplesWarning :: () -> (# (), () #)+_suppressHlintUnboxedTuplesWarning = undefined

@@ -0,0 +1,305 @@++--------------------------------------------------------------------------------+-- * Utility functions+--------------------------------------------------------------------------------++-- | Do something in a loop for int i from 0 to n+loop1# :: Int# -> (Int# -> State# s -> State# s) -> State# s -> State# s+loop1# n f = loop0 0#+  where+    loop0 i s | isTrue# (i ==# n) = s+              | otherwise = case f i s of s1 -> loop0 (i +# 1#) s1+{-# INLINE loop1# #-}+++-- | Do something in a loop for int i from 0 to n+loop1a# :: Int# -> (Int# -> a -> a) -> a -> a+loop1a# n f = loop0 0#+  where+    loop0 i s | isTrue# (i ==# n) = s+              | otherwise = s `seq` case f i s of s1 -> s1 `seq` loop0 (i +# 1#) s1+{-# INLINE loop1a# #-}+++-- | Treat a single number as an array+broadcastArray :: EL_TYPE_BOXED -> ARR_TYPE ds+broadcastArray (EL_CONSTR x) = ARR_FROMSCALAR x+{-# INLINE broadcastArray #-}++-- | Accumulates only idempotent operations!+--   Being applied to FromScalars, executes only once!+accumV2 :: (EL_TYPE_PRIM-> EL_TYPE_PRIM -> a -> a)+        -> ARR_TYPE ds -> ARR_TYPE ds -> a -> a+accumV2 f (ARR_FROMSCALAR a)+          (ARR_FROMSCALAR b) = f a b+accumV2 f (ARR_CONSTR offset n a)+          (ARR_FROMSCALAR b) = loop1a# n+    (\i -> f (INDEX_ARRAY a (offset +# i)) b)+accumV2 f (ARR_FROMSCALAR a)+          (ARR_CONSTR offset n b) = loop1a# n+    (\i -> f a (INDEX_ARRAY b (offset +# i)))+accumV2 f (ARR_CONSTR offsetA n a)+          (ARR_CONSTR offsetB _ b) = loop1a# n+    (\i -> f (INDEX_ARRAY a (offsetA +# i))+             (INDEX_ARRAY b (offsetB +# i))+    )++mapV :: (EL_TYPE_PRIM -> EL_TYPE_PRIM) -> ARR_TYPE ds -> ARR_TYPE ds+mapV f (ARR_FROMSCALAR x) = ARR_FROMSCALAR (f x)+mapV f (ARR_CONSTR offset n a) = case runRW#+     ( \s0 -> case newByteArray# (n *# EL_SIZE) s0 of+         (# s1, marr #) -> case loop1# n+               (\i ss -> case f (INDEX_ARRAY a (offset +# i)) of+                 r -> WRITE_ARRAY marr i r ss+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> ARR_CONSTR 0# n r+{-# INLINE mapV #-}++zipV :: (EL_TYPE_PRIM -> EL_TYPE_PRIM -> EL_TYPE_PRIM)+     -> ARR_TYPE ds -> ARR_TYPE ds -> ARR_TYPE ds+zipV f (ARR_FROMSCALAR a)+       (ARR_FROMSCALAR b) = ARR_FROMSCALAR (f a b)+zipV f x (ARR_FROMSCALAR b) = mapV (`f` b) x+zipV f (ARR_FROMSCALAR a) y = mapV (f a) y+zipV f (ARR_CONSTR offsetA n a)+       (ARR_CONSTR offsetB _ b) = case runRW#+     ( \s0 -> case newByteArray# (n *# EL_SIZE ) s0 of+         (# s1, marr #) -> case loop1# n+               (\i ss -> case f (INDEX_ARRAY a (offsetA +# i))+                                (INDEX_ARRAY b (offsetB +# i)) of+                 r -> WRITE_ARRAY marr i r ss+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> ARR_CONSTR 0# n r+{-# INLINE zipV #-}++++--------------------------------------------------------------------------------+-- * Instances+--------------------------------------------------------------------------------+++++wr :: ARR_TYPE (ds :: [Nat]) -> Int# -> Int#+   -> (MutableByteArray# RealWorld -> State# RealWorld -> State# RealWorld)+   -> ARR_TYPE ds+wr _ bs n ff = case runRW#+     ( \s0 -> case newByteArray# bs s0 of+               (# s1, marr #) ->  case ff marr s1 of+                 s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> ARR_CONSTR 0# n r+{-# INLINE wr #-}++data ArrayUpdate# (f :: * -> *) s+  = AU# Int# !(f (MutableByteArray# s -> State# s -> State# s))++instance Dimensions ds => ElementWise (Idx ds) EL_TYPE_BOXED (ARR_TYPE (ds :: [Nat])) where+  (!) (ARR_CONSTR off _ a) i+       = case fromEnum i of I# j -> EL_CONSTR (INDEX_ARRAY a (off +# j))+  (!) (ARR_FROMSCALAR x) _ = EL_CONSTR x+  {-# INLINE (!) #-}++  broadcast (EL_CONSTR x) = ARR_FROMSCALAR x+  {-# INLINE broadcast #-}++  ewmap f x@(ARR_CONSTR offset n arr) = case runRW#+     (\s0 -> case newByteArray# (n *# EL_SIZE) s0 of+       (# s1, marr #) -> case overDim_# (dim `inSpaceOf` x)+               ( \ii off s -> case f ii (EL_CONSTR (INDEX_ARRAY arr (offset +# off))) of+                  (EL_CONSTR r) -> WRITE_ARRAY marr off r s+               ) 0# 1# s1 of+           s3 -> unsafeFreezeByteArray# marr s3+     ) of (# _, r #) -> ARR_CONSTR 0# n r+  ewmap f x@(ARR_FROMSCALAR scalVal) = case runRW#+     (\s0 -> case newByteArray# (n *# EL_SIZE) s0 of+       (# s1, marr #) -> case overDim_# (dim `inSpaceOf` x)+               ( \ii off s -> case f ii (EL_CONSTR scalVal) of+                  (EL_CONSTR r) -> WRITE_ARRAY marr off r s+               ) 0# 1# s1 of+           s3 -> unsafeFreezeByteArray# marr s3+     ) of (# _, r #) -> ARR_CONSTR 0# n r+    where+      n = case totalDim x of I# d -> d+  {-# INLINE ewmap #-}++  ewgen f = case runRW#+     (\s0 -> case newByteArray# (n *# EL_SIZE) s0 of+       (# s1, marr #) -> case overDim_# (dim `inSpaceOf` x)+               ( \ii off s -> case f ii of+                  (EL_CONSTR r) -> WRITE_ARRAY marr off r s+               ) 0# 1# s1 of+           s3 -> unsafeFreezeByteArray# marr s3+     ) of (# _, r #) -> ARR_CONSTR 0# n r+    where+      x = undefined :: ARR_TYPE ds+      n = case totalDim x of I# d -> d+  {-# INLINE ewgen #-}++  ewgenA f+      = case foldDimIdx (dim `inSpaceOf` x) g (AU# 0# (pure (\_ s -> s))) of+        AU# _ ff -> wr x bs n <$> ff+    where+      g ds (AU# i ff) = AU# ( i +# 1# )+                          $ (\(EL_CONSTR z) u a s -> WRITE_ARRAY a i z (u a s))+                           <$> f ds <*> ff+      x = undefined :: ARR_TYPE ds+      n = case totalDim x of I# d -> d+      bs = n *# EL_SIZE++  ewfoldr f v0 x@(ARR_CONSTR offset _ arr)+    = foldDimReverse (dim `inSpaceOf` x)+      (\ii off -> f ii (EL_CONSTR (INDEX_ARRAY arr off))) offset 1# v0+  ewfoldr f v0 x@(ARR_FROMSCALAR scalVal) = foldDimReverseIdx (dim `inSpaceOf` x)+      (\ii -> f ii (EL_CONSTR scalVal)) v0+  {-# INLINE ewfoldr #-}++  ewfoldl f v0 x@(ARR_CONSTR offset _ arr)+    = foldDim (dim `inSpaceOf` x)+      (\ii off v -> f ii v (EL_CONSTR (INDEX_ARRAY arr off))) offset 1# v0+  ewfoldl f v0 x@(ARR_FROMSCALAR scalVal) = foldDimIdx (dim `inSpaceOf` x)+      (\ii v -> f ii v (EL_CONSTR scalVal)) v0+  {-# INLINE ewfoldl #-}++  indexWise f x@(ARR_CONSTR offset n arr)+      = case foldDimIdx (dim `inSpaceOf` x) g (AU# 0# (pure (\_ s -> s))) of+        AU# _ ff -> wr x bs n <$> ff+    where+      g ds (AU# i ff) = AU# ( i +# 1# )+                          $ (\(EL_CONSTR z) u a s -> WRITE_ARRAY a i z (u a s))+                           <$> f ds (EL_CONSTR (INDEX_ARRAY arr (offset +# i))) <*> ff+      bs = n *# EL_SIZE++  indexWise f x@(ARR_FROMSCALAR scalVal)+      = case foldDimIdx (dim `inSpaceOf` x) g (AU# 0# (pure (\_ s -> s))) of+        AU# _ ff -> wr x bs n <$> ff+    where+      n = case totalDim x of I# d -> d+      g ds (AU# i ff) = AU# ( i +# 1# )+                          $ (\(EL_CONSTR z) u a s -> WRITE_ARRAY a i z (u a s))+                           <$> f ds (EL_CONSTR scalVal) <*> ff+      bs = n *# EL_SIZE+++  elementWise f x@(ARR_CONSTR offset n arr) =+      wr x bs n <$> loop1a# n g (pure (\_ s -> s))+    where+      g i ff = (\(EL_CONSTR z) u a s -> WRITE_ARRAY a i z (u a s))+                      <$> f (EL_CONSTR (INDEX_ARRAY arr (offset +# i))) <*> ff+      bs = n *# EL_SIZE+  elementWise f x@(ARR_FROMSCALAR scalVal) =+      wr x bs n <$> loop1a# n g (pure (\_ s -> s))+    where+      fa = f (EL_CONSTR scalVal)+      n = case totalDim x of I# d -> d+      g i ff = (\(EL_CONSTR z) u a s -> WRITE_ARRAY a i z (u a s))+                      <$> fa <*> ff+      bs = n *# EL_SIZE++  update ei (EL_CONSTR y) (ARR_CONSTR off len arr)+    | I# i <- fromEnum ei+    = case runRW#+        ( \s0 -> case newByteArray# ( len *# EL_SIZE ) s0 of+          (# s1, marr #) -> case copyByteArray# arr (off *# EL_SIZE) marr 0# (len *# EL_SIZE) s1 of+            s2 -> case WRITE_ARRAY marr i y s2 of+              s3 -> unsafeFreezeByteArray# marr s3+        ) of (# _, r #) -> ARR_CONSTR 0# len r+++  update ei (EL_CONSTR y) x@(ARR_FROMSCALAR scalVal)+    | I# i   <- fromEnum ei+    , I# len <- totalDim x+    = case runRW#+        ( \s0 -> case newByteArray# ( len *# EL_SIZE ) s0 of+          (# s1, marr #) -> case loop1# len (\j -> WRITE_ARRAY marr j scalVal) s1 of+            s2 -> case WRITE_ARRAY marr i y s2 of+              s3 -> unsafeFreezeByteArray# marr s3+        ) of (# _, r #) -> ARR_CONSTR 0# len r++instance Dimensions ds+      => Show (ARR_TYPE (ds :: [Nat])) where+  show x = case dim @ds of+    D -> "{ " ++ show (x ! Z) ++ " }"+    Dn :* D -> ('{' :) . drop 1 $+                    foldr (\i s -> ", " ++ show (x ! i) ++ s) " }"+                            [minBound .. maxBound]+    (Dn :: Dim (n :: Nat)) :* (Dn :: Dim (m :: Nat)) :* (_ :: Dim (dss :: [Nat])) ->+      case inferDropNDimensions @2 @ds of+        Evidence ->+          let loopInner :: Idx dss -> Idx '[n,m] -> String+              loopInner ods (n:!m:!_) = ('{' :) . drop 2 $+                              foldr (\i ss -> '\n':+                                      foldr (\j s ->+                                               ", " ++ show (x ! (i :! j :! ods)) ++ s+                                            ) ss [1..m]+                                    ) " }" [1..n]+              loopOuter ::  Idx dss -> String -> String+              loopOuter Z s  = "\n" ++ loopInner Z maxBound ++ s+              loopOuter ds s = "\n(i j" ++ drop 3 (show ds) ++ "):\n"+                                    ++ loopInner ds maxBound ++ s+          in drop 1 $ foldr loopOuter "" [minBound..maxBound]++instance Eq (ARR_TYPE ds) where+  a == b = accumV2 (\x y r -> r && isTrue# (OP_EQ x y)) a b True+  {-# INLINE (==) #-}+  a /= b = accumV2 (\x y r -> r || isTrue# (OP_NE x y)) a b False+  {-# INLINE (/=) #-}+++-- | Implement partial ordering for `>`, `<`, `>=`, `<=`+--     and lexicographical ordering for `compare`+instance Ord (ARR_TYPE ds) where+  a > b = accumV2 (\x y r -> r && isTrue# (OP_GT x y)) a b True+  {-# INLINE (>) #-}+  a < b = accumV2 (\x y r -> r && isTrue# (OP_LT x y)) a b True+  {-# INLINE (<) #-}+  a >= b = accumV2 (\x y r -> r && isTrue# (OP_GE x y)) a b True+  {-# INLINE (>=) #-}+  a <= b = accumV2 (\x y r -> r && isTrue# (OP_LE x y)) a b True+  {-# INLINE (<=) #-}+  -- | Compare lexicographically+  compare a b = accumV2 (\x y r -> r `mappend`+                          if isTrue# (OP_GT x y)+                          then GT+                          else if isTrue# (OP_LT x y)+                               then LT+                               else EQ+                        ) a b EQ+  {-# INLINE compare #-}+  -- | Element-wise minimum+  min = zipV  (\x y -> if isTrue# (OP_GT x y) then y else x)+  {-# INLINE min #-}+  -- | Element-wise maximum+  max = zipV  (\x y -> if isTrue# (OP_GT x y) then x else y)+  {-# INLINE max #-}+++type instance ElemRep (ARR_TYPE ds) = EL_RUNTIME_REP+type instance ElemPrim (ARR_TYPE ds) = EL_TYPE_PRIM+instance Dimensions ds => PrimBytes (ARR_TYPE ds) where+  toBytes (ARR_CONSTR off size a) = (# off, size, a #)+  toBytes (ARR_FROMSCALAR x) = case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) -> case loop1# n+               (\i -> WRITE_ARRAY marr i x+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> (# 0#, n, r #)+    where+      n = case totalDim (undefined :: ArrayF ds) of I# d -> d+      bs = n *# EL_SIZE+  {-# INLINE toBytes #-}+  fromBytes (# off, size, a #) = ARR_CONSTR off size a+  {-# INLINE fromBytes #-}+  byteSize x = case totalDim x of+     I# d -> EL_SIZE *# d+  {-# INLINE byteSize #-}+  byteAlign _ = EL_ALIGNMENT+  {-# INLINE byteAlign #-}+  elementByteSize _ = EL_SIZE+  {-# INLINE elementByteSize #-}+  ix i (ARR_CONSTR off _ a) = INDEX_ARRAY a (off +# i)+  ix _ (ARR_FROMSCALAR x)  = x+  {-# INLINE ix #-}

@@ -0,0 +1,408 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE BangPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.Family.ArrayD+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayD () where+++import           GHC.Base                  (runRW#)+import           GHC.Prim+import           GHC.Types                 (Double (..), Int (..),+                                            RuntimeRep (..), isTrue#)++import           Numeric.Array.ElementWise+import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.DataFrame.Type+import           Numeric.Dimensions+import           Numeric.Dimensions.Traverse+import           Numeric.TypeLits+import           Numeric.Matrix.Type+++#include "MachDeps.h"+#define ARR_TYPE                 ArrayD+#define ARR_FROMSCALAR           FromScalarD#+#define ARR_CONSTR               ArrayD#+#define EL_TYPE_BOXED            Double+#define EL_TYPE_PRIM             Double#+#define EL_RUNTIME_REP           'DoubleRep+#define EL_CONSTR                D#+#define EL_SIZE                  SIZEOF_HSDOUBLE#+#define EL_ALIGNMENT             ALIGNMENT_HSDOUBLE#+#define EL_ZERO                  0.0##+#define EL_ONE                   1.0##+#define EL_MINUS_ONE             -1.0##+#define INDEX_ARRAY              indexDoubleArray#+#define WRITE_ARRAY              writeDoubleArray#+#define OP_EQ                    (==##)+#define OP_NE                    (/=##)+#define OP_GT                    (>##)+#define OP_GE                    (>=##)+#define OP_LT                    (<##)+#define OP_LE                    (<=##)+#define OP_PLUS                  (+##)+#define OP_MINUS                 (-##)+#define OP_TIMES                 (*##)+#define OP_NEGATE                negateDouble#+#include "Array.h"+++instance Num (ArrayD ds) where+  (+) = zipV (+##)+  {-# INLINE (+) #-}+  (-) = zipV (-##)+  {-# INLINE (-) #-}+  (*) = zipV (*##)+  {-# INLINE (*) #-}+  negate = mapV negateDouble#+  {-# INLINE negate #-}+  abs = mapV (\x -> if isTrue# (x >=## 0.0##)+                    then x+                    else negateDouble# x+                )+  {-# INLINE abs #-}+  signum = mapV (\x -> if isTrue# (x >## 0.0##)+                       then 1.0##+                       else if isTrue# (x <## 0.0##)+                            then -1.0##+                            else 0.0##+                )+  {-# INLINE signum #-}+  fromInteger = broadcastArray . fromInteger+  {-# INLINE fromInteger #-}++instance Fractional (ArrayD ds) where+  (/) = zipV (/##)+  {-# INLINE (/) #-}+  recip = mapV (1.0## /##)+  {-# INLINE recip #-}+  fromRational = broadcastArray . fromRational+  {-# INLINE fromRational #-}+++instance Floating (ArrayD ds) where+  pi = broadcastArray pi+  {-# INLINE pi #-}+  exp = mapV expDouble#+  {-# INLINE exp #-}+  log = mapV logDouble#+  {-# INLINE log #-}+  sqrt = mapV sqrtDouble#+  {-# INLINE sqrt #-}+  sin = mapV sinDouble#+  {-# INLINE sin #-}+  cos = mapV cosDouble#+  {-# INLINE cos #-}+  tan = mapV tanDouble#+  {-# INLINE tan #-}+  asin = mapV asinDouble#+  {-# INLINE asin #-}+  acos = mapV acosDouble#+  {-# INLINE acos #-}+  atan = mapV atanDouble#+  {-# INLINE atan #-}+  sinh = mapV sinDouble#+  {-# INLINE sinh #-}+  cosh = mapV coshDouble#+  {-# INLINE cosh #-}+  tanh = mapV tanhDouble#+  {-# INLINE tanh #-}+  (**) = zipV (**##)+  {-# INLINE (**) #-}++  logBase = zipV (\x y -> logDouble# y /## logDouble# x)+  {-# INLINE logBase #-}+  asinh = mapV (\x -> logDouble# (x +##+                                sqrtDouble# (1.0## +## x *## x)))+  {-# INLINE asinh #-}+  acosh = mapV (\x ->  case x +## 1.0## of+                 y -> logDouble# ( x +## y *##+                           sqrtDouble# ((x -## 1.0##) /## y)+                        )+               )+  {-# INLINE acosh #-}+  atanh = mapV (\x -> 0.5## *##+                logDouble# ((1.0## +## x) /## (1.0## -## x)))+  {-# INLINE atanh #-}+++instance (KnownNat n, KnownNat m, ArrayD '[n,m] ~ Array Double '[n,m], 2 <= n, 2 <= m)+      => MatrixCalculus Double n m where+  transpose (KnownDataFrame (ArrayD# offs nm arr)) = case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) -> case loop2# n m+               (\i j s' -> writeDoubleArray# marr (j +# m *# i)+                              (indexDoubleArray# arr (offs +# j *# n +# i)) s'+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, nm, r #)+    where+      n = case fromInteger $ natVal (Proxy @n) of I# np -> np+      m = case fromInteger $ natVal (Proxy @m) of I# mp -> mp+      bs = n *# m *# EL_SIZE+  transpose (KnownDataFrame (FromScalarD# x)) = unsafeCoerce# $ FromScalarD# x++instance ( KnownDim n, ArrayD '[n,n] ~ Array Double '[n,n] )+      => SquareMatrixCalculus Double n where+  eye = case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) -> case loop1# n+               (\j s' -> writeDoubleArray# marr (j *# n1) 1.0## s'+               ) (setByteArray# marr 0# bs 0# s1) of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, n *# n,  r #)+    where+      n1 = n +# 1#+      n = case dimVal' @n of I# np -> np+      bs = n *# n *# EL_SIZE+  {-# INLINE eye #-}+  diag (KnownDataFrame (Scalar (D# v))) = case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) -> case loop1# n+               (\j s' -> writeDoubleArray# marr (j *# n1) v s'+               ) (setByteArray# marr 0# bs 0# s1) of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, n *# n,  r #)+    where+      n1 = n +# 1#+      n = case dimVal' @n of I# np -> np+      bs = n *# n *# EL_SIZE+  {-# INLINE diag #-}+++  det (KnownDataFrame (ArrayD# off nsqr arr)) = case runRW#+     ( \s0 -> case newByteArray# bs s0 of+       (# s1, mat #) -> case newByteArray#+                            (n *# EL_SIZE)+                            (copyByteArray# arr offb mat 0# bs s1) of+         (# s2, vec #) ->+            let f i x s | isTrue# (i >=# n) = (# s, x #)+                        | otherwise =+                            let !(# s' , j  #) = maxInRowRem# n n i mat s+                                !(# s'', x' #) = if isTrue# (i /=# j)+                                                then (# swapCols# n i j vec mat s'+                                                               , negateDouble# x #)+                                                else (# s', x #)+                                !(# s''', y #) = clearRowEnd# n n i mat s''+                            in if isTrue# (0.0## ==## y)+                               then (# s''', 0.0## #)+                               else f (i +# 1#) (x' *## y) s'''+            in f 0# 1.0## s2+     ) of (# _, r #) -> D# r+    where+      n = case dimVal' @n of I# np -> np+      offb = off *# EL_SIZE+      bs = nsqr *# EL_SIZE+  det (KnownDataFrame (FromScalarD# _)) = 0+  {-# INLINE det #-}++++  trace (KnownDataFrame (ArrayD# off nsqr a)) = KnownDataFrame (Scalar (D# (loop' 0# 0.0##)))+    where+      n1 = n +# 1#+      n = case dimVal' @n of I# np -> np+      loop' i acc | isTrue# (i ># nsqr) = acc+                  | otherwise = loop' (i +# n1)+                         (indexDoubleArray# a (off +# i) +## acc)+  trace (KnownDataFrame (FromScalarD# x)) = KnownDataFrame (Scalar (D# (x *## n)))+    where+      n = case fromIntegral (dimVal' @n) of D# np -> np+  {-# INLINE trace #-}++++instance (KnownNat n, ArrayD '[n,n] ~ Array Double '[n,n], 2 <= n) => MatrixInverse Double n where+  inverse (KnownDataFrame (ArrayD# offs nsqr arr)) = case runRW#+     ( \s0 -> case newByteArray# (bs *# 2#) s0 of+         (# s1, mat #) -> case newByteArray# (vs *# 2#)+                -- copy original matrix to the top of an augmented matrix+                (loop1# n (\i s -> writeDoubleArray# mat+                           (i *# nn +# i +# n) 1.0##+                           (copyByteArray# arr (offb +# i *# vs)+                                           mat (2# *# i *# vs) vs s))+                         (setByteArray# mat 0# (bs *# 2#) 0# s1)+                ) of+           (# s2, vec #) ->+              let f i s | isTrue# (i >=# n) = s+                        | otherwise =+                            let !(# s' , j  #) = maxInRowRem# nn n i mat s+                                s''           = if isTrue# (i /=# j) then swapCols# nn i j vec mat s'+                                                                     else s'+                                !(# s''', _ #) = clearRowAll# nn n i mat s''+                            in f (i +# 1#) s'''+              in unsafeFreezeByteArray# mat+                  ( shrinkMutableByteArray# mat bs+                   (-- copy inverse matrix from the augmented part+                    loop1# n (\i s ->+                       copyMutableByteArray# mat+                                             (2# *# i *# vs +# vs)+                                             mat (i *# vs) vs s)+                   (f 0# s2)+                   )+                  )+     ) of (# _, r #) -> KnownDataFrame (ArrayD# 0# nsqr r)+    where+      nn = 2# *# n+      n = case fromInteger $ natVal (Proxy @n) of I# np -> np+      vs = n *# EL_SIZE+      bs = n *# n *# EL_SIZE+      offb = offs *# EL_SIZE+  inverse (KnownDataFrame (FromScalarD# _)) = error "Cannot take inverse of a degenerate matrix"+++-----------------------------------------------------------------------------+-- Helpers+-----------------------------------------------------------------------------++-- #ifndef UNSAFE_INDICES+--       | isTrue# ( (i ># dim# _x)+--            `orI#` (i <=# 0#)+--           )       = error $ "Bad index " +++--                     show (I# i) ++ " for " ++ show (dim _x)  ++ "D vector"+--       | otherwise+-- #endif+++-- | Swap columns i and j. Does not check if i or j is larger than matrix width m+swapCols# :: Int# -- n+          -> Int# -- ith column to swap+          -> Int# -- jth column to swap+          -> MutableByteArray# s -- buffer byte array of length of n elems+          -> MutableByteArray# s -- byte array of matrix+          -> State# s -- previous state+          -> State# s -- next state+swapCols# n i j vec mat s0 =+  -- copy ith column to bugger vec+  case copyMutableByteArray# mat (i *# bs) vec 0# bs s0 of+    s1 -> case copyMutableByteArray# mat (j *# bs) mat (i *# bs) bs s1 of+      s2 -> copyMutableByteArray# vec 0# mat (j *# bs) bs s2+ where+  bs = n *# EL_SIZE++-- | Starting from i-th row and i+1-th column, substract a multiple of i-th column from i+1 .. m columns,+--   such that there are only zeroes in i-th row and i+1..m columns elements.+clearRowEnd# :: Int# -- n+             -> Int# -- m+             -> Int# -- ith column to remove from all others+             -> MutableByteArray# s -- byte array of matrix+             -> State# s -- previous state+             -> (# State# s, Double# #) -- next state and a diagonal element+clearRowEnd# n m i mat s0 = (# loop' (i +# 1#) s1, y' #)+  where+    y0 = (n +# 1#) *# i +# 1# -- first element in source column+    !(# s1, y' #) = readDoubleArray# mat ((n +# 1#) *# i) s0 -- diagonal element, must be non-zero+    yrc = 1.0## /## y'+    n' = n -# i -# 1#+    loop' k s | isTrue# (k >=# m) = s+              | otherwise = loop' (k +# 1#)+       ( let x0 = k *# n +# i+             !(# s', a' #) = readDoubleArray# mat x0 s+             s'' = writeDoubleArray# mat x0 0.0## s'+             a  = a' *## yrc+         in multNRem# n' (x0 +# 1#) y0 a mat s''+       )++-- | Substract a multiple of i-th column from 0 .. i-1 and i+1 .. m columns,+--   such that there are only zeroes in i-th row everywhere except i-th column+--   Assuming that elements in 0..i-1 columnts and in i-th row are zeroes, so they do not affect other columns.+--   After all columns updated, divide i-th row by its diagonal element, so (i,i) element has 1.+clearRowAll# :: Int# -- n+             -> Int# -- m+             -> Int# -- ith column to remove from all others+             -> MutableByteArray# s -- byte array of matrix+             -> State# s -- previous state+             -> (# State# s, Double# #) -- next state and a diagonal element+clearRowAll# n m i mat s0 = (# divLoop (i +# 1#)+            (writeDoubleArray# mat ((n +# 1#) *# i) 1.0##+            (loop' 0# i (loop' (i +# 1#) m s1))), y' #)+  where+    y0 = (n +# 1#) *# i +# 1# -- first element in source column+    !(# s1, y' #) = readDoubleArray# mat ((n +# 1#) *# i) s0 -- diagonal element, must be non-zero+    yrc = 1.0## /## y'+    n' = n -# i -# 1#+    loop' k km s | isTrue# (k >=# km) = s+                 | otherwise = loop' (k +# 1#) km+       ( let x0 = k *# n +# i+             !(# s', a' #) = readDoubleArray# mat x0 s+             s'' = writeDoubleArray# mat x0 0.0## s'+             a  = a' *## yrc+         in multNRem# n' (x0 +# 1#) y0 a mat s''+       )+    divLoop k s | isTrue# (k >=# n) = s+                | otherwise = divLoop (k +# 1#)+       ( let x0 = n *# i +# k+             !(# s', x #) = readDoubleArray# mat x0 s+         in writeDoubleArray# mat x0 (x *## yrc) s'+       )+++-- | Remove a multiple of one row from another one.+--   do: xi = xi - yi*a+multNRem# :: Int# -- n - nr of elements to go through+          -> Int# -- start idx of x (update)+          -> Int# -- start idx of y (read)+          -> Double# -- multiplier a+          -> MutableByteArray# s -- byte array of matrix+          -> State# s -- previous state+          -> State# s -- next state+multNRem# 0# _ _  _ _ s = s+multNRem# n x0 y0 a mat s = multNRem# (n -# 1#) (x0 +# 1#) (y0 +# 1#) a mat+  ( case readDoubleArray# mat y0 s of+     (# s1, y #) -> case readDoubleArray# mat x0 s1 of+       (# s2, x #) -> writeDoubleArray# mat x0 (x -## y *## a) s2+  )++++-- | Gives index of maximum (absolute) element in i-th row, starting from i-th element only.+--   If i >= m then returns i.+maxInRowRem# :: Int# -- n+             -> Int# -- m+             -> Int# -- ith column to start to search for and a row to look in+             -> MutableByteArray# s -- byte array of matrix+             -> State# s -- previous state+             -> (# State# s, Int# #) -- next state+maxInRowRem# n m i mat s0 = loop' i (abs# v) i s1+  where+    !(# s1, v #) = readDoubleArray# mat ((n +# 1#) *# i) s0+    abs# x = if isTrue# (x >=## 0.0##) then x else negateDouble# x+    loop' ok ov k s | isTrue# (k >=# m) = (# s, ok #)+                    | otherwise = case readDoubleArray# mat (n *# k +# i) s of+                        (# s', v' #) -> if isTrue# (abs# v' >## ov)+                                        then loop' k (abs# v') (k +# 1#) s'+                                        else loop' ok ov (k +# 1#) s'++-- | Do something in a loop for int i from 0 to n-1 and j from 0 to m-1+loop2# :: Int# -> Int# -> (Int# -> Int#-> State# s -> State# s)+       -> State# s -> State# s+loop2# n m f = loop0 0# 0#+  where+    loop0 i j s | isTrue# (j ==# m) = s+                | isTrue# (i ==# n) = loop0 0# (j +# 1#) s+                | otherwise         = case f i j s of s1 -> loop0 (i +# 1#) j s1+{-# INLINE loop2# #-}

@@ -0,0 +1,412 @@+{-# LANGUAGE BangPatterns          #-}+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE BangPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.Family.ArrayF+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayF () where++++import           GHC.Base                  (runRW#)+import           GHC.Prim+import           GHC.Types                 (Float (..), Int (..),+                                            RuntimeRep (..), isTrue#)++import           Numeric.Array.ElementWise+import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.DataFrame.Type+import           Numeric.Dimensions+import           Numeric.Dimensions.Traverse+import           Numeric.TypeLits+import           Numeric.Matrix.Type++#include "MachDeps.h"+#define ARR_TYPE                 ArrayF+#define ARR_FROMSCALAR           FromScalarF#+#define ARR_CONSTR               ArrayF#+#define EL_TYPE_BOXED            Float+#define EL_TYPE_PRIM             Float#+#define EL_RUNTIME_REP           'FloatRep+#define EL_CONSTR                F#+#define EL_SIZE                  SIZEOF_HSFLOAT#+#define EL_ALIGNMENT             ALIGNMENT_HSFLOAT#+#define EL_ZERO                  0.0#+#define EL_ONE                   1.0#+#define EL_MINUS_ONE             -1.0#+#define INDEX_ARRAY              indexFloatArray#+#define WRITE_ARRAY              writeFloatArray#+#define OP_EQ                    eqFloat#+#define OP_NE                    neFloat#+#define OP_GT                    gtFloat#+#define OP_GE                    geFloat#+#define OP_LT                    ltFloat#+#define OP_LE                    leFloat#+#define OP_PLUS                  plusFloat#+#define OP_MINUS                 minusFloat#+#define OP_TIMES                 timesFloat#+#define OP_NEGATE                negateFloat#+#include "Array.h"+++instance Num (ArrayF ds) where+  (+) = zipV plusFloat#+  {-# INLINE (+) #-}+  (-) = zipV minusFloat#+  {-# INLINE (-) #-}+  (*) = zipV timesFloat#+  {-# INLINE (*) #-}+  negate = mapV negateFloat#+  {-# INLINE negate #-}+  abs = mapV (\x -> if isTrue# (geFloat# x 0.0#)+                    then x+                    else negateFloat# x+                )+  {-# INLINE abs #-}+  signum = mapV (\x -> if isTrue# (gtFloat# x 0.0#)+                       then 1.0#+                       else if isTrue# (ltFloat# x 0.0#)+                            then -1.0#+                            else 0.0#+                )+  {-# INLINE signum #-}+  fromInteger = broadcastArray . fromInteger+  {-# INLINE fromInteger #-}++instance Fractional (ArrayF ds) where+  (/) = zipV divideFloat#+  {-# INLINE (/) #-}+  recip = mapV (divideFloat# 1.0#)+  {-# INLINE recip #-}+  fromRational = broadcastArray . fromRational+  {-# INLINE fromRational #-}++++instance Floating (ArrayF ds) where+  pi = broadcastArray pi+  {-# INLINE pi #-}+  exp = mapV expFloat#+  {-# INLINE exp #-}+  log = mapV logFloat#+  {-# INLINE log #-}+  sqrt = mapV sqrtFloat#+  {-# INLINE sqrt #-}+  sin = mapV sinFloat#+  {-# INLINE sin #-}+  cos = mapV cosFloat#+  {-# INLINE cos #-}+  tan = mapV tanFloat#+  {-# INLINE tan #-}+  asin = mapV asinFloat#+  {-# INLINE asin #-}+  acos = mapV acosFloat#+  {-# INLINE acos #-}+  atan = mapV atanFloat#+  {-# INLINE atan #-}+  sinh = mapV sinFloat#+  {-# INLINE sinh #-}+  cosh = mapV coshFloat#+  {-# INLINE cosh #-}+  tanh = mapV tanhFloat#+  {-# INLINE tanh #-}+  (**) = zipV powerFloat#+  {-# INLINE (**) #-}++  logBase = zipV (\x y -> logFloat# y `divideFloat#` logFloat# x)+  {-# INLINE logBase #-}+  asinh = mapV (\x -> logFloat# (x `plusFloat#`+                                sqrtFloat# (1.0# `plusFloat#` timesFloat# x x)))+  {-# INLINE asinh #-}+  acosh = mapV (\x ->  case plusFloat# x 1.0# of+                 y -> logFloat# ( x `plusFloat#` timesFloat# y+                           (sqrtFloat# (minusFloat# x 1.0# `divideFloat#` y))+                        )+               )+  {-# INLINE acosh #-}+  atanh = mapV (\x -> 0.5# `timesFloat#`+                logFloat# (plusFloat# 1.0# x `divideFloat#` minusFloat# 1.0# x))+  {-# INLINE atanh #-}+++++instance (KnownDim n, KnownDim m, ArrayF '[n,m] ~ Array Float '[n,m], 2 <= n, 2 <= m)+      => MatrixCalculus Float n m where+  transpose (KnownDataFrame (ArrayF# offs nm arr)) = case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) -> case loop2# n m+               (\i j s' -> writeFloatArray# marr (j +# m *# i)+                              (indexFloatArray# arr (offs +# j *# n +# i)) s'+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, nm, r #)+    where+      n = case dimVal' @n of I# np -> np+      m = case dimVal' @m of I# mp -> mp+      bs = n *# m *# SIZEOF_HSFLOAT#+  transpose (KnownDataFrame (FromScalarF# x)) = unsafeCoerce# $ FromScalarF# x++instance ( KnownDim n, ArrayF '[n,n] ~ Array Float '[n,n] )+      => SquareMatrixCalculus Float n where+  eye = case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) -> case loop1# n+               (\j s' -> writeFloatArray# marr (j *# n1) 1.0# s'+               ) (setByteArray# marr 0# bs 0# s1) of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, n *# n,  r #)+    where+      n1 = n +# 1#+      n = case dimVal' @n of I# np -> np+      bs = n *# n *# SIZEOF_HSFLOAT#+  {-# INLINE eye #-}+  diag (KnownDataFrame (Scalar (F# v))) = case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) -> case loop1# n+               (\j s' -> writeFloatArray# marr (j *# n1) v s'+               ) (setByteArray# marr 0# bs 0# s1) of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, n *# n,  r #)+    where+      n1 = n +# 1#+      n = case dimVal' @n of I# np -> np+      bs = n *# n *# SIZEOF_HSFLOAT#+  {-# INLINE diag #-}+++  det (KnownDataFrame (ArrayF# off nsqr arr)) = case runRW#+     ( \s0 -> case newByteArray# bs s0 of+       (# s1, mat #) -> case newByteArray#+                            (n *# SIZEOF_HSFLOAT#)+                            (copyByteArray# arr offb mat 0# bs s1) of+         (# s2, vec #) ->+            let f i x s | isTrue# (i >=# n) = (# s, x #)+                        | otherwise =+                            let !(# s' , j  #) = maxInRowRem# n n i mat s+                                !(# s'', x' #) = if isTrue# (i /=# j)+                                                then (# swapCols# n i j vec mat s'+                                                               , negateFloat# x #)+                                                else (# s', x #)+                                !(# s''', y #) = clearRowEnd# n n i mat s''+                            in if isTrue# (eqFloat# 0.0# y)+                               then (# s''', 0.0# #)+                               else f (i +# 1#) (timesFloat# x' y) s'''+            in f 0# 1.0# s2+     ) of (# _, r #) -> F# r+    where+      n = case dimVal' @n of I# np -> np+      offb = off *# SIZEOF_HSFLOAT#+      bs = nsqr *# SIZEOF_HSFLOAT#+  det (KnownDataFrame (FromScalarF# _)) = 0+  {-# INLINE det #-}++++  trace (KnownDataFrame (ArrayF# off nsqr a)) = KnownDataFrame (Scalar (F# (loop' 0# 0.0#)))+    where+      n1 = n +# 1#+      n = case dimVal' @n of I# np -> np+      loop' i acc | isTrue# (i ># nsqr) = acc+                  | otherwise = loop' (i +# n1)+                         (indexFloatArray# a (off +# i) `plusFloat#` acc)+  trace (KnownDataFrame (FromScalarF# x)) = KnownDataFrame (Scalar (F# (x `timesFloat#` n)))+    where+      n = case fromIntegral (dimVal' @n) of F# np -> np+  {-# INLINE trace #-}++++instance (KnownNat n, ArrayF '[n,n] ~ Array Float '[n,n], 2 <= n) => MatrixInverse Float n where+  inverse (KnownDataFrame (ArrayF# offs nsqr arr)) = case runRW#+     ( \s0 -> case newByteArray# (bs *# 2#) s0 of+         (# s1, mat #) -> case newByteArray# (vs *# 2#)+                -- copy original matrix to the top of an augmented matrix+                (loop1# n (\i s -> writeFloatArray# mat+                           (i *# nn +# i +# n) 1.0#+                           (copyByteArray# arr (offb +# i *# vs)+                                           mat (2# *# i *# vs) vs s))+                         (setByteArray# mat 0# (bs *# 2#) 0# s1)+                ) of+           (# s2, vec #) ->+              let f i s | isTrue# (i >=# n) = s+                        | otherwise =+                            let !(# s' , j  #) = maxInRowRem# nn n i mat s+                                s''           = if isTrue# (i /=# j) then swapCols# nn i j vec mat s'+                                                                     else s'+                                !(# s''', _ #) = clearRowAll# nn n i mat s''+                            in f (i +# 1#) s'''+              in unsafeFreezeByteArray# mat+                  ( shrinkMutableByteArray# mat bs+                   (-- copy inverse matrix from the augmented part+                    loop1# n (\i s ->+                       copyMutableByteArray# mat+                                             (2# *# i *# vs +# vs)+                                             mat (i *# vs) vs s)+                   (f 0# s2)+                   )+                  )+     ) of (# _, r #) -> KnownDataFrame (ArrayF# 0# nsqr r)+    where+      nn = 2# *# n+      n = case dimVal' @n of I# np -> np+      vs = n *# SIZEOF_HSFLOAT#+      bs = n *# n *# SIZEOF_HSFLOAT#+      offb = offs *# SIZEOF_HSFLOAT#+  inverse (KnownDataFrame (FromScalarF# _)) = error "Cannot take inverse of a degenerate matrix"+++-----------------------------------------------------------------------------+-- Helpers+-----------------------------------------------------------------------------++-- #ifndef UNSAFE_INDICES+--       | isTrue# ( (i ># dim# _x)+--            `orI#` (i <=# 0#)+--           )       = error $ "Bad index " +++--                     show (I# i) ++ " for " ++ show (dim _x)  ++ "D vector"+--       | otherwise+-- #endif+++-- | Swap columns i and j. Does not check if i or j is larger than matrix width m+swapCols# :: Int# -- n+          -> Int# -- ith column to swap+          -> Int# -- jth column to swap+          -> MutableByteArray# s -- buffer byte array of length of n elems+          -> MutableByteArray# s -- byte array of matrix+          -> State# s -- previous state+          -> State# s -- next state+swapCols# n i j vec mat s0 =+  -- copy ith column to bugger vec+  case copyMutableByteArray# mat (i *# bs) vec 0# bs s0 of+    s1 -> case copyMutableByteArray# mat (j *# bs) mat (i *# bs) bs s1 of+      s2 -> copyMutableByteArray# vec 0# mat (j *# bs) bs s2+ where+  bs = n *# SIZEOF_HSFLOAT#++-- | Starting from i-th row and i+1-th column, substract a multiple of i-th column from i+1 .. m columns,+--   such that there are only zeroes in i-th row and i+1..m columns elements.+clearRowEnd# :: Int# -- n+             -> Int# -- m+             -> Int# -- ith column to remove from all others+             -> MutableByteArray# s -- byte array of matrix+             -> State# s -- previous state+             -> (# State# s, Float# #) -- next state and a diagonal element+clearRowEnd# n m i mat s0 = (# loop' (i +# 1#) s1, y' #)+  where+    y0 = (n +# 1#) *# i +# 1# -- first element in source column+    !(# s1, y' #) = readFloatArray# mat ((n +# 1#) *# i) s0 -- diagonal element, must be non-zero+    yrc = 1.0# `divideFloat#` y'+    n' = n -# i -# 1#+    loop' k s | isTrue# (k >=# m) = s+              | otherwise = loop' (k +# 1#)+       ( let x0 = k *# n +# i+             !(# s', a' #) = readFloatArray# mat x0 s+             s'' = writeFloatArray# mat x0 0.0# s'+             a  = a' `timesFloat#` yrc+         in multNRem# n' (x0 +# 1#) y0 a mat s''+       )++-- | Substract a multiple of i-th column from 0 .. i-1 and i+1 .. m columns,+--   such that there are only zeroes in i-th row everywhere except i-th column+--   Assuming that elements in 0..i-1 columnts and in i-th row are zeroes, so they do not affect other columns.+--   After all columns updated, divide i-th row by its diagonal element, so (i,i) element has 1.+clearRowAll# :: Int# -- n+             -> Int# -- m+             -> Int# -- ith column to remove from all others+             -> MutableByteArray# s -- byte array of matrix+             -> State# s -- previous state+             -> (# State# s, Float# #) -- next state and a diagonal element+clearRowAll# n m i mat s0 = (# divLoop (i +# 1#)+            (writeFloatArray# mat ((n +# 1#) *# i) 1.0#+            (loop' 0# i (loop' (i +# 1#) m s1))), y' #)+  where+    y0 = (n +# 1#) *# i +# 1# -- first element in source column+    !(# s1, y' #) = readFloatArray# mat ((n +# 1#) *# i) s0 -- diagonal element, must be non-zero+    yrc = 1.0# `divideFloat#` y'+    n' = n -# i -# 1#+    loop' k km s | isTrue# (k >=# km) = s+                 | otherwise = loop' (k +# 1#) km+       ( let x0 = k *# n +# i+             !(# s', a' #) = readFloatArray# mat x0 s+             s'' = writeFloatArray# mat x0 0.0# s'+             a  = a' `timesFloat#` yrc+         in multNRem# n' (x0 +# 1#) y0 a mat s''+       )+    divLoop k s | isTrue# (k >=# n) = s+                | otherwise = divLoop (k +# 1#)+       ( let x0 = n *# i +# k+             !(# s', x #) = readFloatArray# mat x0 s+         in writeFloatArray# mat x0 (timesFloat# x yrc) s'+       )+++-- | Remove a multiple of one row from another one.+--   do: xi = xi - yi*a+multNRem# :: Int# -- n - nr of elements to go through+          -> Int# -- start idx of x (update)+          -> Int# -- start idx of y (read)+          -> Float# -- multiplier a+          -> MutableByteArray# s -- byte array of matrix+          -> State# s -- previous state+          -> State# s -- next state+multNRem# 0# _ _  _ _ s = s+multNRem# n x0 y0 a mat s = multNRem# (n -# 1#) (x0 +# 1#) (y0 +# 1#) a mat+  ( case readFloatArray# mat y0 s of+     (# s1, y #) -> case readFloatArray# mat x0 s1 of+       (# s2, x #) -> writeFloatArray# mat x0 (x `minusFloat#` timesFloat# y a) s2+  )++++-- | Gives index of maximum (absolute) element in i-th row, starting from i-th element only.+--   If i >= m then returns i.+maxInRowRem# :: Int# -- n+             -> Int# -- m+             -> Int# -- ith column to start to search for and a row to look in+             -> MutableByteArray# s -- byte array of matrix+             -> State# s -- previous state+             -> (# State# s, Int# #) -- next state+maxInRowRem# n m i mat s0 = loop' i (abs# v) i s1+  where+    !(# s1, v #) = readFloatArray# mat ((n +# 1#) *# i) s0+    abs# x = if isTrue# (x `geFloat#` 0.0#) then x else negateFloat# x+    loop' ok ov k s | isTrue# (k >=# m) = (# s, ok #)+                    | otherwise = case readFloatArray# mat (n *# k +# i) s of+                        (# s', v' #) -> if isTrue# (abs# v' `gtFloat#` ov)+                                        then loop' k (abs# v') (k +# 1#) s'+                                        else loop' ok ov (k +# 1#) s'++-- | Do something in a loop for int i from 0 to n-1 and j from 0 to m-1+loop2# :: Int# -> Int# -> (Int# -> Int#-> State# s -> State# s)+       -> State# s -> State# s+loop2# n m f = loop0 0# 0#+  where+    loop0 i j s | isTrue# (j ==# m) = s+                | isTrue# (i ==# n) = loop0 0# (j +# 1#) s+                | otherwise         = case f i j s of s1 -> loop0 (i +# 1#) j s1+{-# INLINE loop2# #-}

@@ -0,0 +1,95 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE BangPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.Family.ArrayI+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayI () where++import           GHC.Base                  (runRW#)+import           GHC.Prim+import           GHC.Types                 (Int (..), RuntimeRep (..), isTrue#)++import           Numeric.Array.ElementWise+import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.Dimensions+import           Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE                 ArrayI+#define ARR_FROMSCALAR           FromScalarI#+#define ARR_CONSTR               ArrayI#+#define EL_TYPE_BOXED            Int+#define EL_TYPE_PRIM             Int#+#define EL_RUNTIME_REP           'IntRep+#define EL_CONSTR                I#+#define EL_SIZE                  SIZEOF_HSINT#+#define EL_ALIGNMENT             ALIGNMENT_HSINT#+#define EL_ZERO                  0#+#define EL_ONE                   1#+#define EL_MINUS_ONE             -1#+#define INDEX_ARRAY              indexIntArray#+#define WRITE_ARRAY              writeIntArray#+#define OP_EQ                    (==#)+#define OP_NE                    (/=#)+#define OP_GT                    (>#)+#define OP_GE                    (>=#)+#define OP_LT                    (<#)+#define OP_LE                    (<=#)+#define OP_PLUS                  (+#)+#define OP_MINUS                 (-#)+#define OP_TIMES                 (*#)+#define OP_NEGATE                negateInt#+#include "Array.h"+++instance Num (ArrayI ds) where+  (+) = zipV (+#)+  {-# INLINE (+) #-}+  (-) = zipV (-#)+  {-# INLINE (-) #-}+  (*) = zipV (*#)+  {-# INLINE (*) #-}+  negate = mapV negateInt#+  {-# INLINE negate #-}+  abs = mapV (\x -> if isTrue# (x >=# 0#)+                    then x+                    else negateInt# x+                )+  {-# INLINE abs #-}+  signum = mapV (\x -> if isTrue# (x ># 0#)+                       then 1#+                       else if isTrue# (x <# 0#)+                            then -1#+                            else 0#+                )+  {-# INLINE signum #-}+  fromInteger = broadcastArray . fromInteger+  {-# INLINE fromInteger #-}++instance Bounded (ArrayI ds) where+    minBound = broadcastArray minBound+    maxBound = broadcastArray maxBound

@@ -0,0 +1,96 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE BangPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.Family.ArrayI16+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayI16 () where++import           GHC.Base                  (runRW#)+import           GHC.Prim+import           GHC.Types                 (Int (..), RuntimeRep (..), isTrue#)+import           GHC.Int                   (Int16 (..))++import           Numeric.Array.ElementWise+import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.Dimensions+import           Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE                 ArrayI16+#define ARR_FROMSCALAR           FromScalarI16#+#define ARR_CONSTR               ArrayI16#+#define EL_TYPE_BOXED            Int16+#define EL_TYPE_PRIM             Int#+#define EL_RUNTIME_REP           'IntRep+#define EL_CONSTR                I16#+#define EL_SIZE                  SIZEOF_INT16#+#define EL_ALIGNMENT             ALIGNMENT_INT16#+#define EL_ZERO                  0#+#define EL_ONE                   1#+#define EL_MINUS_ONE             -1#+#define INDEX_ARRAY              indexInt16Array#+#define WRITE_ARRAY              writeInt16Array#+#define OP_EQ                    (==#)+#define OP_NE                    (/=#)+#define OP_GT                    (>#)+#define OP_GE                    (>=#)+#define OP_LT                    (<#)+#define OP_LE                    (<=#)+#define OP_PLUS                  (+#)+#define OP_MINUS                 (-#)+#define OP_TIMES                 (*#)+#define OP_NEGATE                negateInt#+#include "Array.h"+++instance Num (ArrayI16 ds) where+  (+) = zipV (+#)+  {-# INLINE (+) #-}+  (-) = zipV (-#)+  {-# INLINE (-) #-}+  (*) = zipV (*#)+  {-# INLINE (*) #-}+  negate = mapV negateInt#+  {-# INLINE negate #-}+  abs = mapV (\x -> if isTrue# (x >=# 0#)+                    then x+                    else negateInt# x+                )+  {-# INLINE abs #-}+  signum = mapV (\x -> if isTrue# (x ># 0#)+                       then 1#+                       else if isTrue# (x <# 0#)+                            then -1#+                            else 0#+                )+  {-# INLINE signum #-}+  fromInteger = broadcastArray . fromInteger+  {-# INLINE fromInteger #-}++instance Bounded (ArrayI16 ds) where+    minBound = broadcastArray minBound+    maxBound = broadcastArray maxBound

@@ -0,0 +1,96 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE BangPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.Family.ArrayI32+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayI32 () where++import           GHC.Base                  (runRW#)+import           GHC.Prim+import           GHC.Types                 (Int (..), RuntimeRep (..), isTrue#)+import           GHC.Int                   (Int32 (..))++import           Numeric.Array.ElementWise+import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.Dimensions+import           Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE                 ArrayI32+#define ARR_FROMSCALAR           FromScalarI32#+#define ARR_CONSTR               ArrayI32#+#define EL_TYPE_BOXED            Int32+#define EL_TYPE_PRIM             Int#+#define EL_RUNTIME_REP           'IntRep+#define EL_CONSTR                I32#+#define EL_SIZE                  SIZEOF_INT32#+#define EL_ALIGNMENT             ALIGNMENT_INT32#+#define EL_ZERO                  0#+#define EL_ONE                   1#+#define EL_MINUS_ONE             -1#+#define INDEX_ARRAY              indexInt32Array#+#define WRITE_ARRAY              writeInt32Array#+#define OP_EQ                    (==#)+#define OP_NE                    (/=#)+#define OP_GT                    (>#)+#define OP_GE                    (>=#)+#define OP_LT                    (<#)+#define OP_LE                    (<=#)+#define OP_PLUS                  (+#)+#define OP_MINUS                 (-#)+#define OP_TIMES                 (*#)+#define OP_NEGATE                negateInt#+#include "Array.h"+++instance Num (ArrayI32 ds) where+  (+) = zipV (+#)+  {-# INLINE (+) #-}+  (-) = zipV (-#)+  {-# INLINE (-) #-}+  (*) = zipV (*#)+  {-# INLINE (*) #-}+  negate = mapV negateInt#+  {-# INLINE negate #-}+  abs = mapV (\x -> if isTrue# (x >=# 0#)+                    then x+                    else negateInt# x+                )+  {-# INLINE abs #-}+  signum = mapV (\x -> if isTrue# (x ># 0#)+                       then 1#+                       else if isTrue# (x <# 0#)+                            then -1#+                            else 0#+                )+  {-# INLINE signum #-}+  fromInteger = broadcastArray . fromInteger+  {-# INLINE fromInteger #-}++instance Bounded (ArrayI32 ds) where+    minBound = broadcastArray minBound+    maxBound = broadcastArray maxBound

@@ -0,0 +1,96 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE BangPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.Family.ArrayI64+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayI64 () where++import           GHC.Base                  (runRW#)+import           GHC.Prim+import           GHC.Types                 (Int (..), RuntimeRep (..), isTrue#)+import           GHC.Int                   (Int64 (..))++import           Numeric.Array.ElementWise+import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.Dimensions+import           Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE                 ArrayI64+#define ARR_FROMSCALAR           FromScalarI64#+#define ARR_CONSTR               ArrayI64#+#define EL_TYPE_BOXED            Int64+#define EL_TYPE_PRIM             Int#+#define EL_RUNTIME_REP           'IntRep+#define EL_CONSTR                I64#+#define EL_SIZE                  SIZEOF_INT64#+#define EL_ALIGNMENT             ALIGNMENT_INT64#+#define EL_ZERO                  0#+#define EL_ONE                   1#+#define EL_MINUS_ONE             -1#+#define INDEX_ARRAY              indexInt64Array#+#define WRITE_ARRAY              writeInt64Array#+#define OP_EQ                    (==#)+#define OP_NE                    (/=#)+#define OP_GT                    (>#)+#define OP_GE                    (>=#)+#define OP_LT                    (<#)+#define OP_LE                    (<=#)+#define OP_PLUS                  (+#)+#define OP_MINUS                 (-#)+#define OP_TIMES                 (*#)+#define OP_NEGATE                negateInt#+#include "Array.h"+++instance Num (ArrayI64 ds) where+  (+) = zipV (+#)+  {-# INLINE (+) #-}+  (-) = zipV (-#)+  {-# INLINE (-) #-}+  (*) = zipV (*#)+  {-# INLINE (*) #-}+  negate = mapV negateInt#+  {-# INLINE negate #-}+  abs = mapV (\x -> if isTrue# (x >=# 0#)+                    then x+                    else negateInt# x+                )+  {-# INLINE abs #-}+  signum = mapV (\x -> if isTrue# (x ># 0#)+                       then 1#+                       else if isTrue# (x <# 0#)+                            then -1#+                            else 0#+                )+  {-# INLINE signum #-}+  fromInteger = broadcastArray . fromInteger+  {-# INLINE fromInteger #-}++instance Bounded (ArrayI64 ds) where+    minBound = broadcastArray minBound+    maxBound = broadcastArray maxBound

@@ -0,0 +1,96 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE BangPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.Family.ArrayI8+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayI8 () where++import           GHC.Base                  (runRW#)+import           GHC.Prim+import           GHC.Types                 (Int (..), RuntimeRep (..), isTrue#)+import           GHC.Int                   (Int8 (..))++import           Numeric.Array.ElementWise+import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.Dimensions+import           Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE                 ArrayI8+#define ARR_FROMSCALAR           FromScalarI8#+#define ARR_CONSTR               ArrayI8#+#define EL_TYPE_BOXED            Int8+#define EL_TYPE_PRIM             Int#+#define EL_RUNTIME_REP           'IntRep+#define EL_CONSTR                I8#+#define EL_SIZE                  SIZEOF_INT8#+#define EL_ALIGNMENT             ALIGNMENT_INT8#+#define EL_ZERO                  0#+#define EL_ONE                   1#+#define EL_MINUS_ONE             -1#+#define INDEX_ARRAY              indexInt8Array#+#define WRITE_ARRAY              writeInt8Array#+#define OP_EQ                    (==#)+#define OP_NE                    (/=#)+#define OP_GT                    (>#)+#define OP_GE                    (>=#)+#define OP_LT                    (<#)+#define OP_LE                    (<=#)+#define OP_PLUS                  (+#)+#define OP_MINUS                 (-#)+#define OP_TIMES                 (*#)+#define OP_NEGATE                negateInt#+#include "Array.h"+++instance Num (ArrayI8 ds) where+  (+) = zipV (+#)+  {-# INLINE (+) #-}+  (-) = zipV (-#)+  {-# INLINE (-) #-}+  (*) = zipV (*#)+  {-# INLINE (*) #-}+  negate = mapV negateInt#+  {-# INLINE negate #-}+  abs = mapV (\x -> if isTrue# (x >=# 0#)+                    then x+                    else negateInt# x+                )+  {-# INLINE abs #-}+  signum = mapV (\x -> if isTrue# (x ># 0#)+                       then 1#+                       else if isTrue# (x <# 0#)+                            then -1#+                            else 0#+                )+  {-# INLINE signum #-}+  fromInteger = broadcastArray . fromInteger+  {-# INLINE fromInteger #-}++instance Bounded (ArrayI8 ds) where+    minBound = broadcastArray minBound+    maxBound = broadcastArray maxBound

@@ -0,0 +1,89 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE BangPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.Family.ArrayW+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayW () where++import           GHC.Base                  (runRW#)+import           GHC.Prim+import           GHC.Types                 (Word (..), Int (..), RuntimeRep (..), isTrue#)++import           Numeric.Array.ElementWise+import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.Dimensions+import           Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE                 ArrayW+#define ARR_FROMSCALAR           FromScalarW#+#define ARR_CONSTR               ArrayW#+#define EL_TYPE_BOXED            Word+#define EL_TYPE_PRIM             Word#+#define EL_RUNTIME_REP           'WordRep+#define EL_CONSTR                W#+#define EL_SIZE                  SIZEOF_HSWORD#+#define EL_ALIGNMENT             ALIGNMENT_HSWORD#+#define EL_ZERO                  0##+#define EL_ONE                   1##+#define EL_MINUS_ONE             -1#+#define INDEX_ARRAY              indexWordArray#+#define WRITE_ARRAY              writeWordArray#+#define OP_EQ                    eqWord#+#define OP_NE                    neWord#+#define OP_GT                    gtWord#+#define OP_GE                    geWord#+#define OP_LT                    ltWord#+#define OP_LE                    leWord#+#define OP_PLUS                  plusWord#+#define OP_MINUS                 minusWord#+#define OP_TIMES                 timesWord#+#include "Array.h"++instance Num (ArrayW ds) where+  (+) = zipV plusWord#+  {-# INLINE (+) #-}+  (-) = zipV minusWord#+  {-# INLINE (-) #-}+  (*) = zipV timesWord#+  {-# INLINE (*) #-}+  negate = mapV (\x -> int2Word# (negateInt# (word2Int# x)))+  {-# INLINE negate #-}+  abs = id+  {-# INLINE abs #-}+  signum = mapV (\x -> if isTrue# (gtWord# x 0##)+                       then 1##+                       else 0##+                )+  {-# INLINE signum #-}+  fromInteger = broadcastArray . fromInteger+  {-# INLINE fromInteger #-}+++instance Bounded (ArrayW ds) where+    minBound = broadcastArray minBound+    maxBound = broadcastArray maxBound

@@ -0,0 +1,90 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE BangPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.Family.ArrayW16+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayW16 () where++import           GHC.Base                  (runRW#)+import           GHC.Prim+import           GHC.Types                 (Int (..), RuntimeRep (..), isTrue#)+import           GHC.Word                  (Word16 (..))++import           Numeric.Array.ElementWise+import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.Dimensions+import           Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE                 ArrayW16+#define ARR_FROMSCALAR           FromScalarW16#+#define ARR_CONSTR               ArrayW16#+#define EL_TYPE_BOXED            Word16+#define EL_TYPE_PRIM             Word#+#define EL_RUNTIME_REP           'WordRep+#define EL_CONSTR                W16#+#define EL_SIZE                  SIZEOF_WORD16#+#define EL_ALIGNMENT             ALIGNMENT_WORD16#+#define EL_ZERO                  0##+#define EL_ONE                   1##+#define EL_MINUS_ONE             -1#+#define INDEX_ARRAY              indexWord16Array#+#define WRITE_ARRAY              writeWord16Array#+#define OP_EQ                    eqWord#+#define OP_NE                    neWord#+#define OP_GT                    gtWord#+#define OP_GE                    geWord#+#define OP_LT                    ltWord#+#define OP_LE                    leWord#+#define OP_PLUS                  plusWord#+#define OP_MINUS                 minusWord#+#define OP_TIMES                 timesWord#+#include "Array.h"++instance Num (ArrayW16 ds) where+  (+) = zipV plusWord#+  {-# INLINE (+) #-}+  (-) = zipV minusWord#+  {-# INLINE (-) #-}+  (*) = zipV timesWord#+  {-# INLINE (*) #-}+  negate = mapV (\x -> int2Word# (negateInt# (word2Int# x)))+  {-# INLINE negate #-}+  abs = id+  {-# INLINE abs #-}+  signum = mapV (\x -> if isTrue# (gtWord# x 0##)+                       then 1##+                       else 0##+                )+  {-# INLINE signum #-}+  fromInteger = broadcastArray . fromInteger+  {-# INLINE fromInteger #-}+++instance Bounded (ArrayW16 ds) where+    minBound = broadcastArray minBound+    maxBound = broadcastArray maxBound

@@ -0,0 +1,90 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE BangPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.Family.ArrayW32+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayW32 () where++import           GHC.Base                  (runRW#)+import           GHC.Prim+import           GHC.Types                 (Int (..), RuntimeRep (..), isTrue#)+import           GHC.Word                  (Word32 (..))++import           Numeric.Array.ElementWise+import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.Dimensions+import           Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE                 ArrayW32+#define ARR_FROMSCALAR           FromScalarW32#+#define ARR_CONSTR               ArrayW32#+#define EL_TYPE_BOXED            Word32+#define EL_TYPE_PRIM             Word#+#define EL_RUNTIME_REP           'WordRep+#define EL_CONSTR                W32#+#define EL_SIZE                  SIZEOF_WORD32#+#define EL_ALIGNMENT             ALIGNMENT_WORD32#+#define EL_ZERO                  0##+#define EL_ONE                   1##+#define EL_MINUS_ONE             -1#+#define INDEX_ARRAY              indexWord32Array#+#define WRITE_ARRAY              writeWord32Array#+#define OP_EQ                    eqWord#+#define OP_NE                    neWord#+#define OP_GT                    gtWord#+#define OP_GE                    geWord#+#define OP_LT                    ltWord#+#define OP_LE                    leWord#+#define OP_PLUS                  plusWord#+#define OP_MINUS                 minusWord#+#define OP_TIMES                 timesWord#+#include "Array.h"++instance Num (ArrayW32 ds) where+  (+) = zipV plusWord#+  {-# INLINE (+) #-}+  (-) = zipV minusWord#+  {-# INLINE (-) #-}+  (*) = zipV timesWord#+  {-# INLINE (*) #-}+  negate = mapV (\x -> int2Word# (negateInt# (word2Int# x)))+  {-# INLINE negate #-}+  abs = id+  {-# INLINE abs #-}+  signum = mapV (\x -> if isTrue# (gtWord# x 0##)+                       then 1##+                       else 0##+                )+  {-# INLINE signum #-}+  fromInteger = broadcastArray . fromInteger+  {-# INLINE fromInteger #-}+++instance Bounded (ArrayW32 ds) where+    minBound = broadcastArray minBound+    maxBound = broadcastArray maxBound

@@ -0,0 +1,90 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE BangPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.Family.ArrayW64+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayW64 () where++import           GHC.Base                  (runRW#)+import           GHC.Prim+import           GHC.Types                 (Int (..), RuntimeRep (..), isTrue#)+import           GHC.Word                  (Word64 (..))++import           Numeric.Array.ElementWise+import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.Dimensions+import           Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE                 ArrayW64+#define ARR_FROMSCALAR           FromScalarW64#+#define ARR_CONSTR               ArrayW64#+#define EL_TYPE_BOXED            Word64+#define EL_TYPE_PRIM             Word#+#define EL_RUNTIME_REP           'WordRep+#define EL_CONSTR                W64#+#define EL_SIZE                  SIZEOF_WORD64#+#define EL_ALIGNMENT             ALIGNMENT_WORD64#+#define EL_ZERO                  0##+#define EL_ONE                   1##+#define EL_MINUS_ONE             -1#+#define INDEX_ARRAY              indexWord64Array#+#define WRITE_ARRAY              writeWord64Array#+#define OP_EQ                    eqWord#+#define OP_NE                    neWord#+#define OP_GT                    gtWord#+#define OP_GE                    geWord#+#define OP_LT                    ltWord#+#define OP_LE                    leWord#+#define OP_PLUS                  plusWord#+#define OP_MINUS                 minusWord#+#define OP_TIMES                 timesWord#+#include "Array.h"++instance Num (ArrayW64 ds) where+  (+) = zipV plusWord#+  {-# INLINE (+) #-}+  (-) = zipV minusWord#+  {-# INLINE (-) #-}+  (*) = zipV timesWord#+  {-# INLINE (*) #-}+  negate = mapV (\x -> int2Word# (negateInt# (word2Int# x)))+  {-# INLINE negate #-}+  abs = id+  {-# INLINE abs #-}+  signum = mapV (\x -> if isTrue# (gtWord# x 0##)+                       then 1##+                       else 0##+                )+  {-# INLINE signum #-}+  fromInteger = broadcastArray . fromInteger+  {-# INLINE fromInteger #-}+++instance Bounded (ArrayW64 ds) where+    minBound = broadcastArray minBound+    maxBound = broadcastArray maxBound

@@ -0,0 +1,90 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE BangPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.Family.ArrayW8+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayW8 () where++import           GHC.Base                  (runRW#)+import           GHC.Prim+import           GHC.Types                 (Int (..), RuntimeRep (..), isTrue#)+import           GHC.Word                  (Word8 (..))++import           Numeric.Array.ElementWise+import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.Dimensions+import           Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE                 ArrayW8+#define ARR_FROMSCALAR           FromScalarW8#+#define ARR_CONSTR               ArrayW8#+#define EL_TYPE_BOXED            Word8+#define EL_TYPE_PRIM             Word#+#define EL_RUNTIME_REP           'WordRep+#define EL_CONSTR                W8#+#define EL_SIZE                  SIZEOF_WORD8#+#define EL_ALIGNMENT             ALIGNMENT_WORD8#+#define EL_ZERO                  0##+#define EL_ONE                   1##+#define EL_MINUS_ONE             -1#+#define INDEX_ARRAY              indexWord8Array#+#define WRITE_ARRAY              writeWord8Array#+#define OP_EQ                    eqWord#+#define OP_NE                    neWord#+#define OP_GT                    gtWord#+#define OP_GE                    geWord#+#define OP_LT                    ltWord#+#define OP_LE                    leWord#+#define OP_PLUS                  plusWord#+#define OP_MINUS                 minusWord#+#define OP_TIMES                 timesWord#+#include "Array.h"++instance Num (ArrayW8 ds) where+  (+) = zipV plusWord#+  {-# INLINE (+) #-}+  (-) = zipV minusWord#+  {-# INLINE (-) #-}+  (*) = zipV timesWord#+  {-# INLINE (*) #-}+  negate = mapV (\x -> int2Word# (negateInt# (word2Int# x)))+  {-# INLINE negate #-}+  abs = id+  {-# INLINE abs #-}+  signum = mapV (\x -> if isTrue# (gtWord# x 0##)+                       then 1##+                       else 0##+                )+  {-# INLINE signum #-}+  fromInteger = broadcastArray . fromInteger+  {-# INLINE fromInteger #-}+++instance Bounded (ArrayW8 ds) where+    minBound = broadcastArray minBound+    maxBound = broadcastArray maxBound

@@ -0,0 +1,321 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.Family.FloatX2+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.FloatX2 () where+++#include "MachDeps.h"++import           GHC.Base                  (runRW#)+import           GHC.Prim+import           GHC.Types                 (Float (..), RuntimeRep (..),+                                            isTrue#)++import           Numeric.Array.ElementWise+import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.Dimensions++++++instance Show FloatX2 where+  show (FloatX2# a1 a2) = "{ "     ++ show (F# a1)+                            ++ ", " ++ show (F# a2)+                            ++ " }"++++instance Eq FloatX2 where+  FloatX2# a1 a2 == FloatX2# b1 b2 = isTrue# (  (a1 `eqFloat#` b1)+                                          `andI#` (a2 `eqFloat#` b2)+                                           )+  {-# INLINE (==) #-}+  FloatX2# a1 a2 /= FloatX2# b1 b2 = isTrue# (  (a1 `neFloat#` b1)+                                           `orI#` (a2 `neFloat#` b2)+                                           )+  {-# INLINE (/=) #-}++++-- | Implement partial ordering for `>`, `<`, `>=`, `<=`+--           and lexicographical ordering for `compare`+instance Ord FloatX2 where+  FloatX2# a1 a2 > FloatX2# b1 b2 = isTrue# (   (a1 `gtFloat#` b1)+                                          `andI#` (a2 `gtFloat#` b2)+                                           )+  {-# INLINE (>) #-}+  FloatX2# a1 a2 < FloatX2# b1 b2 = isTrue# (   (a1 `ltFloat#` b1)+                                          `andI#` (a2 `ltFloat#` b2)+                                           )+  {-# INLINE (<) #-}+  FloatX2# a1 a2 >= FloatX2# b1 b2 = isTrue# (  (a1 `geFloat#` b1)+                                          `andI#` (a2 `geFloat#` b2)+                                           )+  {-# INLINE (>=) #-}+  FloatX2# a1 a2 <= FloatX2# b1 b2 = isTrue# (  (a1 `leFloat#` b1)+                                          `andI#` (a2 `leFloat#` b2)+                                           )+  {-# INLINE (<=) #-}+  -- | Compare lexicographically+  compare (FloatX2# a1 a2) (FloatX2# b1 b2)+    | isTrue# (a1 `gtFloat#` b1) = GT+    | isTrue# (a1 `ltFloat#` b1) = LT+    | isTrue# (a2 `gtFloat#` b2) = GT+    | isTrue# (a2 `ltFloat#` b2) = LT+    | otherwise = EQ+  {-# INLINE compare #-}+  -- | Element-wise minimum+  min (FloatX2# a1 a2) (FloatX2# b1 b2) =+      FloatX2# (if isTrue# (a1 `gtFloat#` b1) then b1 else a1)+                (if isTrue# (a2 `gtFloat#` b2) then b2 else a2)+  {-# INLINE min #-}+  -- | Element-wise maximum+  max (FloatX2# a1 a2) (FloatX2# b1 b2) =+      FloatX2# (if isTrue# (a1 `gtFloat#` b1) then a1 else b1)+                (if isTrue# (a2 `gtFloat#` b2) then a2 else b2)+  {-# INLINE max #-}++++-- | element-wise operations for vectors+instance Num FloatX2 where+  FloatX2# a1 a2 + FloatX2# b1 b2+    = FloatX2# (plusFloat# a1 b1) (plusFloat# a2 b2)+  {-# INLINE (+) #-}+  FloatX2# a1 a2 - FloatX2# b1 b2+    = FloatX2# (minusFloat# a1 b1) (minusFloat# a2 b2)+  {-# INLINE (-) #-}+  FloatX2# a1 a2 * FloatX2# b1 b2+    = FloatX2# (timesFloat# a1 b1) (timesFloat# a2 b2)+  {-# INLINE (*) #-}+  negate (FloatX2# a1 a2)+    = FloatX2# (negateFloat# a1) (negateFloat# a2)+  {-# INLINE negate #-}+  abs (FloatX2# a1 a2)+    = FloatX2# (if isTrue# (a1 `geFloat#` 0.0#) then a1 else negateFloat# a1)+                (if isTrue# (a2 `geFloat#` 0.0#) then a2 else negateFloat# a2)+  {-# INLINE abs #-}+  signum (FloatX2# a1 a2)+    = FloatX2# (if isTrue# (a1 `gtFloat#` 0.0#)+                then 1.0#+                else if isTrue# (a1 `ltFloat#` 0.0#) then -1.0# else 0.0# )+               (if isTrue# (a2 `gtFloat#` 0.0#)+                then 1.0#+                else if isTrue# (a2 `ltFloat#` 0.0#) then -1.0# else 0.0# )+  {-# INLINE signum #-}+  fromInteger n = case fromInteger n of F# x -> FloatX2# x x+  {-# INLINE fromInteger #-}++++instance Fractional FloatX2 where+  FloatX2# a1 a2 / FloatX2# b1 b2 = FloatX2# (divideFloat# a1 b1)+                                                (divideFloat# a2 b2)+  {-# INLINE (/) #-}+  recip (FloatX2# a1 a2) = FloatX2# (divideFloat# 1.0# a1)+                                      (divideFloat# 1.0# a2)+  {-# INLINE recip #-}+  fromRational r = case fromRational r of F# x -> FloatX2# x x+  {-# INLINE fromRational #-}++++instance Floating FloatX2 where+  pi = FloatX2# 3.141592653589793238# 3.141592653589793238#+  {-# INLINE pi #-}+  exp (FloatX2# a1 a2) = FloatX2# (expFloat# a1)+                                    (expFloat# a2)+  {-# INLINE exp #-}+  log (FloatX2# a1 a2) = FloatX2# (logFloat# a1)+                                    (logFloat# a2)+  {-# INLINE log #-}+  sqrt (FloatX2# a1 a2) = FloatX2# (sqrtFloat# a1)+                                     (sqrtFloat# a2)+  {-# INLINE sqrt #-}+  sin (FloatX2# a1 a2) = FloatX2# (sinFloat# a1)+                                    (sinFloat# a2)+  {-# INLINE sin #-}+  cos (FloatX2# a1 a2) = FloatX2# (cosFloat# a1)+                                    (cosFloat# a2)+  {-# INLINE cos #-}+  tan (FloatX2# a1 a2) = FloatX2# (tanFloat# a1)+                                    (tanFloat# a2)+  {-# INLINE tan #-}+  asin (FloatX2# a1 a2) = FloatX2# (asinFloat# a1)+                                     (asinFloat# a2)+  {-# INLINE asin #-}+  acos (FloatX2# a1 a2) = FloatX2# (acosFloat# a1)+                                     (acosFloat# a2)+  {-# INLINE acos #-}+  atan (FloatX2# a1 a2) = FloatX2# (atanFloat# a1)+                                     (atanFloat# a2)+  {-# INLINE atan #-}+  sinh (FloatX2# a1 a2) = FloatX2# (sinFloat# a1)+                                     (sinFloat# a2)+  {-# INLINE sinh #-}+  cosh (FloatX2# a1 a2) = FloatX2# (coshFloat# a1)+                                     (coshFloat# a2)+  {-# INLINE cosh #-}+  tanh (FloatX2# a1 a2) = FloatX2# (tanhFloat# a1)+                                     (tanhFloat# a2)+  {-# INLINE tanh #-}+  FloatX2# a1 a2 ** FloatX2# b1 b2 = FloatX2# (powerFloat# a1 b1)+                                                 (powerFloat# a2 b2)+  {-# INLINE (**) #-}++  logBase x y         =  log y / log x+  {-# INLINE logBase #-}+  asinh x = log (x + sqrt (1.0+x*x))+  {-# INLINE asinh #-}+  acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))+  {-# INLINE acosh #-}+  atanh x = 0.5 * log ((1.0+x) / (1.0-x))+  {-# INLINE atanh #-}++++--  log1p (FloatX2# a1 a2) = case ( log1p (F# a1), log1p (F# a2) ) of+--    (F# x1, F# x2) -> FloatX2# x1 x2+--  expm1 (FloatX2# a1 a2) = case ( expm1 (F# a1), expm1 (F# a2) ) of+--    (F# x1, F# x2) -> FloatX2# x1 x2+--+--  log1mexp a+--      | a <= log 2 = log (negate (expm1Float a))+--      | otherwise  = log1p (negate (exp a))+--  {-# INLINE log1mexp #-}+--  log1pexp a+--      | a <= 18   = log1p (exp a)+--      | a <= 100  = a + exp (negate a)+--      | otherwise = a+--  {-# INLINE log1pexp #-}++++-- instance VectorCalculus Float 2 FloatX2 where+--   broadcastVec (F# x) = FloatX2# x x+--   {-# INLINE broadcastVec #-}+--   FloatX2# a1 a2 .*. FloatX2# b1 b2 = case timesFloat# a1 b1+--                                 `plusFloat#` timesFloat# a2 b2 of+--     x -> FloatX2# x x+--   {-# INLINE (.*.) #-}+--   FloatX2# a1 a2 `dot` FloatX2# b1 b2 = F# ( timesFloat# a1 b1+--                                   `plusFloat#` timesFloat# a2 b2+--                                   )+--   {-# INLINE dot #-}+--   indexVec 1 (FloatX2# a1 _) = F# a1+--   indexVec 2 (FloatX2# _ a2) = F# a2+--   indexVec i _ = error $ "Bad index " ++ show i ++ " for 2D vector"+--   {-# INLINE indexVec #-}+--   normL1 v = case abs v of+--       FloatX2# a1 a2 -> F# (a1 `plusFloat#` a2)+--   {-# INLINE normL1 #-}+--   normL2 v = sqrt $ dot v v+--   {-# INLINE normL2 #-}+--   normLPInf (FloatX2# a1 a2)+--     = F# (if isTrue# (a1 `gtFloat#` a2) then a1 else a2)+--   {-# INLINE normLPInf #-}+--   normLNInf (FloatX2# a1 a2)+--     = F# (if isTrue# (a1 `gtFloat#` a2) then a2 else a1)+--   {-# INLINE normLNInf #-}+--   normLP n (FloatX2# a1 a2) = case realToFrac n of+--     F# x -> F# ( powerFloat# (divideFloat# 1.0# x)+--                  (            powerFloat# a1 x+--                  `plusFloat#` powerFloat# a2 x+--                  )+--                )+--   {-# INLINE normLP #-}+--   dim _ = 2+--   {-# INLINE dim #-}+--+--+--+--+-- instance Vector2D Float where+--   vec2 (F# x) (F# y) = FloatX2# x y+--   {-# INLINE vec2 #-}+--   det2 (FloatX2# a1 a2)  (FloatX2# b1 b2)+--     = F# (timesFloat# a1 b2 `minusFloat#` timesFloat# a2 b1)+--   {-# INLINE det2 #-}++type instance ElemRep FloatX2 = 'FloatRep+type instance ElemPrim FloatX2 = Float#+instance PrimBytes FloatX2 where+  toBytes (FloatX2# a1 a2) = case runRW#+     ( \s0 -> case newByteArray# (SIZEOF_HSFLOAT# *# 2#) s0 of+         (# s1, marr #) -> case writeFloatArray# marr 0# a1 s1 of+           s2 -> case writeFloatArray# marr 1# a2 s2 of+             s3 -> unsafeFreezeByteArray# marr s3+     ) of (# _, a #) -> (# 0#, 2#, a #)+  {-# INLINE toBytes #-}+  fromBytes (# off, _, arr #) = FloatX2#+    (indexFloatArray# arr off)+    (indexFloatArray# arr (off +# 1#))+  {-# INLINE fromBytes #-}+  byteSize _ = SIZEOF_HSFLOAT# *# 2#+  {-# INLINE byteSize #-}+  byteAlign _ = ALIGNMENT_HSFLOAT#+  {-# INLINE byteAlign #-}+  elementByteSize _ = SIZEOF_HSFLOAT#+  {-# INLINE elementByteSize #-}+  ix 0# (FloatX2# a1 _) = a1+  ix 1# (FloatX2# _ a2) = a2+  ix _ _                = undefined+  {-# INLINE ix #-}+++instance ElementWise (Idx '[2]) Float FloatX2 where++  (!) (FloatX2# a1 _) ( 1 :! Z) = F# a1+  (!) (FloatX2# _ a2) ( 2 :! Z) = F# a2+  (!) _               ( _ :! Z) = undefined+  {-# INLINE (!) #-}++  broadcast (F# x) = FloatX2# x x+  {-# INLINE broadcast #-}++  ewmap f (FloatX2# x y) = case (f (1:!Z) (F# x), f (2:!Z) (F# y)) of+                              (F# r1, F# r2) -> FloatX2# r1 r2+  {-# INLINE ewmap #-}++  ewgen f = case (f (1:!Z), f (2:!Z)) of (F# r1, F# r2) -> FloatX2# r1 r2+  {-# INLINE ewgen #-}++  ewgenA f = (\(F# r1) (F# r2) -> FloatX2# r1 r2) <$> f (1:!Z) <*> f (2:!Z)+  {-# INLINE ewgenA #-}++  ewfoldl f x0 (FloatX2# x y) = f (2:!Z) (f (1:!Z) x0 (F# x)) (F# y)+  {-# INLINE ewfoldl #-}++  ewfoldr f x0 (FloatX2# x y) = f (1:!Z) (F# x) (f (2:!Z) (F# y) x0)+  {-# INLINE ewfoldr #-}++  elementWise f (FloatX2# x y) = (\(F# a) (F# b) -> FloatX2# a b)+                               <$> f (F# x) <*> f (F# y)+  {-# INLINE elementWise #-}++  indexWise f (FloatX2# x y) = (\(F# a) (F# b) -> FloatX2# a b)+                             <$> f (1:!Z) (F# x) <*> f (2:!Z) (F# y)+  {-# INLINE indexWise #-}++  update (1 :! Z) (F# q) (FloatX2# _ y) = FloatX2# q y+  update (2 :! Z) (F# q) (FloatX2# x _) = FloatX2# x q+  update (_ :! Z) _ x = x+  {-# INLINE update #-}

@@ -0,0 +1,294 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.Family.FloatX3+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.FloatX3 () where+++#include "MachDeps.h"++import           GHC.Base                  (runRW#)+import           GHC.Prim+import           GHC.Types                 (Float (..), RuntimeRep (..),+                                            isTrue#)++import           Numeric.Array.ElementWise+import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.Dimensions++++++instance Show FloatX3 where+  show (FloatX3# a1 a2 a3) = "{ "     ++ show (F# a1)+                              ++ ", " ++ show (F# a2)+                              ++ ", " ++ show (F# a3)+                              ++ " }"++++instance Eq FloatX3 where+  FloatX3# a1 a2 a3 == FloatX3# b1 b2 b3 = isTrue# (  (a1 `eqFloat#` b1)+                                              `andI#` (a2 `eqFloat#` b2)+                                              `andI#` (a3 `eqFloat#` b3)+                                              )+  {-# INLINE (==) #-}+  FloatX3# a1 a2 a3 /= FloatX3# b1 b2 b3 = isTrue# (  (a1 `neFloat#` b1)+                                               `orI#` (a2 `neFloat#` b2)+                                               `orI#` (a3 `neFloat#` b3)+                                               )+  {-# INLINE (/=) #-}++++-- | Implement partial ordering for `>`, `<`, `>=`, `<=`+--           and lexicographical ordering for `compare`+instance Ord FloatX3 where+  FloatX3# a1 a2 a3 > FloatX3# b1 b2 b3 = isTrue# (   (a1 `gtFloat#` b1)+                                              `andI#` (a2 `gtFloat#` b2)+                                              `andI#` (a3 `gtFloat#` b3)+                                              )+  {-# INLINE (>) #-}+  FloatX3# a1 a2 a3 < FloatX3# b1 b2 b3 = isTrue# (   (a1 `ltFloat#` b1)+                                              `andI#` (a2 `ltFloat#` b2)+                                              `andI#` (a3 `ltFloat#` b3)+                                              )+  {-# INLINE (<) #-}+  FloatX3# a1 a2 a3 >= FloatX3# b1 b2 b3 = isTrue# (  (a1 `geFloat#` b1)+                                              `andI#` (a2 `geFloat#` b2)+                                              `andI#` (a3 `geFloat#` b3)+                                              )+  {-# INLINE (>=) #-}+  FloatX3# a1 a2 a3 <= FloatX3# b1 b2 b3 = isTrue# (  (a1 `leFloat#` b1)+                                              `andI#` (a2 `leFloat#` b2)+                                              `andI#` (a3 `leFloat#` b3)+                                              )+  {-# INLINE (<=) #-}+  -- | Compare lexicographically+  compare (FloatX3# a1 a2 a3) (FloatX3# b1 b2 b3)+    | isTrue# (a1 `gtFloat#` b1) = GT+    | isTrue# (a1 `ltFloat#` b1) = LT+    | isTrue# (a2 `gtFloat#` b2) = GT+    | isTrue# (a2 `ltFloat#` b2) = LT+    | isTrue# (a3 `gtFloat#` b3) = GT+    | isTrue# (a3 `ltFloat#` b3) = LT+    | otherwise = EQ+  {-# INLINE compare #-}+  -- | Element-wise minimum+  min (FloatX3# a1 a2 a3) (FloatX3# b1 b2 b3) =+      FloatX3# (if isTrue# (a1 `gtFloat#` b1) then b1 else a1)+               (if isTrue# (a2 `gtFloat#` b2) then b2 else a2)+               (if isTrue# (a3 `gtFloat#` b3) then b3 else a3)+  {-# INLINE min #-}+  -- | Element-wise maximum+  max (FloatX3# a1 a2 a3) (FloatX3# b1 b2 b3) =+      FloatX3# (if isTrue# (a1 `gtFloat#` b1) then a1 else b1)+               (if isTrue# (a2 `gtFloat#` b2) then a2 else b2)+               (if isTrue# (a3 `gtFloat#` b3) then a3 else b3)+  {-# INLINE max #-}++++-- | element-wise operations for vectors+instance Num FloatX3 where+  FloatX3# a1 a2 a3 + FloatX3# b1 b2 b3+    = FloatX3# (plusFloat# a1 b1) (plusFloat# a2 b2) (plusFloat# a3 b3)+  {-# INLINE (+) #-}+  FloatX3# a1 a2 a3 - FloatX3# b1 b2 b3+    = FloatX3# (minusFloat# a1 b1) (minusFloat# a2 b2) (minusFloat# a3 b3)+  {-# INLINE (-) #-}+  FloatX3# a1 a2 a3 * FloatX3# b1 b2 b3+    = FloatX3# (timesFloat# a1 b1) (timesFloat# a2 b2) (timesFloat# a3 b3)+  {-# INLINE (*) #-}+  negate (FloatX3# a1 a2 a3)+    = FloatX3# (negateFloat# a1) (negateFloat# a2) (negateFloat# a3)+  {-# INLINE negate #-}+  abs (FloatX3# a1 a2 a3)+    = FloatX3# (if isTrue# (a1 `geFloat#` 0.0#) then a1 else negateFloat# a1)+               (if isTrue# (a2 `geFloat#` 0.0#) then a2 else negateFloat# a2)+               (if isTrue# (a3 `geFloat#` 0.0#) then a3 else negateFloat# a3)+  {-# INLINE abs #-}+  signum (FloatX3# a1 a2 a3)+    = FloatX3# (if isTrue# (a1 `gtFloat#` 0.0#)+                then 1.0#+                else if isTrue# (a1 `ltFloat#` 0.0#) then -1.0# else 0.0# )+               (if isTrue# (a2 `gtFloat#` 0.0#)+                then 1.0#+                else if isTrue# (a2 `ltFloat#` 0.0#) then -1.0# else 0.0# )+               (if isTrue# (a3 `gtFloat#` 0.0#)+                then 1.0#+                else if isTrue# (a3 `ltFloat#` 0.0#) then -1.0# else 0.0# )+  {-# INLINE signum #-}+  fromInteger n = case fromInteger n of F# x -> FloatX3# x x x+  {-# INLINE fromInteger #-}++++instance Fractional FloatX3 where+  FloatX3# a1 a2 a3 / FloatX3# b1 b2 b3  = FloatX3# (divideFloat# a1 b1)+                                                    (divideFloat# a2 b2)+                                                    (divideFloat# a3 b3)+  {-# INLINE (/) #-}+  recip (FloatX3# a1 a2 a3) = FloatX3# (divideFloat# 1.0# a1)+                                       (divideFloat# 1.0# a2)+                                       (divideFloat# 1.0# a3)+  {-# INLINE recip #-}+  fromRational r = case fromRational r of F# x -> FloatX3# x x x+  {-# INLINE fromRational #-}++++instance Floating FloatX3 where+  pi = FloatX3# 3.141592653589793238# 3.141592653589793238# 3.141592653589793238#+  {-# INLINE pi #-}+  exp (FloatX3# a1 a2 a3) = FloatX3# (expFloat# a1)+                                     (expFloat# a2)+                                     (expFloat# a3)+  {-# INLINE exp #-}+  log (FloatX3# a1 a2 a3) = FloatX3# (logFloat# a1)+                                     (logFloat# a2)+                                     (logFloat# a3)+  {-# INLINE log #-}+  sqrt (FloatX3# a1 a2 a3) = FloatX3# (sqrtFloat# a1)+                                      (sqrtFloat# a2)+                                      (sqrtFloat# a3)+  {-# INLINE sqrt #-}+  sin (FloatX3# a1 a2 a3) = FloatX3# (sinFloat# a1)+                                     (sinFloat# a2)+                                     (sinFloat# a3)+  {-# INLINE sin #-}+  cos (FloatX3# a1 a2 a3) = FloatX3# (cosFloat# a1)+                                     (cosFloat# a2)+                                     (cosFloat# a3)+  {-# INLINE cos #-}+  tan (FloatX3# a1 a2 a3) = FloatX3# (tanFloat# a1)+                                     (tanFloat# a2)+                                     (tanFloat# a3)+  {-# INLINE tan #-}+  asin (FloatX3# a1 a2 a3) = FloatX3# (asinFloat# a1)+                                      (asinFloat# a2)+                                      (asinFloat# a3)+  {-# INLINE asin #-}+  acos (FloatX3# a1 a2 a3) = FloatX3# (acosFloat# a1)+                                      (acosFloat# a2)+                                      (acosFloat# a3)+  {-# INLINE acos #-}+  atan (FloatX3# a1 a2 a3) = FloatX3# (atanFloat# a1)+                                      (atanFloat# a2)+                                      (atanFloat# a3)+  {-# INLINE atan #-}+  sinh (FloatX3# a1 a2 a3) = FloatX3# (sinFloat# a1)+                                      (sinFloat# a2)+                                      (sinFloat# a3)+  {-# INLINE sinh #-}+  cosh (FloatX3# a1 a2 a3) = FloatX3# (coshFloat# a1)+                                      (coshFloat# a2)+                                      (coshFloat# a3)+  {-# INLINE cosh #-}+  tanh (FloatX3# a1 a2 a3) = FloatX3# (tanhFloat# a1)+                                      (tanhFloat# a2)+                                      (tanhFloat# a3)+  {-# INLINE tanh #-}+  FloatX3# a1 a2 a3 ** FloatX3# b1 b2 b3 = FloatX3# (powerFloat# a1 b1)+                                                    (powerFloat# a2 b2)+                                                    (powerFloat# a3 b3)+  {-# INLINE (**) #-}++  logBase x y         =  log y / log x+  {-# INLINE logBase #-}+  asinh x = log (x + sqrt (1.0+x*x))+  {-# INLINE asinh #-}+  acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))+  {-# INLINE acosh #-}+  atanh x = 0.5 * log ((1.0+x) / (1.0-x))+  {-# INLINE atanh #-}++++type instance ElemRep FloatX3 = 'FloatRep+type instance ElemPrim FloatX3 = Float#+instance PrimBytes FloatX3 where+  toBytes (FloatX3# a1 a2 a3) = case runRW#+     ( \s0 -> case newByteArray# (SIZEOF_HSFLOAT# *# 3#) s0 of+         (# s1, marr #) -> case writeFloatArray# marr 0# a1 s1 of+           s2 -> case writeFloatArray# marr 1# a2 s2 of+             s3 -> case writeFloatArray# marr 2# a3 s3 of+               s4 -> unsafeFreezeByteArray# marr s4+     ) of (# _, a #) -> (# 0#, 3#, a #)+  {-# INLINE toBytes #-}+  fromBytes (# off, _, arr #) = FloatX3#+    (indexFloatArray# arr off)+    (indexFloatArray# arr (off +# 1#))+    (indexFloatArray# arr (off +# 2#))+  {-# INLINE fromBytes #-}+  byteSize _ = SIZEOF_HSFLOAT# *# 3#+  {-# INLINE byteSize #-}+  byteAlign _ = ALIGNMENT_HSFLOAT#+  {-# INLINE byteAlign #-}+  elementByteSize _ = SIZEOF_HSFLOAT#+  {-# INLINE elementByteSize #-}+  ix 0# (FloatX3# a1 _ _) = a1+  ix 1# (FloatX3# _ a2 _) = a2+  ix 2# (FloatX3# _ _ a3) = a3+  ix _ _                  = undefined+  {-# INLINE ix #-}+++instance ElementWise (Idx '[3]) Float FloatX3 where++  (!) (FloatX3# a1 _ _) ( 1 :! Z) = F# a1+  (!) (FloatX3# _ a2 _) ( 2 :! Z) = F# a2+  (!) (FloatX3# _ _ a3) ( 3 :! Z) = F# a3+  (!) _               ( _ :! Z)   = undefined+  {-# INLINE (!) #-}++  broadcast (F# x) = FloatX3# x x x+  {-# INLINE broadcast #-}++  ewmap f (FloatX3# x y z) = case (f (1:!Z) (F# x), f (2:!Z) (F# y), f (3:!Z) (F# z)) of+                              (F# r1, F# r2, F# r3) -> FloatX3# r1 r2 r3+  {-# INLINE ewmap #-}++  ewgen f = case (f (1:!Z), f (2:!Z), f (3:!Z)) of (F# r1, F# r2, F# r3) -> FloatX3# r1 r2 r3+  {-# INLINE ewgen #-}++  ewgenA f = (\(F# r1) (F# r2) (F# r3) -> FloatX3# r1 r2 r3)+          <$> f (1:!Z) <*> f (2:!Z) <*> f (3:!Z)+  {-# INLINE ewgenA #-}++  ewfoldl f x0 (FloatX3# x y z) = f (3:!Z) (f (2:!Z) (f (1:!Z) x0 (F# x)) (F# y)) (F# z)+  {-# INLINE ewfoldl #-}++  ewfoldr f x0 (FloatX3# x y z) = f (1:!Z) (F# x) (f (2:!Z) (F# y) (f (3:!Z) (F# z) x0))+  {-# INLINE ewfoldr #-}++  elementWise f (FloatX3# x y z) = (\(F# a) (F# b) (F# c) -> FloatX3# a b c)+                                 <$> f (F# x) <*> f (F# y) <*> f (F# z)+  {-# INLINE elementWise #-}++  indexWise f (FloatX3# x y z) = (\(F# a) (F# b) (F# c) -> FloatX3# a b c)+                             <$> f (1:!Z) (F# x) <*> f (2:!Z) (F# y) <*> f (3:!Z) (F# z)+  {-# INLINE indexWise #-}++  update (1 :! Z) (F# q) (FloatX3# _ y z) = FloatX3# q y z+  update (2 :! Z) (F# q) (FloatX3# x _ z) = FloatX3# x q z+  update (3 :! Z) (F# q) (FloatX3# x y _) = FloatX3# x y q+  update (_ :! Z) _ x = x+  {-# INLINE update #-}

@@ -0,0 +1,329 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Array.Family.FloatX4+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.FloatX4 () where+++#include "MachDeps.h"++import           GHC.Base                  (runRW#)+import           GHC.Prim+import           GHC.Types                 (Float (..), RuntimeRep (..),+                                            isTrue#)++import           Numeric.Array.ElementWise+import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.Dimensions++++++instance Show FloatX4 where+  show (FloatX4# a1 a2 a3 a4) = "{ "     ++ show (F# a1)+                              ++ ", " ++ show (F# a2)+                              ++ ", " ++ show (F# a3)+                              ++ ", " ++ show (F# a4)+                              ++ " }"++++instance Eq FloatX4 where+  FloatX4# a1 a2 a3 a4 == FloatX4# b1 b2 b3 b4 = isTrue# (  (a1 `eqFloat#` b1)+                                              `andI#` (a2 `eqFloat#` b2)+                                              `andI#` (a3 `eqFloat#` b3)+                                              `andI#` (a4 `eqFloat#` b4)+                                              )+  {-# INLINE (==) #-}+  FloatX4# a1 a2 a3 a4 /= FloatX4# b1 b2 b3 b4 = isTrue# (  (a1 `neFloat#` b1)+                                               `orI#` (a2 `neFloat#` b2)+                                               `orI#` (a3 `neFloat#` b3)+                                               `orI#` (a4 `neFloat#` b4)+                                               )+  {-# INLINE (/=) #-}++++-- | Implement partial ordering for `>`, `<`, `>=`, `<=`+--           and lexicographical ordering for `compare`+instance Ord FloatX4 where+  FloatX4# a1 a2 a3 a4 > FloatX4# b1 b2 b3 b4 = isTrue# (   (a1 `gtFloat#` b1)+                                              `andI#` (a2 `gtFloat#` b2)+                                              `andI#` (a3 `gtFloat#` b3)+                                              `andI#` (a4 `gtFloat#` b4)+                                              )+  {-# INLINE (>) #-}+  FloatX4# a1 a2 a3 a4 < FloatX4# b1 b2 b3 b4 = isTrue# (   (a1 `ltFloat#` b1)+                                              `andI#` (a2 `ltFloat#` b2)+                                              `andI#` (a3 `ltFloat#` b3)+                                              `andI#` (a4 `ltFloat#` b4)+                                              )+  {-# INLINE (<) #-}+  FloatX4# a1 a2 a3 a4 >= FloatX4# b1 b2 b3 b4 = isTrue# (  (a1 `geFloat#` b1)+                                              `andI#` (a2 `geFloat#` b2)+                                              `andI#` (a3 `geFloat#` b3)+                                              `andI#` (a4 `geFloat#` b4)+                                              )+  {-# INLINE (>=) #-}+  FloatX4# a1 a2 a3 a4 <= FloatX4# b1 b2 b3 b4 = isTrue# (  (a1 `leFloat#` b1)+                                              `andI#` (a2 `leFloat#` b2)+                                              `andI#` (a3 `leFloat#` b3)+                                              `andI#` (a4 `leFloat#` b4)+                                              )+  {-# INLINE (<=) #-}+  -- | Compare lexicographically+  compare (FloatX4# a1 a2 a3 a4) (FloatX4# b1 b2 b3 b4)+    | isTrue# (a1 `gtFloat#` b1) = GT+    | isTrue# (a1 `ltFloat#` b1) = LT+    | isTrue# (a2 `gtFloat#` b2) = GT+    | isTrue# (a2 `ltFloat#` b2) = LT+    | isTrue# (a3 `gtFloat#` b3) = GT+    | isTrue# (a3 `ltFloat#` b3) = LT+    | isTrue# (a4 `gtFloat#` b4) = GT+    | isTrue# (a4 `ltFloat#` b4) = LT+    | otherwise = EQ+  {-# INLINE compare #-}+  -- | Element-wise minimum+  min (FloatX4# a1 a2 a3 a4) (FloatX4# b1 b2 b3 b4) =+      FloatX4# (if isTrue# (a1 `gtFloat#` b1) then b1 else a1)+               (if isTrue# (a2 `gtFloat#` b2) then b2 else a2)+               (if isTrue# (a3 `gtFloat#` b3) then b3 else a3)+               (if isTrue# (a4 `gtFloat#` b4) then b4 else a4)+  {-# INLINE min #-}+  -- | Element-wise maximum+  max (FloatX4# a1 a2 a3 a4) (FloatX4# b1 b2 b3 b4) =+      FloatX4# (if isTrue# (a1 `gtFloat#` b1) then a1 else b1)+               (if isTrue# (a2 `gtFloat#` b2) then a2 else b2)+               (if isTrue# (a3 `gtFloat#` b3) then a3 else b3)+               (if isTrue# (a4 `gtFloat#` b4) then a4 else b4)+  {-# INLINE max #-}++++-- | element-wise operations for vectors+instance Num FloatX4 where+  FloatX4# a1 a2 a3 a4 + FloatX4# b1 b2 b3 b4+    = FloatX4# (plusFloat# a1 b1) (plusFloat# a2 b2) (plusFloat# a3 b3) (plusFloat# a4 b4)+  {-# INLINE (+) #-}+  FloatX4# a1 a2 a3 a4 - FloatX4# b1 b2 b3 b4+    = FloatX4# (minusFloat# a1 b1) (minusFloat# a2 b2) (minusFloat# a3 b3) (minusFloat# a4 b4)+  {-# INLINE (-) #-}+  FloatX4# a1 a2 a3 a4 * FloatX4# b1 b2 b3 b4+    = FloatX4# (timesFloat# a1 b1) (timesFloat# a2 b2) (timesFloat# a3 b3) (timesFloat# a4 b4)+  {-# INLINE (*) #-}+  negate (FloatX4# a1 a2 a3 a4)+    = FloatX4# (negateFloat# a1) (negateFloat# a2) (negateFloat# a3) (negateFloat# a4)+  {-# INLINE negate #-}+  abs (FloatX4# a1 a2 a3 a4)+    = FloatX4# (if isTrue# (a1 `geFloat#` 0.0#) then a1 else negateFloat# a1)+               (if isTrue# (a2 `geFloat#` 0.0#) then a2 else negateFloat# a2)+               (if isTrue# (a3 `geFloat#` 0.0#) then a3 else negateFloat# a3)+               (if isTrue# (a4 `geFloat#` 0.0#) then a4 else negateFloat# a4)+  {-# INLINE abs #-}+  signum (FloatX4# a1 a2 a3 a4)+    = FloatX4# (if isTrue# (a1 `gtFloat#` 0.0#)+                then 1.0#+                else if isTrue# (a1 `ltFloat#` 0.0#) then -1.0# else 0.0# )+               (if isTrue# (a2 `gtFloat#` 0.0#)+                then 1.0#+                else if isTrue# (a2 `ltFloat#` 0.0#) then -1.0# else 0.0# )+               (if isTrue# (a3 `gtFloat#` 0.0#)+                then 1.0#+                else if isTrue# (a3 `ltFloat#` 0.0#) then -1.0# else 0.0# )+               (if isTrue# (a4 `gtFloat#` 0.0#)+                then 1.0#+                else if isTrue# (a4 `ltFloat#` 0.0#) then -1.0# else 0.0# )+  {-# INLINE signum #-}+  fromInteger n = case fromInteger n of F# x -> FloatX4# x x x x+  {-# INLINE fromInteger #-}++++instance Fractional FloatX4 where+  FloatX4# a1 a2 a3 a4 / FloatX4# b1 b2 b3 b4  = FloatX4# (divideFloat# a1 b1)+                                                    (divideFloat# a2 b2)+                                                    (divideFloat# a3 b3)+                                                    (divideFloat# a4 b4)+  {-# INLINE (/) #-}+  recip (FloatX4# a1 a2 a3 a4) = FloatX4# (divideFloat# 1.0# a1)+                                       (divideFloat# 1.0# a2)+                                       (divideFloat# 1.0# a3)+                                       (divideFloat# 1.0# a4)+  {-# INLINE recip #-}+  fromRational r = case fromRational r of F# x -> FloatX4# x x x x+  {-# INLINE fromRational #-}++++instance Floating FloatX4 where+  pi = FloatX4# 3.141592653589793238# 3.141592653589793238# 3.141592653589793238# 3.141592653589793238#+  {-# INLINE pi #-}+  exp (FloatX4# a1 a2 a3 a4) = FloatX4# (expFloat# a1)+                                     (expFloat# a2)+                                     (expFloat# a3)+                                     (expFloat# a4)+  {-# INLINE exp #-}+  log (FloatX4# a1 a2 a3 a4) = FloatX4# (logFloat# a1)+                                     (logFloat# a2)+                                     (logFloat# a3)+                                     (logFloat# a4)+  {-# INLINE log #-}+  sqrt (FloatX4# a1 a2 a3 a4) = FloatX4# (sqrtFloat# a1)+                                      (sqrtFloat# a2)+                                      (sqrtFloat# a3)+                                      (sqrtFloat# a4)+  {-# INLINE sqrt #-}+  sin (FloatX4# a1 a2 a3 a4) = FloatX4# (sinFloat# a1)+                                     (sinFloat# a2)+                                     (sinFloat# a3)+                                     (sinFloat# a4)+  {-# INLINE sin #-}+  cos (FloatX4# a1 a2 a3 a4) = FloatX4# (cosFloat# a1)+                                     (cosFloat# a2)+                                     (cosFloat# a3)+                                     (cosFloat# a4)+  {-# INLINE cos #-}+  tan (FloatX4# a1 a2 a3 a4) = FloatX4# (tanFloat# a1)+                                     (tanFloat# a2)+                                     (tanFloat# a3)+                                     (tanFloat# a4)+  {-# INLINE tan #-}+  asin (FloatX4# a1 a2 a3 a4) = FloatX4# (asinFloat# a1)+                                      (asinFloat# a2)+                                      (asinFloat# a3)+                                      (asinFloat# a4)+  {-# INLINE asin #-}+  acos (FloatX4# a1 a2 a3 a4) = FloatX4# (acosFloat# a1)+                                      (acosFloat# a2)+                                      (acosFloat# a3)+                                      (acosFloat# a4)+  {-# INLINE acos #-}+  atan (FloatX4# a1 a2 a3 a4) = FloatX4# (atanFloat# a1)+                                      (atanFloat# a2)+                                      (atanFloat# a3)+                                      (atanFloat# a4)+  {-# INLINE atan #-}+  sinh (FloatX4# a1 a2 a3 a4) = FloatX4# (sinFloat# a1)+                                      (sinFloat# a2)+                                      (sinFloat# a3)+                                      (sinFloat# a4)+  {-# INLINE sinh #-}+  cosh (FloatX4# a1 a2 a3 a4) = FloatX4# (coshFloat# a1)+                                      (coshFloat# a2)+                                      (coshFloat# a3)+                                      (coshFloat# a4)+  {-# INLINE cosh #-}+  tanh (FloatX4# a1 a2 a3 a4) = FloatX4# (tanhFloat# a1)+                                      (tanhFloat# a2)+                                      (tanhFloat# a3)+                                      (tanhFloat# a4)+  {-# INLINE tanh #-}+  FloatX4# a1 a2 a3 a4 ** FloatX4# b1 b2 b3 b4 = FloatX4# (powerFloat# a1 b1)+                                                    (powerFloat# a2 b2)+                                                    (powerFloat# a3 b3)+                                                    (powerFloat# a4 b4)+  {-# INLINE (**) #-}++  logBase x y         =  log y / log x+  {-# INLINE logBase #-}+  asinh x = log (x + sqrt (1.0+x*x))+  {-# INLINE asinh #-}+  acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))+  {-# INLINE acosh #-}+  atanh x = 0.5 * log ((1.0+x) / (1.0-x))+  {-# INLINE atanh #-}++++type instance ElemRep FloatX4 = 'FloatRep+type instance ElemPrim FloatX4 = Float#+instance PrimBytes FloatX4 where+  toBytes (FloatX4# a1 a2 a3 a4) = case runRW#+     ( \s0 -> case newByteArray# (SIZEOF_HSFLOAT# *# 3#) s0 of+         (# s1, marr #) -> case writeFloatArray# marr 0# a1 s1 of+           s2 -> case writeFloatArray# marr 1# a2 s2 of+             s3 -> case writeFloatArray# marr 2# a3 s3 of+               s4 -> case writeFloatArray# marr 3# a4 s4 of+                 s5 -> unsafeFreezeByteArray# marr s5+     ) of (# _, a #) -> (# 0#, 4#, a #)+  {-# INLINE toBytes #-}+  fromBytes (# off, _, arr #) = FloatX4#+    (indexFloatArray# arr off)+    (indexFloatArray# arr (off +# 1#))+    (indexFloatArray# arr (off +# 2#))+    (indexFloatArray# arr (off +# 3#))+  {-# INLINE fromBytes #-}+  byteSize _ = SIZEOF_HSFLOAT# *# 4#+  {-# INLINE byteSize #-}+  byteAlign _ = ALIGNMENT_HSFLOAT#+  {-# INLINE byteAlign #-}+  elementByteSize _ = SIZEOF_HSFLOAT#+  {-# INLINE elementByteSize #-}+  ix 0# (FloatX4# a1 _ _ _) = a1+  ix 1# (FloatX4# _ a2 _ _) = a2+  ix 2# (FloatX4# _ _ a3 _) = a3+  ix 3# (FloatX4# _ _ _ a4) = a4+  ix _ _                    = undefined+  {-# INLINE ix #-}+++instance ElementWise (Idx '[4]) Float FloatX4 where++  (!) (FloatX4# a1 _ _ _) ( 1 :! Z) = F# a1+  (!) (FloatX4# _ a2 _ _) ( 2 :! Z) = F# a2+  (!) (FloatX4# _ _ a3 _) ( 3 :! Z) = F# a3+  (!) (FloatX4# _ _ _ a4) ( 4 :! Z) = F# a4+  (!) _                   ( _ :! Z) = undefined+  {-# INLINE (!) #-}++  broadcast (F# x) = FloatX4# x x x x+  {-# INLINE broadcast #-}++  ewmap f (FloatX4# x y z w) = case (f (1:!Z) (F# x), f (2:!Z) (F# y), f (3:!Z) (F# z), f (3:!Z) (F# w)) of+                              (F# r1, F# r2, F# r3, F# r4) -> FloatX4# r1 r2 r3 r4+  {-# INLINE ewmap #-}++  ewgen f = case (f (1:!Z), f (2:!Z), f (3:!Z), f (4:!Z)) of (F# r1, F# r2, F# r3, F# r4) -> FloatX4# r1 r2 r3 r4+  {-# INLINE ewgen #-}++  ewgenA f = (\(F# a) (F# b) (F# c) (F# d) -> FloatX4# a b c d)+          <$> f (1:!Z) <*> f (2:!Z) <*> f (3:!Z) <*> f (4:!Z)+  {-# INLINE ewgenA #-}++  ewfoldl f x0 (FloatX4# x y z w) = f (4:!Z) (f (3:!Z) (f (2:!Z) (f (1:!Z) x0 (F# x)) (F# y)) (F# z)) (F# w)+  {-# INLINE ewfoldl #-}++  ewfoldr f x0 (FloatX4# x y z w) = f (1:!Z) (F# x) (f (2:!Z) (F# y) (f (3:!Z) (F# z) (f (4:!Z) (F# w) x0)))+  {-# INLINE ewfoldr #-}++  elementWise f (FloatX4# x y z w) = (\(F# a) (F# b) (F# c) (F# d) -> FloatX4# a b c d)+                                 <$> f (F# x) <*> f (F# y) <*> f (F# z) <*> f (F# w)+  {-# INLINE elementWise #-}++  indexWise f (FloatX4# x y z w) = (\(F# a) (F# b) (F# c) (F# d) -> FloatX4# a b c d)+                             <$> f (1:!Z) (F# x) <*> f (2:!Z) (F# y) <*> f (3:!Z) (F# z) <*> f (4:!Z) (F# w)+  {-# INLINE indexWise #-}++  update (1 :! Z) (F# q) (FloatX4# _ y z w) = FloatX4# q y z w+  update (2 :! Z) (F# q) (FloatX4# x _ z w) = FloatX4# x q z w+  update (3 :! Z) (F# q) (FloatX4# x y _ w) = FloatX4# x y q w+  update (4 :! Z) (F# q) (FloatX4# x y z _) = FloatX4# x y z q+  update (_ :! Z) _ x = x+  {-# INLINE update #-}

@@ -1,14 +1,22 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MagicHash, UnboxedTuples #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE ConstraintKinds            #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE FunctionalDependencies     #-}+{-# LANGUAGE MagicHash                  #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE PolyKinds                  #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeInType                 #-}+{-# LANGUAGE UnboxedTuples              #-}+{-# LANGUAGE UndecidableInstances       #-} ----------------------------------------------------------------------------- -- | -- Module      :  Numeric.Commons -- Copyright   :  (c) Artem Chirkin--- License     :  MIT+-- License     :  BSD3 -- -- Maintainer  :  chirkin@arch.ethz.ch --@@ -16,292 +24,287 @@ -----------------------------------------------------------------------------  module Numeric.Commons-  ( PrimBytes (..)-  , FloatBytes (..)-  , DoubleBytes (..)-  , IntBytes (..)-  , WordBytes (..)+  ( ElemRep, ElemPrim+  , PrimBytes (..), FloatBytes, DoubleBytes, IntBytes, WordBytes   ) where  #include "MachDeps.h" #include "HsBaseConfig.h" -import GHC.Base (runRW#)-import GHC.Ptr-import GHC.Prim-import GHC.Types-import GHC.Int-import GHC.Word-import Foreign.Storable+import           GHC.Base  (runRW#)+import           GHC.Int   (Int16 (..), Int32 (..), Int64 (..), Int8 (..))+import           GHC.Prim+import           GHC.Types (Double (..), Float (..), Int (..), RuntimeRep (..),+                            Type, Word (..))+import           GHC.Word  (Word16 (..), Word32 (..), Word64 (..), Word8 (..))  -class PrimBytes a where+type family ElemRep a :: RuntimeRep+type instance ElemRep Float  = 'FloatRep+type instance ElemRep Double = 'DoubleRep+type instance ElemRep Int    = 'IntRep+type instance ElemRep Int8   = 'IntRep+type instance ElemRep Int16  = 'IntRep+type instance ElemRep Int32  = 'IntRep+type instance ElemRep Int64  = 'IntRep+type instance ElemRep Word   = 'WordRep+type instance ElemRep Word8  = 'WordRep+type instance ElemRep Word16 = 'WordRep+type instance ElemRep Word32 = 'WordRep+type instance ElemRep Word64 = 'WordRep++type family ElemPrim a :: TYPE (r :: RuntimeRep)+type instance ElemPrim Float = Float#+type instance ElemPrim Double = Double#+type instance ElemPrim Int = Int#+type instance ElemPrim Int8 = Int#+type instance ElemPrim Int16 = Int#+type instance ElemPrim Int32 = Int#+type instance ElemPrim Int64 = Int#+type instance ElemPrim Word = Word#+type instance ElemPrim Word8 = Word#+type instance ElemPrim Word16 = Word#+type instance ElemPrim Word32 = Word#+type instance ElemPrim Word64 = Word#++type FloatBytes a  = (PrimBytes a, ElemRep a ~ 'FloatRep , ElemPrim a ~ Float#)+type DoubleBytes a = (PrimBytes a, ElemRep a ~ 'DoubleRep, ElemPrim a ~ Double#)+type IntBytes a    = (PrimBytes a, ElemRep a ~ 'IntRep   , ElemPrim a ~ Int#)+type WordBytes a   = (PrimBytes a, ElemRep a ~ 'WordRep  , ElemPrim a ~ Word#)++-- | Facilities to convert to and from raw byte array.+--   Warning! offsets and sizes are in elements, not in bytes!+--   Therefore one must be really carefull if having a crazy idea of+--     converting between types of different element sizes.+class PrimBytes (a :: Type) where   -- | Store content of a data type in a primitive byte array-  toBytes :: a -> ByteArray#+  --   (ElementOffset, NumberOfElements, ByteArrayContent )+  toBytes :: a -> (# Int# , Int# , ByteArray# #)   -- | Load content of a data type from a primitive byte array-  fromBytes :: ByteArray# -> a+  --   (ElementOffset, NumberOfElements, ByteArrayContent )+  fromBytes :: (# Int# , Int# , ByteArray# #) -> a   -- | Size of a data type in bytes   byteSize :: a -> Int#   -- | Alignment of a data type in bytes   byteAlign :: a -> Int#---- | Primitive indexing. No checks, no safety.-class FloatBytes a where-  -- | Primitive get Float# (element offset)-  ixF :: Int# -> a -> Float#---- | Primitive indexing. No checks, no safety.-class DoubleBytes a where-  -- | Primitive get Double# (element offset)-  ixD :: Int# -> a -> Double#---- | Primitive indexing. No checks, no safety.-class IntBytes a where-  -- | Primitive get Int# (element offset)-  ixI :: Int# -> a -> Int#---- | Primitive indexing. No checks, no safety.-class WordBytes a where-  -- | Primitive get Word# (element offset)-  ixW :: Int# -> a -> Word#--instance PrimBytes a => Storable a where-  sizeOf x = I# (byteSize x)-  alignment x = I# (byteAlign x)-  peekElemOff ptr (I# offset) = peekByteOff ptr (I# (offset *# byteSize (undefined :: a)))-  pokeElemOff ptr (I# offset) = pokeByteOff ptr (I# (offset *# byteSize (undefined :: a)))-  peekByteOff (Ptr addr) (I# offset) = IO $ \s0 -> case newByteArray# bsize s0 of-        (# s1, marr #) -> case copyAddrToByteArray# (addr `plusAddr#` offset) marr 0# bsize s1 of-          s2 -> case unsafeFreezeByteArray# marr s2 of-            (# s3, arr #) -> (# s3, fromBytes arr #)-    where-      bsize = byteSize (undefined :: a)-  pokeByteOff (Ptr addr) (I# offset) x = IO $ \s0 -> case copyByteArrayToAddr# (toBytes x)-                                                                               0#-                                                                               (addr `plusAddr#` offset)-                                                                               bsize s0 of-       s2 -> (# s2, () #)-    where-      bsize = byteSize (undefined :: a)-  peek ptr = peekByteOff ptr 0-  poke ptr = pokeByteOff ptr 0-+  -- | Size of a conainer type elements in bytes+  elementByteSize :: a -> Int#+  -- | Primitive indexing+  ix  :: Int# -> a -> (ElemPrim a :: TYPE (ElemRep a))  instance PrimBytes Float where   toBytes v@(F# x) = case runRW#      ( \s0 -> case newByteArray# (byteSize v) s0 of          (# s1, marr #) -> case writeFloatArray# marr 0# x s1 of              s2 -> unsafeFreezeByteArray# marr s2-     ) of (# _, a #) -> a+     ) of (# _, a #) -> (# 0#, 1#, a #)   {-# INLINE toBytes #-}-  fromBytes arr = F# (indexFloatArray# arr 0#)+  fromBytes (# off, _, arr #) = F# (indexFloatArray# arr off)   {-# INLINE fromBytes #-}   byteSize _ = SIZEOF_HSFLOAT#   {-# INLINE byteSize #-}   byteAlign _ = ALIGNMENT_HSFLOAT#   {-# INLINE byteAlign #-}--instance FloatBytes Float where-  ixF _ (F# x) = x-  {-# INLINE ixF #-}+  elementByteSize = byteSize+  {-# INLINE elementByteSize #-}+  ix _ (F# x) = x+  {-# INLINE ix #-}  instance PrimBytes Double where   toBytes v@(D# x) = case runRW#      ( \s0 -> case newByteArray# (byteSize v) s0 of          (# s1, marr #) -> case writeDoubleArray# marr 0# x s1 of              s2 -> unsafeFreezeByteArray# marr s2-     ) of (# _, a #) -> a+     ) of (# _, a #) -> (# 0#, 1#, a #)   {-# INLINE toBytes #-}-  fromBytes arr = D# (indexDoubleArray# arr 0#)+  fromBytes (# off, _, arr #) = D# (indexDoubleArray# arr off)   {-# INLINE fromBytes #-}   byteSize _ = SIZEOF_HSDOUBLE#   {-# INLINE byteSize #-}   byteAlign _ = ALIGNMENT_HSDOUBLE#   {-# INLINE byteAlign #-}--instance DoubleBytes Double where-  ixD _ (D# x) = x-  {-# INLINE ixD #-}+  elementByteSize = byteSize+  {-# INLINE elementByteSize #-}+  ix _ (D# x) = x+  {-# INLINE ix #-}  instance PrimBytes Int where   toBytes v@(I# x) = case runRW#      ( \s0 -> case newByteArray# (byteSize v) s0 of          (# s1, marr #) -> case writeIntArray# marr 0# x s1 of              s2 -> unsafeFreezeByteArray# marr s2-     ) of (# _, a #) -> a+     ) of (# _, a #) -> (# 0#, 1#, a #)   {-# INLINE toBytes #-}-  fromBytes arr = I# (indexIntArray# arr 0#)+  fromBytes (# off, _, arr #) = I# (indexIntArray# arr off)   {-# INLINE fromBytes #-}   byteSize _ = SIZEOF_HSINT#   {-# INLINE byteSize #-}   byteAlign _ = ALIGNMENT_HSINT#   {-# INLINE byteAlign #-}--instance IntBytes Int where-  ixI _ (I# x) = x-  {-# INLINE ixI #-}+  elementByteSize = byteSize+  {-# INLINE elementByteSize #-}+  ix _ (I# x) = x+  {-# INLINE ix #-}  instance PrimBytes Int8 where   toBytes v@(I8# x) = case runRW#      ( \s0 -> case newByteArray# (byteSize v) s0 of          (# s1, marr #) -> case writeInt8Array# marr 0# x s1 of              s2 -> unsafeFreezeByteArray# marr s2-     ) of (# _, a #) -> a+     ) of (# _, a #) -> (# 0#, 1#, a #)   {-# INLINE toBytes #-}-  fromBytes arr = I8# (indexInt8Array# arr 0#)+  fromBytes (# off, _, arr #) = I8# (indexInt8Array# arr off)   {-# INLINE fromBytes #-}   byteSize _ = SIZEOF_INT8#   {-# INLINE byteSize #-}   byteAlign _ = ALIGNMENT_INT8#   {-# INLINE byteAlign #-}--instance IntBytes Int8 where-  ixI _ (I8# x) = x-  {-# INLINE ixI #-}+  elementByteSize = byteSize+  {-# INLINE elementByteSize #-}+  ix _ (I8# x) = x+  {-# INLINE ix #-}  instance PrimBytes Int16 where   toBytes v@(I16# x) = case runRW#      ( \s0 -> case newByteArray# (byteSize v) s0 of          (# s1, marr #) -> case writeInt16Array# marr 0# x s1 of              s2 -> unsafeFreezeByteArray# marr s2-     ) of (# _, a #) -> a+     ) of (# _, a #) -> (# 0#, 1#, a #)   {-# INLINE toBytes #-}-  fromBytes arr = I16# (indexInt16Array# arr 0#)+  fromBytes (# off, _, arr #) = I16# (indexInt16Array# arr off)   {-# INLINE fromBytes #-}   byteSize _ = SIZEOF_INT16#   {-# INLINE byteSize #-}   byteAlign _ = ALIGNMENT_INT16#   {-# INLINE byteAlign #-}--instance IntBytes Int16 where-  ixI _ (I16# x) = x-  {-# INLINE ixI #-}+  elementByteSize = byteSize+  {-# INLINE elementByteSize #-}+  ix _ (I16# x) = x+  {-# INLINE ix #-}  instance PrimBytes Int32 where   toBytes v@(I32# x) = case runRW#      ( \s0 -> case newByteArray# (byteSize v) s0 of          (# s1, marr #) -> case writeInt32Array# marr 0# x s1 of              s2 -> unsafeFreezeByteArray# marr s2-     ) of (# _, a #) -> a+     ) of (# _, a #) -> (# 0#, 1#, a #)   {-# INLINE toBytes #-}-  fromBytes arr = I32# (indexInt32Array# arr 0#)+  fromBytes (# off, _, arr #) = I32# (indexInt32Array# arr off)   {-# INLINE fromBytes #-}   byteSize _ = SIZEOF_INT32#   {-# INLINE byteSize #-}   byteAlign _ = ALIGNMENT_INT32#   {-# INLINE byteAlign #-}--instance IntBytes Int32 where-  ixI _ (I32# x) = x-  {-# INLINE ixI #-}+  elementByteSize = byteSize+  {-# INLINE elementByteSize #-}+  ix _ (I32# x) = x+  {-# INLINE ix #-}  instance PrimBytes Int64 where   toBytes v@(I64# x) = case runRW#      ( \s0 -> case newByteArray# (byteSize v) s0 of          (# s1, marr #) -> case writeInt64Array# marr 0# x s1 of              s2 -> unsafeFreezeByteArray# marr s2-     ) of (# _, a #) -> a+     ) of (# _, a #) -> (# 0#, 1#, a #)   {-# INLINE toBytes #-}-  fromBytes arr = I64# (indexInt64Array# arr 0#)+  fromBytes (# off, _, arr #) = I64# (indexInt64Array# arr off)   {-# INLINE fromBytes #-}   byteSize _ = SIZEOF_INT64#   {-# INLINE byteSize #-}   byteAlign _ = ALIGNMENT_INT64#   {-# INLINE byteAlign #-}--instance IntBytes Int64 where-  ixI _ (I64# x) = x-  {-# INLINE ixI #-}+  elementByteSize = byteSize+  {-# INLINE elementByteSize #-}+  ix _ (I64# x) = x+  {-# INLINE ix #-}  instance PrimBytes Word where   toBytes v@(W# x) = case runRW#      ( \s0 -> case newByteArray# (byteSize v) s0 of          (# s1, marr #) -> case writeWordArray# marr 0# x s1 of              s2 -> unsafeFreezeByteArray# marr s2-     ) of (# _, a #) -> a+     ) of (# _, a #) -> (# 0#, 1#, a #)   {-# INLINE toBytes #-}-  fromBytes arr = W# (indexWordArray# arr 0#)+  fromBytes (# off, _, arr #) = W# (indexWordArray# arr off)   {-# INLINE fromBytes #-}   byteSize _ = SIZEOF_HSWORD#   {-# INLINE byteSize #-}   byteAlign _ = ALIGNMENT_HSWORD#   {-# INLINE byteAlign #-}--instance WordBytes Word where-  ixW _ (W# x) = x-  {-# INLINE ixW #-}+  elementByteSize = byteSize+  {-# INLINE elementByteSize #-}+  ix _ (W# x) = x+  {-# INLINE ix #-}  instance PrimBytes Word8 where   toBytes v@(W8# x) = case runRW#      ( \s0 -> case newByteArray# (byteSize v) s0 of          (# s1, marr #) -> case writeWord8Array# marr 0# x s1 of              s2 -> unsafeFreezeByteArray# marr s2-     ) of (# _, a #) -> a+     ) of (# _, a #) -> (# 0#, 1#, a #)   {-# INLINE toBytes #-}-  fromBytes arr = W8# (indexWord8Array# arr 0#)+  fromBytes (# off, _, arr #) = W8# (indexWord8Array# arr off)   {-# INLINE fromBytes #-}   byteSize _ = SIZEOF_WORD8#   {-# INLINE byteSize #-}   byteAlign _ = ALIGNMENT_WORD8#   {-# INLINE byteAlign #-}--instance WordBytes Word8 where-  ixW _ (W8# x) = x-  {-# INLINE ixW #-}+  elementByteSize = byteSize+  {-# INLINE elementByteSize #-}+  ix _ (W8# x) = x+  {-# INLINE ix #-}  instance PrimBytes Word16 where   toBytes v@(W16# x) = case runRW#      ( \s0 -> case newByteArray# (byteSize v) s0 of          (# s1, marr #) -> case writeWord16Array# marr 0# x s1 of              s2 -> unsafeFreezeByteArray# marr s2-     ) of (# _, a #) -> a+     ) of (# _, a #) -> (# 0#, 1#, a #)   {-# INLINE toBytes #-}-  fromBytes arr = W16# (indexWord16Array# arr 0#)+  fromBytes (# off, _, arr #) = W16# (indexWord16Array# arr off)   {-# INLINE fromBytes #-}   byteSize _ = SIZEOF_WORD16#   {-# INLINE byteSize #-}   byteAlign _ = ALIGNMENT_WORD16#   {-# INLINE byteAlign #-}--instance WordBytes Word16 where-  ixW _ (W16# x) = x-  {-# INLINE ixW #-}+  elementByteSize = byteSize+  {-# INLINE elementByteSize #-}+  ix _ (W16# x) = x+  {-# INLINE ix #-}  instance PrimBytes Word32 where   toBytes v@(W32# x) = case runRW#      ( \s0 -> case newByteArray# (byteSize v) s0 of          (# s1, marr #) -> case writeWord32Array# marr 0# x s1 of              s2 -> unsafeFreezeByteArray# marr s2-     ) of (# _, a #) -> a+     ) of (# _, a #) -> (# 0#, 1#, a #)   {-# INLINE toBytes #-}-  fromBytes arr = W32# (indexWord32Array# arr 0#)+  fromBytes (# off, _, arr #) = W32# (indexWord32Array# arr off)   {-# INLINE fromBytes #-}   byteSize _ = SIZEOF_WORD32#   {-# INLINE byteSize #-}   byteAlign _ = ALIGNMENT_WORD32#   {-# INLINE byteAlign #-}+  elementByteSize = byteSize+  {-# INLINE elementByteSize #-}+  ix _ (W32# x) = x+  {-# INLINE ix #-} -instance WordBytes Word32 where-  ixW _ (W32# x) = x-  {-# INLINE ixW #-}  instance PrimBytes Word64 where   toBytes v@(W64# x) = case runRW#      ( \s0 -> case newByteArray# (byteSize v) s0 of          (# s1, marr #) -> case writeWord64Array# marr 0# x s1 of              s2 -> unsafeFreezeByteArray# marr s2-     ) of (# _, a #) -> a+     ) of (# _, a #) -> (# 0#, 1#, a #)   {-# INLINE toBytes #-}-  fromBytes arr = W64# (indexWord64Array# arr 0#)+  fromBytes (# off, _, arr #) = W64# (indexWord64Array# arr off)   {-# INLINE fromBytes #-}   byteSize _ = SIZEOF_WORD64#   {-# INLINE byteSize #-}   byteAlign _ = ALIGNMENT_WORD64#   {-# INLINE byteAlign #-}--instance WordBytes Word64 where-  ixW _ (W64# x) = x-  {-# INLINE ixW #-}---+  elementByteSize = byteSize+  {-# INLINE elementByteSize #-}+  ix _ (W64# x) = x+  {-# INLINE ix #-}

@@ -0,0 +1,43 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.DataFrame+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.DataFrame+  ( DataFrame (SomeDataFrame)+  , NumericFrame+    -- * Utility type families and constraints+  , FPFRame, IntegralFrame, NumericVariantFrame, CommonOpFrame+    -- * Simplified type aliases+  , module Numeric.Scalar+  , module Numeric.Vector+  , module Numeric.Matrix+    -- * Functionality+  , module Numeric.DataFrame.SubSpace+  , module Numeric.DataFrame.Contraction+  , module Numeric.DataFrame.Inference+  , module Numeric.DataFrame.Shape+  , ElementWise ()+  , ArrayInstanceEvidence, ArrayInstance (..), getArrayInstance, inferArrayInstance+  , ArraySizeInference (..), ArraySize (..)+  , ElemTypeInference (..), ElemType (..)+  ) where++import           Numeric.Array+import           Numeric.Array.ElementWise++import           Numeric.DataFrame.Contraction+import           Numeric.DataFrame.Inference+import           Numeric.DataFrame.Shape+import           Numeric.DataFrame.SubSpace+import           Numeric.DataFrame.Type++import           Numeric.Matrix+import           Numeric.Scalar+import           Numeric.Vector

@@ -0,0 +1,535 @@+{-# LANGUAGE DataKinds              #-}+{-# LANGUAGE FlexibleContexts       #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MagicHash              #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE ScopedTypeVariables    #-}+{-# LANGUAGE TypeApplications       #-}+{-# LANGUAGE TypeFamilies           #-}+{-# LANGUAGE TypeOperators          #-}+{-# LANGUAGE UnboxedTuples          #-}+{-# LANGUAGE UndecidableInstances   #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.DataFrame.Contraction+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+-- This modules provides generalization of a matrix product:+--  tensor-like contraction.+-- For matrices and vectors this is a normal matrix*matrix or vector*matrix or matrix*vector product,+-- for larger dimensions it calculates the scalar product of "adjacent" dimesnions of a tensor.+--+-----------------------------------------------------------------------------++module Numeric.DataFrame.Contraction+  ( Contraction (..), (%*)+  ) where+++import           Data.Int               (Int16, Int32, Int64, Int8)+import           Data.Type.Equality     ((:~:) (..))+import           Data.Word              (Word16, Word32, Word64, Word8)+import           GHC.Base               (runRW#)+import           GHC.Prim+import           GHC.Types              (Int (..), RuntimeRep (..), Type,+                                         Word (..), isTrue#)+import           Unsafe.Coerce          (unsafeCoerce)++import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.DataFrame.Type+import           Numeric.Dimensions+import           Numeric.TypeLits+++class ConcatList as bs asbs+      => Contraction (t :: Type) (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])+                             | asbs as -> bs, asbs bs -> as, as bs -> asbs where+    -- | Generalization of a matrix product: take scalar product over one dimension+    --   and, thus, concatenate other dimesnions+    contract :: ( KnownDim m+                , PrimBytes (DataFrame t (as +: m))+                , PrimBytes (DataFrame t (m :+ bs))+                , PrimBytes (DataFrame t asbs)+                )+             => DataFrame t (as +: m) -> DataFrame t (m :+ bs) -> DataFrame t asbs++-- | Tensor contraction.+--   In particular:+--     1. matrix-matrix product+--     2. matrix-vector or vector-matrix product+--     3. dot product of two vectors.+(%*) :: ( ConcatList as bs (as ++ bs)+        , Contraction t as bs asbs+        , KnownDim m+        , PrimBytes (DataFrame t (as +: m))+        , PrimBytes (DataFrame t (m :+ bs))+        , PrimBytes (DataFrame t (as ++ bs))+        )  => DataFrame t (as +: m) -> DataFrame t (m :+ bs) -> DataFrame t (as ++ bs)+(%*) = contract+{-# INLINE (%*) #-}+infixl 7 %*+++--------------------------------------------------------------------------------++instance ( ConcatList as bs asbs+         , Dimensions as+         , Dimensions bs+         ) => Contraction Float as bs asbs where+    contract x y+        | (pm :: Proxy m) <- getM y+        , I# m <- intNatVal pm+        , I# n <- totalDim (Proxy @as)+        , I# k <- totalDim (Proxy @bs)+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Float (m : bs) ) :~: 'FloatRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Float (m : bs) ) :~:  Float#+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Float (as +: m)) :~: 'FloatRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Float (as +: m)) :~:  Float#+        = prodF n m k x y+      where+        getM :: forall m p . p (m ': bs) -> Proxy m+        getM _ = Proxy+++instance ( ConcatList as bs asbs+         , Dimensions as+         , Dimensions bs+         ) => Contraction Double as bs asbs where+    contract x y+        | (pm :: Proxy m) <- getM y+        , I# m <- intNatVal pm+        , I# n <- totalDim (Proxy @as)+        , I# k <- totalDim (Proxy @bs)+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Double (m : bs) ) :~: 'DoubleRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Double (m : bs) ) :~:  Double#+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Double (as +: m)) :~: 'DoubleRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Double (as +: m)) :~:  Double#+        = prodD n m k x y+      where+        getM :: forall m p . p (m ': bs) -> Proxy m+        getM _ = Proxy++instance ( ConcatList as bs asbs+         , Dimensions as+         , Dimensions bs+         ) => Contraction Int as bs asbs where+    contract x y+        | (pm :: Proxy m) <- getM y+        , I# m <- intNatVal pm+        , I# n <- totalDim (Proxy @as)+        , I# k <- totalDim (Proxy @bs)+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Int (m : bs) ) :~: 'IntRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int (m : bs) ) :~:  Int#+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Int (as +: m)) :~: 'IntRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int (as +: m)) :~:  Int#+        = prodI n m k x y+      where+        getM :: forall m p . p (m ': bs) -> Proxy m+        getM _ = Proxy++instance ( ConcatList as bs asbs+         , Dimensions as+         , Dimensions bs+         ) => Contraction Int8 as bs asbs where+    contract x y+        | (pm :: Proxy m) <- getM y+        , I# m <- intNatVal pm+        , I# n <- totalDim (Proxy @as)+        , I# k <- totalDim (Proxy @bs)+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Int8 (m : bs) ) :~: 'IntRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int8 (m : bs) ) :~:  Int#+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Int8 (as +: m)) :~: 'IntRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int8 (as +: m)) :~:  Int#+        = prodI8 n m k x y+      where+        getM :: forall m p . p (m ': bs) -> Proxy m+        getM _ = Proxy++instance ( ConcatList as bs asbs+         , Dimensions as+         , Dimensions bs+         ) => Contraction Int16 as bs asbs where+    contract x y+        | (pm :: Proxy m) <- getM y+        , I# m <- intNatVal pm+        , I# n <- totalDim (Proxy @as)+        , I# k <- totalDim (Proxy @bs)+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Int16 (m : bs) ) :~: 'IntRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int16 (m : bs) ) :~:  Int#+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Int16 (as +: m)) :~: 'IntRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int16 (as +: m)) :~:  Int#+        = prodI16 n m k x y+      where+        getM :: forall m p . p (m ': bs) -> Proxy m+        getM _ = Proxy++instance ( ConcatList as bs asbs+         , Dimensions as+         , Dimensions bs+         ) => Contraction Int32 as bs asbs where+    contract x y+        | (pm :: Proxy m) <- getM y+        , I# m <- intNatVal pm+        , I# n <- totalDim (Proxy @as)+        , I# k <- totalDim (Proxy @bs)+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Int32 (m : bs) ) :~: 'IntRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int32 (m : bs) ) :~:  Int#+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Int32 (as +: m)) :~: 'IntRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int32 (as +: m)) :~:  Int#+        = prodI32 n m k x y+      where+        getM :: forall m p . p (m ': bs) -> Proxy m+        getM _ = Proxy++instance ( ConcatList as bs asbs+         , Dimensions as+         , Dimensions bs+         ) => Contraction Int64 as bs asbs where+    contract x y+        | (pm :: Proxy m) <- getM y+        , I# m <- intNatVal pm+        , I# n <- totalDim (Proxy @as)+        , I# k <- totalDim (Proxy @bs)+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Int64 (m : bs) ) :~: 'IntRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int64 (m : bs) ) :~:  Int#+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Int64 (as +: m)) :~: 'IntRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int64 (as +: m)) :~:  Int#+        = prodI64 n m k x y+      where+        getM :: forall m p . p (m ': bs) -> Proxy m+        getM _ = Proxy+++++instance ( ConcatList as bs asbs+         , Dimensions as+         , Dimensions bs+         ) => Contraction Word as bs asbs where+    contract x y+        | (pm :: Proxy m) <- getM y+        , I# m <- intNatVal pm+        , I# n <- totalDim (Proxy @as)+        , I# k <- totalDim (Proxy @bs)+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Word (m : bs) ) :~: 'WordRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word (m : bs) ) :~:  Word#+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Word (as +: m)) :~: 'WordRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word (as +: m)) :~:  Word#+        = prodW n m k x y+      where+        getM :: forall m p . p (m ': bs) -> Proxy m+        getM _ = Proxy++instance ( ConcatList as bs asbs+         , Dimensions as+         , Dimensions bs+         ) => Contraction Word8 as bs asbs where+    contract x y+        | (pm :: Proxy m) <- getM y+        , I# m <- intNatVal pm+        , I# n <- totalDim (Proxy @as)+        , I# k <- totalDim (Proxy @bs)+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Word8 (m : bs) ) :~: 'WordRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word8 (m : bs) ) :~:  Word#+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Word8 (as +: m)) :~: 'WordRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word8 (as +: m)) :~:  Word#+        = prodW8 n m k x y+      where+        getM :: forall m p . p (m ': bs) -> Proxy m+        getM _ = Proxy++instance ( ConcatList as bs asbs+         , Dimensions as+         , Dimensions bs+         ) => Contraction Word16 as bs asbs where+    contract x y+        | (pm :: Proxy m) <- getM y+        , I# m <- intNatVal pm+        , I# n <- totalDim (Proxy @as)+        , I# k <- totalDim (Proxy @bs)+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Word16 (m : bs) ) :~: 'WordRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word16 (m : bs) ) :~:  Word#+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Word16 (as +: m)) :~: 'WordRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word16 (as +: m)) :~:  Word#+        = prodW16 n m k x y+      where+        getM :: forall m p . p (m ': bs) -> Proxy m+        getM _ = Proxy++instance ( ConcatList as bs asbs+         , Dimensions as+         , Dimensions bs+         ) => Contraction Word32 as bs asbs where+    contract x y+        | (pm :: Proxy m) <- getM y+        , I# m <- intNatVal pm+        , I# n <- totalDim (Proxy @as)+        , I# k <- totalDim (Proxy @bs)+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Word32 (m : bs) ) :~: 'WordRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word32 (m : bs) ) :~:  Word#+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Word32 (as +: m)) :~: 'WordRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word32 (as +: m)) :~:  Word#+        = prodW32 n m k x y+      where+        getM :: forall m p . p (m ': bs) -> Proxy m+        getM _ = Proxy++instance ( ConcatList as bs asbs+         , Dimensions as+         , Dimensions bs+         ) => Contraction Word64 as bs asbs where+    contract x y+        | (pm :: Proxy m) <- getM y+        , I# m <- intNatVal pm+        , I# n <- totalDim (Proxy @as)+        , I# k <- totalDim (Proxy @bs)+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Word64 (m : bs) ) :~: 'WordRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word64 (m : bs) ) :~:  Word#+        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Word64 (as +: m)) :~: 'WordRep+        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word64 (as +: m)) :~:  Word#+        = prodW64 n m k x y+      where+        getM :: forall m p . p (m ': bs) -> Proxy m+        getM _ = Proxy++++++prodF :: (FloatBytes a, FloatBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodF n m k x y = case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) ->+           let loop' i j l r | isTrue# (l ==# m) = r+                             | otherwise = loop' i j (l +# 1#) (r `plusFloat#` timesFloat# (ix (i +# n *# l) x)+                                                                                           (ix (l +# m *# j) y))+           in case loop2# n k+               (\i j s' -> writeFloatArray# marr (i +# n *# j) (loop' i j 0# 0.0#) s'+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, n *# k,  r #)+    where+      bs = n *# k *# elementByteSize x+{-# INLINE prodF #-}++prodD :: (DoubleBytes a, DoubleBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodD n m k x y= case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) ->+           let loop' i j l r | isTrue# (l ==# m) = r+                             | otherwise = loop' i j (l +# 1#) (r +## (*##) (ix (i +# n *# l) x)+                                                                            (ix (l +# m *# j) y))+           in case loop2# n k+               (\i j s' -> writeDoubleArray# marr (i +# n *# j) (loop' i j 0# 0.0##) s'+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, n *# k,  r #)+    where+      bs = n *# k *# elementByteSize x+{-# INLINE prodD #-}++prodI :: (IntBytes a, IntBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodI n m k x y= case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) ->+           let loop' i j l r | isTrue# (l ==# m) = r+                             | otherwise = loop' i j (l +# 1#) (r +# (*#) (ix (i +# n *# l) x)+                                                                          (ix (l +# m *# j) y))+           in case loop2# n k+               (\i j s' -> writeIntArray# marr (i +# n *# j) (loop' i j 0# 0#) s'+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, n *# k,  r #)+    where+      bs = n *# k *# elementByteSize x+{-# INLINE prodI #-}++prodI8 :: (IntBytes a, IntBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodI8 n m k x y= case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) ->+           let loop' i j l r | isTrue# (l ==# m) = r+                             | otherwise = loop' i j (l +# 1#) (r +# (*#) (ix (i +# n *# l) x)+                                                                          (ix (l +# m *# j) y))+           in case loop2# n k+               (\i j s' -> writeInt8Array# marr (i +# n *# j) (loop' i j 0# 0#) s'+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, n *# k,  r #)+    where+      bs = n *# k *# elementByteSize x+{-# INLINE prodI8 #-}+++prodI16 :: (IntBytes a, IntBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodI16 n m k x y= case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) ->+           let loop' i j l r | isTrue# (l ==# m) = r+                             | otherwise = loop' i j (l +# 1#) (r +# (*#) (ix (i +# n *# l) x)+                                                                          (ix (l +# m *# j) y))+           in case loop2# n k+               (\i j s' -> writeInt16Array# marr (i +# n *# j) (loop' i j 0# 0#) s'+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, n *# k,  r #)+    where+      bs = n *# k *# elementByteSize x+{-# INLINE prodI16 #-}+++prodI32 :: (IntBytes a, IntBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodI32 n m k x y= case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) ->+           let loop' i j l r | isTrue# (l ==# m) = r+                             | otherwise = loop' i j (l +# 1#) (r +# (*#) (ix (i +# n *# l) x)+                                                                          (ix (l +# m *# j) y))+           in case loop2# n k+               (\i j s' -> writeInt32Array# marr (i +# n *# j) (loop' i j 0# 0#) s'+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, n *# k,  r #)+    where+      bs = n *# k *# elementByteSize x+{-# INLINE prodI32 #-}+++prodI64 :: (IntBytes a, IntBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodI64 n m k x y= case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) ->+           let loop' i j l r | isTrue# (l ==# m) = r+                             | otherwise = loop' i j (l +# 1#) (r +# (*#) (ix (i +# n *# l) x)+                                                                          (ix (l +# m *# j) y))+           in case loop2# n k+               (\i j s' -> writeInt64Array# marr (i +# n *# j) (loop' i j 0# 0#) s'+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, n *# k,  r #)+    where+      bs = n *# k *# elementByteSize x+{-# INLINE prodI64 #-}++prodW :: (WordBytes a, WordBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodW n m k x y = case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) ->+           let loop' i j l r | isTrue# (l ==# m) = r+                             | otherwise = loop' i j (l +# 1#) (r `plusWord#` timesWord# (ix (i +# n *# l) x)+                                                                                         (ix (l +# m *# j) y))+           in case loop2# n k+               (\i j s' -> writeWordArray# marr (i +# n *# j) (loop' i j 0# 0##) s'+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, n *# k,  r #)+    where+      bs = n *# k *# elementByteSize x+{-# INLINE prodW #-}++prodW8 :: (WordBytes a, WordBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodW8 n m k x y = case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) ->+           let loop' i j l r | isTrue# (l ==# m) = r+                             | otherwise = loop' i j (l +# 1#) (r `plusWord#` timesWord# (ix (i +# n *# l) x)+                                                                                         (ix (l +# m *# j) y))+           in case loop2# n k+               (\i j s' -> writeWord8Array# marr (i +# n *# j) (loop' i j 0# 0##) s'+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, n *# k,  r #)+    where+      bs = n *# k *# elementByteSize x+{-# INLINE prodW8 #-}+++prodW16 :: (WordBytes a, WordBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodW16 n m k x y = case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) ->+           let loop' i j l r | isTrue# (l ==# m) = r+                             | otherwise = loop' i j (l +# 1#) (r `plusWord#` timesWord# (ix (i +# n *# l) x)+                                                                                         (ix (l +# m *# j) y))+           in case loop2# n k+               (\i j s' -> writeWord16Array# marr (i +# n *# j) (loop' i j 0# 0##) s'+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, n *# k,  r #)+    where+      bs = n *# k *# elementByteSize x+{-# INLINE prodW16 #-}++prodW32 :: (WordBytes a, WordBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodW32 n m k x y = case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) ->+           let loop' i j l r | isTrue# (l ==# m) = r+                             | otherwise = loop' i j (l +# 1#) (r `plusWord#` timesWord# (ix (i +# n *# l) x)+                                                                                         (ix (l +# m *# j) y))+           in case loop2# n k+               (\i j s' -> writeWord32Array# marr (i +# n *# j) (loop' i j 0# 0##) s'+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, n *# k,  r #)+    where+      bs = n *# k *# elementByteSize x+{-# INLINE prodW32 #-}++prodW64 :: (WordBytes a, WordBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodW64 n m k x y = case runRW#+     ( \s0 -> case newByteArray# bs s0 of+         (# s1, marr #) ->+           let loop' i j l r | isTrue# (l ==# m) = r+                             | otherwise = loop' i j (l +# 1#) (r `plusWord#` timesWord# (ix (i +# n *# l) x)+                                                                                         (ix (l +# m *# j) y))+           in case loop2# n k+               (\i j s' -> writeWord64Array# marr (i +# n *# j) (loop' i j 0# 0##) s'+               ) s1 of+             s2 -> unsafeFreezeByteArray# marr s2+     ) of (# _, r #) -> fromBytes (# 0#, n *# k,  r #)+    where+      bs = n *# k *# elementByteSize x+{-# INLINE prodW64 #-}+++-- | Do something in a loop for int i from 0 to n-1 and j from 0 to m-1+loop2# :: Int# -> Int# -> (Int# -> Int#-> State# s -> State# s) -> State# s -> State# s+loop2# n m f = loop' 0# 0#+  where+    loop' i j s | isTrue# (j ==# m) = s+                | isTrue# (i ==# n) = loop' 0# (j +# 1#) s+                | otherwise         = case f i j s of s1 -> loop' (i +# 1#) j s1+{-# INLINE loop2# #-}+++-- contract' :: forall (t :: Type) (m :: Nat) (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])+--            . ( ToList asbs ~ SimplifyList ('Concat (ToList as) (ToList bs))+--              , ToList as   ~ SimplifyList ('Prefix (ToList bs) (ToList asbs))+--              , ToList bs   ~ SimplifyList ('Suffix (ToList as) (ToList asbs))+--              , Dimensions asbs+--              , Dimensions (as +: m)+--              , Dimensions (m :+ bs)+--              , KnownDim m+--              , ElementDataType t+--              )+--           => DataFrame t (as +: m) -> DataFrame t (m :+ bs) -> DataFrame t asbs+-- contract' x y = case dim @asbs of+--   D -> case ( unsafeCoerce Refl :: as :~: '[]+--             , unsafeCoerce Refl :: bs :~: '[]+--             ) of+--     (Refl, Refl) -> case edtRefl (Proxy @t) of+--         EDTFloat -> contract x y+--   _ :* (sbs :: Dim (sbs :: [Nat])) -> case edtRefl (Proxy @t) of+--       EDTFloat -> contract x y+    --    case ( unsafeCoerce Refl :: EvalConsNat (SimplifyList (ToListNat sbs)) :~: sbs+    --         , unsafeCoerce Refl :: SimplifyList (ToListNat bs) :~: ToListNat bs+    --         , unsafeCoerce Refl :: ToList (as +: m) :~: SimplifyList (ToList (as +: m))+    --         ) of+    -- (Refl, Refl, Refl) -> case edtRefl (Proxy @t) of+    --     EDTFloat -> contract x y

@@ -0,0 +1,128 @@+{-# LANGUAGE DataKinds                 #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE KindSignatures            #-}+{-# LANGUAGE MagicHash                 #-}+{-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE TypeApplications          #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE UnboxedTuples             #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.DataFrame.IO+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+-- Mutable DataFrames living in IO.+--+-----------------------------------------------------------------------------++module Numeric.DataFrame.IO+    ( MutableFrame (), IODataFrame ()+    , newDataFrame, copyDataFrame, copyMutableDataFrame+    , unsafeFreezeDataFrame+    , freezeDataFrame, thawDataFrame+    , writeDataFrame, readDataFrame+    , writeDataFrameOff, readDataFrameOff+    ) where++import           GHC.Prim               (RealWorld)+import           GHC.Types              (Int (..), IO (..))++import           Numeric.Commons+import           Numeric.DataFrame.Type+import           Numeric.DataFrame.Mutable+import           Numeric.Dimensions+import           Numeric.Scalar++-- | Mutable DataFrame that lives in IO.+--   Internal representation is always a ByteArray.+newtype IODataFrame t (ns :: [Nat]) = IODataFrame (MDataFrame RealWorld t (ns :: [Nat]))+++-- | Create a new mutable DataFrame.+newDataFrame :: forall t (ns :: [Nat])+               . ( PrimBytes t, Dimensions ns)+              => IO (IODataFrame t ns)+newDataFrame = IODataFrame <$> IO (newDataFrame# @t @ns)+{-# INLINE newDataFrame #-}++-- | Copy one DataFrame into another mutable DataFrame at specified position.+copyDataFrame :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])+                . ( PrimBytes (DataFrame t as)+                  , ConcatList as bs asbs+                  , Dimensions bs+                  )+               => DataFrame t as -> Idx bs -> IODataFrame t asbs -> IO ()+copyDataFrame df ei (IODataFrame mdf) = IO (copyDataFrame# df ei mdf)+{-# INLINE copyDataFrame #-}++-- | Copy one mutable DataFrame into another mutable DataFrame at specified position.+copyMutableDataFrame :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])+                . ( PrimBytes t+                  , ConcatList as bs asbs+                  , Dimensions bs+                  )+               => IODataFrame t as -> Idx bs -> IODataFrame t asbs -> IO ()+copyMutableDataFrame (IODataFrame mdfA) ei (IODataFrame mdfB)+    = IO (copyMDataFrame# mdfA ei mdfB)+{-# INLINE copyMutableDataFrame #-}+++-- | Make a mutable DataFrame immutable, without copying.+unsafeFreezeDataFrame :: forall t (ns :: [Nat])+                        . PrimBytes (DataFrame t ns)+                       => IODataFrame t ns -> IO (DataFrame t ns)+unsafeFreezeDataFrame (IODataFrame mdf) = IO (unsafeFreezeDataFrame# mdf)+{-# INLINE unsafeFreezeDataFrame #-}+++-- | Copy content of a mutable DataFrame into a new immutable DataFrame.+freezeDataFrame :: forall t (ns :: [Nat])+                  . PrimBytes (DataFrame t ns)+                 => IODataFrame t ns -> IO (DataFrame t ns)+freezeDataFrame (IODataFrame mdf) = IO (freezeDataFrame# mdf)+{-# INLINE freezeDataFrame #-}++-- | Create a new mutable DataFrame and copy content of immutable one in there.+thawDataFrame :: forall t (ns :: [Nat])+                . PrimBytes (DataFrame t ns)+               => DataFrame t ns -> IO (IODataFrame t ns)+thawDataFrame df = IODataFrame <$> IO (thawDataFrame# df)+{-# INLINE thawDataFrame #-}+++-- | Write a single element at the specified index+writeDataFrame :: forall t (ns :: [Nat])+                . ( MutableFrame t ns, Dimensions ns )+               => IODataFrame t ns -> Idx ns -> Scalar t -> IO ()+writeDataFrame (IODataFrame mdf) ei = IO . writeDataFrame# mdf ei . unScalar+{-# INLINE writeDataFrame #-}+++-- | Read a single element at the specified index+readDataFrame :: forall t (ns :: [Nat])+                . ( MutableFrame t ns, Dimensions ns )+               => IODataFrame t ns -> Idx ns -> IO (Scalar t)+readDataFrame (IODataFrame mdf) = fmap scalar . IO . readDataFrame# mdf+{-# INLINE readDataFrame #-}+++-- | Write a single element at the specified element offset+writeDataFrameOff :: forall t (ns :: [Nat])+                . ( MutableFrame t ns, Dimensions ns )+               => IODataFrame t ns -> Int -> Scalar t -> IO ()+writeDataFrameOff (IODataFrame mdf) (I# i) x = IO $ \s -> (# writeDataFrameOff# mdf i (unScalar x) s, () #)+{-# INLINE writeDataFrameOff #-}+++-- | Read a single element at the specified element offset+readDataFrameOff :: forall t (ns :: [Nat])+                . ( MutableFrame t ns, Dimensions ns )+               => IODataFrame t ns -> Int -> IO (Scalar t)+readDataFrameOff (IODataFrame mdf) (I# i) = scalar <$> IO (readDataFrameOff# mdf i)+{-# INLINE readDataFrameOff #-}

@@ -0,0 +1,140 @@+{-# LANGUAGE DataKinds                 #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE GADTs                     #-}+{-# LANGUAGE KindSignatures            #-}+{-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE TypeApplications          #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.DataFrame.Inference+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+-- The module provides data types and functions to infer typeclasses at runtime.+--+-----------------------------------------------------------------------------++module Numeric.DataFrame.Inference+    ( PrimBytesEvidence, inferPrimBytes+    , ElementWiseEvidence, inferElementWise+    , NumericFrameEvidence, inferNumericFrame+    ) where++import           Numeric.Array+import           Numeric.Array.ElementWise+import           Numeric.Commons+import           Numeric.DataFrame.Type+import           Numeric.Dimensions+++-- | Evidence for PrimBytes class+type PrimBytesEvidence t (ds :: [Nat])+  = Evidence (PrimBytes (DataFrame t ds))++-- | Evidence for ElementWise class+type ElementWiseEvidence t (ds :: [Nat])+  = Evidence (ElementWise (Idx ds) t (DataFrame t ds))++-- | Allow all common operations on available data frames+type NumericFrameEvidence t (ds :: [Nat])+  = Evidence ( NumericFrame t ds)++inferPrimBytes :: forall t (ds :: [Nat])+                . ( ArrayInstanceInference t ds+                  , Dimensions ds+                  )+               => PrimBytesEvidence t ds+inferPrimBytes = case getArrayInstance @t @ds of+    AIScalar   -> case elemTypeInstance @t of+      ETFloat  -> Evidence+      ETDouble -> Evidence+      ETInt    -> Evidence+      ETInt8   -> Evidence+      ETInt16  -> Evidence+      ETInt32  -> Evidence+      ETInt64  -> Evidence+      ETWord   -> Evidence+      ETWord8  -> Evidence+      ETWord16 -> Evidence+      ETWord32 -> Evidence+      ETWord64 -> Evidence+    AIArrayF   -> Evidence+    AIArrayD   -> Evidence+    AIArrayI   -> Evidence+    AIArrayI8  -> Evidence+    AIArrayI16 -> Evidence+    AIArrayI32 -> Evidence+    AIArrayI64 -> Evidence+    AIArrayW   -> Evidence+    AIArrayW8  -> Evidence+    AIArrayW16 -> Evidence+    AIArrayW32 -> Evidence+    AIArrayW64 -> Evidence+    AIFloatX2  -> Evidence+    AIFloatX3  -> Evidence+    AIFloatX4  -> Evidence++inferElementWise :: forall t (ds :: [Nat])+                . ( ArrayInstanceInference t ds+                  , Dimensions ds+                  )+                 => ElementWiseEvidence t ds+inferElementWise = case getArrayInstance @t @ds of+    AIScalar   -> Evidence+    AIArrayF   -> Evidence+    AIArrayD   -> Evidence+    AIArrayI   -> Evidence+    AIArrayI8  -> Evidence+    AIArrayI16 -> Evidence+    AIArrayI32 -> Evidence+    AIArrayI64 -> Evidence+    AIArrayW   -> Evidence+    AIArrayW8  -> Evidence+    AIArrayW16 -> Evidence+    AIArrayW32 -> Evidence+    AIArrayW64 -> Evidence+    AIFloatX2  -> Evidence+    AIFloatX3  -> Evidence+    AIFloatX4  -> Evidence+++inferNumericFrame :: forall t (ds :: [Nat])+                   . ( ArrayInstanceInference t ds+                     , Dimensions ds+                     )+                   => NumericFrameEvidence t ds+inferNumericFrame+  | Evidence <- inferDimKnownDims @ds +!+ inferDimFiniteList @ds+  = case getArrayInstance @t @ds of+    AIFloatX2  -> Evidence+    AIFloatX3  -> Evidence+    AIFloatX4  -> Evidence+    AIScalar   -> case elemTypeInstance @t of+      ETFloat  -> Evidence+      ETDouble -> Evidence+      ETInt    -> Evidence+      ETInt8   -> Evidence+      ETInt16  -> Evidence+      ETInt32  -> Evidence+      ETInt64  -> Evidence+      ETWord   -> Evidence+      ETWord8  -> Evidence+      ETWord16 -> Evidence+      ETWord32 -> Evidence+      ETWord64 -> Evidence+    AIArrayF   -> Evidence+    AIArrayD   -> Evidence+    AIArrayI   -> Evidence+    AIArrayI8  -> Evidence+    AIArrayI16 -> Evidence+    AIArrayI32 -> Evidence+    AIArrayI64 -> Evidence+    AIArrayW   -> Evidence+    AIArrayW8  -> Evidence+    AIArrayW16 -> Evidence+    AIArrayW32 -> Evidence+    AIArrayW64 -> Evidence

@@ -0,0 +1,223 @@+{-# LANGUAGE DataKinds                 #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE KindSignatures            #-}+{-# LANGUAGE MagicHash                 #-}+{-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE TypeApplications          #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE UnboxedTuples             #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.DataFrame.Mutable+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+-- Interfrace to perform primitive stateful operations on mutable frames.+--+-----------------------------------------------------------------------------++module Numeric.DataFrame.Mutable+    ( MutableFrame (..), MDataFrame ()+    , newDataFrame#, copyDataFrame#, copyMDataFrame#, unsafeFreezeDataFrame#+    , freezeDataFrame#, thawDataFrame#+    , writeDataFrame#, readDataFrame#+    ) where+++import           GHC.Int                (Int16 (..), Int32 (..), Int64 (..),+                                         Int8 (..))+import           GHC.Prim+import           GHC.Types              (Double (..), Float (..), Int (..),+                                         Word (..))+import           GHC.Word               (Word16 (..), Word32 (..), Word64 (..),+                                         Word8 (..))++import           Numeric.Commons+import           Numeric.DataFrame.Type+import           Numeric.Dimensions+import           Numeric.TypeLits+++-- | Mutable DataFrame type+data MDataFrame s t (ns :: [Nat]) = MDataFrame# Int# Int# (MutableByteArray# s)++-- | Create a new mutable DataFrame.+newDataFrame# :: forall t (ns :: [Nat]) s+               . ( PrimBytes t, Dimensions ns)+              => State# s -> (# State# s, MDataFrame s t ns #)+newDataFrame# s0+    | elS  <- elementByteSize (undefined :: t)+    , I# n <- totalDim (Proxy @ns)+    , (# s1, mba #) <- newByteArray# (n *# elS) s0+    = (# s1,  MDataFrame# 0# n mba #)+{-# INLINE newDataFrame# #-}++-- | Copy one DataFrame into another mutable DataFrame at specified position.+copyDataFrame# :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) s+                . ( PrimBytes (DataFrame t as)+                  , ConcatList as bs asbs+                  , Dimensions bs+                  )+               => DataFrame t as -> Idx bs -> MDataFrame s t asbs -> State# s -> (# State# s, () #)+copyDataFrame# df ei (MDataFrame# offM _ arrM) s+    | (# offA, lenA, arrA #) <- toBytes df+    , elS <- elementByteSize df+    , I# i <- fromEnum ei+    = (# copyByteArray# arrA (offA *# elS) arrM ((offM +# i) *# elS) (lenA *# elS) s, () #)+{-# INLINE copyDataFrame# #-}++-- | Copy one mutable DataFrame into another mutable DataFrame at specified position.+copyMDataFrame# :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) s+                . ( PrimBytes t+                  , ConcatList as bs asbs+                  , Dimensions bs+                  )+               => MDataFrame s t as -> Idx bs -> MDataFrame s t asbs -> State# s -> (# State# s, () #)+copyMDataFrame# (MDataFrame# offA lenA arrA) ei (MDataFrame# offM _ arrM) s+    | elS <- elementByteSize (undefined :: t)+    , I# i <- fromEnum ei+    = (# copyMutableByteArray# arrA (offA *# elS) arrM ((offM +# i) *# elS) (lenA *# elS) s, () #)+{-# INLINE copyMDataFrame# #-}++-- | Make a mutable DataFrame immutable, without copying.+unsafeFreezeDataFrame# :: forall t (ns :: [Nat]) s+                        . PrimBytes (DataFrame t ns)+                       => MDataFrame s t ns -> State# s -> (# State# s, DataFrame t ns #)+unsafeFreezeDataFrame# (MDataFrame# offM lenM arrM) s1+    | (# s2, arrA #) <- unsafeFreezeByteArray# arrM s1+    = (# s2, fromBytes (# offM, lenM, arrA #) #)+{-# INLINE unsafeFreezeDataFrame# #-}++-- | Copy content of a mutable DataFrame into a new immutable DataFrame.+freezeDataFrame# :: forall t (ns :: [Nat]) s+                  . PrimBytes (DataFrame t ns)+                 => MDataFrame s t ns -> State# s -> (# State# s, DataFrame t ns #)+freezeDataFrame# (MDataFrame# offM n arrM) s0+    | elS  <- elementByteSize (undefined :: DataFrame t ns)+    , (# s1, mba #) <- newByteArray# (n *# elS) s0+    , s2 <- copyMutableByteArray# arrM (offM *# elS) mba 0# (n *# elS) s1+    , (# s3, arrA #) <- unsafeFreezeByteArray# mba s2+    = (# s3, fromBytes (# 0#, n, arrA #) #)+{-# INLINE freezeDataFrame# #-}++-- | Create a new mutable DataFrame and copy content of immutable one in there.+thawDataFrame# :: forall t (ns :: [Nat]) s+                . PrimBytes (DataFrame t ns)+               => DataFrame t ns -> State# s -> (# State# s, MDataFrame s t ns #)+thawDataFrame# df s0+    | elS  <- elementByteSize (undefined :: DataFrame t ns)+    , (# offA, n, arrA #) <- toBytes df+    , (# s1, arrM #) <- newByteArray# (n *# elS) s0+    , s2 <- copyByteArray# arrA (offA *# elS) arrM 0# (n *# elS) s1+    = (# s2, MDataFrame# 0# n arrM #)+{-# INLINE thawDataFrame# #-}++-- | Write a single element at the specified index+writeDataFrame# :: forall t (ns :: [Nat]) s+                . ( MutableFrame t ns, Dimensions ns )+               => MDataFrame s t ns -> Idx ns -> t -> State# s -> (# State# s, () #)+writeDataFrame# mdf ei x s | I# i <- fromEnum ei = (# writeDataFrameOff# mdf i x s, () #)+{-# INLINE writeDataFrame# #-}++-- | Read a single element at the specified index+readDataFrame# :: forall t (ns :: [Nat]) s+                . ( MutableFrame t ns, Dimensions ns )+               => MDataFrame s t ns -> Idx ns -> State# s -> (# State# s, t #)+readDataFrame# mdf ei | I# i <- fromEnum ei = readDataFrameOff# mdf i+{-# INLINE readDataFrame# #-}++class MutableFrame t (ns :: [Nat]) where+    -- | Write a single element at the specified element offset+    writeDataFrameOff# :: MDataFrame s t ns -> Int# -> t -> State# s -> State# s+    -- | Read a single element at the specified element offset+    readDataFrameOff# :: MDataFrame s t ns -> Int# -> State# s -> (# State# s, t #)++instance MutableFrame Float (ns :: [Nat]) where+    writeDataFrameOff# (MDataFrame# off _ arr) i (F# x) = writeFloatArray# arr (off +# i) x+    {-# INLINE writeDataFrameOff# #-}+    readDataFrameOff#  (MDataFrame# off _ arr) i s0+      | (# s1, r #) <- readFloatArray# arr (off +# i) s0 = (# s1, F# r #)+    {-# INLINE readDataFrameOff# #-}++instance MutableFrame Double (ns :: [Nat]) where+    writeDataFrameOff# (MDataFrame# off _ arr) i (D# x) = writeDoubleArray# arr (off +# i) x+    {-# INLINE writeDataFrameOff# #-}+    readDataFrameOff#  (MDataFrame# off _ arr) i s0+      | (# s1, r #) <- readDoubleArray# arr (off +# i) s0 = (# s1, D# r #)+    {-# INLINE readDataFrameOff# #-}++instance MutableFrame Int (ns :: [Nat]) where+    writeDataFrameOff# (MDataFrame# off _ arr) i (I# x) = writeIntArray# arr (off +# i) x+    {-# INLINE writeDataFrameOff# #-}+    readDataFrameOff#  (MDataFrame# off _ arr) i s0+      | (# s1, r #) <- readIntArray# arr (off +# i) s0 = (# s1, I# r #)+    {-# INLINE readDataFrameOff# #-}++instance MutableFrame Int8 (ns :: [Nat]) where+    writeDataFrameOff# (MDataFrame# off _ arr) i (I8# x) = writeInt8Array# arr (off +# i) x+    {-# INLINE writeDataFrameOff# #-}+    readDataFrameOff#  (MDataFrame# off _ arr) i s0+      | (# s1, r #) <- readInt8Array# arr (off +# i) s0 = (# s1, I8# r #)+    {-# INLINE readDataFrameOff# #-}++instance MutableFrame Int16 (ns :: [Nat]) where+    writeDataFrameOff# (MDataFrame# off _ arr) i (I16# x) = writeInt16Array# arr (off +# i) x+    {-# INLINE writeDataFrameOff# #-}+    readDataFrameOff#  (MDataFrame# off _ arr) i s0+      | (# s1, r #) <- readInt16Array# arr (off +# i) s0 = (# s1, I16# r #)+    {-# INLINE readDataFrameOff# #-}++instance MutableFrame Int32 (ns :: [Nat]) where+    writeDataFrameOff# (MDataFrame# off _ arr) i (I32# x) = writeInt32Array# arr (off +# i) x+    {-# INLINE writeDataFrameOff# #-}+    readDataFrameOff#  (MDataFrame# off _ arr) i s0+      | (# s1, r #) <- readInt32Array# arr (off +# i) s0 = (# s1, I32# r #)+    {-# INLINE readDataFrameOff# #-}++instance MutableFrame Int64 (ns :: [Nat]) where+    writeDataFrameOff# (MDataFrame# off _ arr) i (I64# x) = writeInt64Array# arr (off +# i) x+    {-# INLINE writeDataFrameOff# #-}+    readDataFrameOff#  (MDataFrame# off _ arr) i s0+      | (# s1, r #) <- readInt64Array# arr (off +# i) s0 = (# s1, I64# r #)+    {-# INLINE readDataFrameOff# #-}+++instance MutableFrame Word (ns :: [Nat]) where+    writeDataFrameOff# (MDataFrame# off _ arr) i (W# x) = writeWordArray# arr (off +# i) x+    {-# INLINE writeDataFrameOff# #-}+    readDataFrameOff#  (MDataFrame# off _ arr) i s0+      | (# s1, r #) <- readWordArray# arr (off +# i) s0 = (# s1, W# r #)+    {-# INLINE readDataFrameOff# #-}++instance MutableFrame Word8 (ns :: [Nat]) where+    writeDataFrameOff# (MDataFrame# off _ arr) i (W8# x) = writeWord8Array# arr (off +# i) x+    {-# INLINE writeDataFrameOff# #-}+    readDataFrameOff#  (MDataFrame# off _ arr) i s0+      | (# s1, r #) <- readWord8Array# arr (off +# i) s0 = (# s1, W8# r #)+    {-# INLINE readDataFrameOff# #-}++instance MutableFrame Word16 (ns :: [Nat]) where+    writeDataFrameOff# (MDataFrame# off _ arr) i (W16# x) = writeWord16Array# arr (off +# i) x+    {-# INLINE writeDataFrameOff# #-}+    readDataFrameOff#  (MDataFrame# off _ arr) i s0+      | (# s1, r #) <- readWord16Array# arr (off +# i) s0 = (# s1, W16# r #)+    {-# INLINE readDataFrameOff# #-}++instance MutableFrame Word32 (ns :: [Nat]) where+    writeDataFrameOff# (MDataFrame# off _ arr) i (W32# x) = writeWord32Array# arr (off +# i) x+    {-# INLINE writeDataFrameOff# #-}+    readDataFrameOff#  (MDataFrame# off _ arr) i s0+      | (# s1, r #) <- readWord32Array# arr (off +# i) s0 = (# s1, W32# r #)+    {-# INLINE readDataFrameOff# #-}++instance MutableFrame Word64 (ns :: [Nat]) where+    writeDataFrameOff# (MDataFrame# off _ arr) i (W64# x) = writeWord64Array# arr (off +# i) x+    {-# INLINE writeDataFrameOff# #-}+    readDataFrameOff#  (MDataFrame# off _ arr) i s0+      | (# s1, r #) <- readWord64Array# arr (off +# i) s0 = (# s1, W64# r #)+    {-# INLINE readDataFrameOff# #-}

@@ -0,0 +1,130 @@+{-# LANGUAGE DataKinds                 #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE KindSignatures            #-}+{-# LANGUAGE MagicHash                 #-}+{-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE TypeApplications          #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE UnboxedTuples             #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.DataFrame.ST+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+-- Mutable DataFrames living in ST.+--+-----------------------------------------------------------------------------++module Numeric.DataFrame.ST+    ( MutableFrame (), STDataFrame ()+    , newDataFrame, copyDataFrame, copyMutableDataFrame+    , unsafeFreezeDataFrame+    , freezeDataFrame, thawDataFrame+    , writeDataFrame, readDataFrame+    , writeDataFrameOff, readDataFrameOff+    ) where+++import           GHC.Types              (Int (..))+import           GHC.ST                 (ST(..))++import           Numeric.Commons+import           Numeric.DataFrame.Type+import           Numeric.DataFrame.Mutable+import           Numeric.Dimensions+import           Numeric.Scalar+++-- | Mutable DataFrame that lives in ST.+--   Internal representation is always a ByteArray.+newtype STDataFrame s t (ns :: [Nat]) = STDataFrame (MDataFrame s t (ns :: [Nat]))+++-- | Create a new mutable DataFrame.+newDataFrame :: forall t (ns :: [Nat]) s+               . ( PrimBytes t, Dimensions ns)+              => ST s (STDataFrame s t ns)+newDataFrame = STDataFrame <$> ST (newDataFrame# @t @ns)+{-# INLINE newDataFrame #-}++-- | Copy one DataFrame into another mutable DataFrame at specified position.+copyDataFrame :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) s+                . ( PrimBytes (DataFrame t as)+                  , ConcatList as bs asbs+                  , Dimensions bs+                  )+               => DataFrame t as -> Idx bs -> STDataFrame s t asbs -> ST s ()+copyDataFrame df ei (STDataFrame mdf) = ST (copyDataFrame# df ei mdf)+{-# INLINE copyDataFrame #-}++-- | Copy one mutable DataFrame into another mutable DataFrame at specified position.+copyMutableDataFrame :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) s+                . ( PrimBytes t+                  , ConcatList as bs asbs+                  , Dimensions bs+                  )+               => STDataFrame s t as -> Idx bs -> STDataFrame s t asbs -> ST s ()+copyMutableDataFrame (STDataFrame mdfA) ei (STDataFrame mdfB)+    = ST (copyMDataFrame# mdfA ei mdfB)+{-# INLINE copyMutableDataFrame #-}+++-- | Make a mutable DataFrame immutable, without copying.+unsafeFreezeDataFrame :: forall t (ns :: [Nat]) s+                        . PrimBytes (DataFrame t ns)+                       => STDataFrame s t ns -> ST s (DataFrame t ns)+unsafeFreezeDataFrame (STDataFrame mdf) = ST (unsafeFreezeDataFrame# mdf)+{-# INLINE unsafeFreezeDataFrame #-}+++-- | Copy content of a mutable DataFrame into a new immutable DataFrame.+freezeDataFrame :: forall t (ns :: [Nat]) s+                  . PrimBytes (DataFrame t ns)+                 => STDataFrame s t ns -> ST s (DataFrame t ns)+freezeDataFrame (STDataFrame mdf) = ST (freezeDataFrame# mdf)+{-# INLINE freezeDataFrame #-}++-- | Create a new mutable DataFrame and copy content of immutable one in there.+thawDataFrame :: forall t (ns :: [Nat]) s+                . PrimBytes (DataFrame t ns)+               => DataFrame t ns -> ST s (STDataFrame s t ns)+thawDataFrame df = STDataFrame <$> ST (thawDataFrame# df)+{-# INLINE thawDataFrame #-}+++-- | Write a single element at the specified index+writeDataFrame :: forall t (ns :: [Nat]) s+                . ( MutableFrame t ns, Dimensions ns )+               => STDataFrame s t ns -> Idx ns -> Scalar t -> ST s ()+writeDataFrame (STDataFrame mdf) ei = ST . writeDataFrame# mdf ei . unScalar+{-# INLINE writeDataFrame #-}+++-- | Read a single element at the specified index+readDataFrame :: forall t (ns :: [Nat]) s+                . ( MutableFrame t ns, Dimensions ns )+               => STDataFrame s t ns -> Idx ns -> ST s (Scalar t)+readDataFrame (STDataFrame mdf) = fmap scalar . ST . readDataFrame# mdf+{-# INLINE readDataFrame #-}+++-- | Write a single element at the specified element offset+writeDataFrameOff :: forall t (ns :: [Nat]) s+                . ( MutableFrame t ns, Dimensions ns )+               => STDataFrame s t ns -> Int -> Scalar t -> ST s ()+writeDataFrameOff (STDataFrame mdf) (I# i) x = ST $ \s -> (# writeDataFrameOff# mdf i (unScalar x) s, () #)+{-# INLINE writeDataFrameOff #-}+++-- | Read a single element at the specified element offset+readDataFrameOff :: forall t (ns :: [Nat]) s+                . ( MutableFrame t ns, Dimensions ns )+               => STDataFrame s t ns -> Int -> ST s (Scalar t)+readDataFrameOff (STDataFrame mdf) (I# i) = scalar <$> ST (readDataFrameOff# mdf i)+{-# INLINE readDataFrameOff #-}

@@ -0,0 +1,265 @@+{-# LANGUAGE BangPatterns              #-}+{-# LANGUAGE DataKinds                 #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE GADTs                     #-}+{-# LANGUAGE KindSignatures            #-}+{-# LANGUAGE MagicHash                 #-}+{-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE PolyKinds                 #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE TypeApplications          #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE TypeOperators             #-}+{-# LANGUAGE UnboxedTuples             #-}+{-# LANGUAGE UndecidableInstances      #-}+{-# OPTIONS_GHC -fno-warn-orphans      #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.DataFrame.Shape+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+-- Construct new DataFrames from pieces.+--+-----------------------------------------------------------------------------++module Numeric.DataFrame.Shape+    ( (<:>), (<::>), (<+:>)+    , fromList, DataFrameToList (..), fromScalar+    ) where++import           Data.Type.Equality          ((:~:) (..))+import           GHC.Base                    (runRW#)+import qualified GHC.Exts                    as Exts (IsList (..))+import           GHC.Prim+import           GHC.Types                   (Int (..), Type, isTrue#)+import           Unsafe.Coerce               (unsafeCoerce)++import qualified Numeric.Array.ElementWise   as EW+import           Numeric.Array.Family        hiding (Scalar)+import           Numeric.Commons+import           Numeric.DataFrame.Inference+import           Numeric.DataFrame.Type+import           Numeric.Dimensions+import           Numeric.TypeLits+import           Numeric.Scalar              as Scalar+import           Numeric.Vector              (vec2)++-- | Append one DataFrame to another, adding up their last dimensionality+(<:>) :: forall (n :: Nat) (m :: Nat) (npm :: Nat) (ds :: [Nat])+                (t :: Type)+       . ( PrimBytes (DataFrame t (ds +: n))+         , PrimBytes (DataFrame t (ds +: m))+         , PrimBytes (DataFrame t (ds +: npm))+         , npm ~ (n + m)+         , n   ~ (npm - m)+         , m   ~ (npm - n)+         )+        => DataFrame t (ds +: n)+        -> DataFrame t (ds +: m)+        -> DataFrame t (ds +: npm)+a <:> b = case (# toBytes a, toBytes b+                , byteSize a+                , byteSize b+                , elementByteSize a #) of+  (# (# off1, n1, arr1 #), (# off2, n2, arr2 #), bs1, bs2, ebs #) -> case runRW#+     ( \s0 -> case newByteArray# (bs1 +# bs2) s0 of+         (# s1, mr #) -> case copyByteArray# arr1 (off1 *# ebs) mr 0# bs1 s1 of+           s2 -> case copyByteArray# arr2 (off2 *# ebs) mr bs1 bs2 s2 of+             s3 -> unsafeFreezeByteArray# mr s3+     ) of (# _, r #) -> fromBytes (# 0#, n1 +# n2, r #)+infixl 5 <:>++-- | Append one DataFrame to another, adding up their last dimensionality+(<::>) :: forall (ds :: [Nat]) (t :: Type)+       .  ( PrimBytes (DataFrame t ds)+          , PrimBytes (DataFrame t ds)+          , PrimBytes (DataFrame t (ds +: 2 :: [Nat]))+          )+        => DataFrame t ds+        -> DataFrame t ds+        -> DataFrame t (ds +: 2 :: [Nat])+a <::> b = case (# toBytes a, toBytes b+                , byteSize a+                , byteSize b+                , elementByteSize a #) of+  (# (# off1, n1, arr1 #), (# off2, n2, arr2 #), bs1, bs2, ebs #) -> case runRW#+     ( \s0 -> case newByteArray# (bs1 +# bs2) s0 of+         (# s1, mr #) -> case copyByteArray# arr1 (off1 *# ebs) mr 0# bs1 s1 of+           s2 -> case copyByteArray# arr2 (off2 *# ebs) mr bs1 bs2 s2 of+             s3 -> unsafeFreezeByteArray# mr s3+     ) of (# _, r #) -> fromBytes (# 0#, n1 +# n2, r #)+infixl 5 <::>+{-# NOINLINE [1] (<::>) #-}++{-# RULES+"<::>/vec2-Float"  forall (a :: Scalar Float)  (b :: Scalar Float)  . a <::> b = vec2 (unScalar a) (unScalar b)+"<::>/vec2-Double" forall (a :: Scalar Double) (b :: Scalar Double) . a <::> b = vec2 (unScalar a) (unScalar b)+"<::>/vec2-Int"    forall (a :: Scalar Int)    (b :: Scalar Int)    . a <::> b = vec2 (unScalar a) (unScalar b)+-- "<::>/vec2-Word"   forall (a :: Scalar Word)   (b :: Scalar Word)   . a <::> b = vec2 (unScalar a) (unScalar b)+  #-}++-- | Append one DataFrame to another, adding up their last dimensionality+(<+:>) :: forall (ds :: [Nat]) (n :: Nat) (m :: Nat) (t :: Type)+        . ( PrimBytes (DataFrame t (ds +: n))+          , PrimBytes (DataFrame t ds)+          , PrimBytes (DataFrame t (ds +: m))+          , m ~ (n + 1)+          )+        => DataFrame t (ds +: n)+        -> DataFrame t ds+        -> DataFrame t (ds +: m)+a <+:> b = case (# toBytes a, toBytes b+                , byteSize a+                , byteSize b+                , elementByteSize a #) of+  (# (# off1, n1, arr1 #), (# off2, n2, arr2 #), bs1, bs2, ebs #) -> case runRW#+     ( \s0 -> case newByteArray# (bs1 +# bs2) s0 of+         (# s1, mr #) -> case copyByteArray# arr1 (off1 *# ebs) mr 0# bs1 s1 of+           s2 -> case copyByteArray# arr2 (off2 *# ebs) mr bs1 bs2 s2 of+             s3 -> unsafeFreezeByteArray# mr s3+     ) of (# _, r #) -> fromBytes (# 0#, n1 +# n2, r #)+infixl 5 <+:>+++-- | Input must be parametrized by [Nat] to make sure every element+--   in the input list has the same dimensionality.+--   Output is in [XNat], because the last dimension is unknown at compile time+fromList :: forall ns t xns xnsm+          . ( ns ~ AsDims xns+            , xnsm ~ (xns +: XN 2)+            , PrimBytes (DataFrame t ns)+            , Dimensions ns+            , ArrayInstanceInference t ns+            )+         => [DataFrame t ns] -> DataFrame t (xns +: XN 2)+fromList xs = fromListN (length xs) xs++-- | Implement function `toList`.+--   We need to create a dedicated type class for this+--   to make it polymorphic over kind k (Nat <-> XNat).+class DataFrameToList t z (ds :: [k]) where+    -- | Unwrap the last dimension of a DataFrame into a list  of smaller frames+    toList :: DataFrame t (ds +: z) -> [DataFrame t ds]++++instance ( Dimensions ns+         , Dimensions (ns +: z)+         , PrimBytes (DataFrame t ns)+         , PrimBytes (DataFrame t (ns +: z))+         )+         => DataFrameToList t z (ns :: [Nat]) where+  toList df@(KnownDataFrame _) = go offset+    where+      !(I# step) = totalDim (Proxy @ns)+      !(# offset, lenN, arr #) = toBytes df+      lim = offset +# lenN+      go pos | isTrue# (pos >=# lim)  = []+             | otherwise = fromBytes (# pos, step , arr #) : go (pos +# step)++instance DataFrameToList t xz (xns :: [XNat]) where+  toList (SomeDataFrame (df :: DataFrame t nsz))+      | (pns :: Proxy ns, _ :: Proxy z, Refl, Refl, Refl, Refl, Refl) <- getXSZ @nsz+      , Just Evidence <- inferInitDimensions @nsz+      , Evidence <- inferInitArrayInstance df+      , Evidence <- inferNumericFrame @t @ns+      , I# step <- totalDim pns+      , (# offset, lenN, arr #) <- toBytes df+      = go pns step arr (offset +# lenN) offset+    where+      getXSZ :: forall xs z . (Proxy xs, Proxy z+                              , (xs +: z) :~: nsz+                              , xs :~: Init nsz+                              , (Head nsz :+ Tail nsz) :~: nsz+                              , FixedDim xns (Init nsz) :~: Init nsz+                              , FixedXDim xns (Init nsz) :~: xns)+      getXSZ = ( Proxy, Proxy, unsafeCoerce Refl+               , unsafeCoerce Refl+               , unsafeCoerce Refl+               , unsafeCoerce Refl+               , unsafeCoerce Refl)+      go :: forall ns+          . ( FixedDim xns ns ~ ns+            , FixedXDim xns ns ~ xns+            , NumericFrame t ns+            , Dimensions ns+            )+         => Proxy ns -> Int# -> ByteArray# -> Int# -> Int# -> [DataFrame t xns]+      go p step arr lim pos | isTrue# (pos >=# lim)  = []+                            | otherwise = SomeDataFrame (+                                           fromBytes (# pos, step , arr #) :: DataFrame t ns+                                        )+                                      : go p step arr lim (pos +# step)+  toList _ = error "(DataFrameToList.ToList) Impossible happend: DataFrame has rank zero!"+++fromListN :: forall ns t xns xnsm+           . ( ns ~ AsDims xns+             , xnsm ~ (xns +: XN 2)+             , PrimBytes (DataFrame t ns)+             , Dimensions ns+             , ArrayInstanceInference t ns+             )+          => Int -> [DataFrame t ns] -> DataFrame t (xns +: XN 2)+fromListN _ []  = error "DataFrame fromList: the list must have at least two elements"+fromListN _ [_] = error "DataFrame fromList: the list must have at least two elements"+fromListN n@(I# n#) xs  | Just (SomeNat (pm :: Proxy m)) <- someNatVal (fromIntegral n)+                        , (pnsm, Refl, Refl, Refl) <- snocP pm+                        , I# len# <- totalDim (Proxy @ns)+                        , resultBytes# <- df len#+                        , Evidence <- inferSnocDimensions @ns @m+                        , Evidence <- inferSnocArrayInstance (head xs) pm+                        , Evidence <- inferPrimBytes @t @(ns +: m)+                        , Evidence <- inferNumericFrame @t @(ns +: m)+    = SomeDataFrame . enforceDim @t pnsm $ fromBytes (# 0#, n# *# len#, resultBytes# #)+  where+    elSize# = elementByteSize (head xs)+    df :: Int# -> ByteArray#+    df len# = case runRW#+      ( \s0 -> let !(# s1, marr #) = newByteArray# (n# *# elSize# *# len#) s0+                   go s _ [] = s+                   go s pos (earr : as) = case toBytes earr of+                     (# eoff#, _, ea #) -> go+                       (copyByteArray# ea (eoff# *# elSize#) marr (pos *# elSize#) (elSize# *# len#) s)+                       (pos +# len#)+                       as+                   s2 = go s1 0# xs+               in unsafeFreezeByteArray# marr s2+      ) of (# _, r #) -> r+    snocP :: forall m . Proxy m ->+           ( Proxy (ns +: m)+           , FixedXDim xnsm (ns +: m) :~: xnsm+           , FixedDim  xnsm (ns +: m) :~: (ns +: m)+           , (2 <=? m) :~: 'True+           )+    snocP _ = (Proxy, unsafeCoerce Refl, unsafeCoerce Refl, unsafeCoerce Refl)+    enforceDim :: forall s nsm . Proxy nsm -> DataFrame s nsm -> DataFrame s nsm+    enforceDim _ = id+fromListN n _ = error $ "DataFrame fromList: not a proper list length: " ++ show n+++instance ( xnsm ~ (x ': xns')+         , xns ~ Init xnsm+         , Last xnsm ~ XN 2+         , ns ~ AsDims xns+         , (x ': xns') ~ (xns +: XN 2)+         , PrimBytes (DataFrame t ns)+         , Dimensions ns+         , ArrayInstanceInference t ns+         )+      => Exts.IsList (DataFrame t ((x ': xns') :: [XNat])) where+  type Item (DataFrame t (x ': xns')) = DataFrame t (AsDims (Init (x ': xns')))+  fromList xs = fromListN (length xs) xs+  fromListN = fromListN+  toList (SomeDataFrame (df :: DataFrame t ds))+    | Refl <- unsafeCoerce Refl :: ds :~: (ns +: Last ds) = toList df++-- | Broadcast scalar value onto a whole data frame+fromScalar :: EW.ElementWise (Idx ds) t (DataFrame t ds)+           => Scalar.Scalar t -> DataFrame t ds+fromScalar = EW.broadcast . Scalar.unScalar

@@ -0,0 +1,360 @@+{-# LANGUAGE BangPatterns            #-}+{-# LANGUAGE DataKinds               #-}+{-# LANGUAGE FlexibleContexts        #-}+{-# LANGUAGE FlexibleInstances       #-}+{-# LANGUAGE FunctionalDependencies  #-}+{-# LANGUAGE InstanceSigs            #-}+{-# LANGUAGE KindSignatures          #-}+{-# LANGUAGE MagicHash               #-}+{-# LANGUAGE MultiParamTypeClasses   #-}+{-# LANGUAGE ScopedTypeVariables     #-}+{-# LANGUAGE TypeApplications        #-}+{-# LANGUAGE TypeFamilies            #-}+{-# LANGUAGE TypeOperators           #-}+{-# LANGUAGE UnboxedTuples           #-}+{-# LANGUAGE UndecidableInstances    #-}+{-# LANGUAGE UndecidableSuperClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.DataFrame.SubSpace+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.DataFrame.SubSpace+  ( SubSpace (..), (!), element+  , ewfoldMap, iwfoldMap+  , ewzip, iwzip+  ) where++import           GHC.Base                  (runRW#)+import           GHC.Prim+import           GHC.Types                 (Int (..), Type)+++import qualified Numeric.Array.ElementWise as EW+import           Numeric.Commons+import           Numeric.DataFrame.Type+import           Numeric.Dimensions+import           Numeric.Dimensions.Traverse+import           Numeric.TypeLits+import           Numeric.Scalar++-- | Operations on DataFrames+-- as is an element dimensionality+-- bs is an indexing dimensionality+-- t is an underlying data type (i.e. Float, Int, Double)+--+class ( ConcatList as bs asbs+      , Dimensions as+      , Dimensions bs+      , Dimensions asbs+      ) => SubSpace (t :: Type) (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])+                    | asbs as -> bs, asbs bs -> as, as bs -> asbs where+    -- | Get an element+    (!.) :: Idx bs -> DataFrame t asbs -> DataFrame t as+    -- | Set a new value to an element+    update :: Idx bs -> DataFrame t as -> DataFrame t asbs -> DataFrame t asbs+    -- | Map a function over each element of DataFrame+    ewmap  :: forall s (as' :: [Nat]) (asbs' :: [Nat])+            . SubSpace s as' bs asbs'+           => (DataFrame s as' -> DataFrame t as)+           -> DataFrame s asbs' -> DataFrame t asbs+    -- | Map a function over each element with its index of DataFrame+    iwmap  :: forall s (as' :: [Nat]) (asbs' :: [Nat])+            . SubSpace s as' bs asbs'+           => (Idx bs -> DataFrame s as' -> DataFrame t as)+           -> DataFrame s asbs' -> DataFrame t asbs+    -- | Generate a DataFrame by repeating an element+    ewgen :: DataFrame t as -> DataFrame t asbs+    -- | Generate a DataFrame by iterating a function (index -> element)+    iwgen :: (Idx bs -> DataFrame t as) -> DataFrame t asbs+    -- | Left-associative fold of a DataFrame.+    --   The fold is strict, so accumulater is evaluated to WHNF;+    --   but you'd better make sure that the function is strict enough to not+    --   produce memory leaks deeply inside the result data type.+    ewfoldl :: (b -> DataFrame t as -> b) -> b -> DataFrame t asbs -> b+    -- | Left-associative fold of a DataFrame with an index+    --   The fold is strict, so accumulater is evaluated to WHNF;+    --   but you'd better make sure that the function is strict enough to not+    --   produce memory leaks deeply inside the result data type.+    iwfoldl :: (Idx bs -> b -> DataFrame t as -> b) -> b -> DataFrame t asbs -> b+    -- | Right-associative fold of a DataFrame+    --   The fold is strict, so accumulater is evaluated to WHNF;+    --   but you'd better make sure that the function is strict enough to not+    --   produce memory leaks deeply inside the result data type.+    ewfoldr :: (DataFrame t as -> b -> b) -> b -> DataFrame t asbs -> b+    -- | Right-associative fold of a DataFrame with an index+    --   The fold is strict, so accumulater is evaluated to WHNF;+    --   but you'd better make sure that the function is strict enough to not+    --   produce memory leaks deeply inside the result data type.+    iwfoldr :: (Idx bs -> DataFrame t as -> b -> b) -> b -> DataFrame t asbs -> b+    -- | Apply an applicative functor on each element (Lens-like traversal)+    elementWise :: forall s (as' :: [Nat]) (asbs' :: [Nat]) f+                 . ( Applicative f+                   , SubSpace s as' bs asbs'+                   )+                => (DataFrame s as' -> f (DataFrame t as))+                -> DataFrame s asbs' -> f (DataFrame t asbs)+    -- | Apply an applicative functor on each element with its index+    --     (Lens-like indexed traversal)+    indexWise :: forall s (as' :: [Nat]) (asbs' :: [Nat]) f+               . ( Applicative f+                 , SubSpace s as' bs asbs'+                 )+              => (Idx bs -> DataFrame s as' -> f (DataFrame t as))+              -> DataFrame s asbs' -> f (DataFrame t asbs)+infixr 4 !.++-- | Apply a functor over a single element (simple lens)+element :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) f+         . (SubSpace t as bs asbs, Applicative f)+        => Idx bs+        -> (DataFrame t as -> f (DataFrame t as))+        -> DataFrame t asbs -> f (DataFrame t asbs)+element i f df = flip (update i) df <$> f (i !. df)+{-# INLINE element #-}++-- | Index an element (reverse of !.)+(!) :: SubSpace t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])+    => DataFrame t asbs -> Idx bs -> DataFrame t as+(!) = flip (!.)+infixl 4 !+{-# INLINE (!) #-}+++ewfoldMap :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) m+           . (Monoid m, SubSpace t as bs asbs)+          => (DataFrame t as -> m) -> DataFrame t asbs -> m+ewfoldMap f = ewfoldl (\b -> mappend b . f) mempty+{-# INLINE ewfoldMap #-}++iwfoldMap :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) m+           . ( Monoid m, SubSpace t as bs asbs)+          => (Idx bs -> DataFrame t as -> m) -> DataFrame t asbs -> m+iwfoldMap f = iwfoldl (\i b -> mappend b . f i) mempty+{-# INLINE iwfoldMap #-}++++-- | Zip two spaces on a specified subspace index-wise (with index)+iwzip :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])+                s (as' :: [Nat]) (asbs' :: [Nat])+                r (as'' :: [Nat]) (asbs'' :: [Nat])+       . ( SubSpace t as bs asbs+         , SubSpace s as' bs asbs'+         , SubSpace r as'' bs asbs''+         )+      => (Idx bs -> DataFrame t as -> DataFrame s as' -> DataFrame r as'')+      -> DataFrame t asbs+      -> DataFrame s asbs'+      -> DataFrame r asbs''+iwzip f dft dfs = iwmap g dft+  where+    g i dft' = f i dft' (i !. dfs)+{-# INLINE iwzip #-}++-- | Zip two spaces on a specified subspace element-wise (without index)+ewzip :: forall t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])+                s (as' :: [Nat]) (asbs' :: [Nat])+                r (as'' :: [Nat]) (asbs'' :: [Nat])+       . ( SubSpace t as bs asbs+         , SubSpace s as' bs asbs'+         , SubSpace r as'' bs asbs''+         )+      => (DataFrame t as -> DataFrame s as' -> DataFrame r as'')+      -> DataFrame t asbs+      -> DataFrame s asbs'+      -> DataFrame r asbs''+ewzip = iwzip . const+{-# INLINE ewzip #-}++++instance {-# OVERLAPPABLE #-}+         ( ConcatList as bs asbs+         , Dimensions as+         , Dimensions bs+         , Dimensions asbs+         , PrimBytes (DataFrame t as)+         , PrimBytes (DataFrame t asbs)+         , as ~ (a'' ': as'')+         , asbs ~ (a'' ': asbs'')+         ) => SubSpace t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) where++    i !. d = r+        where+          r = case (# toBytes d, fromEnum i, totalDim r #) of+                (# (# off, _, arr #), I# i#, I# l# #)+                  -> fromBytes (# off +# i# *# l#, l#, arr #)+    {-# INLINE (!.) #-}++    ewmap = iwmap . const+    {-# INLINE ewmap #-}++    iwmap f df+      | elS <- elementByteSize (undefined :: DataFrame t asbs)+      , I# lenBS <- totalDim (Proxy @bs)+      , I# lenAS <- totalDim (Proxy @as)+      , lenASB <- lenAS *# elS+      = case runRW#+          ( \s0 -> case newByteArray# (lenAS *# lenBS *# elS) s0 of+              (# s1, marr #) -> case overDim_#+                  (dim @bs)+                  ( \i pos s -> case toBytes $ f i (i !. df) of+                      (# offX, _, arrX #) -> copyByteArray# arrX (offX *# elS) marr pos lenASB s+                  ) 0# lenASB s1 of+                s2 -> unsafeFreezeByteArray# marr s2+          ) of (# _, r #) -> fromBytes (# 0#, lenAS *# lenBS, r #)++    ewgen x+      | (# offX, lenX, arrX #) <- toBytes x+      , I# lenASBS <- totalDim (Proxy @asbs)+      , elS <- elementByteSize x+      , offXB <- offX *# elS+      , lenXB <- lenX *# elS+      = case runRW#+          ( \s0 -> case newByteArray# (lenASBS *# elS) s0 of+              (# s1, marr #) -> case overDimOff_# (dim @bs)+                  ( \posB -> copyByteArray# arrX offXB marr posB lenXB )+                  0# lenXB s1 of+                s2 -> unsafeFreezeByteArray# marr s2+          ) of (# _, r #) -> fromBytes (# 0#, lenASBS, r #)++    iwgen f+      | I# lenASBS <- totalDim (Proxy @asbs)+      , elS <- elementByteSize (undefined :: DataFrame t asbs)+      , I# lenAS <- totalDim (Proxy @as)+      , lenASB <- lenAS *# elS+      = case runRW#+          ( \s0 -> case newByteArray# (lenASBS *# elS) s0 of+              (# s1, marr #) -> case overDim_# (dim @bs)+                  ( \i pos s -> case toBytes (f i) of+                      (# offX, _, arrX #) -> copyByteArray# arrX (offX *# elS) marr pos lenASB s+                  ) 0# lenASB s1 of+                s2 -> unsafeFreezeByteArray# marr s2+          ) of (# _, r #) -> fromBytes (# 0#, lenASBS, r #)++    ewfoldl f x0 df = case (# toBytes df, totalDim ( Proxy @as) #) of+        (# (# off, _, arr #), I# step #) -> foldDimOff (dim @bs)+                    (\pos acc -> f acc $! fromBytes (# pos, step, arr #))+                    off step x0++    iwfoldl f x0 df = case (# toBytes df, totalDim ( Proxy @as) #) of+        (# (# off, _, arr #), I# step #) -> foldDim (dim @bs)+                    (\i pos acc -> f i acc $! fromBytes (# pos, step, arr #))+                    off step x0++    ewfoldr f x0 df = case (# toBytes df, totalDim ( Proxy @as) #) of+        (# (# off, len, arr #), I# step #) -> foldDimOff (dim @bs)+                    (\pos -> f (fromBytes (# pos, step, arr #)))+                    (off +# len -# step) (negateInt# step) x0++    iwfoldr f x0 df = case (# toBytes df, totalDim ( Proxy @as) #) of+        (# (# off, _, arr #), I# step #) -> foldDimReverse (dim @bs)+                    (\i pos -> f i (fromBytes (# pos, step, arr #)) )+                    off step x0++    -- implement elementWise in terms of indexWise+    elementWise = indexWise . const+    {-# INLINE elementWise #-}++    indexWise :: forall (s :: Type) (f :: Type -> Type) (as' :: [Nat]) (asbs' :: [Nat])+               . ( Applicative f+                 , SubSpace s as' bs asbs'+                 )+              => (Idx bs -> DataFrame s as' -> f (DataFrame t as))+              -> DataFrame s asbs' -> f (DataFrame t asbs)+    indexWise f df = runWithState <$> iwfoldl applyF (pure initialState) df+      where+        -- run a state-based continuation within RW+        runWithState :: ( State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #))+                     -> DataFrame t asbs+        runWithState g = case runRW#+                           ( \s0 -> case g s0 of+                                (# s1, (# marr, _ #) #) -> unsafeFreezeByteArray# marr s1+                           ) of (# _, arr #) -> fromBytes (# 0#, rezLength#, arr #)++        -- Prepare empty byte array for the result DataFrame and keep a current position counter+        -- Input: state+        -- Output: state ++        --     ( current mutable byte array + current write position )+        initialState :: State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #)+        initialState s0 = case newByteArray# (rezLength# *# rezElBSize#) s0 of+                            (# s1, marr #) -> (# s1, (# marr, 0# #) #)++        -- Given the result chunk, write it into a mutable array+        updateChunk :: (State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #))+                    -> DataFrame t as+                    -> (State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #))+        updateChunk g dfChunk = case toBytes dfChunk of+            (# off#, _, arr#  #) -> \s -> case g s of+                                        (# s1, (# marr#, pos# #) #) -> case+                                            copyByteArray# arr# (off# *# rezElBSize#)+                                                           marr# (pos# *# rezElBSize#)+                                                           (rezStepN# *# rezElBSize#) s1 of+                                          s2 -> (# s2, (# marr#, pos# +# rezStepN# #) #)++        -- Apply applicative functor on each chunk and update a state.+        applyF :: Idx bs+               -> f (State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #))+               -> DataFrame s as'+               -> f (State# RealWorld -> (# State# RealWorld, (# MutableByteArray# RealWorld, Int# #) #))+        applyF idx s dfChunk = idx `seq` dfChunk `seq` updateChunk <$> s <*> f idx dfChunk++        -- Element byte size of the result DataFrame (byte size of s)+        rezElBSize# = elementByteSize (undefined :: DataFrame t asbs)+        -- Number of primitive elements in the result DataFrame chunk+        !(I# rezStepN#) = totalDim (Proxy @as)+        -- Number of primitive elements in the result DataFrame+        !(I# rezLength#) = totalDim (Proxy @asbs)++    update ei x df+      | I# i <- fromEnum ei+      , (# off, len, arr #) <- toBytes df+      , (# offX, lenX, arrX #) <- toBytes x+      , elS <- elementByteSize df+      = case runRW#+          ( \s0 -> case newByteArray# ( len *# elS ) s0 of+            (# s1, marr #) -> case copyByteArray# arr (off *# elS) marr 0# (len *# elS) s1 of+              s2 -> case copyByteArray# arrX (offX *# elS) marr (lenX *# i *# elS) (lenX *# elS) s2 of+                s3 -> unsafeFreezeByteArray# marr s3+          ) of (# _, r #) -> fromBytes (# 0#, len, r #)+++++-- | Specialized instance of SubSpace for operating on scalars.+instance {-# OVERLAPPING #-}+         ( Dimensions bs+         , EW.ElementWise (Idx bs) t (DataFrame t bs)+         , PrimBytes (DataFrame t bs)+         ) => SubSpace t ('[] :: [Nat]) (bs :: [Nat]) (bs :: [Nat]) where+    i !. x =  scalar $ x EW.! i+    {-# INLINE (!.) #-}+    ewmap = iwmap . const+    {-# INLINE ewmap #-}+    iwmap f x = EW.ewgen (\i -> unScalar $ f i (i !. x))+    {-# INLINE iwmap #-}+    ewgen = EW.broadcast . unScalar+    {-# INLINE ewgen #-}+    iwgen f = EW.ewgen (unScalar . f)+    {-# INLINE iwgen #-}+    ewfoldl f = EW.ewfoldl (\_ a -> f a . scalar)+    {-# INLINE ewfoldl #-}+    iwfoldl f = EW.ewfoldl (\i a -> f i a . scalar)+    {-# INLINE iwfoldl #-}+    ewfoldr f = EW.ewfoldr (\_ x  -> f (scalar x))+    {-# INLINE ewfoldr #-}+    iwfoldr f = EW.ewfoldr (\i x -> f i (scalar x))+    {-# INLINE iwfoldr #-}+    elementWise = indexWise . const+    {-# INLINE elementWise #-}+    indexWise f x = EW.ewgenA (\i -> unScalar <$> f i (i !. x))+    {-# INLINE indexWise #-}+    update i x = EW.update i (unScalar x)+    {-# INLINE update #-}

@@ -0,0 +1,270 @@+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE ConstraintKinds            #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE ExistentialQuantification  #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GADTs                      #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures             #-}+{-# LANGUAGE MagicHash                  #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE PolyKinds                  #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TypeApplications           #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE UnboxedTuples              #-}+{-# LANGUAGE UndecidableInstances       #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.DataFrame.Type+-- Copyright   :  (c) Artem Chirkin+-- License     :  BSD3+--+-- Maintainer  :  chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.DataFrame.Type+  ( -- * Data types+    DataFrame (..)+    -- * Bring type classes into scope+  , NumericFrame+    -- * Utility type families and constraints+  , FPFRame, IntegralFrame, NumericVariantFrame, CommonOpFrame+  ) where++import           Data.Int                  (Int16, Int32, Int64, Int8)+import           Data.Word                 (Word16, Word32, Word64, Word8)+import           Foreign.Storable          (Storable (..))+import           GHC.Exts                  (Int (..), Ptr (..), Float#, Double#, Int#, Word#)+import           GHC.Prim                  (copyAddrToByteArray#,+                                            copyByteArrayToAddr#, newByteArray#,+                                            plusAddr#, quotInt#,+                                            unsafeFreezeByteArray#, (*#))+import           GHC.Types                 (Constraint, IO (..), Type, RuntimeRep (..))+++import           Numeric.Array.ElementWise+import           Numeric.Array.Family+import           Numeric.Commons+import           Numeric.Dimensions++-- | Keep data in a primitive data frame+--    and maintain information about Dimensions in the type-system+data family DataFrame (t :: Type) (xs :: [k])++-- | Completely fixed at compile time+newtype instance Dimensions ns => DataFrame t (ns :: [Nat])+  = KnownDataFrame { _getDF :: Array t ns }++-- | Partially known at compile time+data instance DataFrame t (xns :: [XNat])+  = forall (ns :: [Nat])+  . ( FixedDim xns ns ~ ns+    , FixedXDim xns ns ~ xns+    , NumericFrame t ns+    )+  => SomeDataFrame (DataFrame t ns)++-- | Allow all numeric operations depending on element type+type NumericFrame t ds = (CommonOpFrame t ds, NumericVariantFrame t ds)++-- | Allow all common operations on data frames+type CommonOpFrame t ds+  = ( Show (DataFrame t ds)+    , Eq (DataFrame t ds)+    , Ord (DataFrame t ds)+    , Num (DataFrame t ds)+    , ElementWise (Idx ds) t (DataFrame t ds)+    , PrimBytes (DataFrame t ds)+    , ArrayInstanceInference t ds+    , KnownDims ds+    , FiniteList ds+    , Dimensions ds+    )++-- | Allow floating-point operations on data frames+type FPFRame t ds+  = ( Fractional (DataFrame t ds)+    , Floating (DataFrame t ds)+    )++-- | Allow some integer-like operations on data frames+type IntegralFrame t (ds :: [Nat])+  = Bounded (DataFrame t ds)+++type family NumericVariantFrame t ds :: Constraint where+  NumericVariantFrame Float  ds  = FPFRame Float ds+  NumericVariantFrame Double ds  = FPFRame Double ds+  NumericVariantFrame Int    ds  = IntegralFrame Int    ds+  NumericVariantFrame Int8   ds  = IntegralFrame Int8   ds+  NumericVariantFrame Int16  ds  = IntegralFrame Int16  ds+  NumericVariantFrame Int32  ds  = IntegralFrame Int32  ds+  NumericVariantFrame Int64  ds  = IntegralFrame Int64  ds+  NumericVariantFrame Word   ds  = IntegralFrame Word   ds+  NumericVariantFrame Word8  ds  = IntegralFrame Word8  ds+  NumericVariantFrame Word16 ds  = IntegralFrame Word16 ds+  NumericVariantFrame Word32 ds  = IntegralFrame Word32 ds+  NumericVariantFrame Word64 ds  = IntegralFrame Word64 ds+  NumericVariantFrame _      _   = ()+++++instance ( Show (Array t ds)+         , Dimensions ds+         ) => Show (DataFrame t ds) where+  show (KnownDataFrame arr) = unlines+                            [ "DF [" ++ drop 4 (show $ dim @ds) ++ "]:"+                            , show arr+                            ]+deriving instance Bounded (Array t ds) => Bounded (DataFrame t ds)+deriving instance Enum (Array t ds) => Enum (DataFrame t ds)+deriving instance Eq (Array t ds) => Eq (DataFrame t ds)+deriving instance Integral (Array t ds)+               => Integral (DataFrame t ds)+deriving instance Num (Array t ds)+               => Num (DataFrame t ds)+deriving instance Fractional (Array t ds)+               => Fractional (DataFrame t ds)+deriving instance Floating (Array t ds)+               => Floating (DataFrame t ds)+deriving instance Ord (Array t ds)+               => Ord (DataFrame t ds)+deriving instance ( Read (Array t ds), Dimensions ds )+               => Read (DataFrame t ds)+deriving instance Real (Array t ds)+               => Real (DataFrame t ds)+deriving instance RealFrac (Array t ds)+               => RealFrac (DataFrame t ds)+deriving instance RealFloat (Array t ds)+               => RealFloat (DataFrame t ds)+instance ( Dimensions ds+         , ElementWise (Idx ds) t (Array t ds)+         ) => ElementWise (Idx ds) t (DataFrame t ds) where+  (!) = (!) . _getDF+  {-# INLINE (!) #-}+  ewmap f = KnownDataFrame . ewmap f . _getDF+  {-# INLINE ewmap #-}+  ewgen = KnownDataFrame . ewgen+  {-# INLINE ewgen #-}+  ewgenA = fmap KnownDataFrame . ewgenA+  {-# INLINE ewgenA #-}+  ewfoldl f x0 = ewfoldl f x0 . _getDF+  {-# INLINE ewfoldl #-}+  ewfoldr f x0 = ewfoldr f x0 . _getDF+  {-# INLINE ewfoldr #-}+  elementWise f = fmap KnownDataFrame . elementWise f . _getDF+  {-# INLINE elementWise #-}+  indexWise f = fmap KnownDataFrame . indexWise f . _getDF+  {-# INLINE indexWise #-}+  broadcast = KnownDataFrame . broadcast+  {-# INLINE broadcast #-}+  update i x = KnownDataFrame . update i x . _getDF+  {-# INLINE update #-}+++instance PrimBytes (DataFrame t ds) => Storable (DataFrame t ds) where+  sizeOf x = I# (byteSize x)+  alignment x = I# (byteAlign x)+  peekElemOff ptr (I# offset) =+    peekByteOff ptr (I# (offset *# byteSize (undefined :: DataFrame t ds)))+  pokeElemOff ptr (I# offset) =+    pokeByteOff ptr (I# (offset *# byteSize (undefined :: DataFrame t ds)))+  peekByteOff (Ptr addr) (I# offset) = IO $ \s0 -> case newByteArray# bsize s0 of+    (# s1, marr #) -> case copyAddrToByteArray# (addr `plusAddr#` offset)+                                                 marr 0# bsize s1 of+      s2 -> case unsafeFreezeByteArray# marr s2 of+        (# s3, arr #) -> (# s3, fromBytes (# 0#, bsize `quotInt#` ebsize, arr #) #)+    where+      bsize = byteSize (undefined :: DataFrame t ds)+      ebsize = elementByteSize (undefined :: DataFrame t ds)+  pokeByteOff (Ptr addr) (I# offset) x = IO+          $ \s0 -> case copyByteArrayToAddr# xbytes xboff+                                             (addr `plusAddr#` offset)+                                              bsize s0 of+       s2 -> (# s2, () #)+    where+      !(# elOff, elNum, xbytes #) = toBytes x+      bsize = elementByteSize x *# elNum+      xboff  = elementByteSize x *# elOff+  peek ptr = peekByteOff ptr 0+  poke ptr = pokeByteOff ptr 0+++++type instance ElemRep (DataFrame t xs) = ElemRep (Array t xs)+type instance ElemPrim (DataFrame Float  ds) = Float#+type instance ElemPrim (DataFrame Double ds) = Double#+type instance ElemPrim (DataFrame Int    ds) = Int#+type instance ElemPrim (DataFrame Int8   ds) = Int#+type instance ElemPrim (DataFrame Int16  ds) = Int#+type instance ElemPrim (DataFrame Int32  ds) = Int#+type instance ElemPrim (DataFrame Int64  ds) = Int#+type instance ElemPrim (DataFrame Word   ds) = Word#+type instance ElemPrim (DataFrame Word8  ds) = Word#+type instance ElemPrim (DataFrame Word16 ds) = Word#+type instance ElemPrim (DataFrame Word32 ds) = Word#+type instance ElemPrim (DataFrame Word64 ds) = Word#+deriving instance ( PrimBytes (Array Float ds)+                  , ElemPrim (Array Float ds) ~ Float#+                  , ElemRep (Array Float ds) ~ 'FloatRep) => PrimBytes (DataFrame Float ds)+deriving instance ( PrimBytes (Array Double ds)+                  , ElemPrim (Array Double ds) ~ Double#+                  , ElemRep (Array Double ds) ~ 'DoubleRep) => PrimBytes (DataFrame Double ds)+deriving instance ( PrimBytes (Array Int ds)+                  , ElemPrim (Array Int ds) ~ Int#+                  , ElemRep (Array Int ds) ~ 'IntRep) => PrimBytes (DataFrame Int ds)+deriving instance ( PrimBytes (Array Int8 ds)+                  , ElemPrim (Array Int8 ds) ~ Int#+                  , ElemRep (Array Int8 ds) ~ 'IntRep) => PrimBytes (DataFrame Int8 ds)+deriving instance ( PrimBytes (Array Int16 ds)+                  , ElemPrim (Array Int16 ds) ~ Int#+                  , ElemRep (Array Int16 ds) ~ 'IntRep) => PrimBytes (DataFrame Int16 ds)+deriving instance ( PrimBytes (Array Int32 ds)+                  , ElemPrim (Array Int32 ds) ~ Int#+                  , ElemRep (Array Int32 ds) ~ 'IntRep) => PrimBytes (DataFrame Int32 ds)+deriving instance ( PrimBytes (Array Int64 ds)+                  , ElemPrim (Array Int64 ds) ~ Int#+                  , ElemRep (Array Int64 ds) ~ 'IntRep) => PrimBytes (DataFrame Int64 ds)+deriving instance ( PrimBytes (Array Word ds)+                  , ElemPrim (Array Word ds) ~ Word#+                  , ElemRep (Array Word ds) ~ 'WordRep) => PrimBytes (DataFrame Word ds)+deriving instance ( PrimBytes (Array Word8 ds)+                  , ElemPrim (Array Word8 ds) ~ Word#+                  , ElemRep (Array Word8 ds) ~ 'WordRep) => PrimBytes (DataFrame Word8 ds)+deriving instance ( PrimBytes (Array Word16 ds)+                  , ElemPrim (Array Word16 ds) ~ Word#+                  , ElemRep (Array Word16 ds) ~ 'WordRep) => PrimBytes (DataFrame Word16 ds)+deriving instance ( PrimBytes (Array Word32 ds)+                  , ElemPrim (Array Word32 ds) ~ Word#+                  , ElemRep (Array Word32 ds) ~ 'WordRep) => PrimBytes (DataFrame Word32 ds)+deriving instance ( PrimBytes (Array Word64 ds)+                  , ElemPrim (Array Word64 ds) ~ Word#+                  , ElemRep (Array Word64 ds) ~ 'WordRep) => PrimBytes (DataFrame Word64 ds)++++++++instance Eq (DataFrame t (ds :: [XNat])) where+  SomeDataFrame (a :: DataFrame t nsa) == SomeDataFrame (b :: DataFrame t nsb)+      = case sameDim (dim @nsa) (dim @nsb) of+          Just Evidence -> a == b+          Nothing   -> False++instance Show (DataFrame t (ds :: [XNat])) where+  show (SomeDataFrame arr) = show arr++++_suppressHlintUnboxedTuplesWarning :: () -> (# (), () #)+_suppressHlintUnboxedTuplesWarning = undefined

@@ -1,557 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilyDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MagicHash, UnboxedTuples #-}-{-# LANGUAGE KindSignatures, DataKinds #-}-{-# LANGUAGE TypeOperators, FlexibleInstances, ScopedTypeVariables #-}--------------------------------------------------------------------------------- |--- Module      :  Numeric.EasyTensor--- Copyright   :  (c) Artem Chirkin--- License     :  MIT------ Maintainer  :  chirkin@arch.ethz.ch------ This module generalizes matrices and vectors.--- Yet it is limited to rank 2, allowing for a simple and nicely type-checked interface.-----------------------------------------------------------------------------------------module Numeric.EasyTensor-  ( Tensor ()-  -- * Common operations-  , fill-  , prod, (%*)-  , inverse, transpose-  , (<:>), (//), (\\)-  , index, indexCol, indexRow, dimN, dimM-  , (V..*.), dot, (·), normL1,  normL2, normLPInf, normLNInf, normLP-  , eye, diag, det, trace-  , toDiag, toDiag', fromDiag, fromDiag'-  -- * Type abbreviations-  , Mat, Vec, Vec'-  , Vec2f, Vec3f, Vec4f-  , Vec2f', Vec3f', Vec4f'-  , Mat22f, Mat23f, Mat24f-  , Mat32f, Mat33f, Mat34f-  , Mat42f, Mat43f, Mat44f-  -- * Simplified type constructors-  , scalar, vec2, vec3, vec4, vec2', vec3', vec4'-  , mat22, mat33, mat44-  -- * Some low-dimensional operations-  , det2, det2', cross, (×)-  ) where--import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types-import GHC.TypeLits-import Unsafe.Coerce (unsafeCoerce)--import qualified Numeric.Vector as V-import qualified Numeric.Matrix as M-import qualified Numeric.Matrix.Class as M-import Numeric.Commons----newtype Tensor t n m = Tensor { _unT :: TT t n m }-instance Show (TT t n m) => Show (Tensor t n m) where-  show (Tensor t) = show t-deriving instance Eq (TT t n m) => Eq (Tensor t n m)-deriving instance Ord (TT t n m) => Ord (Tensor t n m)-deriving instance Num (TT t n m) => Num (Tensor t n m)-deriving instance Fractional (TT t n m) => Fractional (Tensor t n m)-deriving instance Floating (TT t n m) => Floating (Tensor t n m)-deriving instance V.VectorCalculus t n (TT t n 1) => V.VectorCalculus t n (Tensor t n 1)-deriving instance V.VectorCalculus t m (TT t 1 m) => V.VectorCalculus t m (Tensor t 1 m)-deriving instance M.MatrixCalculus t n m (TT t n m) => M.MatrixCalculus t n m (Tensor t n m)-deriving instance M.SquareMatrixCalculus t n (TT t n n) => M.SquareMatrixCalculus t n (Tensor t n n)-deriving instance M.MatrixInverse (TT t n n) => M.MatrixInverse (Tensor t n n)-deriving instance PrimBytes (TT t n m) => PrimBytes (Tensor t n m)-deriving instance FloatBytes (TT t n m) => FloatBytes (Tensor t n m)-deriving instance DoubleBytes (TT t n m) => DoubleBytes (Tensor t n m)-deriving instance IntBytes (TT t n m) => IntBytes (Tensor t n m)-deriving instance WordBytes (TT t n m) => WordBytes (Tensor t n m)-----newtype Scalar t = Scalar { _unScalar :: t }-  deriving ( Bounded, Enum, Eq, Integral, Num, Fractional, Floating, Ord, Read, Real, RealFrac, RealFloat-           , PrimBytes, FloatBytes, DoubleBytes, IntBytes, WordBytes)-instance Show t => Show (Scalar t) where-  show (Scalar t) = "{ " ++ show t ++ " }"--newtype CoVector t n = CoVector {_unCoVec :: V.Vector t n}-instance Show (V.Vector t n) => Show (CoVector t n) where-  show (CoVector t) = show t-deriving instance Eq (V.Vector t n) => Eq (CoVector t n)-deriving instance Ord (V.Vector t n) => Ord (CoVector t n)-deriving instance Num (V.Vector t n) => Num (CoVector t n)-deriving instance Fractional (V.Vector t n) => Fractional (CoVector t n)-deriving instance Floating (V.Vector t n) => Floating (CoVector t n)-deriving instance PrimBytes (V.Vector t n) => PrimBytes (CoVector t n)-deriving instance V.VectorCalculus t n (V.Vector t n) => V.VectorCalculus t n (CoVector t n)-deriving instance FloatBytes (V.Vector t n) => FloatBytes (CoVector t n)-deriving instance DoubleBytes (V.Vector t n) => DoubleBytes (CoVector t n)-deriving instance IntBytes (V.Vector t n) => IntBytes (CoVector t n)-deriving instance WordBytes (V.Vector t n) => WordBytes (CoVector t n)--newtype ContraVector t n = ContraVector {_unContraVec :: V.Vector t n}-instance Show (V.Vector t n) => Show (ContraVector t n) where-  show (ContraVector t) = show t ++ "'"-deriving instance Eq (V.Vector t n) => Eq (ContraVector t n)-deriving instance Ord (V.Vector t n) => Ord (ContraVector t n)-deriving instance Num (V.Vector t n) => Num (ContraVector t n)-deriving instance Fractional (V.Vector t n) => Fractional (ContraVector t n)-deriving instance Floating (V.Vector t n) => Floating (ContraVector t n)-deriving instance PrimBytes (V.Vector t n) => PrimBytes (ContraVector t n)-deriving instance V.VectorCalculus t n (V.Vector t n) => V.VectorCalculus t n (ContraVector t n)-deriving instance FloatBytes (V.Vector t n) => FloatBytes (ContraVector t n)-deriving instance DoubleBytes (V.Vector t n) => DoubleBytes (ContraVector t n)-deriving instance IntBytes (V.Vector t n) => IntBytes (ContraVector t n)-deriving instance WordBytes (V.Vector t n) => WordBytes (ContraVector t n)--newtype Matrix t n m = Matrix (M.Matrix t n m)-instance Show (M.Matrix t n m) => Show (Matrix t n m) where-  show (Matrix t) = show t-deriving instance Eq (M.Matrix t n m) => Eq (Matrix t n m)-deriving instance Ord (M.Matrix t n m) => Ord (Matrix t n m)-deriving instance Num (M.Matrix t n m) => Num (Matrix t n m)-deriving instance Fractional (M.Matrix t n m) => Fractional (Matrix t n m)-deriving instance Floating (M.Matrix t n m) => Floating (Matrix t n m)-deriving instance PrimBytes (M.Matrix t n m) => PrimBytes (Matrix t n m)-deriving instance M.MatrixCalculus t n m (M.Matrix t n m) => M.MatrixCalculus t n m (Matrix t n m)-deriving instance M.SquareMatrixCalculus t n (M.Matrix t n n) => M.SquareMatrixCalculus t n (Matrix t n n)-deriving instance M.MatrixInverse (M.Matrix t n n) => M.MatrixInverse (Matrix t n n)-deriving instance FloatBytes (M.Matrix t n m) => FloatBytes (Matrix t n m)-deriving instance DoubleBytes (M.Matrix t n m) => DoubleBytes (Matrix t n m)-deriving instance IntBytes (M.Matrix t n m) => IntBytes (Matrix t n m)-deriving instance WordBytes (M.Matrix t n m) => WordBytes (Matrix t n m)-----type family TT t (n :: Nat) (m :: Nat) = v | v -> t n m where-  TT t 1 1 = Scalar t-  TT t n 1 = ContraVector t n-  TT t 1 m = CoVector t m-  TT t n m = Matrix t n m---- | Fill whole tensor with a single value-fill :: M.MatrixCalculus t n m (Tensor t n m) => Tensor t 1 1 -> Tensor t n m-fill = M.broadcastMat . _unScalar . _unT-{-# INLINE fill #-}---- | Get an element of a tensor-index :: M.MatrixCalculus t n m (Tensor t n m) => Int -> Int -> Tensor t n m -> Tensor t 1 1-index i j = Tensor . Scalar . M.indexMat i j-{-# INLINE index #-}---- | Get a column vector of a matrix-indexCol :: ( M.MatrixCalculus t n m (Tensor t n m)-            , V.VectorCalculus t n (Tensor t n 1)-            , PrimBytes (Tensor t n 1)-            )-         => Int -> Tensor t n m -> Tensor t n 1-indexCol = M.indexCol-{-# INLINE indexCol #-}---- | Get a row vector of a matrix-indexRow :: ( M.MatrixCalculus t n m (Tensor t n m)-            , V.VectorCalculus t m (Tensor t 1 m)-            , PrimBytes (Tensor t 1 m)-            )-         => Int -> Tensor t n m -> Tensor t 1 m-indexRow = M.indexRow-{-# INLINE indexRow #-}--transpose :: ( M.MatrixCalculus t n m (Tensor t n m)-             , M.MatrixCalculus t m n (Tensor t m n)-             , PrimBytes (Tensor t m n)-             ) => Tensor t n m -> Tensor t m n-transpose = M.transpose-{-# INLINE transpose #-}---dimN :: ( M.MatrixCalculus t n m (Tensor t n m)) => Tensor t n m -> Int-dimN = M.dimN-{-# INLINE dimN #-}--dimM :: ( M.MatrixCalculus t n m (Tensor t n m)) => Tensor t n m -> Int-dimM = M.dimM-{-# INLINE dimM #-}---- | Matrix product for tensors rank 2, as well matrix-vector or vector-matrix products-infixl 7 %*-(%*) :: (M.MatrixProduct (Tensor t n m) (Tensor t m k) (Tensor t n k))-     => Tensor t n m -> Tensor t m k -> Tensor t n k-(%*) = prod-{-# INLINE (%*) #-}---- | Matrix product for tensors rank 2, as well matrix-vector or vector-matrix products-prod :: (M.MatrixProduct (Tensor t n m) (Tensor t m k) (Tensor t n k))-     => Tensor t n m -> Tensor t m k -> Tensor t n k-prod = M.prod-{-# INLINE prod #-}---- | Divide on the right: R = A * B^(-1)-(//) :: ( M.MatrixProduct (Tensor t n m) (Tensor t m m) (Tensor t n m)-        , M.MatrixInverse (TT t m m))-     => Tensor t n m -> Tensor t m m -> Tensor t n m-(//) a b = prod a (inverse b)-{-# INLINE (//) #-}---- | Divide on the left: R = A^(-1) * b-(\\) :: ( M.MatrixProduct (Tensor t n n) (Tensor t n m) (Tensor t n m)-        , M.MatrixInverse (TT t n n))-     => Tensor t n n -> Tensor t n m -> Tensor t n m-(\\) a b = prod (inverse a) b-{-# INLINE (\\) #-}----- | Matrix inverse-inverse :: M.MatrixInverse (Tensor t n n) => Tensor t n n -> Tensor t n n-inverse = M.inverse-{-# INLINE inverse #-}---instance ( FloatBytes (Tensor Float n m)-         , FloatBytes (Tensor Float m k)-         , PrimBytes (Tensor Float n k)-         , M.MatrixCalculus Float n m (Tensor Float n m)-         , M.MatrixCalculus Float m k (Tensor Float m k)-         )-      => M.MatrixProduct (Tensor Float n m) (Tensor Float m k) (Tensor Float n k) where-  prod x y = case (dimN x, dimM x, dimM y) of-    ( I# n, I# m, I# k) -> M.prodF n m k x y-  {-# INLINE prod #-}--instance ( DoubleBytes (Tensor Double n m)-         , DoubleBytes (Tensor Double m k)-         , PrimBytes (Tensor Double n k)-         , M.MatrixCalculus Double n m (Tensor Double n m)-         , M.MatrixCalculus Double m k (Tensor Double m k)-         )-      => M.MatrixProduct (Tensor Double n m) (Tensor Double m k) (Tensor Double n k) where-  prod x y = case (dimN x, dimM x, dimM y) of-    ( I# n, I# m, I# k) -> M.prodD n m k x y-  {-# INLINE prod #-}------ | Append one vector to another, adding up their dimensionality-(<:>) :: ( PrimBytes (Tensor t k n)-         , PrimBytes (Tensor t k m)-         , PrimBytes (Tensor t k (n + m))-         )-        => Tensor t k n -> Tensor t k m -> Tensor t k (n + m)-a <:> b = case (# toBytes a, toBytes b, byteSize a, byteSize b #) of-  (# arr1, arr2, n, m #) -> case runRW#-     ( \s0 -> case newByteArray# (n +# m) s0 of-         (# s1, marr #) -> case copyByteArray# arr1 0# marr 0# n s1 of-           s2 -> case copyByteArray# arr2 0# marr n m s2 of-             s3 -> unsafeFreezeByteArray# marr s3-     ) of (# _, r #) -> fromBytes r-infixl 5 <:>---- Simple types--type Mat t n m = Tensor t n m-type Vec t n = Tensor t n 1-type Vec' t m = Tensor t 1 m----- Even Sympler types--type Vec2f = Tensor Float 2 1-type Vec3f = Tensor Float 3 1-type Vec4f = Tensor Float 4 1-type Vec2f' = Tensor Float 1 2-type Vec3f' = Tensor Float 1 3-type Vec4f' = Tensor Float 1 4---type Mat22f = Tensor Float 2 2-type Mat32f = Tensor Float 3 2-type Mat42f = Tensor Float 4 2-type Mat23f = Tensor Float 2 3-type Mat33f = Tensor Float 3 3-type Mat43f = Tensor Float 4 3-type Mat24f = Tensor Float 2 4-type Mat34f = Tensor Float 3 4-type Mat44f = Tensor Float 4 4----- construct tensors--scalar :: t -> Tensor t 1 1-scalar = Tensor . Scalar--vec2 :: V.Vector2D t => t -> t -> Tensor t 2 1-vec2 a b = Tensor . ContraVector $ V.vec2 a b--vec2' :: V.Vector2D t => t -> t -> Tensor t 1 2-vec2' a b = Tensor . CoVector $ V.vec2 a b--vec3 :: V.Vector3D t => t -> t -> t -> Tensor t 3 1-vec3 a b c = Tensor . ContraVector $ V.vec3 a b c--vec3' :: V.Vector3D t => t -> t -> t -> Tensor t 1 3-vec3' a b c = Tensor . CoVector $ V.vec3 a b c--vec4 :: V.Vector4D t => t -> t -> t -> t -> Tensor t 4 1-vec4 a b c d = Tensor . ContraVector $ V.vec4 a b c d--vec4' :: V.Vector4D t => t -> t -> t -> t -> Tensor t 1 4-vec4' a b c d = Tensor . CoVector $ V.vec4 a b c d------ | Compose a 2x2D matrix-mat22 :: M.Matrix2x2 t => Tensor t 2 1 -> Tensor t 2 1 -> Tensor t 2 2-mat22 (Tensor (ContraVector a)) (Tensor (ContraVector b)) = Tensor . Matrix $ M.mat22 a b---- | Compose a 3x3D matrix-mat33 :: ( PrimBytes (Tensor t 3 3)-         , PrimBytes (Tensor t 3 2)-         , PrimBytes (Tensor t 3 1)-         )-      => Tensor t 3 1 -> Tensor t 3 1 -> Tensor t 3 1 -> Tensor t 3 3-mat33 a b c = a <:> b <:> c---- | Compose a 4x4D matrix-mat44 :: ( PrimBytes (Tensor t 4 4)-         , PrimBytes (Tensor t 4 3)-         , PrimBytes (Tensor t 4 2)-         , PrimBytes (Tensor t 4 1)-         )-      => Tensor t 4 1 -> Tensor t 4 1 -> Tensor t 4 1 -> Tensor t 4 1 -> Tensor t 4 4-mat44 a b c d = a <:> b <:> c <:> d---- useful low-dimensional functions--det2 :: V.Vector2D t => Tensor t 2 1 -> Tensor t 2 1 -> Tensor t 1 1-det2 (Tensor (ContraVector a)) (Tensor (ContraVector b)) = Tensor . Scalar $ V.det2 a b--det2' :: V.Vector2D t => Tensor t 1 2 -> Tensor t 1 2 -> Tensor t 1 1-det2' (Tensor (CoVector a)) (Tensor (CoVector b)) = Tensor . Scalar $ V.det2 a b---- | Cross product for two vectors in 3D-infixl 7 ×-(×) :: V.Vector3D t => Tensor t 3 1 -> Tensor t 3 1 -> Tensor t 3 1-(×) = cross-{-# INLINE (×) #-}---- | Cross product for two vectors in 3D-cross :: V.Vector3D t => Tensor t 3 1 -> Tensor t 3 1 -> Tensor t 3 1-cross (Tensor (ContraVector a)) (Tensor (ContraVector b)) = Tensor . ContraVector $ V.cross a b-{-# INLINE cross #-}----- re-use functions provided by Vector and Matrix Calculus---- | Dot product of two vectors-infixl 7 ·-(·) :: V.VectorCalculus t n v => v -> v -> Tensor t 1 1-(·) = dot-{-# INLINE (·) #-}----- | Dot product of two vectors-dot :: V.VectorCalculus t n v => v -> v -> Tensor t 1 1-dot a b = Tensor . Scalar $ V.dot a b-{-# INLINE dot #-}---- | Sum of absolute values-normL1 :: V.VectorCalculus t n v => v -> Tensor t 1 1-normL1 = Tensor . Scalar . V.normL1-{-# INLINE normL1 #-}---- | hypot function (square root of squares)-normL2 :: V.VectorCalculus t n v => v -> Tensor t 1 1-normL2 = Tensor . Scalar . V.normL2-{-# INLINE normL2 #-}---- | Maximum of absolute values-normLPInf :: V.VectorCalculus t n v => v -> Tensor t 1 1-normLPInf = Tensor . Scalar . V.normLPInf-{-# INLINE normLPInf #-}---- | Minimum of absolute values-normLNInf :: V.VectorCalculus t n v => v -> Tensor t 1 1-normLNInf = Tensor . Scalar . V.normLNInf-{-# INLINE normLNInf #-}---- | Norm in Lp space-normLP :: V.VectorCalculus t n v => Int -> v -> Tensor t 1 1-normLP p = Tensor . Scalar . V.normLP p-{-# INLINE normLP #-}---- | Identity matrix. Mat with 1 on diagonal and 0 elsewhere-eye :: M.SquareMatrixCalculus t n (Tensor t n n) => Tensor t n n-eye = M.eye-{-# INLINE eye #-}---- | Put the same value on the Mat diagonal, 0 otherwise-diag :: M.SquareMatrixCalculus t n (Tensor t n n) => Tensor t 1 1 -> Tensor t n n-diag = M.diag . _unScalar . _unT-{-# INLINE diag #-}---- | Determinant of  Mat-det :: M.SquareMatrixCalculus t n (Tensor t n n) => Tensor t n n -> Tensor t 1 1-det = Tensor . Scalar . M.det-{-# INLINE det #-}---- | Sum of diagonal elements
-trace :: M.SquareMatrixCalculus t n (Tensor t n n) => Tensor t n n -> Tensor t 1 1-trace = Tensor . Scalar . M.trace-{-# INLINE trace #-}---- | Get the diagonal elements from Mat into Vec-fromDiag :: ( M.SquareMatrixCalculus t n (Tensor t n n)-            , V.VectorCalculus t n (Tensor t n 1)-            , PrimBytes (Tensor t n 1)-            )-         => Tensor t n n -> Tensor t n 1-fromDiag = M.fromDiag-{-# INLINE fromDiag #-}---- | Get the diagonal elements from Mat into Vec-fromDiag' :: ( M.SquareMatrixCalculus t n (Tensor t n n)-            , V.VectorCalculus t n (Tensor t 1 n)-            , PrimBytes (Tensor t 1 n)-            )-         => Tensor t n n -> Tensor t 1 n-fromDiag' = M.fromDiag-{-# INLINE fromDiag' #-}---- | Set Vec values into the diagonal elements of Mat-toDiag :: ( M.SquareMatrixCalculus t n (Tensor t n n)-          , V.VectorCalculus t n (Tensor t n 1)-          , PrimBytes (Tensor t n 1)-          )-       => Tensor t n 1 -> Tensor t n n-toDiag = M.toDiag-{-# INLINE toDiag #-}
---- | Set Vec values into the diagonal elements of Mat-toDiag' :: ( M.SquareMatrixCalculus t n (Tensor t n n)-           , V.VectorCalculus t n (Tensor t 1 n)-           , PrimBytes (Tensor t 1 n)-           )-        => Tensor t 1 n -> Tensor t n n-toDiag' = M.toDiag-{-# INLINE toDiag' #-}----- missing instances---instance Num t => V.VectorCalculus t 1 (Scalar t) where-  broadcastVec = Scalar-  {-# INLINE broadcastVec #-}-  (.*.) = (*)-  {-# INLINE (.*.) #-}-  dot a = _unScalar . (a *)-  {-# INLINE dot #-}-  indexVec 1 = _unScalar-  indexVec i = const . error $ "Bad index " ++ show i ++ " for a scalar"-  {-# INLINE indexVec #-}-  normL1 = _unScalar . abs-  {-# INLINE normL1 #-}-  normL2 = _unScalar . abs-  {-# INLINE normL2 #-}-  normLPInf = _unScalar-  {-# INLINE normLPInf #-}-  normLNInf = _unScalar-  {-# INLINE normLNInf #-}-  normLP _ = _unScalar . abs-  {-# INLINE normLP #-}-  dim _ = 1-  {-# INLINE dim #-}--instance Num t => M.MatrixCalculus t 1 1 (Scalar t) where-  broadcastMat = Scalar-  {-# INLINE broadcastMat #-}-  indexMat 1 1 = _unScalar-  indexMat i j = const . error $ "Bad index (" ++ show i ++ ", " ++ show j ++ ") for a scalar"-  {-# INLINE indexMat #-}-  transpose = unsafeCoerce-  {-# INLINE transpose #-}-  dimN _ = 1-  {-# INLINE dimN #-}-  dimM _ = 1-  {-# INLINE dimM #-}-  indexCol 1 = unsafeCoerce-  indexCol j = const . error $ "Bad column index " ++ show j ++ " for a scalar"-  {-# INLINE indexCol #-}-  indexRow 1 = unsafeCoerce-  indexRow i = const . error $ "Bad row index " ++ show i ++ " for a scalar"-  {-# INLINE indexRow #-}----instance Num t => M.SquareMatrixCalculus t 1 (Scalar t) where-  eye = Scalar 1-  {-# INLINE eye #-}-  diag = Scalar-  {-# INLINE diag #-}
-  det = _unScalar-  {-# INLINE det #-}-  trace = _unScalar-  {-# INLINE trace #-}
-  fromDiag = unsafeCoerce-  {-# INLINE fromDiag #-}
-  toDiag = unsafeCoerce-  {-# INLINE toDiag #-}--instance Fractional t => M.MatrixInverse (Scalar t) where-  inverse = Scalar . recip . _unScalar---instance (KnownNat n, V.VectorCalculus t n (V.Vector t n)) => M.MatrixCalculus t n 1 (ContraVector t n) where-  broadcastMat = ContraVector . V.broadcastVec-  {-# INLINE broadcastMat #-}-  indexMat i 1 (ContraVector v) = V.indexVec i v-  indexMat i j (ContraVector v) = error $ "Bad index (" ++ show i ++ ", " ++ show j ++ ") for a " ++ show (V.dim v) ++ "x1D matrix"-  {-# INLINE indexMat #-}-  transpose (ContraVector v) = unsafeCoerce $ CoVector v-  {-# INLINE transpose #-}-  dimN = V.dim . _unContraVec-  {-# INLINE dimN #-}-  dimM _ = 1-  {-# INLINE dimM #-}-  indexCol 1 (ContraVector v) = unsafeCoerce $ ContraVector v-  indexCol j (ContraVector v) = error $ "Bad column index " ++ show j ++ " for a " ++ show (V.dim v) ++ "x1D matrix"-  {-# INLINE indexCol #-}-  indexRow i = unsafeCoerce . Scalar . V.indexVec i . _unContraVec-  {-# INLINE indexRow #-}---instance (KnownNat m, V.VectorCalculus t m (V.Vector t m)) => M.MatrixCalculus t 1 m (CoVector t m) where-  broadcastMat = CoVector . V.broadcastVec-  {-# INLINE broadcastMat #-}-  indexMat 1 i (CoVector v) = V.indexVec i v-  indexMat j i (CoVector v) = error $ "Bad index (" ++ show j ++ ", " ++ show i ++ ") for a 1x" ++ show (V.dim v) ++ "D matrix"-  {-# INLINE indexMat #-}-  transpose (CoVector v) = unsafeCoerce $ ContraVector v-  {-# INLINE transpose #-}-  dimN _ = 1-  {-# INLINE dimN #-}-  dimM = V.dim . _unCoVec-  {-# INLINE dimM #-}-  indexCol i = unsafeCoerce . Scalar . V.indexVec i . _unCoVec-  {-# INLINE indexCol #-}-  indexRow 1 x = unsafeCoerce x-  indexRow j (CoVector v) = error $ "Bad column index " ++ show j ++ " for a 1x" ++ show (V.dim v) ++ "D matrix"-  {-# INLINE indexRow #-}--