{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-
<https://www.coin-or.org/Clp/userguide/clpuserguide.html>
-}
module Numeric.COINOR.CLP (
   simplex,
   concurrent,
   LP.Direction(..),
   PlusMinusOne(..),
   Term(..), (LP..*),
   Constraints,
   LP.free, (LP.<=.), (LP.>=.), (LP.==.), (LP.>=<.),
   Method, Priv.dual, Priv.primal,
   Priv.initialSolve, Priv.initialDualSolve, Priv.initialPrimalSolve,
   Priv.initialBarrierSolve, Priv.initialBarrierNoCrossSolve,
   FailureType(..),
   Result,
   -- * only for testing
   Priv.solveEndless,
   ) where

{- ToDo: can we use addRows instead of loadProblem?
Certainly yes, but where can we set matrix layout then?
-}
-- ToDo: extend .* to functions of indices using a type class
-- ToDo: interior point - Clp/examples/testBarrier.cpp
import qualified Numeric.COINOR.CLP.FFI as FFI
import qualified Numeric.COINOR.CLP.Debug as Debug
import qualified Numeric.COINOR.CLP.Private as Priv
import Numeric.COINOR.CLP.Private
         (Method(runMethod), Result, FailureType(..),
          runContT, withBuffer, false,
          storeBounds, prepareRowBoundsArrays, prepareColumnBoundsArrays,
          storeConstraints, prepareConstraints,
          setOptimizationDirection, examineStatus)

import qualified Numeric.LinearProgramming.Common as LP
import Numeric.LinearProgramming.Common
         (Inequality(Inequality), Bounds,
          Term(Term), Constraints, Direction(..), Objective)

import qualified Data.Array.Comfort.Storable as Array
import qualified Data.Array.Comfort.Shape as Shape
import qualified Data.NonEmpty as NonEmpty
import qualified Data.List.HT as ListHT
import Data.NonEmpty ((!:))
import Data.Traversable (for)
import Data.Foldable (traverse_)

import qualified Control.Concurrent.Split.MVar as MVar
import qualified Control.Concurrent as Conc
import qualified Control.Monad.Trans.Cont as MC
import Control.Monad.IO.Class (liftIO)
import Control.Monad (void)
import Control.Exception (bracket)

import System.IO.Unsafe (unsafePerformIO)

import Foreign.C.Types (CDouble)
import Foreign.C.String (withCString)
import Foreign.Ptr (Ptr, nullPtr)


{- $setup
>>> import qualified Numeric.COINOR.CLP as LP
>>> import qualified Numeric.LinearProgramming.Test as TestLP
>>> import Numeric.COINOR.CLP
>>>    (PlusMinusOne(..), (.*), (==.), (<=.), (>=.), (>=<.))
>>>
>>> import qualified Data.Array.Comfort.Storable as Array
>>> import qualified Data.Array.Comfort.Shape as Shape
>>> import qualified Data.NonEmpty as NonEmpty
>>> import Data.NonEmpty ((!:))
>>>
>>> import Data.Either.HT (mapRight)
>>> import Data.Tuple.HT (mapSnd)
>>>
>>> import qualified Test.QuickCheck as QC
>>> import Test.QuickCheck ((===), (.&&.), (.||.))
>>>
>>> type X = Shape.Element
>>> type PairShape = Shape.NestedTuple Shape.TupleIndex (X,X)
>>> type TripletShape = Shape.NestedTuple Shape.TupleIndex (X,X,X)
>>>
>>> pairShape :: PairShape
>>> pairShape = Shape.static
>>>
>>> tripletShape :: TripletShape
>>> tripletShape = Shape.static
>>>
>>> approxReal :: (Ord a, Num a) => a -> a -> a -> Bool
>>> approxReal tol x y = abs (x-y) <= tol
>>>
>>> genMethod :: QC.Gen (String, LP.Method)
>>> genMethod = QC.elements $
>>>    ("dual", LP.dual) :
>>>    ("primal", LP.primal) :
>>>    ("initialSolve", LP.initialSolve) :
>>>    ("initialDualSolve", LP.initialDualSolve) :
>>>    ("initialPrimalSolve", LP.initialPrimalSolve) :
>>>    ("initialBarrierSolve", LP.initialBarrierSolve) :
>>>    -- let tests fail
>>>    -- ("initialBarrierNoCrossSolve", LP.initialBarrierNoCrossSolve) :
>>>    []
>>>
>>> forAllMethod ::
>>>    (QC.Testable prop) => (LP.Method -> prop) -> QC.Property
>>> forAllMethod prop = QC.forAllShow genMethod fst (prop . snd)
-}



data PlusMinusOne = MinusOne | PlusOne deriving (PlusMinusOne -> PlusMinusOne -> Bool
(PlusMinusOne -> PlusMinusOne -> Bool)
-> (PlusMinusOne -> PlusMinusOne -> Bool) -> Eq PlusMinusOne
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlusMinusOne -> PlusMinusOne -> Bool
== :: PlusMinusOne -> PlusMinusOne -> Bool
$c/= :: PlusMinusOne -> PlusMinusOne -> Bool
/= :: PlusMinusOne -> PlusMinusOne -> Bool
Eq, Int -> PlusMinusOne -> ShowS
[PlusMinusOne] -> ShowS
PlusMinusOne -> String
(Int -> PlusMinusOne -> ShowS)
-> (PlusMinusOne -> String)
-> ([PlusMinusOne] -> ShowS)
-> Show PlusMinusOne
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlusMinusOne -> ShowS
showsPrec :: Int -> PlusMinusOne -> ShowS
$cshow :: PlusMinusOne -> String
show :: PlusMinusOne -> String
$cshowList :: [PlusMinusOne] -> ShowS
showList :: [PlusMinusOne] -> ShowS
Show)


class Coefficient a where
   loadProblem ::
      (Shape.Indexed sh, Shape.Index sh ~ ix) =>
      sh ->
      Constraints a ix ->
      Ptr FFI.Simplex ->
      Ptr CDouble -> Ptr CDouble ->
      Ptr CDouble ->
      Ptr CDouble -> Ptr CDouble ->
      MC.ContT () IO ()

instance Coefficient Double where
   loadProblem :: forall sh ix.
