diff --git a/stack.yaml b/stack.yaml index 06e9ce1..862882a 100644 --- a/stack.yaml +++ b/stack.yaml @@ -10,6 +10,7 @@ packages: - tensorflow-mnist - tensorflow-mnist-input-data - tensorflow-queue +- tensorflow-nn extra-deps: # proto-lens is not yet in Stackage. diff --git a/tensorflow-nn/Setup.hs b/tensorflow-nn/Setup.hs new file mode 100644 index 0000000..e8ef27d --- /dev/null +++ b/tensorflow-nn/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/tensorflow-nn/src/TensorFlow/NN.hs b/tensorflow-nn/src/TensorFlow/NN.hs new file mode 100644 index 0000000..5cb5fda --- /dev/null +++ b/tensorflow-nn/src/TensorFlow/NN.hs @@ -0,0 +1,87 @@ +-- 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 DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} + +module TensorFlow.NN + ( sigmoidCrossEntropyWithLogits + ) where + +import Prelude hiding ( log + , exp + ) +import TensorFlow.Build ( Build(..) + , render + , withNameScope + ) +import TensorFlow.GenOps.Core ( greaterEqual + , select + , log + , exp + ) +import TensorFlow.Tensor ( Tensor(..) + , Value(..) + ) +import TensorFlow.Types ( TensorType(..) + , OneOf + ) +import TensorFlow.Ops ( zerosLike + , add + ) + +-- | Computes sigmoid cross entropy given `logits`. +-- +-- Measures the probability error in discrete classification tasks in which each +-- class is independent and not mutually exclusive. For instance, one could +-- perform multilabel classification where a picture can contain both an elephant +-- and a dog at the same time. +-- +-- For brevity, let `x = logits`, `z = targets`. The logistic loss is +-- +-- z * -log(sigmoid(x)) + (1 - z) * -log(1 - sigmoid(x)) +-- = z * -log(1 / (1 + exp(-x))) + (1 - z) * -log(exp(-x) / (1 + exp(-x))) +-- = z * log(1 + exp(-x)) + (1 - z) * (-log(exp(-x)) + log(1 + exp(-x))) +-- = z * log(1 + exp(-x)) + (1 - z) * (x + log(1 + exp(-x)) +-- = (1 - z) * x + log(1 + exp(-x)) +-- = x - x * z + log(1 + exp(-x)) +-- +-- For x < 0, to avoid overflow in exp(-x), we reformulate the above +-- +-- x - x * z + log(1 + exp(-x)) +-- = log(exp(x)) - x * z + log(1 + exp(-x)) +-- = - x * z + log(1 + exp(x)) +-- +-- Hence, to ensure stability and avoid overflow, the implementation uses this +-- equivalent formulation +-- +-- max(x, 0) - x * z + log(1 + exp(-abs(x))) +-- +-- `logits` and `targets` must have the same type and shape. +sigmoidCrossEntropyWithLogits + :: (OneOf '[Float, Double] a, TensorType a, Num a) + => Tensor Value a -- ^ __logits__ + -> Tensor Value a -- ^ __targets__ + -> Build (Tensor Value a) +sigmoidCrossEntropyWithLogits logits targets = do + logits' <- render logits + targets' <- render targets + let zeros = zerosLike logits' + cond = logits' `greaterEqual` zeros + relu_logits = select cond logits' zeros + neg_abs_logits = select cond (-logits') logits' + withNameScope "logistic_loss" $ do + left <- render $ relu_logits - logits' * targets' + right <- render $ log (1 + exp neg_abs_logits) + withNameScope "sigmoid_add" $ render $ left `add` right diff --git a/tensorflow-nn/tensorflow-nn.cabal b/tensorflow-nn/tensorflow-nn.cabal new file mode 100644 index 0000000..de029b9 --- /dev/null +++ b/tensorflow-nn/tensorflow-nn.cabal @@ -0,0 +1,44 @@ +name: tensorflow-nn +version: 0.1.0.0 +synopsis: Friendly layer around TensorFlow bindings. +description: Please see README.md +homepage: https://github.com/tensorflow/haskell#readme +license: Apache +author: TensorFlow authors +maintainer: tensorflow-haskell@googlegroups.com +copyright: Google Inc. +category: Machine Learning +build-type: Simple +cabal-version: >=1.22 + +library + hs-source-dirs: src + exposed-modules: TensorFlow.NN + build-depends: base >= 4.7 && < 5 + , tensorflow-core-ops == 0.1.* + , tensorflow == 0.1.* + , tensorflow-ops == 0.1.* + default-language: Haskell2010 + + +Test-Suite NNTest + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: NNTest.hs + hs-source-dirs: tests + build-depends: HUnit + , QuickCheck + , base + , tensorflow + , tensorflow-ops + , tensorflow-nn + , google-shim + , test-framework + , test-framework-hunit + , test-framework-quickcheck2 + , vector + + +source-repository head + type: git + location: https://github.com/tensorflow/haskell diff --git a/tensorflow-nn/tests/NNTest.hs b/tensorflow-nn/tests/NNTest.hs new file mode 100644 index 0000000..acc09f0 --- /dev/null +++ b/tensorflow-nn/tests/NNTest.hs @@ -0,0 +1,119 @@ +-- 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 OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} + +module Main where + +import Data.Maybe (fromMaybe) +import Google.Test (googleTest) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit ((@?)) +import Test.HUnit.Lang (Assertion(..)) +import qualified Data.Vector as V +import qualified TensorFlow.Build as TF +import qualified TensorFlow.Gradient as TF +import qualified TensorFlow.NN as TF +import qualified TensorFlow.Ops as TF +import qualified TensorFlow.Session as TF +import qualified TensorFlow.Tensor as TF +import qualified TensorFlow.Types as TF + +-- | These tests are ported from: +-- +-- /tensorflow/python/ops/nn_xent_tests.py +-- +-- This is the implementation we use to check the implementation we +-- wrote in `TensorFlow.NN.sigmoidCrossEntropyWithLogits`. +-- +sigmoidXentWithLogits :: Floating a => Ord a => [a] -> [a] -> [a] +sigmoidXentWithLogits logits' targets' = + let sig = map (\x -> 1 / (1 + exp (-x))) logits' + eps = 0.0001 + pred = map (\p -> min (max p eps) (1 - eps)) sig + xent y z = (-z) * (log y) - (1 - z) * log (1 - y) + in zipWith xent pred targets' + + +data Inputs = Inputs { + logits :: [Float] + , targets :: [Float] + } + + +defInputs :: Inputs +defInputs = Inputs { + logits = [-100, -2, -2, 0, 2, 2, 2, 100] + , targets = [ 0, 0, 1, 0, 0, 1, 0.5, 1] + } + + +assertAllClose :: V.Vector Float -> V.Vector Float -> Assertion +assertAllClose xs ys = all (<= tol) (V.zipWith absDiff xs ys) @? + ("Difference > tolerance: \nxs: " ++ show xs ++ "\nys: " ++ show ys + ++ "\ntolerance: " ++ show tol) + where + absDiff x y = abs (x - y) + tol = 0.001 :: Float + + +testLogisticOutput = testCase "testLogisticOutput" $ do + let inputs = defInputs + vLogits = TF.vector $ logits inputs + vTargets = TF.vector $ targets inputs + tfLoss = TF.sigmoidCrossEntropyWithLogits vLogits vTargets + ourLoss = V.fromList $ sigmoidXentWithLogits (logits inputs) (targets inputs) + + r <- run tfLoss + assertAllClose r ourLoss + + +testLogisticOutputMultipleDim = + testCase "testLogisticOutputMultipleDim" $ do + let inputs = defInputs + shape = [2, 2, 2] + vLogits = TF.constant shape (logits inputs) + vTargets = TF.constant shape (targets inputs) + tfLoss = TF.sigmoidCrossEntropyWithLogits vLogits vTargets + ourLoss = V.fromList $ sigmoidXentWithLogits (logits inputs) (targets inputs) + + r <- run tfLoss + assertAllClose r ourLoss + + +testGradientAtZero = testCase "testGradientAtZero" $ do + let inputs = defInputs { logits = [0, 0], targets = [0, 1] } + vLogits = TF.vector $ logits inputs + vTargets = TF.vector $ targets inputs + tfLoss = TF.sigmoidCrossEntropyWithLogits vLogits vTargets + + r <- run $ do + l <- tfLoss + TF.gradients l [vLogits] + + assertAllClose (head r) (V.fromList [0.5, -0.5]) + + +run = TF.runSession . TF.buildAnd TF.run + + +main :: IO () +main = googleTest [ testLogisticOutput + , testLogisticOutputMultipleDim + , testGradientAtZero + ]