minizinc-process 0.1.2.1 → 0.1.3.0
raw patch · 5 files changed
+202/−63 lines, 5 filesdep +hedgehogdep +hspecdep +hspec-hedgehogdep −stringsearchdep ~aesondep ~attoparsecdep ~base
Dependencies added: hedgehog, hspec, hspec-hedgehog, minizinc-process
Dependencies removed: stringsearch
Dependency ranges changed: aeson, attoparsec, base, bytestring, containers, directory, hashable, process, process-extras, text
Files
- CHANGELOG.md +7/−0
- README.md +26/−4
- minizinc-process.cabal +23/−9
- src/Process/Minizinc.hs +43/−50
- test/Test.hs +103/−0
CHANGELOG.md view
@@ -2,6 +2,13 @@ ## Unreleased changes +## 0.1.3.0 -- 2020-11-11++* Unify backing code when getting last result and streaming results (better RAM usage for long sequences).+* Add function to clean temporary files.+* Initial set of unit tests.+* Use bracket and cleanupProcess to dispose of resources.+ ## 0.1.2.1 -- 2020-11-08 * Handle case where final result is partial.
README.md view
@@ -49,14 +49,14 @@ data Input = Input {x :: Int} deriving (Generic) -instance ToJSON Input -- required for `runLastMinizincJSON`+instance ToJSON Input -- required by `runLastMinizincJSON` for serialization of input -instance Hashable Input -- required for `runLastMinizincJSON`+instance Hashable Input -- required by `simpleMiniZinc` to create a somewhat unique filepath data Output = Output {y :: Int} deriving (Show, Generic) -instance FromJSON Output -- required for `runLastMinizincJSON`+instance FromJSON Output -- required by `runLastMinizincJSON` for deserialization of output main :: IO () main = do@@ -71,6 +71,13 @@ (in our example, this type application is the only indication needed to tell the compiler to deserialize `Output` objects). +A more-general function named `runMinizincJSON` allows to stream results+iteratively has the solver progresses. This function is more complicated than+`runLastMinizincJSON` has it takes a callback to consume an output and control+whether to continue reading inputs or not (i.e., a coroutine) plus some initial+state that is carried over (a bit like a fold). Luckily, we provide two+coroutines `keepLast` and `collectResults` for some typical use cases.+ # Usage in a project In a typical project, you will have fixed models and varying inputs.@@ -86,7 +93,22 @@ For now, the implementation leverages file-system to pass the JSON object to MiniZinc, this design means you should pay attention to disk usage and maybe-clean the clutter.+clean the clutter. A function named `cleanTmpFile` will remove the `.json` disk+file for a given pair of MiniZinc and input objects.++# Development++## Testing++We use [Hedgehog](https://hedgehog.qa/) to test the overall system at once rather than having+individual tests for the internal parser and other files.++Test cases are in `.hs` files under the `test` directory whereas the `.mzn`+models are in the `models` directory.+We use a naming nomenclature to help organize what files require what+input/output types: `test{inputtype}_{testnum}.mzn` where `inputtype` pertains+to the haskell Input/Output types and `testnum` pertains to the test number.+Thus: all `testnum` are unique and are groupable by `inputtype`. # Misc.
minizinc-process.cabal view
@@ -4,7 +4,7 @@ -- http://haskell.org/cabal/users-guide/ name: minizinc-process-version: 0.1.2.1+version: 0.1.3.0 synopsis: A set of helpers to call minizinc models. description: MiniZinc is a language and a toolchain to solve discrete optimization problems. This package provides simple wrappers around the MiniZinc executable to pass inputs and read outputs. homepage: https://github.com/lucasdicioccio/minizinc-process#readme@@ -30,15 +30,29 @@ Process.Minizinc.Inspect hs-source-dirs: src+ build-depends: base >=4.8.2 && <4.14+ , aeson >= 1.4+ , attoparsec >= 0.13.2.2+ , bytestring >= 0.10.4.0+ , containers >= 0.5.5.1+ , directory >= 1.3.1.0+ , hashable >= 1.2.7.0+ , process >= 1.6.4.0+ , process-extras >= 0.7.4+ , text >= 1.2.3.0+ default-language: Haskell2010++test-suite minizinc-process-tests-hedghehog+ main-is: Test.hs+ type: exitcode-stdio-1.0 build-depends: base >=4.13 && <4.14 , aeson- , attoparsec- , bytestring- , containers- , directory+ , minizinc-process , hashable- , process- , process-extras- , stringsearch- , text+ , hedgehog+ , hspec+ , hspec-hedgehog+ hs-source-dirs:+ test default-language: Haskell2010+
src/Process/Minizinc.hs view
@@ -15,29 +15,30 @@ Solver (..), SolverName, MilliSeconds,- runLastMinizincJSON, SearchState(..),+ result, ResultHandler(..), runMinizincJSON,+ collectResults,+ keepLast,+ runLastMinizincJSON,+ cleanTmpFile, ) where -import Control.Monad ((>=>), void) import Control.Applicative ((<|>))+import Control.Exception (bracket) import Data.Attoparsec.ByteString (Parser, parse, IResult(..)) import Data.Attoparsec.Combinator (try)-import Data.Aeson (FromJSON, fromJSON, ToJSON, decode, encode, Value, Result(..))+import Data.Aeson (FromJSON, fromJSON, ToJSON, encode, Value, Result(..)) import Data.Aeson.Parser.Internal (json') import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Lazy as LByteString-import Data.ByteString.Lazy (fromStrict)-import Data.ByteString.Search.DFA (split) import Data.Hashable (Hashable, hash)-import qualified Data.List as List-import System.Process.ByteString (readProcessWithExitCode)-import System.Process (createProcess, proc, StdStream(CreatePipe), std_out)-import GHC.IO.Handle (Handle, hClose, hIsEOF)+import System.Directory (removeFile)+import System.Process (createProcess, proc, StdStream(CreatePipe), std_out, cleanupProcess)+import GHC.IO.Handle (Handle, hIsEOF) -- | Type alias asking for milliseconds. type MilliSeconds a = Int@@ -47,6 +48,7 @@ -- | Supported solvers or 'Other'. data Solver = Chuffed | COIN_BC | CPLEX | Gecode | Gurobi | SCIP | Xpress | Other SolverName+ deriving (Show) -- | An object helping to run MiniZinc. data MiniZinc input answer@@ -63,6 +65,10 @@ mkExtraArgs :: input -> [String] } +-- | Removes the temporary data file created as input before running minizinc.+cleanTmpFile :: MiniZinc input a -> input -> IO ()+cleanTmpFile mzn = removeFile . mkTmpDataPath mzn+ -- | A constructor for MiniZinc object for simple situations. simpleMiniZinc :: Hashable input =>@@ -73,7 +79,7 @@ simpleMiniZinc path timeout solver = MiniZinc path- (\obj -> show (hash obj) ++ ".json")+ (\obj -> "minizinc-process-" ++ show (hash obj) ++ ".json") (const timeout) (const solver) (const [])@@ -83,37 +89,16 @@ withArgs args mzn = mzn { mkExtraArgs = const args } -- | Runs MiniZinc on the input and parses output for the last answer.------ The parser for now is primitive and all the parsing occurs after processing--- with no guarantee to run on bounded-memory. This matters if your MiniZinc--- model returns so many solutions that the output is large. runLastMinizincJSON :: (ToJSON input, FromJSON answer) => MiniZinc input answer -> input -> IO (Maybe answer) runLastMinizincJSON minizinc obj = do- LByteString.writeFile fullPath $ encode obj- (_, out, err) <- readProcessWithExitCode "minizinc" args ""- seq (ByteString.length err) $ pure $ locateLastAnswer out+ fmap adapt $ runMinizincJSON minizinc obj Nothing keepLast where- fullPath :: FilePath- fullPath = mkTmpDataPath minizinc obj- locateLastAnswer :: FromJSON answer => ByteString -> Maybe answer- locateLastAnswer = locateLastOutput >=> decode . fromStrict- args :: [String]- args =- [ "--time-limit",- show (mkTimeLimit minizinc obj),- "--solver",- showSolver (mkSolver minizinc obj),- "--output-mode",- "json"- ]- ++ (mkExtraArgs minizinc obj)- ++ [ model minizinc,- fullPath- ]+ adapt :: Maybe (SearchState a) -> Maybe a+ adapt x = x >>= result data SearchState a = Exhausted a@@ -122,6 +107,11 @@ | InternalError String deriving (Show, Eq, Ord, Functor) +result :: SearchState a -> Maybe a+result (Incomplete a) = Just a+result (Exhausted a) = Just a+result _ = Nothing+ reduce :: FromJSON a => SearchState Value -> SearchState a reduce Unsatisfiable = Unsatisfiable reduce (InternalError s) = InternalError s@@ -137,6 +127,20 @@ { handleNext :: b -> SearchState obj -> IO (b, Maybe (ResultHandler obj b)) } +-- | Collect all results in memory.+-- The resulting list is in reverse order (best are first elements in case of optimizations).+collectResults :: ResultHandler obj [SearchState obj]+collectResults = ResultHandler go+ where+ go xs x = seq x $ pure (x:xs, Just $ collectResults)++-- | Keep only the latest result in memory.+keepLast :: ResultHandler obj (Maybe (SearchState obj))+keepLast = ResultHandler go+ where+ go _ x = seq x $ pure (Just x, Just $ keepLast)++ runMinizincJSON :: forall input answer b. (ToJSON input, FromJSON answer) =>@@ -147,10 +151,11 @@ IO b runMinizincJSON minizinc obj v0 resultHandler = do LByteString.writeFile fullPath $ encode obj- (_, Just out, _, _) <- createProcess (proc "minizinc" args){ std_out = CreatePipe }- vRet <- go out (parse oneResult) "" v0 resultHandler- hClose out- pure vRet+ let start = createProcess (proc "minizinc" args){ std_out = CreatePipe }+ bracket+ start+ cleanupProcess+ (\(_, Just out, _, _) -> go out (parse oneResult) "" v0 resultHandler) where go :: Handle -> (ByteString -> IResult ByteString (SearchState Value))@@ -213,18 +218,6 @@ SCIP -> "SCIP" Xpress -> "Xpress" Other n -> n--locateLastOutput :: ByteString -> Maybe ByteString-locateLastOutput =- safehead- . reverse- . List.filter (ByteString.isPrefixOf openCurlybrace)- . split resultSeparator- where- safehead [] = Nothing- safehead xs = Just $ head xs- resultSeparator = "\n----------\n"- openCurlybrace = "{" -- | NOTE: the parser is fed with hGetLine (stripping EOL markers)
+ test/Test.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Data.Function ((&))+import qualified Data.List as List+import Data.Aeson (FromJSON(..), ToJSON(..), (.=), (.:))+import qualified Data.Aeson as Aeson+import Data.Hashable (Hashable(..))+import Control.Monad.IO.Class (liftIO)+import Control.Monad (when)++import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Test.Hspec (describe, it, hspec)+import Test.Hspec.Hedgehog (hedgehog)++import Process.Minizinc++data Input001 = Input001 { input001X :: Int }+ deriving (Show,Eq,Ord)+instance Hashable Input001 where+ hashWithSalt s (Input001 x) = hashWithSalt s x+instance ToJSON Input001 where+ toJSON (Input001 x) = Aeson.object [ "x" .= x ]+data Output001 = Output001 { output001Y :: Int }+ deriving (Show,Eq,Ord)+instance FromJSON Output001 where+ parseJSON = Aeson.withObject "output001" $ \v -> Output001 <$> v .: "y"++solver :: MonadGen m => m Solver+solver = Gen.element [ Gecode, Chuffed, COIN_BC ]++mipSolver :: MonadGen m => m Solver+mipSolver = Gen.element [ COIN_BC ]++cpSolver :: MonadGen m => m Solver+cpSolver = Gen.element [ Gecode, Chuffed ]++mzncall_t001_01 = do+ x <- forAll $ Gen.integral (Range.linear (-100) 100)+ s <- forAll solver+ let mzn = simpleMiniZinc @Input001 @Output001 "models/test001_01.mzn" 1000 s+ let input = Input001 x+ outy <- liftIO $ runLastMinizincJSON mzn input+ liftIO $ cleanTmpFile mzn input+ Just x === fmap output001Y outy++mzncall_t001_02 = do+ x <- forAll $ Gen.integral (Range.linear (-100) 100)+ s <- forAll solver+ let mzn = simpleMiniZinc @Input001 @Output001 "models/test001_02.mzn" 1000 s+ let input = Input001 x+ outy <- liftIO $ runLastMinizincJSON mzn input+ liftIO $ cleanTmpFile mzn input+ Nothing === outy++mzncall_t001_03 = do+ x <- forAll $ Gen.integral (Range.linear (-100) 100)+ s <- forAll cpSolver+ let mzn = simpleMiniZinc @Input001 @Output001 "models/test001_03.mzn" 3000 s+ & withArgs ["-a"]+ let input = Input001 x+ outputs <- liftIO $ runMinizincJSON mzn input [] collectResults++ let (exhaustives,nonExhaustives) = List.partition isExhaustive outputs++ when (length outputs == 7) $ do+ liftIO $ cleanTmpFile mzn input++ length outputs === 7+ length nonExhaustives === 6+ length exhaustives === 1+ where+ isExhaustive (Exhausted a) = True+ isExhaustive _ = False++prop_mzncall_t001_01 :: Property+prop_mzncall_t001_01 =+ property mzncall_t001_01++prop_mzncall_t001_02 :: Property+prop_mzncall_t001_02 =+ property mzncall_t001_02++prop_mzncall_t001_03 :: Property+prop_mzncall_t001_03 =+ property mzncall_t001_03++tests :: IO Bool+tests = checkParallel $$(discover)++main :: IO ()+main = hspec $ do+ describe "output-input json reading" $ do+ it "should solve trivial problems" $ hedgehog $ do+ mzncall_t001_01+ it "should not solve unsatisfiable problems" $ hedgehog $ do+ mzncall_t001_02+ it "should find seven satisfiable answers to y in [x-3 .. x+3]" $ hedgehog $ do+ mzncall_t001_03