(Indexed sh, Index sh ~ ix) =>
sh
-> Constraints Double ix
-> Ptr Simplex
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> ContT () IO ()
loadProblem sh
shape Constraints Double ix
constrs Ptr Simplex
lp Ptr CDouble
collbPtr Ptr CDouble
colubPtr Ptr CDouble
objPtr Ptr CDouble
rowlbPtr Ptr CDouble
rowubPtr = do
      let (Array ShapeInt CDouble
coefficients, Array ShapeInt CInt
indices, Array ShapeInt BigIndex
rowStarts) = sh
-> Constraints Double ix
-> (Array ShapeInt CDouble, Array ShapeInt CInt,
    Array ShapeInt BigIndex)
forall sh ix.
(Indexed sh, Index sh ~ ix) =>
sh
-> Constraints Double ix
-> (Array ShapeInt CDouble, Array ShapeInt CInt,
    Array ShapeInt BigIndex)
prepareConstraints sh
shape Constraints Double ix
constrs
      (Ptr CDouble
coefficientsPtr, Ptr CInt
indexPtr, Ptr BigIndex
startPtr)
         <- (Array ShapeInt CDouble, Array ShapeInt CInt,
 Array ShapeInt BigIndex)
-> ContT () IO (Ptr CDouble, Ptr CInt, Ptr BigIndex)
forall r.
(Array ShapeInt CDouble, Array ShapeInt CInt,
 Array ShapeInt BigIndex)
-> ContT r IO (Ptr CDouble, Ptr CInt, Ptr BigIndex)
storeConstraints (Array ShapeInt CDouble
coefficients, Array ShapeInt CInt
indices, Array ShapeInt BigIndex
rowStarts)
      let createMatrix :: IO (Ptr CoinPackedMatrix)
createMatrix =
            CBool
-> CInt
-> CInt
-> BigIndex
-> Ptr CDouble
-> Ptr CInt
-> Ptr BigIndex
-> Ptr CInt
-> IO (Ptr CoinPackedMatrix)
FFI.newCoinPackedMatrix
               CBool
false
               (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
shape)
               (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Constraints Double ix -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Constraints Double ix
constrs)
               (Int -> BigIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BigIndex) -> Int -> BigIndex
forall a b. (a -> b) -> a -> b
$ ShapeInt -> Int
forall sh. C sh => sh -> Int
Shape.size (ShapeInt -> Int) -> ShapeInt -> Int
forall a b. (a -> b) -> a -> b
$ Array ShapeInt CDouble -> ShapeInt
forall sh a. Array sh a -> sh
Array.shape Array ShapeInt CDouble
coefficients)
               Ptr CDouble
coefficientsPtr
               Ptr CInt
indexPtr
               Ptr BigIndex
startPtr
               Ptr CInt
forall a. Ptr a
nullPtr
      Ptr CoinPackedMatrix
matrix <- ((Ptr CoinPackedMatrix -> IO ()) -> IO ())
-> ContT () IO (Ptr CoinPackedMatrix)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
MC.ContT (((Ptr CoinPackedMatrix -> IO ()) -> IO ())
 -> ContT () IO (Ptr CoinPackedMatrix))
-> ((Ptr CoinPackedMatrix -> IO ()) -> IO ())
-> ContT () IO (Ptr CoinPackedMatrix)
forall a b. (a -> b) -> a -> b
$ IO (Ptr CoinPackedMatrix)
-> (Ptr CoinPackedMatrix -> IO ())
-> (Ptr CoinPackedMatrix -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Ptr CoinPackedMatrix)
createMatrix Ptr CoinPackedMatrix -> IO ()
FFI.deleteCoinPackedMatrix
      IO () -> ContT () IO ()
forall a. IO a -> ContT () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
         Ptr Simplex
-> Ptr CoinPackedMatrix
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> IO ()
FFI.loadProblemFromCoinMatrix Ptr Simplex
lp Ptr CoinPackedMatrix
matrix
            Ptr CDouble
collbPtr Ptr CDouble
colubPtr
            Ptr CDouble
objPtr
            Ptr CDouble
rowlbPtr Ptr CDouble
rowubPtr
            Ptr CDouble
forall a. Ptr a
nullPtr

instance Coefficient PlusMinusOne where
   loadProblem :: forall sh ix.
(Indexed sh, Index sh ~ ix) =>
sh
-> Constraints PlusMinusOne ix
-> Ptr Simplex
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> ContT () IO ()
loadProblem sh
shape Constraints PlusMinusOne ix
constrs Ptr Simplex
lp Ptr CDouble
collbPtr Ptr CDouble
colubPtr Ptr CDouble
objPtr Ptr CDouble
rowlbPtr Ptr CDouble
rowubPtr = do
      let shapeOffset :: Index sh -> Int
shapeOffset = sh -> Index sh -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
Shape.offset sh
shape
      let coefficients :: [([Term PlusMinusOne ix], [Term PlusMinusOne ix])]
coefficients =
            (Inequality [Term PlusMinusOne ix]
 -> ([Term PlusMinusOne ix], [Term PlusMinusOne ix]))
-> Constraints PlusMinusOne ix
-> [([Term PlusMinusOne ix], [Term PlusMinusOne ix])]
forall a b. (a -> b) -> [a] -> [b]
map
               (\(Inequality [Term PlusMinusOne ix]
terms Bound
_bnd) ->
                  (Term PlusMinusOne ix -> Bool)
-> [Term PlusMinusOne ix]
-> ([Term PlusMinusOne ix], [Term PlusMinusOne ix])
forall a. (a -> Bool) -> [a] -> ([a], [a])
ListHT.partition (\(Term PlusMinusOne
c ix
_) -> PlusMinusOne
c PlusMinusOne -> PlusMinusOne -> Bool
forall a. Eq a => a -> a -> Bool
== PlusMinusOne
PlusOne) [Term PlusMinusOne ix]
terms)
               Constraints PlusMinusOne ix
constrs
      Ptr CInt
indexPtr <-
         Array ShapeInt CInt -> ContT () IO (Ptr CInt)
forall sh a r. Array sh a -> ContT r IO (Ptr a)
withBuffer (Array ShapeInt CInt -> ContT () IO (Ptr CInt))
-> Array ShapeInt CInt -> ContT () IO (Ptr CInt)
forall a b. (a -> b) -> a -> b
$ [CInt] -> Array ShapeInt CInt
forall a. Storable a => [a] -> Array ShapeInt a
Array.vectorFromList ([CInt] -> Array ShapeInt CInt) -> [CInt] -> Array ShapeInt CInt
forall a b. (a -> b) -> a -> b
$
         (([Term PlusMinusOne ix], [Term PlusMinusOne ix]) -> [CInt])
