{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Fuzz testing for math programming backends.
module Math.Programming.Tests.Fuzz where

import Control.Monad.IO.Class
import Control.Monad.State
import Control.Monad.Writer
import qualified Data.Map as M
import qualified Data.Sequence as S
import qualified Data.Text as T
import Lens.Micro
import Lens.Micro.Mtl
import Lens.Micro.TH
import Math.Programming
import System.Random
import System.Random.Stateful
import Test.Hspec hiding (focus, pending)
import Test.Hspec.QuickCheck
import Test.QuickCheck

newtype Variable = Variable Int
  deriving
    ( Int -> Variable -> ShowS
[Variable] -> ShowS
Variable -> String
(Int -> Variable -> ShowS)
-> (Variable -> String) -> ([Variable] -> ShowS) -> Show Variable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Variable] -> ShowS
$cshowList :: [Variable] -> ShowS
show :: Variable -> String
$cshow :: Variable -> String
showsPrec :: Int -> Variable -> ShowS
$cshowsPrec :: Int -> Variable -> ShowS
Show,
      Variable -> Variable -> Bool
(Variable -> Variable -> Bool)
-> (Variable -> Variable -> Bool) -> Eq Variable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Variable -> Variable -> Bool
$c/= :: Variable -> Variable -> Bool
== :: Variable -> Variable -> Bool
$c== :: Variable -> Variable -> Bool
Eq,
      Eq Variable
Eq Variable
-> (Variable -> Variable -> Ordering)
-> (Variable -> Variable -> Bool)
-> (Variable -> Variable -> Bool)
-> (Variable -> Variable -> Bool)
-> (Variable -> Variable -> Bool)
-> (Variable -> Variable -> Variable)
-> (Variable -> Variable -> Variable)
-> Ord Variable
Variable -> Variable -> Bool
Variable -> Variable -> Ordering
Variable -> Variable -> Variable
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Variable -> Variable -> Variable
$cmin :: Variable -> Variable -> Variable
max :: Variable -> Variable -> Variable
$cmax :: Variable -> Variable -> Variable
>= :: Variable -> Variable -> Bool
$c>= :: Variable -> Variable -> Bool
> :: Variable -> Variable -> Bool
$c> :: Variable -> Variable -> Bool
<= :: Variable -> Variable -> Bool
$c<= :: Variable -> Variable -> Bool
< :: Variable -> Variable -> Bool
$c< :: Variable -> Variable -> Bool
compare :: Variable -> Variable -> Ordering
$ccompare :: Variable -> Variable -> Ordering
Ord
    )

newtype Constraint = Constraint Int
  deriving
    ( Int -> Constraint -> ShowS
[Constraint] -> ShowS
Constraint -> String
(Int -> Constraint -> ShowS)
-> (Constraint -> String)
-> ([Constraint] -> ShowS)
-> Show Constraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constraint] -> ShowS
$cshowList :: [Constraint] -> ShowS
show :: Constraint -> String
$cshow :: Constraint -> String
showsPrec :: Int -> Constraint -> ShowS
$cshowsPrec :: Int -> Constraint -> ShowS
Show,
      Constraint -> Constraint -> Bool
(Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool) -> Eq Constraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constraint -> Constraint -> Bool
$c/= :: Constraint -> Constraint -> Bool
== :: Constraint -> Constraint -> Bool
$c== :: Constraint -> Constraint -> Bool
Eq,
      Eq Constraint
Eq Constraint
-> (Constraint -> Constraint -> Ordering)
-> (Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Constraint)
-> (Constraint -> Constraint -> Constraint)
-> Ord Constraint
Constraint -> Constraint -> Bool
Constraint -> Constraint -> Ordering
Constraint -> Constraint -> Constraint
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Constraint -> Constraint -> Constraint
$cmin :: Constraint -> Constraint -> Constraint
max :: Constraint -> Constraint -> Constraint
$cmax :: Constraint -> Constraint -> Constraint
>= :: Constraint -> Constraint -> Bool
$c>= :: Constraint -> Constraint -> Bool
> :: Constraint -> Constraint -> Bool
$c> :: Constraint -> Constraint -> Bool
<= :: Constraint -> Constraint -> Bool
$c<= :: Constraint -> Constraint -> Bool
< :: Constraint -> Constraint -> Bool
$c< :: Constraint -> Constraint -> Bool
compare :: Constraint -> Constraint -> Ordering
$ccompare :: Constraint -> Constraint -> Ordering
Ord
    )

