diff --git a/hasktorch.cabal b/hasktorch.cabal --- a/hasktorch.cabal +++ b/hasktorch.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasktorch -version: 0.2.1.7 +version: 0.2.1.8 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 @@ -107,15 +107,15 @@ cpp-options: -D__APPLE__ build-depends: async >= 2.2.5 && < 2.3 , base >= 4.7 && < 5 - , libtorch-ffi == 2.0.1.* + , libtorch-ffi >= 2.0.1.10 && < 2.0.2 , libtorch-ffi-helper == 2.0.0.* , finite-typelits >= 0.1 && < 0.3 - , ghc-typelits-extra >= 0.4.6 && < 0.5 - , ghc-typelits-knownnat >= 0.7.9 && < 0.8 - , ghc-typelits-natnormalise >= 0.7.9 && < 0.8 + , ghc-typelits-extra >= 0.4.6 && < 0.6 + , ghc-typelits-knownnat >= 0.7.9 && < 0.9 + , ghc-typelits-natnormalise >= 0.7.9 && < 0.10 , mtl >= 2.3.1 && < 2.4 , safe-exceptions >= 0.1.7 && < 0.2 - , random >= 1.2.1 && < 1.3 + , random >= 1.2.1 && < 1.4 , reflection >= 2.1 && < 2.2 , stm >= 2.5.1 && < 2.6 , JuicyPixels >= 3.3 && < 3.4 @@ -131,7 +131,7 @@ , pipes-csv >= 1.4.3 && < 1.5 , lens-family-core >= 2.1.3 && < 2.2 , cassava >= 0.5.3 && < 0.6 - , lifted-async >= 0.10.2 && < 0.11 + , lifted-async >= 0.10.2 && < 0.12 , monad-control >= 1.0.3 && < 1.1 , foldl >= 1.4 && < 1.5 , transformers-base >= 0.4.6 && < 0.5 @@ -140,7 +140,7 @@ , containers >= 0.6.7 && < 0.8 , inline-c >= 0.9.1 && < 0.10 , vector-sized >= 1.5 && < 1.7 - , template-haskell >= 2.20.0 && < 2.23 + , template-haskell >= 2.20.0 && < 2.24 , megaparsec >= 9.5 && < 9.8 , half >= 0.3 && < 0.4 , constraints >= 0.14 && < 0.15 diff --git a/src/Torch/Autograd.hs b/src/Torch/Autograd.hs --- a/src/Torch/Autograd.hs +++ b/src/Torch/Autograd.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RecordWildCards #-} module Torch.Autograd where @@ -14,7 +15,9 @@ import qualified Torch.Internal.Managed.Type.Tensor as ATen import qualified Torch.Internal.Type as ATen import Torch.Tensor +import Data.Default.Class + -- | Note: to create an `IndependentTensor` use `makeIndependent`; -- | otherwise, Torch will complain the parameter does not require a gradient. newtype IndependentTensor = IndependentTensor @@ -22,8 +25,21 @@ } deriving (Show, Generic) +data GradOptions = GradOptions + { keepGraph :: Bool + , createGraph :: Bool + , accumulateGrad :: Bool + } + deriving (Show) + +instance Default GradOptions where + def = GradOptions True False False + grad :: Tensor -> [IndependentTensor] -> [Tensor] grad y inputs = unsafePerformIO $ cast2 Torch.Internal.Managed.Autograd.grad y (map toDependent inputs) + +gradWithOptions :: GradOptions -> Tensor -> [IndependentTensor] -> [Tensor] +gradWithOptions GradOptions{..} y inputs = unsafePerformIO $ cast5 Torch.Internal.Managed.Autograd.gradWithOptions keepGraph createGraph accumulateGrad y (map toDependent inputs) requiresGrad :: Tensor -> Bool requiresGrad t = unsafePerformIO $ cast1 ATen.tensor_requires_grad t diff --git a/src/Torch/Typed/Autograd.hs b/src/Torch/Typed/Autograd.hs --- a/src/Torch/Typed/Autograd.hs +++ b/src/Torch/Typed/Autograd.hs @@ -9,6 +9,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoStarIsType #-} +{-# LANGUAGE RecordWildCards #-} module Torch.Typed.Autograd ( Torch.Typed.Autograd.HasGrad, @@ -28,10 +29,13 @@ import qualified Torch.Tensor as D import Torch.Typed.Parameter import Torch.Typed.Tensor +import Torch.Autograd (GradOptions(..)) + class HasGrad a b | a -> b where -- | calculate gradients of a zero-dimensional tensor with respect to a list of parameters grad :: forall dtype device. Tensor device dtype '[] -> a -> b + gradWithOptions :: forall dtype device. GradOptions -> Tensor device dtype '[] -> a -> b toDependent :: a -> b @@ -49,6 +53,15 @@ LibTorch.grad loss [Torch.Typed.Autograd.toDependent input] + gradWithOptions GradOptions{..} loss input = + head . unsafePerformIO $ + ATen.cast5 + LibTorch.gradWithOptions + keepGraph + createGraph + accumulateGrad + loss + [Torch.Typed.Autograd.toDependent input] toDependent = Torch.Typed.Parameter.toDependent instance HasGrad (HList ('[] :: [Type])) (HList ('[] :: [Type])) where @@ -66,6 +79,15 @@ unsafePerformIO $ ATen.cast2 LibTorch.grad + loss + (Torch.Typed.Autograd.toDependent inputs) + gradWithOptions GradOptions{..} loss inputs = + unsafePerformIO $ + ATen.cast5 + LibTorch.gradWithOptions + keepGraph + createGraph + accumulateGrad loss (Torch.Typed.Autograd.toDependent inputs) toDependent (a :. as) = diff --git a/test/Torch/Typed/FunctionalSpec2.hs b/test/Torch/Typed/FunctionalSpec2.hs --- a/test/Torch/Typed/FunctionalSpec2.hs +++ b/test/Torch/Typed/FunctionalSpec2.hs @@ -635,8 +635,8 @@ it "solve" $ do let solveShapes = hzip - (Proxy @'[1, 0] :. Proxy @'[1, 2] :. Proxy @'[2, 1] :. Proxy @'[3, 1, 2] :. HNil) - (Proxy @'[1, 1] :. Proxy @'[1, 1] :. Proxy @'[2, 2] :. Proxy @'[3, 1, 1] :. HNil) + (Proxy @'[1, 2] :. Proxy @'[2, 1] :. Proxy @'[3, 1, 2] :. HNil) + (Proxy @'[1, 1] :. Proxy @'[2, 2] :. Proxy @'[3, 1, 1] :. HNil) case device of Device {deviceType = CPU, deviceIndex = 0} -> hfoldrM @IO SolveSpec () (hattach cpu (hproduct standardFloatingPointDTypes solveShapes))