-> [([Term PlusMinusOne ix], [Term PlusMinusOne ix])] -> [CInt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
            (\([Term PlusMinusOne ix]
positive,[Term PlusMinusOne ix]
negative) ->
               (Int -> CInt) -> [Int] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
map Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [CInt]) -> [Int] -> [CInt]
forall a b. (a -> b) -> a -> b
$
                  (Term PlusMinusOne ix -> Int) -> [Term PlusMinusOne ix] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Term PlusMinusOne
_ ix
ix) -> Index sh -> Int
shapeOffset ix
Index sh
ix) [Term PlusMinusOne ix]
positive
                  [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++
                  (Term PlusMinusOne ix -> Int) -> [Term PlusMinusOne ix] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Term PlusMinusOne
_ ix
ix) -> Index sh -> Int
shapeOffset ix
Index sh
ix) [Term PlusMinusOne ix]
negative)
            [([Term PlusMinusOne ix], [Term PlusMinusOne ix])]
coefficients
      let rowStarts :: [Int]
rowStarts =
            (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$
            (Inequality [Term PlusMinusOne ix] -> Int)
-> Constraints PlusMinusOne ix -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Inequality [Term PlusMinusOne ix]
terms Bound
_bnd) -> [Term PlusMinusOne ix] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Term PlusMinusOne ix]
terms) Constraints PlusMinusOne ix
constrs
      Ptr BigIndex
startPositivePtr <-
         Array ShapeInt BigIndex -> ContT () IO (Ptr BigIndex)
forall sh a r. Array sh a -> ContT r IO (Ptr a)
withBuffer (Array ShapeInt BigIndex -> ContT () IO (Ptr BigIndex))
-> Array ShapeInt BigIndex -> ContT () IO (Ptr BigIndex)
forall a b. (a -> b) -> a -> b
$ [BigIndex] -> Array ShapeInt BigIndex
forall a. Storable a => [a] -> Array ShapeInt a
Array.vectorFromList ([BigIndex] -> Array ShapeInt BigIndex)
-> [BigIndex] -> Array ShapeInt BigIndex
forall a b. (a -> b) -> a -> b
$ (Int -> BigIndex) -> [Int] -> [BigIndex]
forall a b. (a -> b) -> [a] -> [b]
map Int -> BigIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
rowStarts
      Ptr BigIndex
startNegativePtr <-
         Array ShapeInt BigIndex -> ContT () IO (Ptr BigIndex)
forall sh a r. Array sh a -> ContT r IO (Ptr a)
withBuffer (Array ShapeInt BigIndex -> ContT () IO (Ptr BigIndex))
-> Array ShapeInt BigIndex -> ContT () IO (Ptr BigIndex)
forall a b. (a -> b) -> a -> b
$ [BigIndex] -> Array ShapeInt BigIndex
forall a. Storable a => [a] -> Array ShapeInt a
Array.vectorFromList ([BigIndex] -> Array ShapeInt BigIndex)
-> [BigIndex] -> Array ShapeInt BigIndex
forall a b. (a -> b) -> a -> b
$
         (Int
 -> ([Term PlusMinusOne ix], [Term PlusMinusOne ix]) -> BigIndex)
-> [Int]
-> [([Term PlusMinusOne ix], [Term PlusMinusOne ix])]
-> [BigIndex]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
k ([Term PlusMinusOne ix]
pos,[Term PlusMinusOne ix]
_neg) -> Int -> BigIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BigIndex) -> Int -> BigIndex
forall a b. (a -> b) -> a -> b
$ Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Term PlusMinusOne ix] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Term PlusMinusOne ix]
pos)
            [Int]
rowStarts [([Term PlusMinusOne ix], [Term PlusMinusOne ix])]
coefficients
      let createMatrix :: IO (Ptr PlusMinusOneMatrix)
createMatrix =
            CInt
-> CInt
-> CBool
-> Ptr CInt
-> Ptr BigIndex
-> Ptr BigIndex
-> IO (Ptr PlusMinusOneMatrix)
FFI.newPlusMinusOneMatrix
               (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Constraints PlusMinusOne ix -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Constraints PlusMinusOne ix
constrs)
               (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
shape)
               (Int -> CBool
forall a. Enum a => Int -> a
toEnum (Int -> CBool) -> Int -> CBool
forall a b. (a -> b) -> a -> b
$ Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
False)
               Ptr CInt
indexPtr Ptr BigIndex
startPositivePtr Ptr BigIndex
startNegativePtr
      Ptr PlusMinusOneMatrix
matrix <- ((Ptr PlusMinusOneMatrix -> IO ()) -> IO ())
-> ContT () IO (Ptr PlusMinusOneMatrix)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
MC.ContT (((Ptr PlusMinusOneMatrix -> IO ()) -> IO ())
 -> ContT () IO (Ptr PlusMinusOneMatrix))
-> ((Ptr PlusMinusOneMatrix -> IO ()) -> IO ())
-> ContT () IO (Ptr PlusMinusOneMatrix)
forall a b. (a -> b) -> a -> b
$ IO (Ptr PlusMinusOneMatrix)
-> (Ptr PlusMinusOneMatrix -> IO ())
-> (Ptr PlusMinusOneMatrix -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Ptr PlusMinusOneMatrix)
createMatrix Ptr PlusMinusOneMatrix -> IO ()
FFI.deletePlusMinusOneMatrix
      IO () -> ContT () IO ()
forall a. IO a -> ContT () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
         Ptr Simplex
-> Ptr PlusMinusOneMatrix
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> IO ()
forall matrix.
Ptr Simplex
-> Ptr matrix
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> IO ()
FFI.loadProblemFromMatrix Ptr Simplex
lp Ptr PlusMinusOneMatrix
matrix
            Ptr CDouble
collbPtr Ptr CDouble
colubPtr
            Ptr CDouble
objPtr
            Ptr CDouble
rowlbPtr Ptr CDouble
rowubPtr
            Ptr CDouble
forall a. Ptr a
nullPtr


