dvda 0.3.0.1 → 0.3.1

raw patch · 6 files changed

+85/−42 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Dvda.hs +4/−1
• Dvda/AD.hs +5/−5
• Dvda/Expr.hs +43/−27
• Dvda/FunGraph.hs +12/−0
• Dvda/Vis.hs +20/−8
• dvda.cabal +1/−1

@@ -17,8 +17,10 @@             , Expr               -- * construct FunGraphs             , toFunGraph+            , cse               -- * show/summarize FunGraphs             , previewGraph+            , previewGraph'               -- * compile and link function --            , buildHSFunction --            , buildHSFunctionPure@@ -28,7 +30,8 @@             ) where  import Dvda.AD ( rad )+import Dvda.CSE ( cse ) import Dvda.Expr ( Expr, sym, symDependent, symDependentN ) import Dvda.FunGraph ( toFunGraph, (:*)(..) )-import Dvda.Vis ( previewGraph )+import Dvda.Vis ( previewGraph, previewGraph' ) --import Dvda.HSBuilder

@@ -14,7 +14,7 @@ --fad :: Num a => (Dual a -> [Dual a]) -> a -> [a] --fad f x = map dualPerturbation $ f (Dual x 1) -bpBinary :: (Eq a, Num a)+bpBinary :: (Ord a, Num a)             => Expr a -> Expr a -> Expr a             -> (Dual (Expr a) -> Dual (Expr a) -> Dual (Expr a))             -> [(Expr a, Expr a)]@@ -25,7 +25,7 @@     gsens = backpropNode (sens*dfdg) g     hsens = backpropNode (sens*dfdh) h -bpUnary :: (Eq a, Num a)+bpUnary :: (Ord a, Num a)            => Expr a -> Expr a            -> (Dual (Expr a) -> Dual (Expr a))            -> [(Expr a, Expr a)]@@ -33,7 +33,7 @@   where     dfdg = dualPerturbation $ unop (Dual g 1) -backpropNode :: (Eq a, Num a) => Expr a -> Expr a -> [(Expr a, Expr a)]+backpropNode :: (Ord a, Num a) => Expr a -> Expr a -> [(Expr a, Expr a)] backpropNode sens e@(ESym (SymDependent name k dep_)) = (e,sens):(backpropNode (sens*primal') dep)   where     primal' = ESym (SymDependent name (k+1) dep_)@@ -65,10 +65,10 @@ backpropNode sens (EFloating (ATanh x)) = bpUnary sens x atanh backpropNode sens (EFloating (ACosh x)) = bpUnary sens x acosh -backprop :: (Num a, Eq a, Hashable a) => Expr a -> HashMap (Expr a) (Expr a)+backprop :: (Num a, Ord a, Hashable a) => Expr a -> HashMap (Expr a) (Expr a) backprop x = HM.fromListWith (+) (backpropNode 1 x) -rad :: (Num a, Eq a, Hashable a) => Expr a -> [Expr a] -> [Expr a]+rad :: (Num a, Ord a, Hashable a) => Expr a -> [Expr a] -> [Expr a] rad x args = map (\arg -> HM.lookupDefault 0 arg sensitivities) args   where     sensitivities = backprop x

@@ -44,7 +44,7 @@  data Sym = Sym String                  -- doesn't depend on independent variable, or is an independent variable          | SymDependent String Int Sym -- depends on independent variable, Int specifies the nth derivative-           deriving Eq+           deriving (Eq, Ord)  instance Show Sym where   show (Sym name) = name@@ -63,10 +63,10 @@             | Negate a             | Abs a             | Signum a-            | FromInteger Integer+            | FromInteger Integer deriving Ord  data Fractionals a = Div a a-                   | FromRational Rational deriving Eq+                   | FromRational Rational deriving (Eq, Ord)  data Floatings a = Pow a a                  | LogBase a a@@ -82,7 +82,7 @@                  | Tanh a                  | ASinh a                  | ATanh a-                 | ACosh a deriving Eq+                 | ACosh a deriving (Eq, Ord)  deriving instance Data Sym deriving instance Data a => Data (Nums a)@@ -235,7 +235,18 @@ --deriving instance Enum a => Enum (Floatings a) --deriving instance Bounded a => Bounded (Floatings a) -instance (Num a, Eq a) => Num (Expr a) where+fromNeg :: (Num a, Ord a) => Expr a -> Maybe (Expr a)+fromNeg (ENum (Negate x)) = Just x+fromNeg (ENum (FromInteger k))+  | k < 0 = Just (ENum (FromInteger (abs k)))+fromNeg (EFractional (FromRational r))+  | r < 0 = Just (EFractional (FromRational (abs r)))+fromNeg (EConst c)+  | c < 0 = Just (EConst (abs c))+fromNeg _ = Nothing+++instance (Num a, Ord a) => Num (Expr a) where   (*) (EConst x) (EConst y) = EConst (x*y)   (*) (ENum (FromInteger kx)) (ENum (FromInteger ky)) = ENum $ FromInteger (kx * ky)   (*) (EFractional (FromRational rx)) (EFractional (FromRational ry)) = EFractional $ FromRational (rx * ry)@@ -245,14 +256,15 @@   (*) (EFractional (FromRational rx)) (EConst y) = EConst $ fromRational rx * y   (*) (ENum (FromInteger kx)) (EFractional (FromRational ry)) = EFractional $ FromRational (fromInteger kx * ry)   (*) (EFractional (FromRational rx)) (ENum (FromInteger ky)) = EFractional $ FromRational (rx * fromInteger ky)-  (*) (ENum (Negate x)) (ENum (Negate y)) = x * y-  (*) (ENum (Negate x)) y = negate (x * y)-  (*) x (ENum (Negate y)) = negate (x * y)   (*) x y     | isVal 0 x || isVal 0 y = 0     | isVal 1 x = y     | isVal 1 y = x-    | otherwise = ENum $ Mul x y+  (*) x y = case (fromNeg x, fromNeg y) of+              (Just x', Just y') -> x' * y'+              (Nothing, Just y') -> negate (x  * y')+              (Just x', Nothing) -> negate (x' * y )+              _ -> ENum $ Mul x y    (+) (EConst x) (EConst y) = EConst (x+y)   (+) (ENum (FromInteger kx)) (ENum (FromInteger ky)) = ENum $ FromInteger (kx + ky)@@ -263,14 +275,15 @@   (+) (EFractional (FromRational rx)) (EConst y) = EConst $ fromRational rx + y   (+) (ENum (FromInteger kx)) (EFractional (FromRational ry)) = EFractional $ FromRational (fromInteger kx + ry)   (+) (EFractional (FromRational rx)) (ENum (FromInteger ky)) = EFractional $ FromRational (rx + fromInteger ky)-  (+) (ENum (Negate x)) (ENum (Negate y)) = negate (x + y)-  (+) x (ENum (Negate y)) = x - y-  (+) (ENum (Negate x)) y = y - x   (+) x y     | isVal 0 x = y     | isVal 0 y = x     | x == negate y = 0-    | otherwise = ENum $ Add x y+  (+) x y = case (fromNeg x, fromNeg y) of+              (Just x', Just y') -> negate (x' + y')+              (Nothing, Just y') -> x  - y'+              (Just x', Nothing) -> y  - x'+              _ -> ENum $ Add x y    (-) (EConst x) (EConst y) = EConst (x-y)   (-) (ENum (FromInteger kx)) (ENum (FromInteger ky)) = ENum $ FromInteger (kx - ky)@@ -281,19 +294,21 @@   (-) (EFractional (FromRational rx)) (EConst y) = EConst $ fromRational rx - y   (-) (ENum (FromInteger kx)) (EFractional (FromRational ry)) = EFractional $ FromRational (fromInteger kx - ry)   (-) (EFractional (FromRational rx)) (ENum (FromInteger ky)) = EFractional $ FromRational (rx - fromInteger ky)-  (-) (ENum (Negate x)) (ENum (Negate y)) = y - x -- (-x) - (-y) == y - x-  (-) x (ENum (Negate y)) = x + y -- (x) - (-y) == x + y-  (-) (ENum (Negate x)) y = negate (x + y) -- (-x) - (y) == -(x+y)   (-) x y     | isVal 0 x = negate y     | isVal 0 y = x     | x == y = 0-    | otherwise = ENum $ Sub x y+  (-) x y = case (fromNeg x, fromNeg y) of+              (Just x', Just y') -> y' - x' -- (-x) - (-y) == y - x+              (Nothing, Just y') -> x + y' -- (x) - (-y) == x + y+              (Just x', Nothing) -> negate (x' + y) -- (-x) - (y) == -(x+y)+              _ -> ENum $ Sub x y    abs (EConst x) = EConst (abs x)   abs (ENum (FromInteger k)) = ENum (FromInteger (abs k))   abs (EFractional (FromRational r)) = EFractional (FromRational (abs r))-  abs x = ENum $ Abs x+  abs x = case fromNeg x of Nothing -> ENum (Abs x)+                            Just x' -> abs x'    negate (EConst x) = EConst (negate x)   negate (ENum (FromInteger k)) = ENum (FromInteger (negate k))@@ -308,7 +323,7 @@    fromInteger = ENum . FromInteger -instance (Fractional a, Eq a) => Fractional (Expr a) where+instance (Fractional a, Ord a) => Fractional (Expr a) where   (/) (EConst x) (EConst y) = EConst (x/y)   (/) (ENum (FromInteger kx)) (ENum (FromInteger ky)) = EFractional $ FromRational (kx % ky)   (/) (EFractional (FromRational rx)) (EFractional (FromRational ry)) = EFractional $ FromRational (rx / ry)@@ -318,18 +333,19 @@   (/) (EFractional (FromRational rx)) (EConst y) = EConst $ fromRational rx / y   (/) (ENum (FromInteger kx)) (EFractional (FromRational ry)) = EFractional $ FromRational (fromInteger kx / ry)   (/) (EFractional (FromRational rx)) (ENum (FromInteger ky)) = EFractional $ FromRational (rx / fromInteger ky)-  (/) (ENum (Negate x)) (ENum (Negate y)) = x / y-  (/) (ENum (Negate x)) y = negate (x / y)-  (/) x (ENum (Negate y)) = negate (x / y)   (/) x y     | isVal 0 y = error "Fractional (Expr a) divide by zero"     | isVal 0 x = 0     | isVal 1 y = x-    | otherwise = EFractional $ Div x y+  (/) x y = case (fromNeg x, fromNeg y) of+              (Just x', Just y') -> x' / y'+              (Nothing, Just y') -> negate (x  / y')+              (Just x', Nothing) -> negate (x' / y )+              _ -> EFractional $ Div x y    fromRational = EFractional . FromRational -instance (Floating a, Eq a) => Floating (Expr a) where+instance (Floating a, Ord a) => Floating (Expr a) where   pi          = EConst pi   x ** y      = EFloating $ Pow x y   logBase x y = EFloating $ LogBase x y@@ -360,6 +376,7 @@   GNum :: Num a => Nums b -> GExpr a b   GFractional :: Fractional a => Fractionals b -> GExpr a b   GFloating :: Floating a => Floatings b -> GExpr a b+deriving instance (Ord a, Ord b) => Ord (GExpr a b)  -- you might use this to use Expr's nice Show instance gexprToExpr :: (b -> Expr a) -> GExpr a b -> Expr a@@ -462,7 +479,7 @@   mapDeRef f (EFloating (ATanh x))     = GFloating <$> (ATanh <$> (f x))   mapDeRef f (EFloating (ACosh x))     = GFloating <$> (ACosh <$> (f x)) -substitute :: (Eq a, Hashable a, Show a) => Expr a -> [(Expr a, Expr a)] -> Expr a+substitute :: (Ord a, Hashable a, Show a) => Expr a -> [(Expr a, Expr a)] -> Expr a substitute expr subList   | nonSymInputs /= [] = error $ "substitute got non-ESym input: " ++ show nonSymInputs   | otherwise = subs expr@@ -574,7 +591,6 @@ foldExpr f acc (EFloating (ATanh x))     = foldExpr f acc x foldExpr f acc (EFloating (ACosh x))     = foldExpr f acc x - -- | symbolic scalar sym :: String -> Expr a sym = ESym . Sym@@ -611,7 +627,7 @@  -- | Separate nonlinear and linear parts of an expression --   @extractLinearPart (fNonLin(x)+a*x) x == (fNonLin(x), a)-extractLinearPart :: (Num a, Eq a, Show a) => Expr a -> Expr a -> (Expr a, a)+extractLinearPart :: (Num a, Ord a, Show a) => Expr a -> Expr a -> (Expr a, a) extractLinearPart e@(EConst _) _ = (e,0) extractLinearPart e@(ENum (FromInteger _)) _ = (e,0) extractLinearPart e@(EFractional (FromRational _)) _ = (e,0)

@@ -17,6 +17,7 @@                      , topSort --                     , fgGraph                      , nodelistToFunGraph+                     , exprsToFunGraph                      ) where  import Control.Applicative@@ -150,3 +151,14 @@  topSort :: FunGraph a -> [Int] topSort fg = map ((\(_,k,_) -> k) . (fgNodeFromVertex fg)) $ Graph.topSort (fgGraph fg)++-- | make a FunGraph out of outputs, automatically detecting the proper inputs+exprsToFunGraph :: (Eq a, Show a, Hashable a) => [Expr a] -> IO (FunGraph a)+exprsToFunGraph outputs = do+  let getSyms :: [Expr a] -> [Sym]+      getSyms exprs = HS.toList $ foldr (\acc expr -> foldExpr f expr acc) HS.empty exprs+        where+          f (ESym s) hs = HS.insert s hs+          f _ hs = hs+      inputs = map ESym $ getSyms outputs+  toFunGraph inputs outputs

