From 2db125dc523f6c234752d95663c4084b5e4969f9 Mon Sep 17 00:00:00 2001 From: dandoh Date: Sat, 9 Jan 2021 16:30:24 +0700 Subject: [PATCH] [ test ] update tests --- HashedExpression.cabal | 3 +- app/Examples/Brain.hs | 8 +- examples/brain/plot.py | 9 ++ src/HashedExpression.hs | 4 +- src/HashedExpression/Dot.hs | 1 + src/HashedExpression/Problem.hs | 1 - test/ProblemSpec.hs | 207 +++++++++++--------------------- test/Spec.hs | 18 +-- 8 files changed, 100 insertions(+), 151 deletions(-) create mode 100644 src/HashedExpression/Dot.hs diff --git a/HashedExpression.cabal b/HashedExpression.cabal index 5902c0d4..cc2c7d00 100644 --- a/HashedExpression.cabal +++ b/HashedExpression.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 0cda2753e432df682e88beb10c796b5c541d422d133c8d9c275263a6fd8540e9 +-- hash: 9d0766922c44fc23016fa53343138e21016edc5091f5bb2d2141d69eccd6972c name: HashedExpression version: 0.0.9 @@ -32,6 +32,7 @@ library HashedExpression.Codegen.CSimple HashedExpression.Differentiation.Reverse HashedExpression.Differentiation.Reverse.State + HashedExpression.Dot HashedExpression.Embed HashedExpression.Interface HashedExpression.Internal diff --git a/app/Examples/Brain.hs b/app/Examples/Brain.hs index 2af85149..daa988b7 100644 --- a/app/Examples/Brain.hs +++ b/app/Examples/Brain.hs @@ -17,10 +17,14 @@ brainReconstructFromMRI = re = param2D @128 @128 "re" mask = param2D @128 @128 "mask" -- regularization + regularization = + norm2square (rotate (0, 1) x - x) + + norm2square (rotate (1, 0) x - x) lambda = 3000 - regularization = lambda * (norm2square (rotate (0, 1) x - x) + norm2square (rotate (1, 0) x - x)) in OptimizationProblem - { objective = norm2square ((mask +: 0) * (ft (x +: 0) - (re +: im))) + regularization, + { objective = + norm2square ((mask +: 0) * (ft (x +: 0) - (re +: im))) + + lambda * regularization, constraints = [ x .<= xUpperBound, x .>= xLowerBound diff --git a/examples/brain/plot.py b/examples/brain/plot.py index c8e5a1a9..5767cebe 100644 --- a/examples/brain/plot.py +++ b/examples/brain/plot.py @@ -19,6 +19,10 @@ def plot_image(data): plt.ion() +print('Real part acquired by MRI...') +bound = read_hdf5("bound.h5", "lb") +plot_image(bound) +input('Program paused. Press ENTER to continue') print('Real part acquired by MRI...') re = read_hdf5("kspace.h5", "re") @@ -30,6 +34,11 @@ def plot_image(data): plot_image(np.log(np.abs(im) + 1e-10)) input('Program paused. Press ENTER to continue') +print('Mask...') +mask = read_hdf5("mask.h5", "mask") +plot_image(mask) +input('Program paused. Press ENTER to continue') + print('Naively reconstruct by taking inverse Fourier Transform...') naive = np.abs(np.fft.ifft2(re + 1j * im)) plot_image(naive) diff --git a/src/HashedExpression.hs b/src/HashedExpression.hs index 2791dbcf..e13f2fcb 100644 --- a/src/HashedExpression.hs +++ b/src/HashedExpression.hs @@ -47,8 +47,9 @@ import HashedExpression.Interp import HashedExpression.Prettify import HashedExpression.Problem import HashedExpression.Value -import Prelude hiding ((**), (^)) +import HashedExpression.Modeling.Typed +import Prelude hiding ((**), (^)) proceed :: Codegen codegen => @@ -67,3 +68,4 @@ proceed OptimizationProblem {..} codegen workingDir = case constructProblemAndGe constructProblemAndGenCode = do problem <- constructProblem objective constraints generateProblemCode codegen problem (mkValMap values) + diff --git a/src/HashedExpression/Dot.hs b/src/HashedExpression/Dot.hs new file mode 100644 index 00000000..03de53c4 --- /dev/null +++ b/src/HashedExpression/Dot.hs @@ -0,0 +1 @@ +module HashedExpression.Dot where diff --git a/src/HashedExpression/Problem.hs b/src/HashedExpression/Problem.hs index 8531bdb5..08f2bd9a 100644 --- a/src/HashedExpression/Problem.hs +++ b/src/HashedExpression/Problem.hs @@ -35,7 +35,6 @@ import HashedExpression.Modeling.Typed (TypedExpr) import HashedExpression.Prettify import HashedExpression.Value - ------------------------------------------------------------------------------- -- | Representation of a variable in an optimization problem diff --git a/test/ProblemSpec.hs b/test/ProblemSpec.hs index 5f633563..a850f017 100644 --- a/test/ProblemSpec.hs +++ b/test/ProblemSpec.hs @@ -10,6 +10,7 @@ module ProblemSpec where import Commons import Control.Monad (replicateM) import Data.Array +import HashedExpression.Interface import HashedExpression.Internal import HashedExpression.Internal.Base import HashedExpression.Modeling.Typed @@ -20,148 +21,80 @@ import Test.Hspec import Test.QuickCheck import Prelude hiding ((^)) --- -- | --- prop_constructProblemNoConstraint :: TypedExpr Scalar R -> Expectation --- prop_constructProblemNoConstraint exp = do --- let constructResult = constructProblem exp (Constraint []) --- case constructResult of --- Left reason -> --- assertFailure $ "Can't construct problem: " ++ reason --- Right Problem {..} -> do --- return () - --- -- | --- makeValidBoxConstraint :: (String, Shape) -> IO ConstraintDecl --- makeValidBoxConstraint (name, shape) = --- case shape of --- [] -> do --- let x = variable name --- val1 <- VScalar <$> generate arbitrary --- val2 <- VScalar <$> generate arbitrary --- generate $ --- elements [x .<= val1, x .>= val2, x `between` (val1, val2)] --- [size] -> do --- let x = fromNodeUnwrapped (shape, R, Var name) --- val1 <- V1D . listArray (0, size - 1) <$> generate (vectorOf size arbitrary) --- val2 <- V1D . listArray (0, size - 1) <$> generate (vectorOf size arbitrary) --- generate $ elements [x .<= val1, x .>= val2, x `between` (val1, val2)] --- [size1, size2] -> do --- let x = fromNodeUnwrapped (shape, R, Var name) --- val1 <- V2D . listArray ((0, 0), (size1 - 1, size2 - 1)) <$> generate (vectorOf (size1 * size2) arbitrary) --- val2 <- V2D . listArray ((0, 0), (size1 - 1, size2 - 1)) <$> generate (vectorOf (size1 * size2) arbitrary) --- generate $ elements [x .<= val1, x .>= val2, x `between` (val1, val2)] - --- [size1, size2, size3] -> do TODO -- add 3D for tests --- val1 <- --- V3D . listArray ((0, 0, 0), (size1 - 1, size2 - 1, size3 - 1)) <$> --- generate (vectorOf (size1 * size2 * size3) arbitrary) --- val2 <- --- V3D . listArray ((0, 0, 0), (size1 - 1, size2 - 1, size3 - 1)) <$> --- generate (vectorOf (size1 * size2 * size3) arbitrary) --- generate $ --- elements [x .<= val1, x .>= val2, x `between` (val1, val2)] +-- | +prop_constructProblemNoConstraint :: TypedExpr Scalar R -> Expectation +prop_constructProblemNoConstraint exp = do + let constructResult = constructProblem exp [] + case constructResult of + Left reason -> + assertFailure $ "Can't construct problem: " ++ reason + Right Problem {..} -> do + return () --- varNodesWithShape :: ExpressionMap -> [(String, Shape)] --- varNodesWithShape mp = map (\(name, shape, _) -> (name, shape)) $ varNodes mp - --- -- | --- prop_constructProblemBoxConstraint :: TypedExpr Scalar R -> Expectation --- prop_constructProblemBoxConstraint e = do --- let exp = asRawExpr e --- let vs = varNodesWithShape $ fst exp --- bcs <- mapM makeValidBoxConstraint vs --- sampled <- generate $ sublistOf bcs --- let constraints = Constraint sampled --- let constructResult = constructProblem exp constraints --- case constructResult of --- Left reason -> --- assertFailure $ "Can't construct problem: " ++ reason --- Right Problem {..} -> do --- case (sampled, boxConstraints) of --- (_ : _, []) -> --- assertFailure --- "Valid box constraints but not appear in the problem" --- (_, bs) -> return () - --- -- | --- makeValidScalarConstraint :: IO ConstraintStatement --- makeValidScalarConstraint = do --- sc <- generate (sized (genExp @Scalar @R)) --- val1 <- VScalar <$> generate arbitrary --- val2 <- VScalar <$> generate arbitrary --- generate $ elements [sc .<= val1, sc .>= val2, sc `between` (val1, val2)] +-- | +prop_constructProblemBoxConstraint :: TypedExpr Scalar R -> Expectation +prop_constructProblemBoxConstraint e = do + let exp = asRawExpr e + let vars = varsWithShape $ fst exp + boxConstraints <- + generate $ + sublistOf $ + concatMap + ( \(name, _) -> + [ BoxLowerDecl name (name <> "_lb"), + BoxUpperDecl name (name <> "_lb") + ] + ) + vars + let constructResult = constructProblem exp boxConstraints + case constructResult of + Left reason -> + assertFailure $ "Can't construct problem: " ++ reason + Right Problem {..} -> return () -- -- | --- prop_constructProblemScalarConstraints :: TypedExpr Scalar R -> Expectation --- prop_constructProblemScalarConstraints e = do --- let exp = asRawExpr e --- let vs = varNodesWithShape $ fst exp --- bcs <- mapM makeValidBoxConstraint vs --- sampled <- generate $ sublistOf bcs --- numScalarConstraint <- generate $ elements [2 .. 4] --- scc <- replicateM numScalarConstraint makeValidScalarConstraint --- let constraints = Constraint $ sampled ++ scc --- let constructResult = constructProblem exp constraints --- case constructResult of --- Left reason -> --- assertFailure $ "Can't construct problem: " ++ reason --- Right Problem {..} -> do --- case (scc, scalarConstraints) of --- ([], _) -> return () --- (_ : _, []) -> --- assertFailure --- "Having scalar constraints but not present in problem" --- (_, sConstraints) -> do --- let isOk sc = length (constraintPartialDerivatives sc) `shouldBe` length variables --- assertBool "Empty constraint ?" $ not (null sConstraints) --- mapM_ isOk sConstraints +makeValidScalarConstraint :: IO ConstraintDecl +makeValidScalarConstraint = do + sc <- generate (sized (genExp @Scalar @R)) + val1 <- generate $ arbitrary @Double + val2 <- generate $ arbitrary @Double + generate $ elements [sc .<= val1, sc .>= val2] --- -- | List of hand-written problems and the expected result --- problemsRepo :: [(Either String Problem, Bool)] --- problemsRepo = --- [ ( let [x, y, z, t] = map (variable2D @128 @128) ["x", "y", "z", "t"] --- f = x <.> y + z <.> t --- constraints = --- Constraint --- [ x .>= VFile (TXT "x_lb.txt"), --- y .<= VFile (TXT "y_ub.txt"), --- x <.> z .>= VScalar 3 --- ] --- in constructProblem f constraints, --- True --- ), --- ( let [x, y, z, t] = map (variable2D @128 @128) ["x", "y", "z", "t"] --- f = x <.> y + z <.> t --- constraints = --- Constraint --- [ x .>= VScalar 5, --- y .<= VFile (TXT "y_ub.txt"), --- x <.> z .>= VScalar 3 --- ] --- in constructProblem f constraints, --- False --- ), --- ( let [x, y, z, t] = map (variable2D @128 @128) ["x", "y", "z", "t"] --- f = x <.> y + z <.> t --- constraints = --- Constraint [x .>= VNum 5, y .<= VNum 10, x <.> z .>= VNum 18] --- in constructProblem f constraints, --- True --- ), --- ( let [x, y, z] = map (variable2D @100 @100) ["x", "y", "z"] --- f = x <.> y + z <.> z --- constraints = Constraint [y <.> z .<= VNum 1] --- in constructProblem f constraints, --- True --- ) --- ] +-- | +prop_constructProblemScalarConstraints :: TypedExpr Scalar R -> Expectation +prop_constructProblemScalarConstraints e = do + let exp = asRawExpr e + let vars = varsWithShape $ fst exp + boxConstraints <- + generate $ + sublistOf $ + concatMap + ( \(name, _) -> + [ BoxLowerDecl name (name <> "_lb"), + BoxUpperDecl name (name <> "_lb") + ] + ) + vars + numScalarConstraint <- generate $ elements [2 .. 4] + scc <- replicateM numScalarConstraint makeValidScalarConstraint + case constructProblem exp (scc ++ boxConstraints) of + Left reason -> + assertFailure $ "Can't construct problem: " ++ reason + Right Problem {..} -> do + case (scc, generalConstraints) of + ([], _) -> return () + (_ : _, []) -> assertFailure "Having scalar constraints but not present in problem" + (_, sConstraints) -> do + let isOk sc = length (constraintPartialDerivatives sc) `shouldBe` length variables + assertBool "Empty constraint ?" $ not (null sConstraints) + mapM_ isOk sConstraints spec :: Spec -spec = +spec = describe "Hash Solver spec " $ do specify "valid problem should be constructed successfully" $ - 1 `shouldBe` 1 - -- specify "valid box constrained problem should be constructed successfully" $ - -- property prop_constructProblemBoxConstraint - -- specify "valid scalar constraints problem should be successfully successfully" $ - -- property prop_constructProblemScalarConstraints + property prop_constructProblemNoConstraint + specify "valid box constrained problem should be constructed successfully" $ + property prop_constructProblemBoxConstraint + specify "valid scalar constraints problem should be successfully successfully" $ + property prop_constructProblemScalarConstraints diff --git a/test/Spec.hs b/test/Spec.hs index f597d88a..6e84500a 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -15,13 +15,13 @@ import Prelude hiding ((^)) main :: IO () main = do hspecWith defaultConfig {configQuickCheckMaxDiscardRatio = Just 100, configQuickCheckMaxSuccess = Just 100} $ do - describe "SimplifySpec" SimplifySpec.spec - describe "CollisionSpec" CollisionSpec.spec + -- describe "SimplifySpec" SimplifySpec.spec + -- describe "CollisionSpec" CollisionSpec.spec describe "ProblemSpec" ProblemSpec.spec - describe "InterpSpec" InterpSpec.spec - describe "StructureSpec" StructureSpec.spec - describe "ReverseDifferentiationSpec" ReverseDifferentiationSpec.spec - hspecWith defaultConfig {configQuickCheckMaxSuccess = Just 10} $ do - describe "SolverSpec" SolverSpec.spec - hspecWith defaultConfig {configQuickCheckMaxSuccess = Just 60} $ do - describe "CSimpleSpec" CSimpleSpec.spec + -- describe "InterpSpec" InterpSpec.spec + -- describe "StructureSpec" StructureSpec.spec + -- describe "ReverseDifferentiationSpec" ReverseDifferentiationSpec.spec + -- hspecWith defaultConfig {configQuickCheckMaxSuccess = Just 10} $ do + -- describe "SolverSpec" SolverSpec.spec + -- hspecWith defaultConfig {configQuickCheckMaxSuccess = Just 60} $ do + -- describe "CSimpleSpec" CSimpleSpec.spec