{- |
>>> :{
   case Shape.indexTupleFromShape tripletShape of
      (x,y,z) ->
         mapSnd Array.toTuple <$>
         LP.simplex LP.dual []
            [[2.*x, 1.*y] <=. 10, [1.*y, (5::Double).*z] <=. 20]
            (LP.Maximize, Array.fromTuple (4,-3,2)
               :: Array.Array TripletShape Double)
:}
Right (28.0,(5.0,0.0,4.0))

>>> :{
   case Shape.indexTupleFromShape tripletShape of
      (x,y,z) ->
         mapSnd Array.toTuple <$>
         LP.simplex LP.primal [y >=<. (-12,12)]
            [[1.*x, (-1).*y] <=. 10, [(-1).*y, (1::Double).*z] <=. 20]
            (LP.Maximize, Array.fromTuple (4,-3,2)
               :: Array.Array TripletShape Double)
:}
Right (116.0,(22.0,12.0,32.0))

>>> :{
   case Shape.indexTupleFromShape tripletShape of
      (x,y,z) ->
         mapSnd Array.toTuple <$>
         LP.simplex LP.primal [y >=<. (-12,12)]
            [[PlusOne .* x, MinusOne .* y] <=. 10,
             [MinusOne .* y, PlusOne .* z] <=. 20]
            (LP.Maximize, Array.fromTuple (4,-3,2)
               :: Array.Array TripletShape Double)
:}
Right (116.0,(22.0,12.0,32.0))

>>> :{
   case Shape.indexTupleFromShape tripletShape of
      (x,y,z) ->
         mapSnd Array.toTuple <$>
         LP.simplex LP.primal [y >=<. (-12,12)]
            [[1.*x, 1.*y] <=. 10, [1.*y, (-1::Double).*z] >=. 20]
            (LP.Maximize, Array.fromTuple (4,3,2)
               :: Array.Array TripletShape Double)
:}
Left PrimalInfeasible

>>> :{
   case Shape.indexTupleFromShape tripletShape of
      (x,y,z) ->
         mapSnd Array.toTuple <$>
         LP.simplex LP.primal [y >=<. (-12,12)]
            [[1.*x, 1.*y] <=. 10, [1.*y, (1::Double).*z] >=. 20]
            (LP.Maximize, Array.fromTuple (4,3,2)
               :: Array.Array TripletShape Double)
:}
Left DualInfeasible

prop> :{
   forAllMethod $ \method (QC.Positive posWeight) (QC.Positive negWeight) target ->
   case Shape.indexTupleFromShape pairShape of
      (pos,neg) ->
         case mapSnd Array.toTuple <$>
               LP.simplex method []
                  [[1.*pos, (-1::Double).*neg] ==. target]
                  (LP.Minimize, Array.fromTuple (posWeight,negWeight)
                     :: Array.Array PairShape Double) of
            Left _ -> QC.property False
            Right (absol,(posResult,negResult)) ->
               QC.property (absol>=0)
               .&&.
               (posResult === 0 .||. negResult === 0)
:}
prop> :{
   forAllMethod $ \method target ->
   case Shape.indexTupleFromShape pairShape of
      (pos,neg) ->
         case mapSnd Array.toTuple <$>
               LP.simplex method []
                  [[1.*pos, (-1::Double).*neg] ==. target]
                  (LP.Minimize, Array.fromTuple (1,1)
                     :: Array.Array PairShape Double) of
            Left _ -> QC.property False
            Right (absol,(posResult,negResult)) ->
               QC.counterexample (show(absol,(posResult,negResult))) $
               QC.property (approxReal 0.001 absol (abs target))
               .&&.
               (posResult === 0 .||. negResult === 0)
:}

prop> :{
   forAllMethod $ \method ->
   TestLP.forAllOrigin $ \origin ->
   TestLP.forAllProblem origin $ \bounds constrs ->
   QC.forAll (TestLP.genObjective origin) $ \(dir,obj) ->
   case LP.simplex method bounds constrs (dir,obj) of
      Left _ -> False
      Right _ -> True
:}
prop> :{
   forAllMethod $ \method ->
   TestLP.forAllOrigin $ \origin ->
   TestLP.forAllProblem origin $ \bounds constrs ->
   QC.forAll (TestLP.genObjective origin) $ \(dir,obj) ->
   case LP.simplex method bounds constrs (dir,obj) of
      Left _ -> QC.property False
      Right (_,sol) -> TestLP.checkFeasibility 0.1 bounds constrs sol
:}
prop> :{
   forAllMethod $ \method ->
   TestLP.forAllOrigin $ \origin ->
   TestLP.forAllProblem origin $ \bounds constrs ->
   QC.forAll (TestLP.genObjective origin) $ \(dir,obj) ->
   case LP.simplex method bounds constrs (dir,obj) of
      Left _ -> QC.property False
      Right (_,sol) ->
         QC.forAll (QC.choose (0,1)) $ \lambda ->
         TestLP.checkFeasibility 0.1 bounds constrs $
         TestLP.affineCombination lambda sol (Array.map fromIntegral origin)
:}
prop> :{
   forAllMethod $ \method ->
   TestLP.forAllOrigin $ \origin ->
   TestLP.forAllProblem origin $ \bounds constrs ->
   QC.forAll (TestLP.genObjective origin) $ \(dir,obj) ->
   case LP.simplex method bounds constrs (dir,obj) of
      Left _ -> QC.property False
      Right (opt,sol) ->
         QC.forAll (QC.choose (0,1)) $ \lambda ->
            let val = TestLP.scalarProduct obj $
                        TestLP.affineCombination lambda sol (Array.map fromIntegral origin)
            in case dir of
                  LP.Minimize -> opt-0.01 <= val
                  LP.Maximize -> opt+0.01 >= val
:}
prop> :{
   forAllMethod $ \method ->
   TestLP.forAllOrigin $ \origin ->
   TestLP.forAllBoundedProblem origin $ \bounds constrs ->
   QC.forAll (TestLP.genObjective origin) $ \dirObjA ->
   QC.forAll (TestLP.genObjective origin) $ \dirObjB ->
   let solA = LP.simplex method bounds constrs dirObjA in
   let solB = LP.simplex method bounds constrs dirObjB in
   QC.counterexample (show (mapRight fst solA, mapRight fst solB)) $
   case (solA, solB) of
      (Right _, Right _) -> True
      (Left _, Left _) -> True
      _ -> False
:}
prop> :{
   forAllMethod $ \method ->
   TestLP.forAllOrigin $ \origin ->
   TestLP.forAllProblem origin $ \bounds constrs ->
   QC.forAll (TestLP.genObjective origin) $ \(_dir,obj) ->
   case (LP.simplex method bounds constrs (LP.Minimize,obj),
         LP.simplex method bounds constrs (LP.Maximize,obj)) of
      (Right (optMin,_), Right (optMax,_)) ->
         QC.counterexample (show (optMin, optMax)) $ optMin <= optMax + 0.01
      _ -> QC.property False
:}
prop> :{
   forAllMethod $ \method ->
   TestLP.forAllOrigin $ \origin ->
   TestLP.forAllProblem origin $ \bounds allConstrs ->
   QC.forAll (QC.sublistOf allConstrs) $ \someConstrs ->
   QC.forAll (TestLP.genObjective origin) $ \(dir,obj) ->
   case (LP.simplex method bounds allConstrs (dir,obj),
         LP.simplex method bounds someConstrs (dir,obj)) of
      (Right (optAll,_), Right (optSome,_)) ->
         QC.counterexample (show (optAll, optSome)) $
         case dir of
            LP.Minimize -> optAll >= optSome-0.01
            LP.Maximize -> optAll <= optSome+0.01
      _ -> QC.property False
:}
prop> :{
   forAllMethod $ \methodA ->
   forAllMethod $ \methodB ->
   TestLP.forAllOrigin $ \origin ->
   TestLP.forAllProblem origin $ \bounds constrs ->
   QC.forAll (TestLP.genObjective origin) $ \dirObj ->
   case (LP.simplex methodA bounds constrs dirObj,
         LP.simplex methodB bounds constrs dirObj) of
      (Right (optA,_), Right (optB,_)) ->
         QC.counterexample (show (optA, optB)) $
         approxReal 0.01 optA optB
      _ -> QC.property False
:}
-}
simplex ::
   (Coefficient a, Shape.Indexed sh, Shape.Index sh ~ ix) =>
   Method -> Bounds ix -> Constraints a ix ->
   (Direction, Objective sh) -> Result sh