newtype Objective = Objective Int
  deriving
    ( Int -> Objective -> ShowS
[Objective] -> ShowS
Objective -> String
(Int -> Objective -> ShowS)
-> (Objective -> String)
-> ([Objective] -> ShowS)
-> Show Objective
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Objective] -> ShowS
$cshowList :: [Objective] -> ShowS
show :: Objective -> String
$cshow :: Objective -> String
showsPrec :: Int -> Objective -> ShowS
$cshowsPrec :: Int -> Objective -> ShowS
Show,
      Objective -> Objective -> Bool
(Objective -> Objective -> Bool)
-> (Objective -> Objective -> Bool) -> Eq Objective
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Objective -> Objective -> Bool
$c/= :: Objective -> Objective -> Bool
== :: Objective -> Objective -> Bool
$c== :: Objective -> Objective -> Bool
Eq,
      Eq Objective
Eq Objective
-> (Objective -> Objective -> Ordering)
-> (Objective -> Objective -> Bool)
-> (Objective -> Objective -> Bool)
-> (Objective -> Objective -> Bool)
-> (Objective -> Objective -> Bool)
-> (Objective -> Objective -> Objective)
-> (Objective -> Objective -> Objective)
-> Ord Objective
Objective -> Objective -> Bool
Objective -> Objective -> Ordering
Objective -> Objective -> Objective
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Objective -> Objective -> Objective
$cmin :: Objective -> Objective -> Objective
max :: Objective -> Objective -> Objective
$cmax :: Objective -> Objective -> Objective
>= :: Objective -> Objective -> Bool
$c>= :: Objective -> Objective -> Bool
> :: Objective -> Objective -> Bool
$c> :: Objective -> Objective -> Bool
<= :: Objective -> Objective -> Bool
$c<= :: Objective -> Objective -> Bool
< :: Objective -> Objective -> Bool
$c< :: Objective -> Objective -> Bool
compare :: Objective -> Objective -> Ordering
$ccompare :: Objective -> Objective -> Ordering
Ord
    )

-- | The types of actions we can perform on a linear program
data LPAction
  = AddVariable Variable
  | AddThenRemoveVariable Variable
  | AddConstraint Constraint
  | AddThenRemoveConstraint Constraint
  | AddObjective Objective
  | AddThenRemoveObjective Objective
  | Optimize
  deriving (Int -> LPAction -> ShowS
[LPAction] -> ShowS
LPAction -> String
(Int -> LPAction -> ShowS)
-> (LPAction -> String) -> ([LPAction] -> ShowS) -> Show LPAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LPAction] -> ShowS
$cshowList :: [LPAction] -> ShowS
show :: LPAction -> String
$cshow :: LPAction -> String
showsPrec :: Int -> LPAction -> ShowS
$cshowsPrec :: Int -> LPAction -> ShowS
Show)

newtype LPActions = LPActions [LPAction]
  deriving (Int -> LPActions -> ShowS
[LPActions] -> ShowS
LPActions -> String
(Int -> LPActions -> ShowS)
-> (LPActions -> String)
-> ([LPActions] -> ShowS)
-> Show LPActions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LPActions] -> ShowS
$cshowList :: [LPActions] -> ShowS
show :: LPActions -> String
$cshow :: LPActions -> String
showsPrec :: Int -> LPActions -> ShowS
$cshowsPrec :: Int -> LPActions -> ShowS
Show)

instance Arbitrary LPActions where
  arbitrary :: Gen LPActions
arbitrary = do
    NonNegative Int
actionCount <- Gen (NonNegative Int)
forall a. Arbitrary a => Gen a
arbitrary
    [LPAction]
