hasktorch 0.2.1.4 → 0.2.1.6
raw patch · 6 files changed
+93/−13 lines, 6 filesdep ~deepseqdep ~doctestdep ~vector
Dependency ranges changed: deepseq, doctest, vector
Files
- bench/Alloc.hs +0/−4
- bench/Runtime.hs +0/−4
- hasktorch.cabal +4/−2
- src/Torch/Optim.hs +9/−3
- src/Torch/Tensor.hs +48/−0
- test/TensorSpec.hs +32/−0
bench/Alloc.hs view
@@ -45,10 +45,6 @@ n :: Int n = 100 -instance NFData T.Tensor- where- rnf (T.Unsafe _) = ()- instance NFData (ForeignPtr a) where rnf v = v `seq` ()
bench/Runtime.hs view
@@ -49,10 +49,6 @@ #define N3 1000 -instance NFData T.Tensor- where- rnf (T.Unsafe _) = ()- instance NFData (ForeignPtr a) where rnf v = v `seq` ()
hasktorch.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasktorch-version: 0.2.1.4+version: 0.2.1.6 synopsis: Haskell bindings to libtorch, supporting both typed and untyped tensors. description: Hasktorch is a library for tensors and neural networks in Haskell. It is an independent open source community project which leverages the core C++ libraries shared by PyTorch. homepage: https://github.com/hasktorch/hasktorch#readme@@ -142,6 +142,7 @@ , megaparsec >= 9.5 && < 9.8 , half >= 0.3 && < 0.4 , constraints >= 0.14 && < 0.15+ , deepseq >= 1.4.8 && < 1.6 default-extensions: Strict , StrictData@@ -210,6 +211,7 @@ , lens-family-core , data-default-class , half+ , vector test-suite doctests if os(darwin) || flag(disable-doctest)@@ -221,7 +223,7 @@ main-is: doctests.hs ghc-options: -Wall -threaded -fplugin GHC.TypeLits.Normalise -fplugin GHC.TypeLits.KnownNat.Solver -fplugin GHC.TypeLits.Extra.Solver -fconstraint-solver-iterations=0 default-language: Haskell2010- build-depends: doctest >=0.16.0.1 && <0.23+ build-depends: doctest >=0.16.0.1 && <0.25 , async , base , libtorch-ffi
src/Torch/Optim.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveGeneric #-} module Torch.Optim where @@ -12,6 +13,8 @@ import Torch.Tensor import Torch.TensorFactories import Prelude hiding (sqrt)+import GHC.Generics (Generic)+import Control.DeepSeq (NFData, force) type LearningRate = Tensor @@ -107,8 +110,10 @@ m2 :: [Tensor], -- 2nd moment iter :: Int -- iteration }- deriving (Show)+ deriving (Show, Generic) +instance NFData Adam+ mkAdam :: Int -> Float ->@@ -142,8 +147,9 @@ -- decaying averages of 1st & 2nd moments f1 m1 dp = mulScalar beta1 m1 + mulScalar (1 - beta1) dp f2 m2 dp = mulScalar beta2 m2 + mulScalar (1 - beta2) (dp * dp)- m1' = zipWith f1 m1 gradients- m2' = zipWith f2 m2 gradients+ -- force to prevent spine laziness. See https://github.com/hasktorch/hasktorch/pull/728+ m1' = force $ zipWith f1 m1 gradients+ m2' = force $ zipWith f2 m2 gradients -- bias adjustment a beta = divScalar (1 - beta ^ (iter + 1)) a1 = fmap (a beta1) m1'
src/Torch/Tensor.hs view
@@ -24,12 +24,17 @@ import Data.Proxy import Data.Reflection import qualified Data.Vector as V+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Generic as VG import Data.Word (Word8) import Foreign.C.Types import Foreign.ForeignPtr+import Foreign.Marshal.Utils (copyBytes) import Foreign.Ptr import Foreign.Storable import GHC.Generics+import GHC.ForeignPtr(mallocPlainForeignPtrBytes) import Numeric import System.IO.Unsafe import Torch.DType@@ -51,12 +56,16 @@ import qualified Torch.Internal.Unmanaged.Type.Tensor as Unmanaged (tensor_data_ptr) import Torch.Lens import Torch.TensorOptions+import Control.DeepSeq (NFData, rnf) type ATenTensor = ForeignPtr ATen.Tensor -- do not use the constructor newtype Tensor = Unsafe ATenTensor +instance NFData Tensor where+ rnf (Unsafe _) = ()+ instance Castable Tensor ATenTensor where cast (Unsafe aten_tensor) f = f aten_tensor uncast aten_tensor f = f $ Unsafe aten_tensor@@ -701,6 +710,45 @@ if product (_dims d) == width -- This validation may be slow. then (_pokeElemOff @a) ptr (offset + i * width) d else throwIO $ userError $ "There are lists having different length."++instance {-# OVERLAPPING #-} (Reifies a DType, Storable a) => TensorLike (VS.Vector a) where+ asTensor v = unsafePerformIO $ do+ t <- ((cast2 ATen.new_empty_tensor) :: [Int] -> TensorOptions -> IO Tensor) [VS.length v] $ withDType (_dtype @a) defaultOpts+ _withTensor t $ \ptr -> do+ VS.unsafeWith v $ \vptr -> do+ copyBytes+ (castPtr ptr)+ (castPtr vptr)+ (VS.length v * (sizeOf (undefined :: a)))+ return t++ _asValue t = unsafePerformIO $+ let len = head (shape t)+ in+ withTensor t $ \ptr -> do+ fp <- mallocPlainForeignPtrBytes (len * (sizeOf (undefined :: a)))+ withForeignPtr fp $ \vptr -> do+ copyBytes+ (castPtr vptr)+ (castPtr ptr)+ (len * (sizeOf (undefined :: a)))+ return $ VS.unsafeFromForeignPtr fp 0 len++ _dtype = reflect (Proxy :: Proxy a)+ _dims v = [VS.length v]+ _deepDims v = Just [VS.length v]+ _peekElemOff = error "Not implemented for storable vector"+ _pokeElemOff = error "Not implemented for storable vector"++instance {-# OVERLAPPING #-} (Reifies a DType, Storable a, VG.Vector VU.Vector a) => TensorLike (VU.Vector a) where+ asTensor v = asTensor (VG.convert v :: VS.Vector a)+ _asValue t = VG.convert (_asValue t :: VS.Vector a)++ _dtype = reflect (Proxy :: Proxy a)+ _dims v = [VG.length v]+ _deepDims v = Just [VG.length v]+ _peekElemOff = error "Not implemented for unboxed vector"+ _pokeElemOff = error "Not implemented for unboxed vector" class AsTensors as where toTensors :: as -> V.Vector Tensor
test/TensorSpec.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-} module TensorSpec (spec) where @@ -17,11 +19,32 @@ import Torch.TensorFactories import Torch.TensorOptions import Test.QuickCheck.Arbitrary+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Generic as VG instance Arbitrary Half where arbitrary = arbitrarySizedFractional shrink = shrinkDecimal +instance (Arbitrary a, VS.Storable a) => Arbitrary (VS.Vector a) where+ arbitrary = do+ n <- choose (0, 20) -- limit length to at most 20+ xs <- vectorOf n arbitrary -- exactly n randomly generated `a`s+ return (VS.fromList xs)++ shrink v = [ VS.fromList xs+ | xs <- shrink (VS.toList v) ]++instance (Arbitrary a, VS.Storable a, VG.Vector VU.Vector a) => Arbitrary (VU.Vector a) where+ arbitrary = do+ n <- choose (0, 20) -- limit length to at most 20+ xs <- vectorOf n arbitrary -- exactly n randomly generated `a`s+ return (VG.fromList xs)++ shrink v = [ VG.fromList xs+ | xs <- shrink (VG.toList v) ]+ spec :: Spec spec = do describe "TensorLike" $ do@@ -64,6 +87,15 @@ it "TensorLike Complex Double" $ property $ \x -> asValue (asTensor x) `shouldBe` (x :: Complex Double)+ it "TensorLike Storable Vector Float" $+ property $+ \x -> asValue (asTensor x) `shouldBe` (x :: VS.Vector Float)+ it "TensorLike Storable Vector Double" $+ property $+ \x -> asValue (asTensor x) `shouldBe` (x :: VS.Vector Double)+ it "TensorLike Unboxed Vector Double" $+ property $+ \x -> asValue (asTensor x) `shouldBe` (x :: VU.Vector Double) it "Compare internal expression of c++ with Storable expression of haskell" $ do show (asTensor [True, False, True, False])