@@ -1,9 +1,7 @@ {-# OPTIONS_GHC -Wall #-}-{-# Language TypeOperators #-}-{-# Language TypeFamilies #-}-{-# Language FlexibleInstances #-}  module Dvda.Vis ( previewGraph+                , previewGraph'                 ) where  import Control.Concurrent ( threadDelay )@@ -14,11 +12,18 @@ import Dvda.Expr import Dvda.FunGraph -previewGraph :: Show a => FunGraph a -> IO ()+-- | show a nice Dot graph+previewGraph :: (Ord a, Show a) => FunGraph a -> IO () previewGraph fg = do   preview $ toFGLGraph fg   threadDelay 10000 +-- | show a nice Dot graph with labeled edges+previewGraph' :: (Ord a, Show a) => FunGraph a -> IO ()+previewGraph' fg = do+  preview $ FGL.emap (\(FGLEdge x) -> FGLEdge' x) $ toFGLGraph fg+  threadDelay 10000+ toFGLGraph :: FunGraph a -> FGL.Gr (FGLNode a) (FGLEdge a) toFGLGraph fg = FGL.mkGraph fglNodes fglEdges   where@@ -29,13 +34,20 @@  data FGLNode a = FGLNode (Int, GExpr a Int) data FGLEdge a = FGLEdge (Int, Int, GExpr a Int)-instance Eq (FGLEdge a) where-  (==) (FGLEdge (p0,k0,_)) (FGLEdge (p1,k1,_)) = (==) (p0,k0) (p1,k1)-instance Ord (FGLEdge a) where-  compare (FGLEdge (p0,k0,_)) (FGLEdge (p1,k1,_)) = compare (p0,k0) (p1,k1)+data FGLEdge' a = FGLEdge' (Int, Int, GExpr a Int)+instance Eq a => Eq (FGLEdge a) where+  (==) (FGLEdge (p0,k0,g0)) (FGLEdge (p1,k1,g1)) = (==) (p0,k0,g0) (p1,k1,g1)+instance Eq a => Eq (FGLEdge' a) where+  (==) (FGLEdge' (p0,k0,g0)) (FGLEdge' (p1,k1,g1)) = (==) (p0,k0,g0) (p1,k1,g1)+instance Ord a => Ord (FGLEdge a) where+  compare (FGLEdge (p0,k0,g0)) (FGLEdge (p1,k1,g1)) = compare (p0,k0,g0) (p1,k1,g1)+instance Ord a => Ord (FGLEdge' a) where+  compare (FGLEdge' (p0,k0,g0)) (FGLEdge' (p1,k1,g1)) = compare (p0,k0,g0) (p1,k1,g1)  instance Labellable (FGLEdge a) where   toLabelValue (FGLEdge (p,k,_)) = toLabelValue $ show p ++ " --> " ++ show k+instance Show a => Labellable (FGLEdge' a) where+  toLabelValue (FGLEdge' (_,_,gexpr)) = toLabelValue $ show gexpr  tlv :: Int -> String -> Label tlv k s = toLabelValue $ show k ++ ": " ++ s

@@ -1,5 +1,5 @@ Name:                dvda-Version:             0.3.0.1+Version:             0.3.1 License:             BSD3 License-file:        LICENSE Author:              Greg Horn