packages feed

dvda 0.2.1 → 0.2.2

raw patch · 11 files changed

+52/−35 lines, 11 files

Files

Dvda.hs view
@@ -14,6 +14,7 @@ module Dvda ( -- * primitives               sym             , symDependent+            , symDependentN             , vsym             , msym             , svec
Dvda/CallNative.hs view
@@ -14,8 +14,6 @@                        ) where  import Data.Hashable ( Hashable )-import Data.HashMap.Lazy ( HashMap )-import qualified Data.HashMap.Lazy as HM import qualified Data.IntMap as IM import Data.List ( mapAccumL ) import Data.Maybe ( fromJust, catMaybes )@@ -25,6 +23,8 @@ import Dvda.BinUn ( BinOp(Mul), applyBinary, applyUnary ) import Dvda.Expr ( Expr(..), Const(..), dim ) import Dvda.Graph ( FunGraph(..), DvdaDim(..), DynamicExpr, fgLookup, fgExprFromKey )+import Dvda.HashMap ( HashMap )+import qualified Dvda.HashMap as HM import Dvda.SymMonad ( rad )  class (Hashable (INumT b), Eq (INumT b), Element (INumT b)) => NativeInputs b where@@ -32,7 +32,7 @@   toReplacements :: FunGraph (INumT b) b c -> b -> HashMap (DynamicExpr (INumT b)) (DynamicExpr (INumT b))  insToSyms :: DvdaDim sh => FunGraph a b c -> Expr sh a -> Expr sh a -> Maybe (DynamicExpr a, DynamicExpr a)-insToSyms fg e@(ERef _ k) out = fmap (\x -> (makeDynamic x, makeDynamic out)) $ fgExprFromKey (dim e) k fg+insToSyms fg e@(ERef _ _ k) out = fmap (\x -> (makeDynamic x, makeDynamic out)) $ fgExprFromKey (dim e) k fg insToSyms _ _ _ = Nothing  instance (DvdaDim sh, Hashable a, Element a, Eq a) => NativeInputs (Expr sh a) where@@ -102,7 +102,7 @@ eval _ _ (EDeriv _ _) = error "WHO PUT AN EDeriv IN THIS GRAPH" eval _ _ (EGrad _ _) = error "WHO PUT AN EDeriv IN THIS GRAPH" eval _ _ (EJacob _ _) = error "WHO PUT AN EJacob IN THIS GRAPH"-eval replacementMap fg expr@(ERef _ k) = eval replacementMap fg (fromJust $ fgExprFromKey (dim expr) k fg)+eval replacementMap fg expr@(ERef _ _ k) = eval replacementMap fg (fromJust $ fgExprFromKey (dim expr) k fg) eval _ fg expr@(EConst _) = (fg, expr) eval replacementMap fg0 expr@(ESym _ _) = case HM.lookup (makeDynamic expr) replacementMap of  Nothing -> (fg0, expr)
Dvda/Expr.hs view
@@ -7,6 +7,7 @@ module Dvda.Expr ( Expr(..)                  , Const(..)                  , Sym(..)+                 , RefHash(..)                  , sym                  , svec                  , smat@@ -23,6 +24,7 @@                  , dim                  , isVal                  , symDependent+                 , symDependentN                  ) where  import Data.Array.Repa(DIM0,DIM1,DIM2,Z(..),(:.)(..), listOfShape, Shape(shapeOfList), rank )@@ -51,7 +53,7 @@ dim (EUnary _ x) = dim x dim (EBinary _ x1 _) = dim x1 dim (EScale _ y) = dim y-dim (ERef sh _) = sh+dim (ERef sh _ _) = sh dim (EDeriv _ _) = Z dim (EGrad _ args) = dim args dim (EJacob x args) = Z :. head (listOfShape (dim x)) :. head (listOfShape (dim args))@@ -73,6 +75,8 @@   show (Sym name) = name   show (SymDependent name k s) = name ++ replicate k '\'' ++ "(" ++ show s ++ ")" +data RefHash = RefHash Int deriving (Eq, Show)+ data Expr sh a where   ESym :: sh -> Sym -> Expr sh a   EConst :: Const sh a -> Expr sh a@@ -80,7 +84,7 @@   EUnary :: UnOp -> Expr sh a -> Expr sh a   EBinary :: BinOp -> Expr sh a -> Expr sh a -> Expr sh a   EScale :: Expr DIM0 a -> Expr sh a -> Expr sh a-  ERef :: sh -> Key -> Expr sh a+  ERef :: sh -> RefHash -> Key -> Expr sh a    EDeriv :: Expr DIM0 a -> Expr DIM0 a -> Expr DIM0 a   EGrad  :: Expr DIM0 a -> Expr sh a -> Expr sh a@@ -97,7 +101,7 @@ paren x = "("++ x ++")"  instance (Shape sh, Show a, Element a) => Show (Expr sh a) where-  show (ERef sh k)+  show (ERef sh _ k)     | rank sh == 0 = "{ref:" ++ show k ++ "}"     | otherwise    = "{ref:" ++ show k ++ ",(" ++ showShapeR sh ++ ")}"   show (EDimensionless x) = show x@@ -144,7 +148,7 @@   (==) (EDimensionless x0) (EDimensionless x1) = x0 == x1   (==) (EUnary op0 x0) (EUnary op1 x1) = op0 == op1 && x0 == x1   (==) (EScale x0 y0) (EScale x1 y1) = x0 == x1 && y0 == y1-  (==) (ERef sh0 k0) (ERef sh1 k1) = sh0 == sh1 && k0 == k1+  (==) (ERef sh0 h0 k0) (ERef sh1 h1 k1) = sh0 == sh1 && h0 == h1 && k0 == k1   (==) (EDeriv x0 y0) (EDeriv x1 y1) = x0 == x1 && y0 == y1   (==) (EGrad x0 y0) (EGrad x1 y1) = x0 == x1 && y0 == y1   (==) (EJacob x0 y0) (EJacob x1 y1) = x0 == x1 && y0 == y1@@ -177,7 +181,7 @@         where           unsorted = [hash x, hash y]   hash (EScale x y)       = 33 `combine` hash x `combine` hash y-  hash (ERef sh k)        = 34 `combine` hash (listOfShape sh) `combine` k+  hash (ERef _ (RefHash h) _) = h    hash (EDeriv x y)       = 35 `combine` hash x `combine` hash y   hash (EGrad x y)        = 36 `combine` hash x `combine` hash y@@ -341,8 +345,12 @@ -- . -- This lets you do d(f(g(t)))/dt == f'(g(t))*g'(t) symDependent :: String -> Expr DIM0 a -> Expr DIM0 a-symDependent name (ESym _ s)  = ESym Z (SymDependent name 0 s)-symDependent _ _ = error "symDependent got non ESym dependency"+symDependent name s = symDependentN name s 0++-- | same as symDependent but it can start as the Nth derivative+symDependentN :: String -> Expr DIM0 a -> Int -> Expr DIM0 a+symDependentN name (ESym _ s) n = ESym Z (SymDependent name n s)+symDependentN _ _ _ = error "symDependent got non ESym dependency"  -- | symbolic dense vector vsym :: Int -> String -> Expr DIM1 a
Dvda/Graph.hs view
@@ -33,13 +33,13 @@ import Data.Maybe ( fromJust ) import Data.IntMap ( Key ) import qualified Data.HashSet as HS-import qualified Data.HashMap.Strict as HM import qualified Data.IntMap as IM import Numeric.LinearAlgebra ( Element ) import Data.Array.Repa ( Shape, DIM0, DIM1, DIM2 ) import Control.Monad.State ( State, get, put ) -import Dvda.Expr ( Expr(..), Const(..), Sym(..), dim )+import Dvda.Expr ( Expr(..), Const(..), Sym(..), RefHash(..), dim )+import qualified Dvda.HashMap as HM  --------------------- dynamic Expr stuff --------------------------- data DynamicExpr a = DynamicExpr0 (Expr DIM0 a)@@ -88,7 +88,7 @@   fromDynamic _ _ = error "DIM2: fromDynamic error"  fgLookup :: (Eq a, Hashable a, Element a, DvdaDim sh) => Expr sh a -> FunGraph a b c -> Maybe (FgNode a)-fgLookup (ERef sh k) fg = fgReverseLookup sh k fg+fgLookup (ERef sh _ k) fg = fgReverseLookup sh k fg fgLookup expr (FunGraph hm _ _ _) = HM.lookup (makeDynamic expr) hm  fgReverseLookup :: (Eq a, Hashable a, Element a, DvdaDim sh) => sh -> Key -> FunGraph a b c -> Maybe (FgNode a)@@ -104,7 +104,7 @@           FunGraph a b c -> Expr sh a -> HS.HashSet (DynamicExpr a) symSet fg e@(ESym sh (SymDependent _ _ dep)) = HS.union (HS.singleton (makeDynamic e)) (symSet fg (ESym sh dep)) symSet _ e@(ESym _ _)          = HS.singleton (makeDynamic e)-symSet fg (ERef sh k)          = snd $ fromJust $ fgReverseLookup sh k fg+symSet fg (ERef sh _ k)        = snd $ fromJust $ fgReverseLookup sh k fg symSet _ (EDimensionless _)    = HS.empty symSet _ (EConst _)            = HS.empty symSet fg (EUnary _ x)         = symSet fg x@@ -118,18 +118,18 @@ --   If the Expr is not yet in the map, insert it and return new key. --   Otherwise don't insert, just return existing key. insert :: (Hashable a, Eq a, Element a, DvdaDim sh) => Expr sh a -> State (FunGraph a b c) (Expr sh a)-insert (ERef _ _) = error "don't insert ERef into graph, ya goon"+insert (ERef _ _ _) = error "don't insert ERef into graph, ya goon" insert (EConst _) = error "don't insert EConst into graph, ya goon" insert expr = do   let dexpr = makeDynamic expr   fg@(FunGraph hm im ins outs) <- get   case fgLookup expr fg of-    Just (k',_) -> return (ERef (dim expr) k')+    Just (k',_) -> return (ERef (dim expr) (RefHash (hash expr)) k')     Nothing -> do let k = HM.size hm                       hm' = HM.insert dexpr (k, symSet fg expr) hm                       im' = IM.insert k dexpr im                   put (FunGraph hm' im' ins outs)-                  return (ERef (dim expr) k)+                  return (ERef (dim expr) (RefHash (hash expr)) k)   funGraphSummary :: (Show a, Element a, Show b, Show c) => FunGraph a b c -> String@@ -190,7 +190,7 @@         gc :: Expr sh a -> [Key]         gc (EBinary _ x y) = gc x ++ gc y         gc (EUnary _ x) = gc x-        gc (ERef _ k) = [k]+        gc (ERef _ _ k) = [k]         gc (ESym _ _) = []         gc (EDimensionless _) = []         gc (EScale x y) = gc x ++ gc y
+ Dvda/HashMap.hs view
@@ -0,0 +1,8 @@+{-# OPTIONS_GHC -Wall #-}++module Dvda.HashMap ( module Data.HashMap.Strict+--                    , module Data.HashMap.Lazy+                    ) where++import Data.HashMap.Strict+--import Data.HashMap.Lazy
Dvda/MultipleShooting/MSCoctave.hs view
@@ -6,18 +6,18 @@                                        , run                                        ) where -import qualified Data.HashMap.Lazy as HM import qualified Data.HashSet as HS import Data.List ( zipWith6, transpose, elemIndex ) import Data.Maybe ( fromJust, catMaybes )  import Dvda+import Dvda.Codegen ( writeSourceFile ) import Dvda.Expr ( Expr(..), Const(..), Sym(..) )-import Dvda.SymMonad ( rad )+import qualified Dvda.HashMap as HM import Dvda.MultipleShooting.MSMonad import Dvda.MultipleShooting.Types import Dvda.OctaveSyntax ( toOctaveSource )-import Dvda.Codegen ( writeSourceFile )+import Dvda.SymMonad ( rad )  {-     min f(x) st:
Dvda/MultipleShooting/MSMonad.hs view
@@ -22,7 +22,6 @@  import Data.Array.Repa ( Z(..) ) import Data.Hashable ( Hashable )-import qualified Data.HashMap.Lazy as HM import qualified Data.HashSet as HS import Data.List ( nub, sort ) --, union ) import Data.Maybe ( isJust, isNothing )@@ -35,6 +34,7 @@  import Dvda ( sym ) import Dvda.Expr ( Expr(..) )+import qualified Dvda.HashMap as HM import Dvda.MultipleShooting.Types  failDuplicates :: [String] -> [String]
Dvda/MultipleShooting/Types.hs view
@@ -11,11 +11,11 @@                                    , simpsonsRuleError'                                    ) where -import Data.HashMap.Lazy ( HashMap ) import Data.HashSet ( HashSet )  import Dvda ( Z ) import Dvda.Expr ( Expr(..) )+import Dvda.HashMap ( HashMap ) import Dvda.SparseLA  data BCTime = ALWAYS | TIMESTEP Int deriving (Show, Eq)
Dvda/OctaveSyntax.hs view
@@ -29,7 +29,7 @@ instance GenOctave (Expr DIM0 Double) where   numObjects _ = 1   writeOutputs e outputK = printf "%% output %d\noutput%d = %s; %% Expr DIM0 Double\n" outputK outputK (writeExpr e)-  writeInputs e@(ERef _ k) inputK = (printf "%% input %d\n%s\n" inputK decl, IM.singleton k decl)+  writeInputs e@(ERef _ _ k) inputK = (printf "%% input %d\n%s\n" inputK decl, IM.singleton k decl)     where       decl = printf "%s = x%d;" (writeExpr e) inputK   writeInputs e inputK = error $ "input " ++ show inputK ++ " is non-symbolic: " ++ show e@@ -51,7 +51,7 @@   writeInputs exprs inputK = ((printf "%% input %d\n" inputK) ++ unlines (map snd keyDecls), IM.fromList keyDecls)     where       keyDecls = zipWith f [(1::Int)..] exprs-      f outIdx e@(ERef _ k) = (k, printf "%s = x%d(%d);" (writeExpr e) inputK outIdx)+      f outIdx e@(ERef _ _ k) = (k, printf "%s = x%d(%d);" (writeExpr e) inputK outIdx)       f outIdx e = error $ "input " ++ show inputK ++ ", " ++ show outIdx ++" is non-symbolic: " ++ show e  instance GenOctave [[Expr DIM0 Double]] where@@ -70,7 +70,7 @@   writeInputs exprs inputK = ((printf "% input %d\n" inputK) ++ unlines (map snd keyDecls), IM.fromList keyDecls)     where       keyDecls = zipWith f [(r,c) | r <- [1..length exprs], c <- [1..(length (head exprs))]] (concat exprs)-      f (rowIdx,colIdx) e@(ERef _ k) = (k, printf "%s = x%d(%d,%d);" (writeExpr e) inputK rowIdx colIdx)+      f (rowIdx,colIdx) e@(ERef _ _ k) = (k, printf "%s = x%d(%d,%d);" (writeExpr e) inputK rowIdx colIdx)       f outIdx e = error $ "input " ++ show inputK ++ ", " ++ show outIdx ++" is non-symbolic: " ++ show e  instance (GenOctave a, GenOctave b) => GenOctave (a :* b) where@@ -115,7 +115,7 @@ octaveUnary ACosh  = "acosh"  writeExpr :: (Show a, Element a) => Expr sh a -> String-writeExpr (ERef _ k) = Config.nameHSVar k+writeExpr (ERef _ _ k) = Config.nameHSVar k writeExpr (EBinary op x y) = writeExpr x ++ " " ++ octaveBinary op ++ " " ++ writeExpr y writeExpr (EUnary op x) = octaveUnary op ++ "( " ++ writeExpr x ++ " )" writeExpr (EScale x y) = "LA.scale " ++ writeExpr x ++ " " ++ writeExpr y
Dvda/SymMonad.hs view
@@ -28,7 +28,6 @@ import Data.Array.Repa ( DIM0, DIM1, DIM2, Z(..) ) import Data.Hashable ( Hashable ) import Data.Maybe ( fromJust )-import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS import qualified Data.IntMap as IM import Numeric.LinearAlgebra ( Element, Vector, Matrix )@@ -39,6 +38,7 @@ import Dvda.BinUn ( applyUnary, applyBinary ) import Dvda.Graph ( FunGraph(..), DynamicExpr(..), DvdaDim(..), insert, emptyFunGraph, fgLookup, fgExprFromKey ) import Dvda.Expr ( Expr(..), Const(..), Sym(..), dim )+import qualified Dvda.HashMap as HM  ---- | take all sub expressions of an Expr and turn them into nodes ----   return an Expr that is just a ref@@ -46,7 +46,7 @@          Expr sh a -> State (FunGraph a b c) (Expr sh a) node (EDimensionless _) = error "don't put EDimensionless in graph, ya goon" node (EJacob _ _) = error "can't do node EJacob yet"-node e@(ERef _ _) = return e+node e@(ERef _ _ _) = return e node e@(EConst _) = return e node e@(ESym _ (SymDependent _ _ dep)) = do   _ <- node (ESym Z dep)@@ -83,7 +83,7 @@   args'' <- mapM node args'   fg <- get -  let args = map (\(ERef sh k) -> fromJust $ fgExprFromKey sh k fg) args''+  let args = map (\(ERef sh _ k) -> fromJust $ fgExprFromKey sh k fg) args''       argSet = HS.fromList (map makeDynamic args)    sensitivities <- getSensitivities argSet expr (EConst (CSingleton (dim expr) 1))@@ -141,7 +141,7 @@ getSensitivities _ (EScale _ _) _ = error "cant' do getSensitivities on EScale yet (needs EinSum?)" getSensitivities _ (EDimensionless _) _ = return HM.empty getSensitivities _ (EConst _) _         = return HM.empty-getSensitivities args (ERef sh k) sens  = do+getSensitivities args (ERef sh _ k) sens  = do   fg <- get   let expr = fromJust $ fgExprFromKey sh k fg   getSensitivities args expr sens@@ -323,7 +323,7 @@ --   . --   Each time an ERef is found, look it up in the FunGraph and continue traversal recover :: DvdaDim sh => FunGraph a b c -> Expr sh a -> Expr sh a-recover fg (ERef sh k) = recover fg (fromJust $ fgExprFromKey sh k fg)+recover fg (ERef sh _ k) = recover fg (fromJust $ fgExprFromKey sh k fg) recover _ e@(EDimensionless _) = e recover _ e@(ESym _ _) = e recover _ e@(EConst _) = e
dvda.cabal view
@@ -1,5 +1,5 @@ Name:                dvda-Version:             0.2.1+Version:             0.2.2 License:             BSD3 License-file:        LICENSE Author:              Greg Horn@@ -69,7 +69,7 @@ --                     Dvda.Codegen.CSyntax --                     Dvda.Codegen.Utils -  Other-modules:     +  Other-modules:     Dvda.HashMap    Build-depends:     base       >= 4     && < 5,                      hashable  >= 1.1 && < 1.2,