actions <- [Int] -> (Int -> Gen LPAction) -> Gen [LPAction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
1 .. Int
actionCount] ((Int -> Gen LPAction) -> Gen [LPAction])
-> (Int -> Gen LPAction) -> Gen [LPAction]
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
      Int
d7 <- (Int -> Int) -> Gen Int -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` (Int
7 :: Int)) Gen Int
forall a. Arbitrary a => Gen a
arbitrary
      LPAction -> Gen LPAction
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LPAction -> Gen LPAction) -> LPAction -> Gen LPAction
forall a b. (a -> b) -> a -> b
$ case Int
d7 of
        Int
0 -> Variable -> LPAction
AddVariable (Int -> Variable
Variable Int
i)
        Int
1 -> Variable -> LPAction
AddThenRemoveVariable (Int -> Variable
Variable Int
i)
        Int
2 -> Constraint -> LPAction
AddConstraint (Int -> Constraint
Constraint Int
i)
        Int
3 -> Constraint -> LPAction
AddThenRemoveConstraint (Int -> Constraint
Constraint Int
i)
        Int
4 -> Objective -> LPAction
AddObjective (Int -> Objective
Objective Int
i)
        Int
5 -> Objective -> LPAction
AddThenRemoveObjective (Int -> Objective
Objective Int
i)
        Int
_ -> LPAction
Optimize
    LPActions -> Gen LPActions
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([LPAction] -> LPActions
LPActions [LPAction]
actions)

data LPState v c o = LPState
  { forall v c o. LPState v c o -> Map Variable v
_variables :: M.Map Variable v,
    forall v c o. LPState v c o -> Map Variable Text
_variableNames :: M.Map Variable T.Text,
    forall v c o. LPState v c o -> Map Constraint c
_constraints :: M.Map Constraint c,
    forall v c o. LPState v c o -> Map Constraint Text
_constraintNames :: M.Map Constraint T.Text,
    forall v c o. LPState v c o -> Map Objective o
_objectives :: M.Map Objective o,
    forall v c o. LPState v c o -> Map Objective Text
_objectiveNames :: M.Map Objective T.Text,
    forall v c o. LPState v c o -> [LPAction]
_pending :: [LPAction],
    forall v c o. LPState v c o -> IOGenM StdGen
_randomGen :: IOGenM StdGen
  }

makeLenses ''LPState

initLPState :: Int -> [LPAction] -> IO (LPState v c o)
initLPState :: forall v c o. Int -> [LPAction] -> IO (LPState v c o)
initLPState Int
seed [LPAction]
todo = do
  IOGenM StdGen
g <- StdGen -> IO (IOGenM StdGen)
forall (m :: * -> *) g. MonadIO m => g -> m (IOGenM g)
newIOGenM (Int -> StdGen
mkStdGen Int
seed)
  LPState v c o -> IO (LPState v c o)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    LPState :: forall v c o.
Map Variable v
-> Map Variable Text
-> Map Constraint c
-> Map Constraint Text
-> Map Objective o
-> Map Objective Text
-> [LPAction]
-> IOGenM StdGen
-> LPState v c o
LPState
      { _variables :: Map Variable v
_variables = Map Variable v
forall k a. Map k a
M.empty,
        _variableNames :: Map Variable Text
_variableNames = Map Variable Text
forall k a. Map k a
M.empty,
        _constraints :: Map Constraint c
_constraints = Map Constraint c
forall k a. Map k a
M.empty,
        _constraintNames :: Map Constraint Text
_constraintNames = Map Constraint Text
forall k a. Map k a
M.empty,
        _objectives :: Map Objective o
_objectives = Map Objective o
forall k a. Map k a
M.empty,
        _objectiveNames :: Map Objective Text
_objectiveNames = Map Objective Text
forall k a. Map k a
M.empty,
        _pending :: [LPAction]
_pending = [LPAction]
todo,
        _randomGen :: IOGenM StdGen
_randomGen = IOGenM StdGen
g
      }

type LPFuzz v c o m =
  ( MonadState (LPState v c o) m,
    MonadLP v c o m,
    MonadWriter (S.Seq String) m,
    MonadIO m
  )

evalPending :: LPFuzz v c o m => m ()
evalPending :: forall v c o (m :: * -> *). LPFuzz v c o m => m ()
evalPending = do
  [LPAction]
todo <- Getting [LPAction] (LPState v c o) [LPAction] -> m [LPAction]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [LPAction] (LPState v c o) [LPAction]
forall v c o. Lens' (LPState v c o) [LPAction]
pending
  case [LPAction]
todo of
    [] -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    (LPAction
x : [LPAction]
xs) -> do
      ASetter (LPState v c o) (LPState v c o) [LPAction] [LPAction]
-> [LPAction] -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter (LPState v c o) (LPState v c o) [LPAction] [LPAction]
forall v c o. Lens' (LPState v c o) [LPAction]
pending [LPAction]
xs
      LPAction -> m ()
forall v c o (m :: * -> *). LPFuzz v c o m => LPAction -> m ()
evalAction LPAction
x
      m ()
forall v c o (m :: * -> *). LPFuzz v c o m => m ()
evalPending

evalAction :: LPFuzz v c o m => LPAction -> m ()
evalAction :: forall v c o (m :: * -> *). LPFuzz v c o m => LPAction -> m ()
evalAction LPAction
action = Seq String -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (String -> Seq String
forall a. a -> Seq a
S.singleton (LPAction -> String
forall a. Show a => a -> String
show LPAction
action)) m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LPAction -> m ()
forall v c o (m :: * -> *). LPFuzz v c o m => LPAction -> m ()
evalAction' LPAction
action

evalAction' :: LPFuzz v c o m => LPAction -> m ()
evalAction' :: forall v c o (m :: * -> *). LPFuzz v c o m => LPAction -> m ()
evalAction' (AddVariable Variable
k) = Variable
-> m v -> ASetter' (LPState v c o) (Map Variable v) -> m ()
forall v c o (m :: * -> *) k a.
(LPFuzz v c o m, Ord k) =>
k -> m a -> ASetter' (LPState v c o) (Map k a) -> m ()
add Variable
k m v
forall v c o (m :: * -> *). MonadLP v c o m => m v
addVariable ASetter' (LPState v c o) (Map Variable v)
forall v c o v.
Lens
  (LPState v c o) (LPState v c o) (Map Variable v) (Map Variable v)
variables
evalAction' (AddThenRemoveVariable Variable
k) = Variable
-> m v
-> (v -> m ())
-> Lens' (LPState v c o) (Map Variable v)
-> m ()
forall v c o (m :: * -> *) k a.
(LPFuzz v c o m, Ord k) =>
k -> m a -> (a -> m ()) -> Lens' (LPState v c o) (Map k a) -> m ()
addThenRemove Variable
k m v
forall v c o (m :: * -> *). MonadLP v c o m => m v
addVariable v -> m ()
forall v c o (m :: * -> *). MonadLP v c o m => v -> m ()
deleteVariable forall v c o v.
Lens
  (LPState v c o) (LPState v c o) (Map Variable v) (Map Variable v)
Lens' (LPState v c o) (Map Variable v)
variables
evalAction' (AddConstraint Constraint
k) = Constraint
-> m c -> ASetter' (LPState v c o) (Map Constraint c) -> m ()
forall v c o (m :: * -> *) k a.
(LPFuzz v c o m, Ord k) =>
k -> m a -> ASetter' (LPState v c o) (Map k a) -> m ()
add Constraint
k m c
forall v c o (m :: * -> *). LPFuzz v c o m => m c
makeConstraint ASetter' (LPState v c o) (Map Constraint c)
forall v c o c.
Lens
  (LPState v c o)
  (LPState v c o)
  (Map Constraint c)
  (Map Constraint c)
constraints
evalAction' (AddThenRemoveConstraint Constraint
k) = Constraint
-> m c
-> (c -> m ())
-> Lens' (LPState v c o) (Map Constraint c)
-> m ()
forall v c o (m :: * -> *) k a.
(LPFuzz v c o m, Ord k) =>
k -> m a -> (a -> m ()) -> Lens' (LPState v c o) (Map k a) -> m ()
addThenRemove Constraint
k m c
forall v c o (m :: * -> *). LPFuzz v c o m => m c
makeConstraint c -> m ()
forall v c o (m :: * -> *). MonadLP v c o m => c -> m ()
deleteConstraint forall v c o c.
Lens
  (LPState v c o)
  (LPState v c o)
  (Map Constraint c)
  (Map Constraint c)
Lens' (LPState v c o) (Map Constraint c)
constraints
evalAction' (AddObjective Objective
k) = Objective
-> m o -> ASetter' (LPState v c o) (Map Objective o) -> m ()
forall v c o (m :: * -> *) k a.
(LPFuzz v c o m, Ord k) =>
k -> m a -> ASetter' (LPState v c o) (Map k a) -> m ()
add Objective
k m o
forall v c o (m :: * -> *). LPFuzz v c o m => m o
makeObjective ASetter' (LPState v c o) (Map Objective o)
forall v c o o.
Lens
  (LPState v c o) (LPState v c o) (Map Objective o) (Map Objective o)
objectives
evalAction' (AddThenRemoveObjective Objective
k) = Objective
-> m o
-> (o -> m ())
-> Lens' (LPState v c o) (Map Objective o)
-> m ()
forall v c o (m :: * -> *) k a.
(LPFuzz v c o m, Ord k) =>
k -> m a -> (a -> m ()) -> Lens' (LPState v c o) (Map k a) -> m ()
addThenRemove Objective
k m o
forall v c o (m :: * -> *). LPFuzz v c o m => m o
makeObjective o -> m ()
forall v c o (m :: * -> *). MonadLP v c o m => o -> m ()
deleteObjective forall v c o o.
Lens
  (LPState v c o) (LPState v c o) (Map Objective o) (Map Objective o)
Lens' (LPState v c o) (Map Objective o)
objectives
evalAction' LPAction
Optimize = m SolutionStatus -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m SolutionStatus
forall v c o (m :: * -> *). MonadLP v c o m => m SolutionStatus
optimizeLP

add :: (LPFuzz v c o m, Ord k) => k -> m a -> ASetter' (LPState v c o) (M.Map k a) -> m ()
add :: forall v c o (m :: * -> *) k a.
(LPFuzz v c o m, Ord k) =>
k -> m a -> ASetter' (LPState v c o) (Map k a) -> m ()
add k
k m a
create ASetter' (LPState v c o) (Map k a)
focus =
  m a
create m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ASetter' (LPState v c o) (Map k a) -> (Map k a -> Map k a) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter' (LPState v c o) (Map k a)
focus ((Map k a -> Map k a) -> m ())
-> (a -> Map k a -> Map k a) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
k

addThenRemove :: (LPFuzz v c o m, Ord k) => k -> (m a) -> (a -> m ()) -> Lens' (LPState v c o) (M.Map k a) -> m ()
addThenRemove :: forall v c o (m :: * -> *) k a.
(LPFuzz v c o m, Ord k) =>
k -> m a -> (a -> m ()) -> Lens' (LPState v c o) (Map k a) -> m ()
addThenRemove k
k m a
create a -> m ()
destroy Lens' (LPState v c o) (Map k a)
focus = do
  Map k a
collection <- Getting (Map k a) (LPState v c o) (Map k a) -> m (Map k a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Map k a) (LPState v c o) (Map k a)
Lens' (LPState v c o) (Map k a)
focus
  case k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k a
collection of
    Just a
v -> a -> m ()
destroy a
v m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ASetter (LPState v c o) (LPState v c o) (Map k a) (Map k a)
-> (Map k a -> Map k a) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter (LPState v c o) (LPState v c o) (Map k a) (Map k a)
Lens' (LPState v c o) (Map k a)
focus (k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
M.delete k
k)
    Maybe a
Nothing -> k
-> m a
-> ASetter (LPState v c o) (LPState v c o) (Map k a) (Map k a)
-> m ()
forall v c o (m :: * -> *) k a.
(LPFuzz v c o m, Ord k) =>
k -> m a -> ASetter' (LPState v c o) (Map k a) -> m ()
add k
k m a
create ASetter (LPState v c o) (LPState v c o) (Map k a) (Map k a)
Lens' (LPState v c o) (Map k a)
focus

makeConstraint :: LPFuzz v c o m => m c
makeConstraint :: forall v c o (m :: * -> *). LPFuzz v c o m => m c
makeConstraint = do
  Expr v
lhs <- m (Expr v)
forall v c o (m :: * -> *). LPFuzz v c o m => m (Expr v)
chooseExpr
  Expr v
rhs <- m (Expr v)
forall v c o (m :: * -> *). LPFuzz v c o m => m (Expr v)
chooseExpr
  Expr v -> Expr v -> m c
op <- m (Expr v -> Expr v -> m c)
forall v c o (m :: * -> *).
LPFuzz v c o m =>
m (Expr v -> Expr v -> m c)
chooseInequality
  Expr v
lhs Expr v -> Expr v -> m c
`op` Expr v
rhs

chooseExpr :: LPFuzz v c o m => m (Expr v)
chooseExpr :: forall v c o (m :: * -> *). LPFuzz v c o m => m (Expr v)
chooseExpr = do
  IOGenM StdGen
g <- Getting (IOGenM StdGen) (LPState v c o) (IOGenM StdGen)
-> m (IOGenM StdGen)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (IOGenM StdGen) (LPState v c o) (IOGenM StdGen)
forall v c o. Lens' (LPState v c o) (IOGenM StdGen)
randomGen
  Map Variable v
vs <- Getting (Map Variable v) (LPState v c o) (Map Variable v)
-> m (Map Variable v)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Map Variable v) (LPState v c o) (Map Variable v)
forall v c o v.
Lens
  (LPState v c o) (LPState v c o) (Map Variable v) (Map Variable v)
variables
  [Expr v]
terms <- [v] -> (v -> m (Expr v)) -> m [Expr v]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map Variable v -> [v]
forall k a. Map k a -> [a]
M.elems Map Variable v
vs) ((v -> m (Expr v)) -> m [Expr v])
-> (v -> m (Expr v)) -> m [Expr v]
forall a b. (a -> b) -> a -> b
$ \v
v -> do
    Double
c <- IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Double, Double) -> IOGenM StdGen -> IO Double
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (-Double
1e10, Double
1e10) IOGenM StdGen
g)
    Expr v -> m (Expr v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
c Double -> v -> Expr v
forall a b. Num a => a -> b -> LinExpr a b
*. v
v)

  Expr v -> m (Expr v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expr v] -> Expr v
forall a (t :: * -> *) b.
(Num a, Foldable t) =>
t (LinExpr a b) -> LinExpr a b
esum [Expr v]
terms)

chooseInequality :: LPFuzz v c o m => m (Expr v -> Expr v -> m c)
chooseInequality :: forall v c o (m :: * -> *).
LPFuzz v c o m =>
m (Expr v -> Expr v -> m c)
chooseInequality = do
  IOGenM StdGen
g <- Getting (IOGenM StdGen) (LPState v c o) (IOGenM StdGen)
-> m (IOGenM StdGen)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (IOGenM StdGen) (LPState v c o) (IOGenM StdGen)
forall v c o. Lens' (LPState v c o) (IOGenM StdGen)
randomGen
  Int
d3 <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Int, Int) -> IOGenM StdGen -> IO Int
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int
0 :: Int, Int
2) IOGenM StdGen
g)
  case Int
d3 of
    Int
0 -> (Expr v -> Expr v -> m c) -> m (Expr v -> Expr v -> m c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr v -> Expr v -> m c
forall v c o (m :: * -> *).
MonadLP v c o m =>
Expr v -> Expr v -> m c
(.<=.)
    Int
1 -> (Expr v -> Expr v -> m c) -> m (Expr v -> Expr v -> m c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr v -> Expr v -> m c
forall v c o (m :: * -> *).
MonadLP v c o m =>
Expr v -> Expr v -> m c
(.>=.)
    Int
_ -> (Expr v -> Expr v -> m c) -> m (Expr v -> Expr v -> m c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr v -> Expr v -> m c
forall v c o (m :: * -> *).
MonadLP v c o m =>
Expr v -> Expr v -> m c
(.==.)

makeObjective :: LPFuzz v c o m => m o
makeObjective :: forall v c o (m :: * -> *). LPFuzz v c o m => m o
makeObjective = do
  IOGenM StdGen
g <- Getting (IOGenM StdGen) (LPState v c o) (IOGenM StdGen)
-> m (IOGenM StdGen)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (IOGenM StdGen) (LPState v c o) (IOGenM StdGen)
forall v c o. Lens' (LPState v c o) (IOGenM StdGen)
randomGen
  Bool
minimizing <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IOGenM StdGen -> IO Bool
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM IOGenM StdGen
g)

  if Bool
minimizing
    then m (Expr v)
forall v c o (m :: * -> *). LPFuzz v c o m => m (Expr v)
chooseExpr m (Expr v) -> (Expr v -> m o) -> m o
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Expr v -> m o
forall v c o (m :: * -> *). MonadLP v c o m => Expr v -> m o
minimize
    else m (Expr v)
forall v c o (m :: * -> *). LPFuzz v c o m => m (Expr v)
chooseExpr m (Expr v) -> (Expr v -> m o) -> m o
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Expr v -> m o
forall v c o (m :: * -> *). MonadLP v c o m => Expr v -> m o
maximize

makeFuzzTests ::
  (MonadIO m, MonadLP v c o m) =>
  -- | The runner for the API being tested.
  (m (S.Seq String) -> IO ()) ->
  -- | The resulting test suite.
  Spec
makeFuzzTests :: forall (m :: * -> *) v c o.
(MonadIO m, MonadLP v c o m) =>
(m (Seq String) -> IO ()) -> Spec
makeFuzzTests m (Seq String) -> IO ()
runner =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Fuzz testing" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> (Int -> LPActions -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"finds no failures" ((Int -> LPActions -> IO ()) -> Spec)
-> (Int -> LPActions -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \Int
seed (LPActions [LPAction]
todo) -> do
      LPState v c o
initState <- IO (LPState v c o) -> IO (LPState v c o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> [LPAction] -> IO (LPState v c o)
forall v c o. Int -> [LPAction] -> IO (LPState v c o)
initLPState Int
seed [LPAction]
todo)
      m (Seq String) -> IO ()
runner (m (Seq String) -> IO ())
-> (StateT (LPState v c o) (WriterT (Seq String) m) ()
    -> m (Seq String))
-> StateT (LPState v c o) (WriterT (Seq String) m) ()
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT (Seq String) m () -> m (Seq String)
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT
        (WriterT (Seq String) m () -> m (Seq String))
-> (StateT (LPState v c o) (WriterT (Seq String) m) ()
    -> WriterT (Seq String) m ())
-> StateT (LPState v c o) (WriterT (Seq String) m) ()
-> m (Seq String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT (LPState v c o) (WriterT (Seq String) m) ()
 -> LPState v c o -> WriterT (Seq String) m ())
-> LPState v c o
-> StateT (LPState v c o) (WriterT (Seq String) m) ()
-> WriterT (Seq String) m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (LPState v c o) (WriterT (Seq String) m) ()
-> LPState v c o -> WriterT (Seq String) m ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT LPState v c o
initState
        (StateT (LPState v c o) (WriterT (Seq String) m) () -> IO ())
-> StateT (LPState v c o) (WriterT (Seq String) m) () -> IO ()
forall a b. (a -> b) -> a -> b
$ StateT (LPState v c o) (WriterT (Seq String) m) ()
forall v c o (m :: * -> *). LPFuzz v c o m => m ()
evalPending