From 45dc726519d3d2fbd918bf5b5422aa49374a023d Mon Sep 17 00:00:00 2001 From: Masahiro Sakai Date: Sat, 28 Dec 2024 23:23:09 +0900 Subject: [PATCH 1/4] remove unused import of Data.Hashable --- src/ToySolver/Graph/ShortestPath.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/ToySolver/Graph/ShortestPath.hs b/src/ToySolver/Graph/ShortestPath.hs index 9349c875..7706ee3f 100644 --- a/src/ToySolver/Graph/ShortestPath.hs +++ b/src/ToySolver/Graph/ShortestPath.hs @@ -68,7 +68,6 @@ import Control.Monad import Control.Monad.ST import Control.Monad.Trans import Control.Monad.Trans.Except -import Data.Hashable import qualified Data.HashTable.Class as H import qualified Data.HashTable.ST.Cuckoo as C import Data.IntMap.Strict (IntMap) From 67f2ee698ed92d520e3c3a511d17af56e615352e Mon Sep 17 00:00:00 2001 From: Masahiro Sakai Date: Sat, 28 Dec 2024 23:24:06 +0900 Subject: [PATCH 2/4] stop using deprecated Turtle.fromText --- misc/build_artifacts.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/misc/build_artifacts.hs b/misc/build_artifacts.hs index c3ca01c5..62ee989f 100644 --- a/misc/build_artifacts.hs +++ b/misc/build_artifacts.hs @@ -6,6 +6,9 @@ import Turtle import qualified Control.Foldl as L import Control.Monad +#if MIN_VERSION_turtle(1,6,0) +import qualified Data.Text as T +#endif import Distribution.Package import Distribution.PackageDescription import Distribution.PackageDescription.Parsec @@ -58,12 +61,20 @@ main = sh $ do when b $ rmtree pkg mktree (pkg "bin") +#if MIN_VERSION_turtle(1,6,0) + let binDir = T.unpack (lineToText local_install_root) "bin" +#else let binDir = fromText (lineToText local_install_root) "bin" +#endif forM exe_files $ \name -> do cp (binDir addExeSuffix name) (pkg "bin" addExeSuffix name) mktree (pkg "lib") +#if MIN_VERSION_turtle(1,6,0) + let libDir = T.unpack (lineToText local_install_root) "lib" +#else let libDir = fromText (lineToText local_install_root) "lib" +#endif when (Info.os == "mingw32") $ do cp (libDir "toysat-ipasir.dll") (pkg "bin" "toysat-ipasir.dll") proc "stack" From d5a8639d0791d53410a4761030b25cc1719ec5f3 Mon Sep 17 00:00:00 2001 From: Masahiro Sakai Date: Sun, 29 Dec 2024 08:45:21 +0900 Subject: [PATCH 3/4] fix warnings in test/Test/Converter.hs --- test/Test/Converter.hs | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/test/Test/Converter.hs b/test/Test/Converter.hs index d9610000..0d69a486 100644 --- a/test/Test/Converter.hs +++ b/test/Test/Converter.hs @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} module Test.Converter (converterTestGroup) where @@ -824,15 +825,10 @@ prop_pb2ip_backward = forAll arbitraryPBFormula $ \pb -> let ret@(mip, info) = pb2ip pb in counterexample (show ret) $ - forAll (arbitraryAssignments mip) $ \sol -> + forAll (arbitraryAssignmentBinaryIP mip) $ \sol -> SAT.evalPBFormula (transformBackward info sol) pb === fmap (transformObjValueBackward info) (evalMIP sol (fmap fromIntegral mip)) - where - arbitraryAssignments mip = liftM Map.fromList $ do - forM (Map.keys (MIP.varType mip)) $ \v -> do - val <- choose (0, 1) - pure (v, fromInteger val) prop_pb2ip_json :: Property prop_pb2ip_json = @@ -859,18 +855,13 @@ prop_wbo2ip_backward = forAll arbitrary $ \b -> let ret@(mip, info) = wbo2ip b wbo in counterexample (show ret) $ - forAll (arbitraryAssignments mip) $ \sol -> + forAll (arbitraryAssignmentBinaryIP mip) $ \sol -> case evalMIP sol (fmap fromIntegral mip) of Nothing -> True Just val2 -> case SAT.evalPBSoftFormula (transformBackward info sol) wbo of Nothing -> False Just val1 -> val1 <= transformObjValueBackward info val2 - where - arbitraryAssignments mip = liftM Map.fromList $ do - forM (Map.keys (MIP.varType mip)) $ \v -> do - val <- choose (0, 1) - pure (v, fromInteger val) prop_wbo2ip_json :: Property prop_wbo2ip_json = @@ -888,15 +879,10 @@ prop_mip2pb_forward = Left err -> counterexample err $ property False Right ret@(pb, info) -> counterexample (show ret) $ - forAll (arbitraryAssignment ip) $ \sol -> + forAll (arbitraryAssignmentBoundedIP ip) $ \sol -> fmap (transformObjValueForward info) (evalMIP sol ip) === SAT.evalPBFormula (transformForward info sol) pb - where - arbitraryAssignment mip = liftM Map.fromList $ do - forM (Map.toList (MIP.varBounds mip)) $ \(v, (MIP.Finite lb, MIP.Finite ub)) -> do - val <- choose (ceiling lb, floor ub) - pure (v, fromInteger val) prop_mip2pb_backward :: Property prop_mip2pb_backward = @@ -920,8 +906,8 @@ prop_mip2pb_backward' = QM.monadicIO $ do solver <- arbitrarySolver -- Using optimizePBFormula is too slow for using in QuickCheck - ret <- QM.run $ solvePBFormula solver pb - case ret of + ret2 <- QM.run $ solvePBFormula solver pb + case ret2 of Nothing -> return () Just m -> QM.assert $ isJust $ evalMIP (transformBackward info m) ip @@ -1013,6 +999,20 @@ arbitraryMIPExpr vs = do c <- arbitrary return $ MIP.Term c ls +arbitraryAssignmentBinaryIP :: MIP.Problem a -> Gen (Map MIP.Var Rational) +arbitraryAssignmentBinaryIP mip = liftM Map.fromList $ do + forM (Map.keys (MIP.varType mip)) $ \v -> do + val <- choose (0, 1) + pure (v, fromInteger val) + +arbitraryAssignmentBoundedIP :: RealFrac a => MIP.Problem a -> Gen (Map MIP.Var Rational) +arbitraryAssignmentBoundedIP mip = liftM Map.fromList $ do + forM (Map.toList (MIP.varBounds mip)) $ \case + (v, (MIP.Finite lb, MIP.Finite ub)) -> do + val <- choose (ceiling lb, floor ub) + pure (v, fromInteger val) + _ -> error "should not happen" + evalMIP :: Map MIP.Var Rational -> MIP.Problem Rational -> Maybe Rational evalMIP sol prob = do forM_ (MIP.constraints prob) $ \constr -> do From 44b2ae9c2adbb131b9128b5422f5ccc9f12b9620 Mon Sep 17 00:00:00 2001 From: Masahiro Sakai Date: Sun, 29 Dec 2024 08:56:19 +0900 Subject: [PATCH 4/4] fix warnings in test/Test/SAT.hs --- test/Test/SAT.hs | 63 ++++++++++++++++++++++++------------------------ 1 file changed, 32 insertions(+), 31 deletions(-) diff --git a/test/Test/SAT.hs b/test/Test/SAT.hs index f9eba663..58cd5e39 100644 --- a/test/Test/SAT.hs +++ b/test/Test/SAT.hs @@ -148,8 +148,8 @@ case_incremental_solving = do ret @?= True SAT.addClause solver [-x1, x2] -- not x1 or x2 - ret <- SAT.solve solver -- unsat - ret @?= False + ret2 <- SAT.solve solver -- unsat + ret2 @?= False -- 制約なし case_empty_constraint :: Assertion @@ -209,8 +209,8 @@ case_instantiateAtLeast = do ret @?= True SAT.addAtLeast solver [-x1,-x2,-x3,-x4] 2 - ret <- SAT.solve solver - ret @?= True + ret2 <- SAT.solve solver + ret2 @?= True case_inconsistent_AtLeast :: Assertion case_inconsistent_AtLeast = do @@ -223,19 +223,20 @@ case_inconsistent_AtLeast = do case_trivial_AtLeast :: Assertion case_trivial_AtLeast = do - solver <- SAT.newSolver - x1 <- SAT.newVar solver - x2 <- SAT.newVar solver - SAT.addAtLeast solver [x1,x2] 0 - ret <- SAT.solve solver - ret @?= True - - solver <- SAT.newSolver - x1 <- SAT.newVar solver - x2 <- SAT.newVar solver - SAT.addAtLeast solver [x1,x2] (-1) - ret <- SAT.solve solver - ret @?= True + do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + SAT.addAtLeast solver [x1,x2] 0 + ret <- SAT.solve solver + ret @?= True + do + solver <- SAT.newSolver + x1 <- SAT.newVar solver + x2 <- SAT.newVar solver + SAT.addAtLeast solver [x1,x2] (-1) + ret <- SAT.solve solver + ret @?= True case_AtLeast_1 :: Assertion case_AtLeast_1 = do @@ -340,14 +341,14 @@ case_solveWith_1 = do SAT.addClause solver [-x1, -x2] -- not x1 or not x2 SAT.addClause solver [-x3, -x1, x2] -- not x3 or not x1 or x2 - ret <- SAT.solve solver -- sat - ret @?= True + ret2 <- SAT.solve solver -- sat + ret2 @?= True - ret <- SAT.solveWith solver [x3] -- unsat - ret @?= False + ret3 <- SAT.solveWith solver [x3] -- unsat + ret3 @?= False - ret <- SAT.solve solver -- sat - ret @?= True + ret4 <- SAT.solve solver -- sat + ret4 @?= True case_solveWith_2 :: Assertion case_solveWith_2 = do @@ -360,8 +361,8 @@ case_solveWith_2 = do ret <- SAT.solveWith solver [x2] ret @?= True - ret <- SAT.solveWith solver [-x2] - ret @?= False + ret2 <- SAT.solveWith solver [-x2] + ret2 @?= False case_getVarFixed :: Assertion case_getVarFixed = do @@ -375,14 +376,14 @@ case_getVarFixed = do SAT.addClause solver [-x1] - ret <- SAT.getVarFixed solver x1 - ret @?= lFalse + ret2 <- SAT.getVarFixed solver x1 + ret2 @?= lFalse - ret <- SAT.getLitFixed solver (-x1) - ret @?= lTrue + ret3 <- SAT.getLitFixed solver (-x1) + ret3 @?= lTrue - ret <- SAT.getLitFixed solver x2 - ret @?= lTrue + ret4 <- SAT.getLitFixed solver x2 + ret4 @?= lTrue case_getAssumptionsImplications_case1 :: Assertion case_getAssumptionsImplications_case1 = do