This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Compute the minimize_op. | |
params = model.trainable_variables | |
grads = optimizer.get_gradients(total_loss, params) | |
grads_and_vars = list(zip(grads, params)) | |
for gradient, variable in grads_and_vars: | |
var_name = variable.name.replace(":", "_") | |
tensorboard.summary.histogram(f"gradients/{var_name}", gradient) | |
tensorboard.summary.scalar(f"gradient_norm/{var_name}", tf.global_norm([gradient])) | |
minimize_op = optimizer.apply_gradients(grads_and_vars) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import six | |
import tensorflow as tf | |
from tensorflow.python.framework import ops | |
from tensorflow.python.training import training_util | |
from tensorflow.python.training.session_run_hook import SessionRunArgs | |
class RayTuneReportingHook(tf.train.SessionRunHook): | |
def __init__(self, params, reporter): | |
self.reporter = reporter |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE ScopedTypeVariables #-} | |
import Control.Applicative | |
import Data.Array.Accelerate as A | |
import Data.Array.Accelerate.CUDA | |
import qualified Data.Array.Accelerate.Interpreter as I | |
import Data.Array.Accelerate.Pretty | |
import Data.Array.Unboxed | |
import qualified Data.List as L | |
import System.Random |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE GeneralizedNewtypeDeriving #-} | |
import Control.Concurrent.STM | |
newtype Money = Money Int deriving (Show, Num, Ord, Eq) | |
data Account = Account{ | |
aBalance :: Money, | |
aAccountId :: Int | |
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- | when no catch frame handles an exception dump core and terminate the process | |
uncaughtExceptionHandler :: SomeException -> IO () | |
{-# NOINLINE uncaughtExceptionHandler #-} | |
uncaughtExceptionHandler !e = do | |
syslog Error $ "Unhandled exception: " ++ show e | |
raiseSignal sigABRT | |
setDefaultUncaughtExceptionHandler :: IO () | |
setDefaultUncaughtExceptionHandler = | |
setUncaughtExceptionHandler uncaughtExceptionHandler |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE DeriveDataTypeable #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
{-# LANGUAGE TemplateHaskell #-} | |
import Control.DeepSeq | |
import Control.DeepSeq.TH | |
import Control.Exception | |
import Data.Typeable | |
import Prelude hiding (catch) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
data MyRecord = MyRecord{ | |
mrField :: [Text] | |
} | |
(do | |
some operations... | |
return $ MyRecord $ fmap (decodeUtf8) listOfByteStrings) | |
`safeCatch` | |
myHandler |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
safeCatch :: (Exception e, NFData a) => IO a -> (e -> IO a) -> IO a | |
safeCatch func handler = catch eval handler where | |
eval = do | |
x <- func | |
rnf x `seq` return $! x |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
data MyRecord = MyRecord{ | |
mrField :: [Text] | |
} | |
(do | |
some operations... | |
return $ MyRecord $ fmap (decodeUtf8) listOfByteStrings) | |
`catch` | |
myHandler |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE ScopedTypeVariables #-} | |
import Control.Exception | |
import Prelude hiding (catch) | |
iThrowExceptions :: Int | |
iThrowExceptions = error "I am a slippery exception" | |
data Record = Record Int deriving (Show) | |
main :: IO () | |
main = do |