diff --git a/src/TensorFlow/EmbeddingOps.hs b/src/TensorFlow/EmbeddingOps.hs --- a/src/TensorFlow/EmbeddingOps.hs +++ b/src/TensorFlow/EmbeddingOps.hs @@ -46,7 +46,7 @@ -- tensor. The returned tensor has shape `shape(ids) + shape(params)[1:]`. embeddingLookup :: forall a b v1 v2 m . ( MonadBuild m - , Rendered v1 + , Rendered (Tensor v1) , TensorType a , OneOf '[Int64, Int32] b , Num b diff --git a/src/TensorFlow/Gradient.hs b/src/TensorFlow/Gradient.hs --- a/src/TensorFlow/Gradient.hs +++ b/src/TensorFlow/Gradient.hs @@ -22,7 +22,8 @@ {-# LANGUAGE ViewPatterns #-} module TensorFlow.Gradient - ( gradients + ( GradientCompatible + , gradients ) where import Control.Monad (forM, zipWithM) @@ -99,6 +100,7 @@ , tensorNodeName , renderedOutput , renderValue + , ToTensor(..) ) import TensorFlow.Types (Attribute, OneOf, TensorType, attrLens) import Proto.Tensorflow.Core.Framework.NodeDef @@ -116,12 +118,13 @@ -- | Gradient of @y@ w.r.t. each element of @xs@. -gradients :: forall a v1 v2 m . (MonadBuild m - , Rendered v2 - , GradientCompatible a - ) +gradients :: forall a v1 t m . ( MonadBuild m + , Rendered t + , ToTensor t + , GradientCompatible a + ) => Tensor v1 a -- ^ The output of the graph. - -> [Tensor v2 a] -- ^ Tensors for which gradients are computed. + -> [t a] -- ^ Tensors for which gradients are computed. -> m [Tensor Value a] gradients y xs = build $ do -- The gradients are computed using "reverse accumulation", similarly to @@ -171,10 +174,9 @@ gradientMap <- graphGrads gr initPending -- Lookup the gradients for each x. forM xs $ \x -> - let xName = tensorNodeName x - in maybe (render $ zerosLike x) return $ do + let Output i xName = renderedOutput x + in maybe (render $ zerosLike $ toTensor x) return $ do n <- nodeMap ^. at xName - let i = outputIndex $ renderedOutput x gradientMap ^. at n . nonEmpty . outputIxAt i outputIxAt :: OutputIx -> Lens' (IntMap.IntMap v) (Maybe v) @@ -429,6 +431,22 @@ nodeDefName :: NodeDef -> NodeName nodeDefName = NodeName . view name +-- | Gradient helper for binary component wise operations +-- See https://github.com/tensorflow/tensorflow/blob/e9de087fa7f59c39bbe12ac2c83c5547c83f746c/tensorflow/core/ops/math_grad.cc#L329 +gradForBinaryCwise :: ( OneOf '[ Int32, Int64, Float, Double, Complex Float, Complex Double ] t + ) + => (Tensor v1 t, Tensor v1 t) + -> (Tensor v1 t, Tensor v1 t) + -> [ Maybe (Tensor Build t) ] +gradForBinaryCwise (x, gx) (y, gy) = + [ Just dx + , Just dy ] + where + dx = reshape (sum gx rx) sx + dy = reshape (sum gy ry) sy + sx = shape x + sy = shape y + (rx, ry) = broadcastGradientArgs sx sy -- | The gradient function for an op type. -- @@ -441,6 +459,39 @@ opGrad "Relu" _ [toT -> x] [dz] = [Just $ reluGrad dz x] opGrad "ReluGrad" _ [_, toT -> x ] [dz] = [Just $ reluGrad dz x, Just $ CoreOps.zerosLike x] +opGrad "Concat" _ _ix [dy] + -- Concat concatenates input tensors + -- x1 of shape s1 = [k1, ..., ki_1, ..., kn] + -- x2 of shape s2 = [k1, ..., ki_2, ..., kn] + -- . . . . . + -- . . . . . + -- . . . . . + -- xm of shape sm = [k1, ..., ki_m, ..., kn] + -- along dimension i to an output tensor + -- y of shape sy = [k1, ..., k, ..., kn] + -- where k = sum ki = sum [ki_1,...,ki_m] + -- + -- The incoming gradient dy from backpropagation is + -- simply forwarded split across input tensors yielding dx. + -- Forwarded gradients have shapes s = [s1, ..., sm]. + | m == 1 = Nothing : [Just $ expr dy] + | otherwise = Nothing : map Just (dx `reshapeZip` s) + where + reshapeZip = zipWith reshape + dx = CoreOps.splitV (fromIntegral m) dy ki _i + s :: [Tensor Build Int32] + s = map shape x + x :: [Tensor Build a] + x = map toT $ tail _ix + -- i: concat dimension. Adjusted modulo n to handle negative indices. + _i = toT (head _ix) `CoreOps.floorMod` n + i = reshape _i $ vector [1 :: Int32] + -- sizes along concatenated dimension + ki :: Tensor Build Int32 + ki = CoreOps.concat 0 $ map (\t -> CoreOps.slice t i $ vector [1 :: Int32]) s + m = length x + n = CoreOps.rank (head x) + opGrad "Square" _ [toT -> x] [dz] = -- TODO(fmayle): Handle complex numbers. -- TODO(fmayle): The python code makes dz a control dependency of the 2*x @@ -481,6 +532,15 @@ -- Min and Max have identical gradient implementations. opGrad "Min" u v w = opGrad "Max" u v w +-- Element wise maximum gradient +-- See https://github.com/tensorflow/tensorflow/blob/e9de087fa7f59c39bbe12ac2c83c5547c83f746c/tensorflow/core/ops/math_grad.cc#L473 +opGrad "Maximum" _ [toT -> x, toT -> y] [dz] = + gradForBinaryCwise (x, gx) (y, gy) + where + xmask = CoreOps.greaterEqual x y + gx = CoreOps.select xmask dz (CoreOps.zerosLike dz) + gy = CoreOps.select (CoreOps.logicalNot xmask) dz (CoreOps.zerosLike dz) + opGrad "Sum" _ [toT -> x, toT -> indices] [dz] = [ Just $ CoreOps.tile grad tileScaling, Nothing ] where @@ -509,6 +569,11 @@ sy = shape (y :: Tensor Build a) (rx, ry) = broadcastGradientArgs sx sy +-- Copies the gradients to all inputs +-- Not broadcasting +opGrad "AddN" _ inputs [dz] = + map ((const . Just . expr) dz) inputs + opGrad "Sub" u v w = [Just x, Just (-y)] where @@ -585,6 +650,27 @@ useCudnnOnGpu = lookupAttr nodeDef "use_cudnn_on_gpu" :: Bool dataFormat = lookupAttr nodeDef "data_format" :: ByteString +opGrad "Conv2DBackpropInput" nodeDef [_, toT -> x, toT -> y] [dz] = + [ Nothing + , Just $ CoreOps.conv2DBackpropFilter' + ((opAttr "strides" .~ strides) + . (opAttr "padding" .~ padding) + . (opAttr "use_cudnn_on_gpu" .~ useCudnnOnGpu) + . (opAttr "data_format" .~ dataFormat)) + dz (shape x) y + , Just $ CoreOps.conv2D' + ((opAttr "strides" .~ strides) + . (opAttr "padding" .~ padding) + . (opAttr "use_cudnn_on_gpu" .~ useCudnnOnGpu) + . (opAttr "data_format" .~ dataFormat)) + dz x + ] + where + strides = lookupAttr nodeDef "strides" :: [Int64] + padding = lookupAttr nodeDef "padding" :: ByteString + useCudnnOnGpu = lookupAttr nodeDef "use_cudnn_on_gpu" :: Bool + dataFormat = lookupAttr nodeDef "data_format" :: ByteString + opGrad "MaxPool" nodeDef [toT -> x] [dz] = [ Just $ CoreOps.maxPoolGrad' ((opAttr "ksize" .~ ksize) @@ -687,9 +773,16 @@ where rx = rangeOfRank dz +-- Treat read ops as an identity function on the variable. This allows us to +-- take gradients w.r.t. to the variable handle instead of the result of a read +-- op. If a variable is read multiple times, the gradients will propagate back +-- through each read. +opGrad "ReadVariableOp" _ _ [dz] = [Just $ expr dz] + -- TODO(fmayle): These can go away if we properly prune the graph. opGrad "Const" _ _ _ = [Nothing, Nothing] opGrad "Placeholder" _ _ _ = [] +opGrad "VarHandleOp" _ _ _ = [] opGrad "Variable" _ _ _ = [] opGrad n nodeDef ins grads = @@ -702,9 +795,12 @@ case o ^. op of "Abs" -> 1 "Add" -> 1 + "AddN" -> 1 "Cast" -> 1 "Const" -> 1 + "Concat" -> 1 "Conv2D" -> 1 + "Conv2DBackpropInput" -> 1 "Div" -> 1 "DynamicStitch" -> 1 "DynamicPartition" -> @@ -716,6 +812,7 @@ "Log" -> 1 "MatMul" -> 1 "Max" -> 1 + "Maximum" -> 1 "MaxPool" -> 1 "Mean" -> 1 "Min" -> 1 @@ -723,6 +820,7 @@ "Neg" -> 1 "Placeholder" -> 1 "OneHot" -> 1 + "ReadVariableOp" -> 1 "RefIdentity" -> 1 "Relu" -> 1 "ReluGrad" -> 1 @@ -737,10 +835,11 @@ "Tile" -> 1 "Transpose" -> 1 "TruncatedNormal" -> 1 + "VarHandleOp" -> 1 "Variable" -> 1 "ZerosLike" -> 1 "Fill" -> 1 - _ -> error $ "numOuputs not implemented for " ++ show (o ^. op) + _ -> error $ "numOutputs not implemented for " ++ show (o ^. op) -- Divides `x / y` assuming `x, y >= 0`, treating `0 / 0 = 0` safeShapeDiv :: Tensor v1 Int32 -> Tensor v2 Int32 -> Tensor Build Int32 diff --git a/src/TensorFlow/Minimize.hs b/src/TensorFlow/Minimize.hs new file mode 100644 --- /dev/null +++ b/src/TensorFlow/Minimize.hs @@ -0,0 +1,115 @@ +-- Copyright 2016 TensorFlow authors. +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module TensorFlow.Minimize + ( Minimizer + , minimizeWith + , gradientDescent + , AdamConfig(..) + , adam + , adam' + ) where + +import Control.Monad (zipWithM) +import Data.Default (Default(..)) +import Data.List (zipWith4) +import Data.Maybe (fromMaybe) + +import qualified TensorFlow.Core as TF +import qualified TensorFlow.Gradient as TF +import qualified TensorFlow.Ops as TF hiding (assign, initializedVariable) +import qualified TensorFlow.Variable as TF + +-- | Functions that minimize a loss w.r.t. a set of 'TF.Variable's. +-- +-- Generally only performs one step of an iterative algorithm. +-- +-- 'Minimizer's are defined as a function of the gradients instead of +-- the loss so that users can apply transformations to the gradients. +type Minimizer a = + forall m. TF.MonadBuild m => + [TF.Variable a] -> [TF.Tensor TF.Value a] -> m TF.ControlNode + +-- | Convenience wrapper around 'TF.gradients' and a 'Minimizer'. +minimizeWith :: (TF.MonadBuild m, TF.GradientCompatible a) + => Minimizer a + -> TF.Tensor v a -- ^ Loss. + -> [TF.Variable a] -- ^ Parameters of the loss function. + -> m TF.ControlNode +minimizeWith minimizer loss params = + TF.gradients loss params >>= minimizer params + +-- | Perform one step of the gradient descent algorithm. +gradientDescent :: TF.GradientCompatible a + => a -- ^ Learning rate. + -> Minimizer a +gradientDescent learningRate params grads = TF.withNameScope "gradientDescent" $ do + let applyGrad param grad = + TF.assignAdd param (TF.scalar (-learningRate) `TF.mul` grad) + TF.group =<< zipWithM applyGrad params grads + +-- TODO: Support more than Float in adam. + +data AdamConfig = AdamConfig + { adamLearningRate :: Float + , adamBeta1 :: Float + , adamBeta2 :: Float + , adamEpsilon :: Float + } + +instance Default AdamConfig where + -- Recommended defaults from the adam paper. + def = AdamConfig 0.001 0.9 0.999 1e-8 + +-- | Perform one step of the adam algorithm. +-- +-- See https://arxiv.org/abs/1412.6980. +-- +-- NOTE: Currently requires all 'TF.Variable's to have an 'TF.initializedValue'. +adam :: Minimizer Float +adam = adam' def + +adam' :: AdamConfig -> Minimizer Float +adam' config params grads = TF.withNameScope "adam" $ do + let lr = TF.scalar (adamLearningRate config) + beta1 = TF.scalar (adamBeta1 config) + beta2 = TF.scalar (adamBeta2 config) + epsilon = TF.scalar (adamEpsilon config) + -- Create adam state variables. + let errorMsg = "TensorFlow.Minimize.adam requires an initial value for all variables" + initVal = fromMaybe (error errorMsg) . TF.initializedValue + ms <- mapM (TF.initializedVariable . TF.zerosLike . initVal) params + vs <- mapM (TF.initializedVariable . TF.zerosLike . initVal) params + beta1Power <- TF.initializedVariable beta1 + beta2Power <- TF.initializedVariable beta2 + -- Perform adam update. + let applyGrad param m v = + TF.resourceApplyAdam param m v + (TF.readValue beta1Power) + (TF.readValue beta2Power) + lr beta1 beta2 epsilon + updateVars <- sequence $ zipWith4 applyGrad params ms vs grads + -- Update beta variables after adam update. + let updateBeta betaPower beta = + TF.withControlDependencies updateVars + (TF.assign betaPower (TF.readValue betaPower `TF.mul` beta)) + updateBeta1 <- updateBeta beta1Power beta1 + updateBeta2 <- updateBeta beta2Power beta2 + TF.group (updateBeta1:updateBeta2:updateVars) diff --git a/src/TensorFlow/Ops.hs b/src/TensorFlow/Ops.hs --- a/src/TensorFlow/Ops.hs +++ b/src/TensorFlow/Ops.hs @@ -106,6 +106,8 @@ , CoreOps.range , CoreOps.range' , reducedShape + , reduceMean + , reduceMean' , CoreOps.relu , CoreOps.relu' , CoreOps.reluGrad @@ -241,8 +243,8 @@ zeroInitializedVariable' params = initializedVariable' params . zeros -- TODO: Support heterogeneous list of tensors. -save :: forall a m v . (Rendered v, MonadBuild m, TensorType a) - => ByteString -- ^ File path. +save :: forall a m v . (Rendered (Tensor v), MonadBuild m, TensorType a) + => ByteString -- ^ File path. -> [Tensor v a] -- ^ Tensors to save. -> m ControlNode save path xs = build $ do @@ -330,6 +332,23 @@ reduceSum' params x = CoreOps.sum' params x allAxes where allAxes = CoreOps.range 0 (CoreOps.rank x :: Tensor Build Int32) 1 +-- | Computes the mean of elements across dimensions of a tensor. +-- See `TensorFlow.GenOps.Core.mean` +reduceMean + :: ( TensorType a + , OneOf '[ Double, Float, Complex Float, Complex Double] a + ) + => Tensor v a -> Tensor Build a +reduceMean = reduceMean' id + +reduceMean' + :: ( TensorType a + , OneOf '[ Double, Float, Complex Float, Complex Double] a + ) + => OpParams -> Tensor v a -> Tensor Build a +reduceMean' params x = CoreOps.mean' params x allAxes + where allAxes = CoreOps.range 0 (CoreOps.rank x :: Tensor Build Int32) 1 + -- | Create a constant vector. vector :: TensorType a => [a] -> Tensor Build a vector = vector' id @@ -358,7 +377,7 @@ truncatedNormal' = CoreOps.truncatedNormal' zeros :: forall a . (Num a, TensorType a) => Shape -> Tensor Build a -zeros (Shape s) = CoreOps.fill (vector $ map fromIntegral s) (scalar 0) +zeros (Shape s) = CoreOps.fill (vector s) (scalar 0) shape :: TensorType t => Tensor v t -> Tensor Build Int32 shape = CoreOps.shape diff --git a/src/TensorFlow/Variable.hs b/src/TensorFlow/Variable.hs --- a/src/TensorFlow/Variable.hs +++ b/src/TensorFlow/Variable.hs @@ -6,6 +6,8 @@ -- TODO: given that distinction, figure out a good story around -- gradients and save/restore. Then, merge this module into -- TensorFlow.Ops. +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} @@ -14,6 +16,7 @@ , variable , variable' , readValue + , initializedValue , initializedVariable , initializedVariable' , zeroInitializedVariable @@ -22,35 +25,59 @@ , assign' , assignAdd , assignAdd' + , resourceApplyAdam + , resourceApplyAdam' ) where +import qualified Data.Complex +import qualified Data.Int +import qualified Data.Word import Data.Text.Encoding (encodeUtf8) import Lens.Family2 ((.~), (&)) import TensorFlow.Core import TensorFlow.Build (opDef) import TensorFlow.BuildOp (buildInputs, pureOp, OpParams) import TensorFlow.Output (opInputs, unNodeName) -import TensorFlow.Tensor (tensorNodeName) +import TensorFlow.Tensor (Rendered(..), ToTensor(..), renderValue, tensorNodeName) import TensorFlow.Types (tensorType) import qualified TensorFlow.GenOps.Core as CoreOps import TensorFlow.Ops (zeros) -newtype Variable a = Variable (Tensor Value ResourceHandle) +data Variable a = Variable + { variableHandle :: Tensor Value ResourceHandle + , initializedValue :: Maybe (Tensor Value a) + -- ^ The initial value of a 'Variable' created with 'initializedVariable'. + } +instance Rendered Variable where + renderedOutput = renderedOutput . variableHandle + +instance ToTensor Variable where + toTensor = readValue + -- | Creates a new, uninitialized variable. variable :: (MonadBuild m, TensorType a) => Shape -> m (Variable a) variable = variable' id variable' :: forall m a . (MonadBuild m, TensorType a) => OpParams -> Shape -> m (Variable a) -variable' params s = build $ do +variable' params s = variableInternal params (Just s) + +variableInternal :: forall m a . (MonadBuild m, TensorType a) + => OpParams -> Maybe Shape -> m (Variable a) +variableInternal params s = build $ do -- Each variable needs a unique "shared_name". Use MonadFix to -- set the attribute to the same name as the variable itself, without -- exposing more internals of the Build module. - rec t <- CoreOps.varHandleOp' (params . (opAttr "shared_name" .~ n)) - (tensorType (undefined :: a)) s + rec let attrs = params . (opAttr "shared_name" .~ n) . (opAttr "shape" .~ s) + dtype = tensorType (undefined :: a) + -- Generated ops don't support unknown shapes. As a workaround, we + -- pass in a rank zero shape and then override it using OpParams. + -- TODO: Consider supporting this better in op generation. + shape = Shape [] + t <- CoreOps.varHandleOp' attrs dtype shape let n = encodeUtf8 $ unNodeName $ tensorNodeName t - return $ Variable t + return $ Variable t Nothing -- | Creates a variable initialized to the given value. -- Initialization happens next time session runs. @@ -62,10 +89,11 @@ => OpParams -> Tensor v a -> m (Variable a) initializedVariable' params initializer = do -- The shape is not known initially. - v@(Variable h) <- variable' params (Shape []) - i <- CoreOps.assignVariableOp h initializer + (Variable h Nothing :: Variable a) <- variableInternal params Nothing + initializer' <- renderValue initializer + i <- CoreOps.assignVariableOp h initializer' addInitializer =<< group i - return v + return (Variable h (Just initializer')) -- | Creates a zero-initialized variable with the given shape. zeroInitializedVariable @@ -96,7 +124,7 @@ readValue' :: forall a . TensorType a => OpParams -> Variable a -> Tensor Build a -readValue' params (Variable h) +readValue' params (Variable h _) = pureOp [] $ do os <- buildInputs h pure $ opDef "ReadVariableOp" @@ -111,7 +139,7 @@ assign' :: (MonadBuild m, TensorType a) => OpParams -> Variable a -> Tensor v a -> m ControlNode -assign' params (Variable h) v = CoreOps.assignVariableOp' params h v +assign' params (Variable h _) v = CoreOps.assignVariableOp' params h v -- | Increments the value of a variable. assignAdd :: (MonadBuild m, TensorType a) @@ -120,4 +148,56 @@ assignAdd' :: (MonadBuild m, TensorType a) => OpParams -> Variable a -> Tensor v a -> m ControlNode -assignAdd' params (Variable h) v = CoreOps.assignAddVariableOp' params h v +assignAdd' params (Variable h _) v = CoreOps.assignAddVariableOp' params h v + +-- | Update '*var' according to the Adam algorithm. +-- +-- lr_t <- learning_rate * sqrt(1 - beta2^t) / (1 - beta1^t) +-- m_t <- beta1 * m_{t-1} + (1 - beta1) * g_t +-- v_t <- beta2 * v_{t-1} + (1 - beta2) * g_t * g_t +-- variable <- variable - lr_t * m_t / (sqrt(v_t) + epsilon) +resourceApplyAdam :: + (MonadBuild m, + OneOf '[(Data.Complex.Complex Double), + (Data.Complex.Complex Float), + Data.Int.Int16, + Data.Int.Int32, + Data.Int.Int64, Data.Int.Int8, + Data.Word.Word16, + Data.Word.Word8, Double, + Float] t) + => Variable t -- ^ __var__: Should be from a Variable(). + -> Variable t -- ^ __m__: Should be from a Variable(). + -> Variable t -- ^ __v__: Should be from a Variable(). + -> Tensor v1 t -- ^ __beta1_power__: Must be a scalar. + -> Tensor v2 t -- ^ __beta2_power__: Must be a scalar. + -> Tensor v3 t -- ^ __lr__: Scaling factor. Must be a scalar. + -> Tensor v4 t -- ^ __beta1__: Momentum factor. Must be a scalar. + -> Tensor v5 t -- ^ __beta2__: Momentum factor. Must be a scalar. + -> Tensor v6 t -- ^ __epsilon__: Ridge term. Must be a scalar. + -> Tensor v7 t -- ^ __grad__: The gradient. + -> m (ControlNode) +resourceApplyAdam = resourceApplyAdam' id + +resourceApplyAdam' :: + (MonadBuild m, + OneOf '[(Data.Complex.Complex Double), + (Data.Complex.Complex Float), + Data.Int.Int16, Data.Int.Int32, + Data.Int.Int64, Data.Int.Int8, + Data.Word.Word16, Data.Word.Word8, Double, + Float] t) + => OpParams + -> Variable t -- ^ __var__: Should be from a Variable(). + -> Variable t -- ^ __m__: Should be from a Variable(). + -> Variable t -- ^ __v__: Should be from a Variable(). + -> Tensor v1 t -- ^ __beta1_power__: Must be a scalar. + -> Tensor v2 t -- ^ __beta2_power__: Must be a scalar. + -> Tensor v3 t -- ^ __lr__: Scaling factor. Must be a scalar. + -> Tensor v4 t -- ^ __beta1__: Momentum factor. Must be a scalar. + -> Tensor v5 t -- ^ __beta2__: Momentum factor. Must be a scalar. + -> Tensor v6 t -- ^ __epsilon__: Ridge term. Must be a scalar. + -> Tensor v7 t -- ^ __grad__: The gradient. + -> m (ControlNode) +resourceApplyAdam' params (Variable var _) (Variable m _) (Variable v _) = + CoreOps.resourceApplyAdam' params var m v diff --git a/tensorflow-ops.cabal b/tensorflow-ops.cabal --- a/tensorflow-ops.cabal +++ b/tensorflow-ops.cabal @@ -1,5 +1,5 @@ name: tensorflow-ops -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Friendly layer around TensorFlow bindings. description: Please see README.md homepage: https://github.com/tensorflow/haskell#readme @@ -17,6 +17,7 @@ exposed-modules: TensorFlow.Gradient , TensorFlow.Ops , TensorFlow.EmbeddingOps + , TensorFlow.Minimize , TensorFlow.NN , TensorFlow.Queue , TensorFlow.Variable @@ -28,9 +29,9 @@ , data-default , lens-family , containers - , tensorflow == 0.1.* - , tensorflow-proto == 0.1.* - , tensorflow-core-ops == 0.1.* + , tensorflow == 0.2.* + , tensorflow-proto == 0.2.* + , tensorflow-core-ops == 0.2.* , text default-language: Haskell2010 @@ -187,8 +188,10 @@ hs-source-dirs: tests build-depends: HUnit , base + , bytestring , proto-lens , lens-family + , random , tensorflow , tensorflow-core-ops , tensorflow-ops diff --git a/tests/GradientTest.hs b/tests/GradientTest.hs --- a/tests/GradientTest.hs +++ b/tests/GradientTest.hs @@ -19,6 +19,7 @@ import Data.Int (Int32, Int64) import Data.List (sort) +import qualified Data.List as List import Data.ProtoLens.TextFormat (showMessage) import Test.Framework (defaultMain, Test) import Lens.Family2 ((^..), (.~)) @@ -26,18 +27,23 @@ import Test.Framework.Providers.HUnit (testCase) import Test.HUnit ((@=?), assertEqual) import qualified Data.Vector as V +import System.Random (randomIO, randomRIO) +import Control.Monad(forM_, replicateM, zipWithM) import Control.Monad.IO.Class (liftIO) import qualified TensorFlow.Core as TF -import qualified TensorFlow.GenOps.Core as TF (max, tile) +import qualified TensorFlow.GenOps.Core as TF (conv2DBackpropInput', max, maximum, tile) import qualified TensorFlow.Gradient as TF -import qualified TensorFlow.Ops as TF +import qualified TensorFlow.Ops as TF hiding (zeroInitializedVariable) import qualified TensorFlow.Output as TF import qualified TensorFlow.Types as TF +import qualified TensorFlow.Variable as TF import Proto.Tensorflow.Core.Framework.Graph (node) import Proto.Tensorflow.Core.Framework.NodeDef (op) +import qualified Data.ByteString.Char8 as BS + testGradientSimple :: Test testGradientSimple = testCase "testGradientSimple" $ do let grads = do @@ -155,6 +161,15 @@ (4 :: Float) @=? TF.unScalar dx +testAddNGradient :: Test +testAddNGradient = testCase "testAddNGradient" $ do + [dx] <- TF.runSession $ do + x <- TF.render $ TF.vector [1, 2, 0 :: Float] + let y = TF.addN [x, x] + TF.gradients y [x] >>= TF.run + V.fromList [2, 2, 2 :: Float] @=? dx + + testMaxGradient :: Test testMaxGradient = testCase "testMaxGradient" $ do [dx] <- TF.runSession $ do @@ -163,7 +178,93 @@ TF.gradients y [x] >>= TF.run V.fromList [0, 0, 1, 0, 0 :: Float] @=? dx +testConcatGradient :: Test +testConcatGradient = testCase "testConcatGradient" $ do + [dv,dv'] <- TF.runSession $ do + v <- TF.render $ TF.vector [1 :: Float] + v' <- TF.render $ TF.vector [2 :: Float] + let y = TF.concat (TF.scalar 0) [ v, v' ] + TF.gradients y [v,v'] >>= TF.run + V.fromList [1 :: Float] @=? dv + V.fromList [1 :: Float] @=? dv' + [dw,dw'] <- TF.runSession $ do + w <- TF.render $ TF.vector [1,2,3,4 :: Float] + w' <- TF.render $ TF.vector [5,6,7,8 :: Float] + let y = TF.concat (TF.scalar 0) [ w, w', w ] + TF.gradients y [w,w'] >>= TF.run + V.fromList [2,2,2,2 :: Float] @=? dw + V.fromList [1,1,1,1 :: Float] @=? dw' +verifyConcatGradients :: [[Int64]] -> Int32 -> IO () +verifyConcatGradients shapes concatDim = do + let floatsFromShape :: [Int64] -> IO [Float] + floatsFromShape shape = replicateM (fromIntegral $ List.product shape) randomIO + constantZip = zipWithM $ \x shape -> TF.render $ TF.constant (TF.Shape shape) x + inputGrads <- mapM floatsFromShape shapes + inputs <- mapM floatsFromShape shapes + dinputs <- TF.runSession $ do + inputTensors <- inputs `constantZip` shapes + inputGradTensors <- inputGrads `constantZip` shapes + inputTensor <- TF.render $ TF.concat (TF.scalar concatDim) inputTensors + inputGradTensor <- TF.render $ TF.concat (TF.scalar concatDim) inputGradTensors + output <- TF.render $ inputTensor `TF.mul` inputGradTensor + TF.gradients output inputTensors >>= TF.run + (V.fromList <$> inputGrads) @=? dinputs + +-- This test checks that the gradient of a concat op +-- is correct along the first, second, and third dimension. +testConcatGradientSimple :: Test +testConcatGradientSimple = testCase "testConcatGradientSimple" $ do + -- The following check is equivalent to ConcatTest._testGradientsSimple from + -- tensorflow/tensorflow/compiler/tests/concat_ops_test.py + verifyConcatGradients [[10,x,2] | x <- [1,2,6]] 1 + -- The following check is equivalent to ConcatTest._testGradientsFirstDim from + -- tensorflow/tensorflow/compiler/tests/concat_ops_test.py + verifyConcatGradients [[x,10,2] | x <- [1,2,6]] 0 + -- The following check is equivalent to ConcatTest._testGradientsLastDim from + -- tensorflow/tensorflow/compiler/tests/concat_ops_test.py + verifyConcatGradients [[10,2,x] | x <- [1,2,6]] 2 + + +-- This test checks that the gradient of a concat op +-- along a random dimension across random shapes is as expected. +-- This test is inspired by ConcatTest._RunAndVerifyGradientsRandom from +-- tensorflow/tensorflow/compiler/tests/concat_ops_test.py, but also +-- verifies the gradient along negative concat dimensions. +testConcatRunAndVerifyGradientsRandom :: Test +testConcatRunAndVerifyGradientsRandom = testCase "testConcatRunAndVerifyGradientsRandom" $ + forM_ [1..5 :: Int] $ \_ -> do + (shapes' :: [Int64]) <- replicateM 5 $ randomRIO (1, 5) + (numTensors :: Int) <- randomRIO (2, 10) + (concatDim :: Int) <- randomRIO (-4, 4) + (concatDimSizes :: [Int64]) <- replicateM numTensors $ randomRIO (1, 5) + let update i xs x = take i xs ++ x: drop (i+1) xs + concatDim' = concatDim `mod` length shapes' + shapes = map (update concatDim' shapes') concatDimSizes + verifyConcatGradients shapes $ fromIntegral concatDim + +-- run single test like this: +-- stack --docker --docker-image=$IMAGE_NAME test tensorflow-ops:GradientTest --test-arguments -t"*MaximumGrad*" +testMaximumGrad :: Test +testMaximumGrad = testCase "testMaximumGrad" $ do + [gx, gy] <- TF.runSession $ do + x <- TF.render $ TF.vector [0 :: Float] + y <- TF.render $ TF.vector [0 :: Float] + let z = TF.maximum x y + TF.gradients z [x, y] >>= TF.run + V.fromList [1] @=? gx + V.fromList [1] @=? gy + +testMaximumGradGrad :: Test +testMaximumGradGrad = testCase "testMaximumGradGrad" $ do + [ggx] <- TF.runSession $ do + x <- TF.render $ TF.vector [2 :: Float] + y <- TF.render $ TF.vector [1 :: Float] + let z = TF.maximum x y + [gx, _gy] <- TF.gradients z [x, y] + TF.gradients gx [x] >>= TF.run + V.fromList [0] @=? ggx + testReluGrad :: Test testReluGrad = testCase "testReluGrad" $ do [dx] <- TF.runSession $ do @@ -181,7 +282,6 @@ TF.gradients y' [x] >>= TF.run V.fromList [0] @=? dx - testFillGrad :: Test testFillGrad = testCase "testFillGrad" $ do [dx] <- TF.runSession $ do @@ -215,14 +315,13 @@ shapeX @=? (shapeDX :: V.Vector Int32) V.fromList [6, 6, 6, 6, 6, 6::Float] @=? (dx :: V.Vector Float) - matMulGradient :: Test matMulGradient = testCase "matMulGradients" $ do let dfBuild = do x <- TF.render $ TF.zeros $ TF.Shape [3, 1 :: Int64] w <- TF.zeroInitializedVariable $ TF.Shape [1, 2 :: Int64] - let f = x `TF.matMul` w :: TF.Tensor TF.Build Float + let f = x `TF.matMul` TF.readValue w :: TF.Tensor TF.Build Float dfs <- TF.gradients f [x] return (x, dfs) @@ -242,11 +341,11 @@ let tower = do x <- TF.render $ TF.zeros $ TF.Shape [batch, 1] w <- TF.zeroInitializedVariable $ TF.Shape [1, width] - let f = x `TF.matMul` w + let f = x `TF.matMul` TF.readValue w [dfdx] <- TF.gradients f [x] let f'x = TF.reduceSum dfdx [dfdw] <- TF.gradients f'x [w] -- take gradient again (this time over w) - return [TF.value w, dfdw] + return [TF.readValue w, TF.expr dfdw] TF.runSession $ do [w, dfdw] <- TF.build tower @@ -255,12 +354,12 @@ let step = w `TF.add` dfdw w0 <- TF.run step - liftIO $ ((V.fromList [4, 4 :: Float]) @=? w0) + liftIO $ V.fromList [4, 4 :: Float] @=? w0 -- test that gradient of matMul deals correctly with transpose_a and transpose_b matMulTransposeGradient :: (Bool, Bool) -> Test -matMulTransposeGradient txw = testCase ("matMulTransposeGradients " ++ (show txw)) $ do +matMulTransposeGradient txw = testCase ("matMulTransposeGradients " ++ show txw) $ do let (transposeX, transposeW) = txw let dfBuild = do @@ -268,7 +367,7 @@ let xZeros = TF.zeros xShape x <- TF.render $ if transposeX then TF.matTranspose xZeros else xZeros variable <- TF.zeroInitializedVariable $ TF.Shape [1, 2 :: Int64] - let wv = if transposeW then TF.matTranspose variable else TF.expr variable + let wv = if transposeW then TF.matTranspose (TF.readValue variable) else TF.readValue variable let f = TF.matMul' (transAttrs transposeX transposeW) x wv :: TF.Tensor TF.Build Float w <- TF.render wv ds <- TF.gradients f [x, w] @@ -290,6 +389,28 @@ transAttrs a b = (TF.opAttr "transpose_a" .~ a) . (TF.opAttr "transpose_b" .~ b) +testConv2DBackpropInputGrad :: Test +testConv2DBackpropInputGrad = testCase "testConv2DBackpropInputGrad" $ do + (dx, shapeDX, shapeX) <- TF.runSession $ do + let conv_input_shape = TF.vector [1, 2, 2, 1 :: Int32] -- [batch, h, w, in_channels] + let conv_out_shape = TF.vector [1, 1, 1, 1 :: Int32] -- [batch, h, w, out_channels] + x <- TF.render $ TF.fill conv_out_shape (TF.scalar (1::Float)) + + let filterShape = TF.vector [2, 2, 1, 1 :: Int32] -- [fh, fw, inc, out] + filter' <- TF.render $ TF.fill filterShape (TF.scalar (1::Float)) + let y = TF.conv2DBackpropInput' + ( (TF.opAttr "strides" .~ [1::Int64, 1, 1, 1]) + . (TF.opAttr "padding" .~ (BS.pack "VALID")) + . (TF.opAttr "data_format" .~ (BS.pack "NHWC")) + ) + conv_input_shape filter' x + + [dx] <- TF.gradients y [x] + TF.run (dx, TF.shape dx, TF.shape x) + shapeX @=? (shapeDX :: V.Vector Int32) + V.fromList [4::Float] @=? (dx :: V.Vector Float) + + main :: IO () main = defaultMain [ testGradientSimple @@ -297,7 +418,13 @@ , testCreateGraphStateful , testCreateGraphNameScopes , testDiamond + , testAddNGradient , testMaxGradient + , testConcatGradient + , testConcatGradientSimple + , testConcatRunAndVerifyGradientsRandom + , testMaximumGrad + , testMaximumGradGrad , testReluGrad , testReluGradGrad , testFillGrad @@ -309,4 +436,5 @@ , matMulTransposeGradient (False, True) , matMulTransposeGradient (True, False) , matMulTransposeGradient (True, True) + , testConv2DBackpropInputGrad ] diff --git a/tests/MatrixTest.hs b/tests/MatrixTest.hs --- a/tests/MatrixTest.hs +++ b/tests/MatrixTest.hs @@ -2,13 +2,14 @@ {-# LANGUAGE OverloadedLists #-} import Control.Monad.IO.Class (liftIO) -import Control.Monad (replicateM_, zipWithM) +import Control.Monad (replicateM_) -import qualified TensorFlow.GenOps.Core as TF (square, rank) -import qualified TensorFlow.Core as TF -import qualified TensorFlow.Gradient as TF -import qualified TensorFlow.Ops as TF import qualified Data.Vector as V +import qualified TensorFlow.Core as TF +import qualified TensorFlow.GenOps.Core as TF (square) +import qualified TensorFlow.Minimize as TF +import qualified TensorFlow.Ops as TF hiding (initializedVariable) +import qualified TensorFlow.Variable as TF import Test.Framework (defaultMain, Test) import Test.Framework.Providers.HUnit (testCase) @@ -17,31 +18,19 @@ randomParam :: TF.Shape -> TF.Session (TF.Tensor TF.Value Float) randomParam (TF.Shape shape) = TF.truncatedNormal (TF.vector shape) -reduceMean :: TF.Tensor v Float -> TF.Tensor TF.Build Float -reduceMean xs = TF.mean xs (TF.range 0 (TF.rank xs) 1) - fitMatrix :: Test fitMatrix = testCase "fitMatrix" $ TF.runSession $ do u <- TF.initializedVariable =<< randomParam [2, 1] v <- TF.initializedVariable =<< randomParam [1, 2] let ones = [1, 1, 1, 1] :: [Float] matx = TF.constant [2, 2] ones - diff = matx `TF.sub` (u `TF.matMul` v) - loss = reduceMean $ TF.square diff - trainStep <- gradientDescent 0.01 loss [u, v] + diff = matx `TF.sub` (TF.readValue u `TF.matMul` TF.readValue v) + loss = TF.reduceMean $ TF.square diff + trainStep <- TF.minimizeWith (TF.gradientDescent 0.01) loss [u, v] replicateM_ 1000 (TF.run trainStep) - (u',v') <- TF.run (u, v) + (u',v') <- TF.run (TF.readValue u, TF.readValue v) -- ones = u * v liftIO $ assertAllClose (V.fromList ones) ((*) <$> u' <*> v') - -gradientDescent :: Float - -> TF.Tensor TF.Build Float - -> [TF.Tensor TF.Ref Float] - -> TF.Session TF.ControlNode -gradientDescent alpha loss params = do - let applyGrad param grad = - TF.assign param (param `TF.sub` (TF.scalar alpha `TF.mul` grad)) - TF.group =<< zipWithM applyGrad params =<< TF.gradients loss params main :: IO () main = defaultMain [ fitMatrix ] diff --git a/tests/RegressionTest.hs b/tests/RegressionTest.hs --- a/tests/RegressionTest.hs +++ b/tests/RegressionTest.hs @@ -1,13 +1,14 @@ -- | Simple linear regression example for the README. -import Control.Monad (replicateM, replicateM_, zipWithM) +import Control.Monad (replicateM, replicateM_) import System.Random (randomIO) import Test.HUnit (assertBool) import qualified TensorFlow.Core as TF import qualified TensorFlow.GenOps.Core as TF -import qualified TensorFlow.Gradient as TF -import qualified TensorFlow.Ops as TF +import qualified TensorFlow.Minimize as TF +import qualified TensorFlow.Ops as TF hiding (initializedVariable) +import qualified TensorFlow.Variable as TF main :: IO () main = do @@ -28,20 +29,11 @@ w <- TF.initializedVariable 0 b <- TF.initializedVariable 0 -- Define the loss function. - let yHat = (x `TF.mul` w) `TF.add` b + let yHat = (x `TF.mul` TF.readValue w) `TF.add` TF.readValue b loss = TF.square (yHat `TF.sub` y) -- Optimize with gradient descent. - trainStep <- gradientDescent 0.001 loss [w, b] + trainStep <- TF.minimizeWith (TF.gradientDescent 0.001) loss [w, b] replicateM_ 1000 (TF.run trainStep) -- Return the learned parameters. - (TF.Scalar w', TF.Scalar b') <- TF.run (w, b) + (TF.Scalar w', TF.Scalar b') <- TF.run (TF.readValue w, TF.readValue b) return (w', b') - -gradientDescent :: Float - -> TF.Tensor TF.Build Float - -> [TF.Tensor TF.Ref Float] - -> TF.Session TF.ControlNode -gradientDescent alpha loss params = do - let applyGrad param grad = - TF.assign param (param `TF.sub` (TF.scalar alpha `TF.mul` grad)) - TF.group =<< zipWithM applyGrad params =<< TF.gradients loss params diff --git a/tests/VariableTest.hs b/tests/VariableTest.hs --- a/tests/VariableTest.hs +++ b/tests/VariableTest.hs @@ -1,6 +1,9 @@ {-# LANGUAGE OverloadedLists #-} module Main (main) where +import Data.Int (Int32) +import Data.Maybe (isJust) +import Control.Monad (when) import Control.Monad.IO.Class (liftIO) import qualified Data.Vector.Storable as V import TensorFlow.Core @@ -12,7 +15,9 @@ , withControlDependencies) import qualified TensorFlow.Ops as Ops import TensorFlow.Variable - ( readValue + ( Variable + , readValue + , initializedValue , initializedVariable , assign , assignAdd @@ -20,12 +25,13 @@ ) import Test.Framework (defaultMain, Test) import Test.Framework.Providers.HUnit (testCase) -import Test.HUnit ((@=?)) +import Test.HUnit ((@=?), assertFailure) main :: IO () main = defaultMain [ testInitializedVariable , testInitializedVariableShape + , testInitializedValue , testDependency , testRereadRef , testAssignAdd @@ -50,6 +56,20 @@ vector <- initializedVariable (Ops.constant [1] [42 :: Float]) result <- run (readValue vector) liftIO $ [42] @=? (result :: V.Vector Float) + s <- run (Ops.shape (readValue vector)) + liftIO $ [1] @=? (s :: V.Vector Int32) + +testInitializedValue :: Test +testInitializedValue = + testCase "testInitializedValue" $ runSession $ do + initialized <- initializedVariable (Ops.constant [1] [42 :: Float]) + result <- run (initializedValue initialized) + liftIO $ Just [42] @=? (result :: Maybe (V.Vector Float)) + + uninitialized <- variable [1] + -- Can't use @=? because there is no Show instance for Tensor. + when (isJust (initializedValue (uninitialized :: Variable Float))) $ + liftIO $ assertFailure "initializedValue should be Nothing, got Just" testDependency :: Test testDependency =