simplex :: forall a sh ix.
(Coefficient a, Indexed sh, Index sh ~ ix) =>
Method
-> Bounds ix
-> Constraints a ix
-> (Direction, Objective sh)
-> Result sh
simplex Method
method Bounds ix
bounds Constraints a ix
constrs (Direction
dir,Objective sh
obj) =
   IO (Result sh) -> Result sh
forall a. IO a -> a
unsafePerformIO (IO (Result sh) -> Result sh) -> IO (Result sh) -> Result sh
forall a b. (a -> b) -> a -> b
$
   IO (Ptr Simplex)
-> (Ptr Simplex -> IO ())
-> (Ptr Simplex -> IO (Result sh))
-> IO (Result sh)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Ptr Simplex)
FFI.newModel Ptr Simplex -> IO ()
FFI.deleteModel ((Ptr Simplex -> IO (Result sh)) -> IO (Result sh))
-> (Ptr Simplex -> IO (Result sh)) -> IO (Result sh)
forall a b. (a -> b) -> a -> b
$ \Ptr Simplex
lp -> do

   Ptr Simplex -> IO ()
Debug.initLog Ptr Simplex
lp
   let shape :: sh
shape = Objective sh -> sh
forall sh a. Array sh a -> sh
Array.shape Objective sh
obj
   Ptr Simplex
-> sh
-> Bounds ix
-> Constraints a ix
-> (Direction, Objective sh)
-> IO ()
forall a sh ix.
(Coefficient a, Indexed sh, Index sh ~ ix) =>
Ptr Simplex
-> sh
-> Bounds ix
-> Constraints a ix
-> (Direction, Objective sh)
-> IO ()
storeProblem Ptr Simplex
lp sh
shape Bounds ix
bounds Constraints a ix
constrs (Direction
dir,Objective sh
obj)
   IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
"/ram/coinor-clp.mps" ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CString
path ->
      Ptr Simplex -> CString -> CInt -> CInt -> CDouble -> IO CInt
FFI.writeMps Ptr Simplex
lp CString
path CInt
0 CInt
1 CDouble
1
   Method -> Ptr Simplex -> IO ()
runMethod Method
method Ptr Simplex
lp
   sh -> Ptr Simplex -> IO (Result sh)
forall sh. C sh => sh -> Ptr Simplex -> IO (Result sh)
examineStatus sh
shape Ptr Simplex
lp


{-
Numeric.COINOR.CLP:179: passed
Numeric.COINOR.CLP:190: passed
Numeric.COINOR.CLP:201: passed
Numeric.COINOR.CLP:213: passed
Numeric.COINOR.CLP:224: passed
Numeric.COINOR.CLP:235: +++ OK, passed 1000000 tests.
Numeric.COINOR.CLP:250: +++ OK, passed 1000000 tests.

Numeric.COINOR.CLP:267: *** Failed! Falsified (after 274041 tests and 3 shrinks):
initialPrimalSolve
StorableArray.fromList (Range {rangeFrom = 'a', rangeTo = 'g'}) [9,-7,0,-3,-3,-3,10]
([Inequality 'a' (Between (-46.0) 61.0),Inequality 'b' (Between (-78.0) 63.0),Inequality 'c' (Between (-94.0) 81.0),Inequality 'd' (Between (-87.0) 74.0),Inequality 'e' (Between (-74.0) 79.0),Inequality 'f' (Between (-60.0) 76.0),Inequality 'g' (Between (-88.0) 90.0)],[Inequality [Term 0.0 'c',Term 4.0 'd',Term (-10.0) 'e',Term (-10.0) 'f',Term (-4.0) 'g'] (Between 3.0 32.0),Inequality [Term (-8.0) 'f',Term (-4.0) 'g'] (Between (-40.0) (-3.0)),Inequality [Term (-2.0) 'a',Term 9.0 'b',Term (-2.0) 'c',Term 8.0 'g'] (LessEqual 5.0)])
(Maximize,StorableArray.fromList (Range {rangeFrom = 'a', rangeTo = 'g'}) [8.0,-1.0,7.0,9.0,9.0,-4.0,0.0])

Numeric.COINOR.CLP:276: *** Failed! Falsified (after 684175 tests and 1 shrink):
initialPrimalSolve
StorableArray.fromList (Range {rangeFrom = 'a', rangeTo = 'h'}) [-8,2,9,1,1,-8,-9,-4]
([Inequality 'a' (Between (-79.0) 49.0),Inequality 'b' (Between (-83.0) 77.0),Inequality 'c' (Between (-55.0) 88.0),Inequality 'd' (Between (-54.0) 59.0),Inequality 'e' (Between (-87.0) 100.0),Inequality 'f' (Between (-59.0) 47.0),Inequality 'g' (Between (-108.0) 68.0),Inequality 'h' (Between (-89.0) 48.0)],[Inequality [Term (-1.0) 'f',Term 9.0 'g'] (Between (-73.0) (-68.0)),Inequality [Term (-9.0) 'f',Term 9.0 'g'] (Between (-20.0) 9.0),Inequality [Term 6.0 'c',Term (-5.0) 'g'] (Between 93.0 124.0),Inequality [Term (-5.0) 'e',Term 3.0 'g'] (GreaterEqual (-57.0)),Inequality [Term (-6.0) 'a',Term 1.0 'b',Term 4.0 'c',Term 10.0 'e',Term (-4.0) 'f',Term 4.0 'h'] (LessEqual 127.0),Inequality [Term 7.0 'c',Term (-3.0) 'd',Term (-4.0) 'e',Term 1.0 'f'] (Between 29.0 59.0)])
(Minimize,StorableArray.fromList (Range {rangeFrom = 'a', rangeTo = 'h'}) [-3.0,-10.0,2.0,3.0,-7.0,9.0,-4.0,8.0])

Numeric.COINOR.CLP:285: *** Failed! Falsified (after 27962 tests and 1 shrink):
initialPrimalSolve
StorableArray.fromList (Range {rangeFrom = 'a', rangeTo = 'e'}) [-8,-8,8,-3,7]
([Inequality 'a' (Between (-86.0) 92.0),Inequality 'b' (Between (-78.0) 51.0),Inequality 'c' (Between (-85.0) 104.0),Inequality 'd' (Between (-98.0) 73.0),Inequality 'e' (Between (-92.0) 71.0)],[Inequality [Term (-2.0) 'a',Term 0.0 'c',Term 3.0 'd'] (LessEqual 28.0),Inequality [Term 1.0 'b',Term (-7.0) 'c'] (GreaterEqual (-85.0)),Inequality [Term (-8.0) 'a',Term (-7.0) 'c',Term 10.0 'e'] (Between 66.0 81.0),Inequality [Term (-5.0) 'a',Term (-1.0) 'd',Term (-5.0) 'e'] (LessEqual 13.0),Inequality [Term 8.0 'd'] (LessEqual (-1.0))])
(Minimize,StorableArray.fromList (Range {rangeFrom = 'a', rangeTo = 'e'}) [6.0,-6.0,-9.0,-5.0,2.0])



Numeric.COINOR.CLP:179: passed
Numeric.COINOR.CLP:190: passed
Numeric.COINOR.CLP:201: passed
Numeric.COINOR.CLP:213: passed
Numeric.COINOR.CLP:224: passed
Numeric.COINOR.CLP:235: +++ OK, passed 1000000 tests.
Numeric.COINOR.CLP:250: +++ OK, passed 1000000 tests.
coinor-clp-test: ClpPredictorCorrector.cpp:2666: void ClpPredictorCorrector::setupForSolve(int): Assertion `value < 0.0' failed.
Abgebrochen



Numeric.COINOR.CLP:179: passed
Numeric.COINOR.CLP:190: passed
Numeric.COINOR.CLP:201: passed
Numeric.COINOR.CLP:213: passed
Numeric.COINOR.CLP:224: passed
Numeric.COINOR.CLP:235: +++ OK, passed 1000000 tests.
Numeric.COINOR.CLP:250: +++ OK, passed 1000000 tests.

Numeric.COINOR.CLP:267: *** Failed! Falsified (after 624378 tests and 2 shrinks):
initialPrimalSolve
StorableArray.fromList (Range {rangeFrom = 'a', rangeTo = 'd'}) [1,3,7,-9]
([Inequality 'a' (Between (-99.0) 78.0),Inequality 'b' (Between (-62.0) 79.0),Inequality 'c' (Between (-53.0) 64.0),Inequality 'd' (Between (-70.0) 51.0)],[Inequality [Term 5.0 'a',Term (-3.0) 'c'] (Between (-34.0) (-16.0)),Inequality [Term (-10.0) 'a',Term (-5.0) 'b',Term 2.0 'd'] (LessEqual (-25.0)),Inequality [Term 9.0 'a',Term 8.0 'c'] (Between 41.0 74.0)])
(Maximize,StorableArray.fromList (Range {rangeFrom = 'a', rangeTo = 'd'}) [-8.0,8.0,-2.0,5.0])

Numeric.COINOR.CLP:276: *** Failed! Falsified (after 136720 tests and 1 shrink):
initialBarrierSolve
StorableArray.fromList (Range {rangeFrom = 'a', rangeTo = 'e'}) [-6,9,-8,-4,-6]
([Inequality 'a' (Between (-94.0) 81.0),Inequality 'b' (Between (-87.0) 104.0),Inequality 'c' (Between (-77.0) 61.0),Inequality 'd' (Between (-64.0) 70.0),Inequality 'e' (Between (-76.0) 59.0)],[Inequality [Term (-3.0) 'd',Term 6.0 'e'] (Between (-38.0) (-20.0)),Inequality [Term (-2.0) 'a',Term 5.0 'e'] (Between (-24.0) 3.0),Inequality [Term (-10.0) 'a',Term (-4.0) 'b',Term 3.0 'c',Term (-8.0) 'd',Term 6.0 'e'] (LessEqual 4.0),Inequality [Term 7.0 'a',Term (-5.0) 'd'] (Between (-35.0) (-16.0))])
(Maximize,StorableArray.fromList (Range {rangeFrom = 'a', rangeTo = 'e'}) [7.0,10.0,6.0,-4.0,-6.0])

Numeric.COINOR.CLP:285: *** Failed! Falsified (after 490268 tests and 2 shrinks):
initialPrimalSolve
StorableArray.fromList (Range {rangeFrom = 'a', rangeTo = 'e'}) [9,9,8,-2,-6]
([Inequality 'a' (Between (-88.0) 95.0),Inequality 'b' (Between (-76.0) 98.0),Inequality 'c' (Between (-81.0) 95.0),Inequality 'd' (Between (-76.0) 49.0),Inequality 'e' (Between (-57.0) 92.0)],[Inequality [Term 1.0 'a',Term (-7.0) 'b',Term (-5.0) 'c'] (GreaterEqual (-102.0)),Inequality [Term 10.0 'd'] (GreaterEqual (-32.0)),Inequality [Term 5.0 'b',Term (-10.0) 'c',Term (-4.0) 'e'] (LessEqual (-2.0)),Inequality [Term (-7.0) 'b',Term 9.0 'd',Term (-8.0) 'e'] (Between (-53.0) (-21.0)),Inequality [Term (-1.0) 'c'] (Between (-20.0) 7.0),Inequality [Term (-10.0) 'd',Term 8.0 'e'] (GreaterEqual (-33.0))])
(Minimize,StorableArray.fromList (Range {rangeFrom = 'a', rangeTo = 'e'}) [-7.0,-9.0,-10.0,10.0,7.0])
-}


{- |
Run many solvers concurrently and take the result of the solver
that finishes first.

Remember to run programs using 'concurrent'
with threaded runtime and @+RTS -N@ runtime option.

>>> :{
   case Shape.indexTupleFromShape tripletShape of
      (x,y,z) ->
         mapSnd Array.toTuple <$>
         LP.concurrent (LP.solveEndless!:LP.dual:[]) []
            [[2.*x, 1.*y] <=. 10, [1.*y, (5::Double).*z] <=. 20]
            (LP.Maximize, Array.fromTuple (4,-3,2)
               :: Array.Array TripletShape Double)
:}
Right (28.0,(5.0,0.0,4.0))

prop> :{
   forAllMethod $ \method ->
   TestLP.forAllOrigin $ \origin ->
   TestLP.forAllBoundedProblem origin $ \bounds constrs ->
   QC.forAll (TestLP.genObjective origin) $ \dirObj ->
   let solA = LP.simplex method bounds constrs dirObj in
   let solB = LP.concurrent (NonEmpty.singleton method) bounds constrs dirObj in
   QC.counterexample (show (mapRight fst solA, mapRight fst solB)) $
   case (solA, solB) of
      (Right (optA,_), Right (optB,_)) -> approxReal 0.01 optA optB
      (Left _, Left _) -> True
      _ -> False
:}
prop> :{
   forAllMethod $ \method ->
   forAllMethod $ \methodA ->
   forAllMethod $ \methodB ->
   forAllMethod $ \methodC ->
   TestLP.forAllOrigin $ \origin ->
   TestLP.forAllBoundedProblem origin $ \bounds constrs ->
   QC.forAll (TestLP.genObjective origin) $ \dirObj ->
   let solA = LP.simplex method bounds constrs dirObj in
   let solB = LP.concurrent (methodA!:methodB:methodC:[])
                  bounds constrs dirObj in
   QC.counterexample (show (mapRight fst solA, mapRight fst solB)) $
   case (solA, solB) of
      (Right (optA,_), Right (optB,_)) -> approxReal 0.01 optA optB
      (Left _, Left _) -> True
      _ -> False
:}
-}
concurrent ::
   (Coefficient a, Shape.Indexed sh, Shape.Index sh ~ ix) =>
   NonEmpty.T [] Method -> Bounds ix -> Constraints a ix ->
   (Direction, Objective sh) -> Result sh
concurrent :: forall a sh ix.
(Coefficient a, Indexed sh, Index sh ~ ix) =>
T [] Method
-> Bounds ix
-> Constraints a ix
-> (Direction, Objective sh)
-> Result sh
concurrent (NonEmpty.Cons Method
method [Method]
methods) Bounds ix
bounds Constraints a ix
constrs (Direction
dir,Objective sh
obj) =
   IO (Result sh) -> Result sh
forall a. IO a -> a
unsafePerformIO (IO (Result sh) -> Result sh) -> IO (Result sh) -> Result sh
forall a b. (a -> b) -> a -> b
$
   IO (Ptr Simplex)
-> (Ptr Simplex -> IO ())
-> (Ptr Simplex -> IO (Result sh))
-> IO (Result sh)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Ptr Simplex)
FFI.newModel Ptr Simplex -> IO ()
FFI.deleteModel ((Ptr Simplex -> IO (Result sh)) -> IO (Result sh))
-> (Ptr Simplex -> IO (Result sh)) -> IO (Result sh)
forall a b. (a -> b) -> a -> b
$ \Ptr Simplex
lp -> do

   Ptr Simplex -> IO ()
Debug.initLog Ptr Simplex
lp
   let shape :: sh
shape = Objective sh -> sh
forall sh a. Array sh a -> sh
Array.shape Objective sh
obj
   Ptr Simplex
-> sh
-> Bounds ix
-> Constraints a ix
-> (Direction, Objective sh)
-> IO ()
forall a sh ix.
(Coefficient a, Indexed sh, Index sh ~ ix) =>
Ptr Simplex
-> sh
-> Bounds ix
-> Constraints a ix
-> (Direction, Objective sh)
-> IO ()
storeProblem Ptr Simplex
lp sh
shape Bounds ix
bounds Constraints a ix
constrs (Direction
dir,Objective sh
obj)
   ContT (Result sh) IO (Result sh) -> IO (Result sh)
forall a. ContT a IO a -> IO a
runContT (ContT (Result sh) IO (Result sh) -> IO (Result sh))
-> ContT (Result sh) IO (Result sh) -> IO (Result sh)
forall a b. (a -> b) -> a -> b
$ do
      [Ptr Simplex]
lps <-
         (([Ptr Simplex] -> IO (Result sh)) -> IO (Result sh))
-> ContT (Result sh) IO [Ptr Simplex]
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
MC.ContT ((([Ptr Simplex] -> IO (Result sh)) -> IO (Result sh))
 -> ContT (Result sh) IO [Ptr Simplex])
-> (([Ptr Simplex] -> IO (Result sh)) -> IO (Result sh))
-> ContT (Result sh) IO [Ptr Simplex]
forall a b. (a -> b) -> a -> b
$
            IO [Ptr Simplex]
-> ([Ptr Simplex] -> IO ())
-> ([Ptr Simplex] -> IO (Result sh))
-> IO (Result sh)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
               ([Method] -> (Method -> IO (Ptr Simplex)) -> IO [Ptr Simplex]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Method]
methods ((Method -> IO (Ptr Simplex)) -> IO [Ptr Simplex])
-> (Method -> IO (Ptr Simplex)) -> IO [Ptr Simplex]
forall a b. (a -> b) -> a -> b
$ IO (Ptr Simplex) -> Method -> IO (Ptr Simplex)
forall a b. a -> b -> a
const (IO (Ptr Simplex) -> Method -> IO (Ptr Simplex))
-> IO (Ptr Simplex) -> Method -> IO (Ptr Simplex)
forall a b. (a -> b) -> a -> b
$ do
                  Ptr Simplex
newLp <- Ptr Simplex -> IO (Ptr Simplex)
FFI.copyModel Ptr Simplex
lp
                  Ptr Simplex -> IO ()
Debug.initLog Ptr Simplex
newLp
                  Ptr Simplex -> IO (Ptr Simplex)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Simplex
newLp)
               ((Ptr Simplex -> IO ()) -> [Ptr Simplex] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Ptr Simplex -> IO ()
FFI.deleteModel)
      IO (Result sh) -> ContT (Result sh) IO (Result sh)
forall a. IO a -> ContT (Result sh) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result sh) -> ContT (Result sh) IO (Result sh))
-> IO (Result sh) -> ContT (Result sh) IO (Result sh)
forall a b. (a -> b) -> a -> b
$ do
         (In (Ptr Simplex)
resultIn, Out (Ptr Simplex)
resultOut) <- IO (In (Ptr Simplex), Out (Ptr Simplex))
forall a. IO (In a, Out a)
MVar.newEmpty
         T [] ThreadId
threads <-
            T [] (Method, Ptr Simplex)
-> ((Method, Ptr Simplex) -> IO ThreadId) -> IO (T [] ThreadId)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ((Method
method,Ptr Simplex
lp) (Method, Ptr Simplex)
-> [(Method, Ptr Simplex)] -> T [] (Method, Ptr Simplex)
forall a (f :: * -> *). a -> f a -> T f a
!: [Method] -> [Ptr Simplex] -> [(Method, Ptr Simplex)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Method]
methods [Ptr Simplex]
lps) (((Method, Ptr Simplex) -> IO ThreadId) -> IO (T [] ThreadId))
-> ((Method, Ptr Simplex) -> IO ThreadId) -> IO (T [] ThreadId)
forall a b. (a -> b) -> a -> b
$ \(Method
methodi,Ptr Simplex
lpi) ->
            IO () -> IO ThreadId
Conc.forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
               Method -> Ptr Simplex -> IO ()
runMethod Method
methodi Ptr Simplex
lpi
               In (Ptr Simplex) -> Ptr Simplex -> IO ()
forall a. In a -> a -> IO ()
MVar.put In (Ptr Simplex)
resultIn Ptr Simplex
lpi
         Ptr Simplex
lpWinner <- Out (Ptr Simplex) -> IO (Ptr Simplex)
forall a. Out a -> IO a
MVar.take Out (Ptr Simplex)
resultOut
         (ThreadId -> IO ()) -> T [] ThreadId -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ThreadId -> IO ()
Conc.killThread T [] ThreadId
threads
         sh -> Ptr Simplex -> IO (Result sh)
forall sh. C sh => sh -> Ptr Simplex -> IO (Result sh)
examineStatus sh
shape Ptr Simplex
lpWinner


storeProblem ::
   (Coefficient a, Shape.Indexed sh, Shape.Index sh ~ ix) =>
   Ptr FFI.Simplex -> sh ->
   Bounds ix -> Constraints a ix -> (Direction, Objective sh) -> IO ()
storeProblem :: forall a sh ix.
(Coefficient a, Indexed sh, Index sh ~ ix) =>
Ptr Simplex
-> sh
-> Bounds ix
-> Constraints a ix
-> (Direction, Objective sh)
-> IO ()
storeProblem Ptr Simplex
lp sh
shape Bounds ix
bounds Constraints a ix
constrs (Direction
dir,Objective sh
obj) = do
   ContT () IO () -> IO ()
forall a. ContT a IO a -> IO a
runContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Ptr CDouble
objPtr <- Array sh CDouble -> ContT () IO (Ptr CDouble)
forall sh a r. Array sh a -> ContT r IO (Ptr a)
withBuffer (Array sh CDouble -> ContT () IO (Ptr CDouble))
-> Array sh CDouble -> ContT () IO (Ptr CDouble)
forall a b. (a -> b) -> a -> b
$ (Double -> CDouble) -> Objective sh -> Array sh CDouble
forall sh a b.
(C sh, Storable a, Storable b) =>
(a -> b) -> Array sh a -> Array sh b
Array.map Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Objective sh
obj
      (Ptr CDouble
collbPtr,Ptr CDouble
colubPtr) <-
         (Array sh CDouble, Array sh CDouble)
-> ContT () IO (Ptr CDouble, Ptr CDouble)
forall sh r.
(Array sh CDouble, Array sh CDouble)
-> ContT r IO (Ptr CDouble, Ptr CDouble)
storeBounds ((Array sh CDouble, Array sh CDouble)
 -> ContT () IO (Ptr CDouble, Ptr CDouble))
-> (Array sh CDouble, Array sh CDouble)
-> ContT () IO (Ptr CDouble, Ptr CDouble)
forall a b. (a -> b) -> a -> b
$ sh -> Bounds ix -> (Array sh CDouble, Array sh CDouble)
forall sh ix.
(Indexed sh, Index sh ~ ix) =>
sh -> Bounds ix -> (Array sh CDouble, Array sh CDouble)
prepareColumnBoundsArrays sh
shape Bounds ix
bounds
      (Ptr CDouble
rowlbPtr,Ptr CDouble
rowubPtr) <- (Array ShapeInt CDouble, Array ShapeInt CDouble)
-> ContT () IO (Ptr CDouble, Ptr CDouble)
forall sh r.
(Array sh CDouble, Array sh CDouble)
-> ContT r IO (Ptr CDouble, Ptr CDouble)
storeBounds ((Array ShapeInt CDouble, Array ShapeInt CDouble)
 -> ContT () IO (Ptr CDouble, Ptr CDouble))
-> (Array ShapeInt CDouble, Array ShapeInt CDouble)
-> ContT () IO (Ptr CDouble, Ptr CDouble)
forall a b. (a -> b) -> a -> b
$ Constraints a ix
-> (Array ShapeInt CDouble, Array ShapeInt CDouble)
forall ix.
Bounds ix -> (Array ShapeInt CDouble, Array ShapeInt CDouble)
prepareRowBoundsArrays Constraints a ix
constrs
      sh
-> Constraints a ix
-> Ptr Simplex
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> ContT () IO ()
forall a sh ix.
(Coefficient a, Indexed sh, Index sh ~ ix) =>
sh
-> Constraints a ix
-> Ptr Simplex
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> ContT () IO ()
forall sh ix.
(Indexed sh, Index sh ~ ix) =>
sh
-> Constraints a ix
-> Ptr Simplex
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> ContT () IO ()
loadProblem sh
shape Constraints a ix
constrs Ptr Simplex
lp Ptr CDouble
collbPtr Ptr CDouble
colubPtr Ptr CDouble
objPtr Ptr CDouble
rowlbPtr Ptr CDouble
rowubPtr
   Ptr Simplex -> Direction -> IO ()
setOptimizationDirection Ptr Simplex
lp Direction
dir