{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Numeric.HiGHS.LP.Private where

import qualified Numeric.HiGHS.LP.FFI as Highs
import Numeric.HiGHS.LP.Enumeration (ModelStatus, modelStatusFromC)
import Numeric.HiGHS.LP.FFI (Highs, HighsInt)
import Numeric.LinearProgramming.Common
         (Term(..), Bound(..), Inequality(Inequality),
          Bounds, Constraints, Direction(..))

import qualified Data.Array.Comfort.Boxed as BoxedArray
import qualified Data.Array.Comfort.Storable.Unchecked.Monadic as ArrayMonadic
import qualified Data.Array.Comfort.Storable.Unchecked as ArrayUnchecked
import qualified Data.Array.Comfort.Storable as Array
import qualified Data.Array.Comfort.Shape as Shape
import qualified Data.Traversable as Trav
import Data.Array.Comfort.Storable (Array)
import Data.Foldable (for_)
import Data.Tuple.HT (mapPair)

import qualified Control.Monad.Trans.Reader as MR
import qualified Control.Monad.Trans.Cont as MC
import qualified Control.Applicative.HT as AppHT
import qualified Control.Functor.HT as FuncHT
import Control.Monad (guard, when)
import Control.Applicative (liftA2, liftA3)

import qualified Foreign.Marshal.Array.Guarded as ForeignArray
import Foreign.Storable (pokeElemOff, peekElemOff)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Ptr (Ptr)
import Foreign.C.String (withCString)
import Foreign.C.Types (CDouble)



withBuffer :: Array sh a -> MC.ContT r IO (Ptr a)
withBuffer :: forall sh a r. Array sh a -> ContT r IO (Ptr a)
withBuffer Array sh a
arr =
   ((Ptr a -> IO r) -> IO r) -> ContT r IO (Ptr a)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
MC.ContT (((Ptr a -> IO r) -> IO r) -> ContT r IO (Ptr a))
-> ((Ptr a -> IO r) -> IO r) -> ContT r IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO r) -> IO r
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Array sh a -> ForeignPtr a
forall sh a. Array sh a -> ForeignPtr a
ArrayUnchecked.buffer Array sh a
arr)

runContT :: MC.ContT a IO a -> IO a
runContT :: forall a. ContT a IO a -> IO a
runContT ContT a IO a
act = ContT a IO a -> (a -> IO a) -> IO a
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
MC.runContT ContT a IO a
act a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return



positiveInfinity, negativeInfinity :: CDouble
positiveInfinity :: CDouble
positiveInfinity =  CDouble
1CDouble -> CDouble -> CDouble
forall a. Fractional a => a -> a -> a
/CDouble
0
negativeInfinity :: CDouble
negativeInfinity = -CDouble
1CDouble -> CDouble -> CDouble
forall a. Fractional a => a -> a -> a
/CDouble
0

prepareBounds :: Inequality a -> (a, (CDouble, CDouble))
prepareBounds :: forall a. Inequality a -> (a, (CDouble, CDouble))
prepareBounds (Inequality a
x Bound
bnd) =
   (,) a
x ((CDouble, CDouble) -> (a, (CDouble, CDouble)))
-> (CDouble, CDouble) -> (a, (CDouble, CDouble))
forall a b. (a -> b) -> a -> b
$
   case Bound
bnd of
      LessEqual Double
up    -> (CDouble
negativeInfinity, Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
up)
      GreaterEqual Double
lo -> (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
lo,    CDouble
positiveInfinity)
      Between Double
lo Double
up   -> (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
lo,    Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
up)
      Equal Double
y         -> (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
y,     Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
y)
      Bound
Free            -> (CDouble
negativeInfinity, CDouble
positiveInfinity)

prepareColumnBoundsArrays ::
   (Shape.Indexed sh, Shape.Index sh ~ ix) =>
   sh -> Bounds ix -> (Array sh CDouble, Array sh CDouble)
prepareColumnBoundsArrays :: forall sh ix.
(Indexed sh, Index sh ~ ix) =>
sh -> Bounds ix -> (Array sh CDouble, Array sh CDouble)
prepareColumnBoundsArrays sh
shape =
   (Array sh CDouble -> Array sh CDouble,
 Array sh CDouble -> Array sh CDouble)
-> (Array sh CDouble, Array sh CDouble)
-> (Array sh CDouble, Array sh CDouble)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (Array sh CDouble -> Array sh CDouble
forall sh a. (C sh, Storable a) => Array sh a -> Array sh a
Array.fromBoxed, Array sh CDouble -> Array sh CDouble
forall sh a. (C sh, Storable a) => Array sh a -> Array sh a
Array.fromBoxed) ((Array sh CDouble, Array sh CDouble)
 -> (Array sh CDouble, Array sh CDouble))
-> (Bounds ix -> (Array sh CDouble, Array sh CDouble))
-> Bounds ix
-> (Array sh CDouble, Array sh CDouble)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Array sh (CDouble, CDouble) -> (Array sh CDouble, Array sh CDouble)
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
FuncHT.unzip (Array sh (CDouble, CDouble)
 -> (Array sh CDouble, Array sh CDouble))
-> (Bounds ix -> Array sh (CDouble, CDouble))
-> Bounds ix
-> (Array sh CDouble, Array sh CDouble)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (CDouble, CDouble)
-> sh
-> [(Index sh, (CDouble, CDouble))]
-> Array sh (CDouble, CDouble)
forall sh a. Indexed sh => a -> sh -> [(Index sh, a)] -> Array sh a
BoxedArray.fromAssociations (CDouble
0, CDouble
positiveInfinity) sh
shape ([(ix, (CDouble, CDouble))] -> Array sh (CDouble, CDouble))
-> (Bounds ix -> [(ix, (CDouble, CDouble))])
-> Bounds ix
-> Array sh (CDouble, CDouble)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (Inequality ix -> (ix, (CDouble, CDouble)))
-> Bounds ix -> [(ix, (CDouble, CDouble))]
forall a b. (a -> b) -> [a] -> [b]
map Inequality ix -> (ix, (CDouble, CDouble))
forall a. Inequality a -> (a, (CDouble, CDouble))
prepareBounds


type ShapeInt = Shape.ZeroBased Int

prepareRowBoundsArrays ::
   Bounds ix -> (Array ShapeInt CDouble, Array ShapeInt CDouble)
prepareRowBoundsArrays :: forall ix.
Bounds ix -> (Array ShapeInt CDouble, Array ShapeInt CDouble)
prepareRowBoundsArrays Bounds ix
constrs =
   let shape :: ShapeInt
shape = Int -> ShapeInt
forall n. n -> ZeroBased n
Shape.ZeroBased (Int -> ShapeInt) -> Int -> ShapeInt
forall a b. (a -> b) -> a -> b
$ Bounds ix -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Bounds ix
constrs in
   ([CDouble] -> Array ShapeInt CDouble,
 [CDouble] -> Array ShapeInt CDouble)
-> ([CDouble], [CDouble])
-> (Array ShapeInt CDouble, Array ShapeInt CDouble)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (ShapeInt -> [CDouble] -> Array ShapeInt CDouble
forall sh a. (C sh, Storable a) => sh -> [a] -> Array sh a
Array.fromList ShapeInt
shape, ShapeInt -> [CDouble] -> Array ShapeInt CDouble
forall sh a. (C sh, Storable a) => sh -> [a] -> Array sh a
Array.fromList ShapeInt
shape) (([CDouble], [CDouble])
 -> (Array ShapeInt CDouble, Array ShapeInt CDouble))
-> ([CDouble], [CDouble])
-> (Array ShapeInt CDouble, Array ShapeInt CDouble)
forall a b. (a -> b) -> a -> b
$
   [(CDouble, CDouble)] -> ([CDouble], [CDouble])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(CDouble, CDouble)] -> ([CDouble], [CDouble]))
-> [(CDouble, CDouble)] -> ([CDouble], [CDouble])
forall a b. (a -> b) -> a -> b
$ (Inequality ix -> (CDouble, CDouble))
-> Bounds ix -> [(CDouble, CDouble)]
forall a b. (a -> b) -> [a] -> [b]
map ((ix, (CDouble, CDouble)) -> (CDouble, CDouble)
forall a b. (a, b) -> b
snd ((ix, (CDouble, CDouble)) -> (CDouble, CDouble))
-> (Inequality ix -> (ix, (CDouble, CDouble)))
-> Inequality ix
-> (CDouble, CDouble)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inequality ix -> (ix, (CDouble, CDouble))
forall a. Inequality a -> (a, (CDouble, CDouble))
prepareBounds) Bounds ix
constrs

storeBounds ::
   (Array sh CDouble, Array sh CDouble) ->
   MC.ContT r IO (Ptr CDouble, Ptr CDouble)
storeBounds :: forall sh r.
(Array sh CDouble, Array sh CDouble)
-> ContT r IO (Ptr CDouble, Ptr CDouble)
storeBounds = (Array sh CDouble -> ContT r IO (Ptr CDouble),
 Array sh CDouble -> ContT r IO (Ptr CDouble))
-> (Array sh CDouble, Array sh CDouble)
-> ContT r IO (Ptr CDouble, Ptr CDouble)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c, b -> f d) -> (a, b) -> f (c, d)
AppHT.mapPair (Array sh CDouble -> ContT r IO (Ptr CDouble)
forall sh a r. Array sh a -> ContT r IO (Ptr a)
withBuffer, Array sh CDouble -> ContT r IO (Ptr CDouble)
forall sh a r. Array sh a -> ContT r IO (Ptr a)
withBuffer)


prepareConstraints ::
   (Shape.Indexed sh, Shape.Index sh ~ ix) =>
   sh -> Constraints Double ix ->
   (Array ShapeInt CDouble, Array ShapeInt HighsInt, Array ShapeInt HighsInt)
prepareConstraints :: forall sh ix.
(Indexed sh, Index sh ~ ix) =>
sh
-> Constraints Double ix
-> (Array ShapeInt CDouble, Array ShapeInt HighsInt,
    Array ShapeInt HighsInt)
prepareConstraints sh
shape Constraints Double ix
constrs =
   let {-
       Highs.passLp returns Warning when there are zero coefficients.
       I think zero coefficients are reasonably ok.
       -}
       constrsNonZero :: Constraints Double ix
constrsNonZero = (Inequality [Term Double ix] -> Inequality [Term Double ix])
-> Constraints Double ix -> Constraints Double ix
forall a b. (a -> b) -> [a] -> [b]
map (([Term Double ix] -> [Term Double ix])
-> Inequality [Term Double ix] -> Inequality [Term Double ix]
forall a b. (a -> b) -> Inequality a -> Inequality b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Term Double ix -> Bool) -> [Term Double ix] -> [Term Double ix]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Term Double
c ix
_x) -> Double
cDouble -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/=Double
0))) Constraints Double ix
constrs
       rowStarts :: Array ShapeInt HighsInt
rowStarts =
         [HighsInt] -> Array ShapeInt HighsInt
forall a. Storable a => [a] -> Array ShapeInt a
Array.vectorFromList ([HighsInt] -> Array ShapeInt HighsInt)
-> [HighsInt] -> Array ShapeInt HighsInt
forall a b. (a -> b) -> a -> b
$ (HighsInt -> HighsInt -> HighsInt)
-> HighsInt -> [HighsInt] -> [HighsInt]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl HighsInt -> HighsInt -> HighsInt
forall a. Num a => a -> a -> a
(+) HighsInt
0 ([HighsInt] -> [HighsInt]) -> [HighsInt] -> [HighsInt]
forall a b. (a -> b) -> a -> b
$
         (Inequality [Term Double ix] -> HighsInt)
-> Constraints Double ix -> [HighsInt]
forall a b. (a -> b) -> [a] -> [b]
map (\(Inequality [Term Double ix]
terms Bound
_bnd) -> Int -> HighsInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> HighsInt) -> Int -> HighsInt
forall a b. (a -> b) -> a -> b
$ [Term Double ix] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Term Double ix]
terms)
            Constraints Double ix
constrsNonZero
       shapeOffset :: Index sh -> Int
shapeOffset = sh -> Index sh -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
Shape.offset sh
shape
       coefficients :: [Term Double ix]
coefficients =
         (Inequality [Term Double ix] -> [Term Double ix])
-> Constraints Double ix -> [Term Double ix]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Inequality [Term Double ix]
terms Bound
_bnd) -> [Term Double ix]
terms) Constraints Double ix
constrsNonZero
       indexArr :: Array ShapeInt HighsInt
indexArr =
         [HighsInt] -> Array ShapeInt HighsInt
forall a. Storable a => [a] -> Array ShapeInt a
Array.vectorFromList ([HighsInt] -> Array ShapeInt HighsInt)
-> [HighsInt] -> Array ShapeInt HighsInt
forall a b. (a -> b) -> a -> b
$
         (Term Double ix -> HighsInt) -> [Term Double ix] -> [HighsInt]
forall a b. (a -> b) -> [a] -> [b]
map (\(Term Double
_ ix
ix) -> Int -> HighsInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> HighsInt) -> Int -> HighsInt
forall a b. (a -> b) -> a -> b
$ Index sh -> Int
shapeOffset ix
Index sh
ix) [Term Double ix]
coefficients
       coefficientArr :: Array ShapeInt CDouble
coefficientArr =
         [CDouble] -> Array ShapeInt CDouble
forall a. Storable a => [a] -> Array ShapeInt a
Array.vectorFromList ([CDouble] -> Array ShapeInt CDouble)
-> [CDouble] -> Array ShapeInt CDouble
forall a b. (a -> b) -> a -> b
$
         (Term Double ix -> CDouble) -> [Term Double ix] -> [CDouble]
forall a b. (a -> b) -> [a] -> [b]
map (\(Term Double
c ix
_) -> Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
c) [Term Double ix]
coefficients
   in (Array ShapeInt CDouble
coefficientArr, Array ShapeInt HighsInt
indexArr, Array ShapeInt HighsInt
rowStarts)

storeConstraints ::
   (Array ShapeInt CDouble, Array ShapeInt HighsInt, Array ShapeInt HighsInt) ->
   MC.ContT r IO (Ptr CDouble, Ptr HighsInt, Ptr HighsInt)
storeConstraints :: forall r.
(Array ShapeInt CDouble, Array ShapeInt HighsInt,
 Array ShapeInt HighsInt)
-> ContT r IO (Ptr CDouble, Ptr HighsInt, Ptr HighsInt)
storeConstraints (Array ShapeInt CDouble
coefficients, Array ShapeInt HighsInt
indices, Array ShapeInt HighsInt
rowStarts) =
   (Ptr CDouble
 -> Ptr HighsInt
 -> Ptr HighsInt
 -> (Ptr CDouble, Ptr HighsInt, Ptr HighsInt))
-> ContT r IO (Ptr CDouble)
-> ContT r IO (Ptr HighsInt)
-> ContT r IO (Ptr HighsInt)
-> ContT r IO (Ptr CDouble, Ptr HighsInt, Ptr HighsInt)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (,,)
      (Array ShapeInt CDouble -> ContT r IO (Ptr CDouble)
forall sh a r. Array sh a -> ContT r IO (Ptr a)
withBuffer Array ShapeInt CDouble
coefficients)
      (Array ShapeInt HighsInt -> ContT r IO (Ptr HighsInt)
forall sh a r. Array sh a -> ContT r IO (Ptr a)
withBuffer Array ShapeInt HighsInt
indices)
      (Array ShapeInt HighsInt -> ContT r IO (Ptr HighsInt)
forall sh a r. Array sh a -> ContT r IO (Ptr a)
withBuffer Array ShapeInt HighsInt
rowStarts)


objectiveSense :: Direction -> Highs.ObjSense
objectiveSense :: Direction -> ObjSense
objectiveSense Direction
dir =
   case Direction
dir of
      Direction
Minimize -> ObjSense
Highs.objSenseMinimize
      Direction
Maximize -> ObjSense
Highs.objSenseMaximize


setBoolOptionValue :: Ptr Highs -> String -> Highs.Bool -> IO ()
setBoolOptionValue :: Ptr Highs -> String -> Bool -> IO ()
setBoolOptionValue Ptr Highs
model String
key Bool
b =
   IO Status -> IO ()
checkStatus (IO Status -> IO ()) -> IO Status -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO Status) -> IO Status
forall a. String -> (CString -> IO a) -> IO a
withCString String
key ((CString -> IO Status) -> IO Status)
-> (CString -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \CString
cstr ->
      Ptr Highs -> CString -> Bool -> IO Status
Highs.setBoolOptionValue Ptr Highs
model CString
cstr Bool
b

setIntOptionValue :: Ptr Highs -> String -> HighsInt -> IO ()
setIntOptionValue :: Ptr Highs -> String -> HighsInt -> IO ()
setIntOptionValue Ptr Highs
model String
key HighsInt
n =
   IO Status -> IO ()
checkStatus (IO Status -> IO ()) -> IO Status -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO Status) -> IO Status
forall a. String -> (CString -> IO a) -> IO a
withCString String
key ((CString -> IO Status) -> IO Status)
-> (CString -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \CString
cstr ->
      Ptr Highs -> CString -> HighsInt -> IO Status
Highs.setIntOptionValue Ptr Highs
model CString
cstr HighsInt
n

setDoubleOptionValue :: Ptr Highs -> String -> CDouble -> IO ()
setDoubleOptionValue :: Ptr Highs -> String -> CDouble -> IO ()
setDoubleOptionValue Ptr Highs
model String
key CDouble
x =
   IO Status -> IO ()
checkStatus (IO Status -> IO ()) -> IO Status -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO Status) -> IO Status
forall a. String -> (CString -> IO a) -> IO a
withCString String
key ((CString -> IO Status) -> IO Status)
-> (CString -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \CString
cstr ->
      Ptr Highs -> CString -> CDouble -> IO Status
Highs.setDoubleOptionValue Ptr Highs
model CString
cstr CDouble
x

setStringOptionValue :: Ptr Highs -> String -> String -> IO ()
setStringOptionValue :: Ptr Highs -> String -> String -> IO ()
setStringOptionValue Ptr Highs
model String
key String
value =
   IO Status -> IO ()
checkStatus (IO Status -> IO ()) -> IO Status -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> (CString -> IO Status) -> IO Status
forall a. String -> (CString -> IO a) -> IO a
withCString String
key ((CString -> IO Status) -> IO Status)
-> (CString -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \CString
keyPtr ->
      String -> (CString -> IO Status) -> IO Status
forall a. String -> (CString -> IO a) -> IO a
withCString String
value ((CString -> IO Status) -> IO Status)
-> (CString -> IO Status) -> IO Status
forall a b. (a -> b) -> a -> b
$ \CString
valuePtr ->
      Ptr Highs -> CString -> CString -> IO Status
Highs.setStringOptionValue Ptr Highs
model CString
keyPtr CString
valuePtr



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

simplex, choose, ipm :: Method
simplex :: Method
simplex = String -> Method
Method String
"simplex"
choose :: Method
choose = String -> Method
Method String
"choose"
ipm :: Method
ipm = String -> Method
Method String
"ipm"

setMethod :: Ptr Highs -> Method -> IO ()
setMethod :: Ptr Highs -> Method -> IO ()
setMethod Ptr Highs
model (Method String
method) =
   Ptr Highs -> String -> String -> IO ()
setStringOptionValue Ptr Highs
model String
"solver" String
method

checkStatus :: IO Highs.Status -> IO ()
checkStatus :: IO Status -> IO ()
checkStatus IO Status
act = do
   Status
status <- IO Status
act
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
Highs.statusError) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Highs function failed"


newtype Query sh a = Query (MR.ReaderT (sh, Ptr Highs) IO a)
   deriving ((forall a b. (a -> b) -> Query sh a -> Query sh b)
-> (forall a b. a -> Query sh b -> Query sh a)
-> Functor (Query sh)
forall a b. a -> Query sh b -> Query sh a
forall a b. (a -> b) -> Query sh a -> Query sh b
forall sh a b. a -> Query sh b -> Query sh a
forall sh a b. (a -> b) -> Query sh a -> Query sh b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall sh a b. (a -> b) -> Query sh a -> Query sh b
fmap :: forall a b. (a -> b) -> Query sh a -> Query sh b
$c<$ :: forall sh a b. a -> Query sh b -> Query sh a
<$ :: forall a b. a -> Query sh b -> Query sh a
Functor, Functor (Query sh)
Functor (Query sh)
-> (forall a. a -> Query sh a)
-> (forall a b. Query sh (a -> b) -> Query sh a -> Query sh b)
-> (forall a b c.
    (a -> b -> c) -> Query sh a -> Query sh b -> Query sh c)
-> (forall a b. Query sh a -> Query sh b -> Query sh b)
-> (forall a b. Query sh a -> Query sh b -> Query sh a)
-> Applicative (Query sh)
forall sh. Functor (Query sh)
forall a. a -> Query sh a
forall sh a. a -> Query sh a
forall a b. Query sh a -> Query sh b -> Query sh a
forall a b. Query sh a -> Query sh b -> Query sh b
forall a b. Query sh (a -> b) -> Query sh a -> Query sh b
forall sh a b. Query sh a -> Query sh b -> Query sh a
forall sh a b. Query sh a -> Query sh b -> Query sh b
forall sh a b. Query sh (a -> b) -> Query sh a -> Query sh b
forall a b c.
(a -> b -> c) -> Query sh a -> Query sh b -> Query sh c
forall sh a b c.
(a -> b -> c) -> Query sh a -> Query sh b -> Query sh c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall sh a. a -> Query sh a
pure :: forall a. a -> Query sh a
$c<*> :: forall sh a b. Query sh (a -> b) -> Query sh a -> Query sh b
<*> :: forall a b. Query sh (a -> b) -> Query sh a -> Query sh b
$cliftA2 :: forall sh a b c.
(a -> b -> c) -> Query sh a -> Query sh b -> Query sh c
liftA2 :: forall a b c.
(a -> b -> c) -> Query sh a -> Query sh b -> Query sh c
$c*> :: forall sh a b. Query sh a -> Query sh b -> Query sh b
*> :: forall a b. Query sh a -> Query sh b -> Query sh b
$c<* :: forall sh a b. Query sh a -> Query sh b -> Query sh a
<* :: forall a b. Query sh a -> Query sh b -> Query sh a
Applicative, Applicative (Query sh)
Applicative (Query sh)
-> (forall a b. Query sh a -> (a -> Query sh b) -> Query sh b)
-> (forall a b. Query sh a -> Query sh b -> Query sh b)
-> (forall a. a -> Query sh a)
-> Monad (Query sh)
forall sh. Applicative (Query sh)
forall a. a -> Query sh a
forall sh a. a -> Query sh a
forall a b. Query sh a -> Query sh b -> Query sh b
forall a b. Query sh a -> (a -> Query sh b) -> Query sh b
forall sh a b. Query sh a -> Query sh b -> Query sh b
forall sh a b. Query sh a -> (a -> Query sh b) -> Query sh b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall sh a b. Query sh a -> (a -> Query sh b) -> Query sh b
>>= :: forall a b. Query sh a -> (a -> Query sh b) -> Query sh b
$c>> :: forall sh a b. Query sh a -> Query sh b -> Query sh b
>> :: forall a b. Query sh a -> Query sh b -> Query sh b
$creturn :: forall sh a. a -> Query sh a
return :: forall a. a -> Query sh a
Monad)

getResult :: (Shape.C sh) => Query sh (Double, Array sh Double)
getResult :: forall sh. C sh => Query sh (Double, Array sh Double)
getResult = (Double -> Array sh Double -> (Double, Array sh Double))
-> Query sh Double
-> Query sh (Array sh Double)
-> Query sh (Double, Array sh Double)
forall a b c.
(a -> b -> c) -> Query sh a -> Query sh b -> Query sh c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Query sh Double
forall sh. Query sh Double
getObjectiveValue Query sh (Array sh Double)
forall sh. C sh => Query sh (Array sh Double)
getOptimalVector

getObjectiveValue :: Query sh Double
getObjectiveValue :: forall sh. Query sh Double
getObjectiveValue =
   ReaderT (sh, Ptr Highs) IO Double -> Query sh Double
forall sh a. ReaderT (sh, Ptr Highs) IO a -> Query sh a
Query (ReaderT (sh, Ptr Highs) IO Double -> Query sh Double)
-> ReaderT (sh, Ptr Highs) IO Double -> Query sh Double
forall a b. (a -> b) -> a -> b
$ ((sh, Ptr Highs) -> IO Double) -> ReaderT (sh, Ptr Highs) IO Double
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
MR.ReaderT (((sh, Ptr Highs) -> IO Double)
 -> ReaderT (sh, Ptr Highs) IO Double)
-> ((sh, Ptr Highs) -> IO Double)
-> ReaderT (sh, Ptr Highs) IO Double
forall a b. (a -> b) -> a -> b
$ (CDouble -> Double) -> IO CDouble -> IO Double
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (IO CDouble -> IO Double)
-> ((sh, Ptr Highs) -> IO CDouble) -> (sh, Ptr Highs) -> IO Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Highs -> IO CDouble
Highs.getObjectiveValue (Ptr Highs -> IO CDouble)
-> ((sh, Ptr Highs) -> Ptr Highs) -> (sh, Ptr Highs) -> IO CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (sh, Ptr Highs) -> Ptr Highs
forall a b. (a, b) -> b
snd

doubleFromCDoubleBuffer :: Int -> Ptr CDouble -> Ptr Double -> IO ()
doubleFromCDoubleBuffer :: Int -> Ptr CDouble -> Ptr Double -> IO ()
doubleFromCDoubleBuffer Int
n Ptr CDouble
srcPtr Ptr Double
dstPtr =
   [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
n [Int
0..]) ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
k ->
      Ptr Double -> Int -> Double -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Double
dstPtr Int
k (Double -> IO ()) -> (CDouble -> Double) -> CDouble -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> IO ()) -> IO CDouble -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CDouble -> Int -> IO CDouble
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CDouble
srcPtr Int
k

getOptimalVector :: (Shape.C sh) => Query sh (Array sh Double)
getOptimalVector :: forall sh. C sh => Query sh (Array sh Double)
getOptimalVector =
   ReaderT (sh, Ptr Highs) IO (Array sh Double)
-> Query sh (Array sh Double)
forall sh a. ReaderT (sh, Ptr Highs) IO a -> Query sh a
Query (ReaderT (sh, Ptr Highs) IO (Array sh Double)
 -> Query sh (Array sh Double))
-> ReaderT (sh, Ptr Highs) IO (Array sh Double)
-> Query sh (Array sh Double)
forall a b. (a -> b) -> a -> b
$ ((sh, Ptr Highs) -> IO (Array sh Double))
-> ReaderT (sh, Ptr Highs) IO (Array sh Double)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
MR.ReaderT (((sh, Ptr Highs) -> IO (Array sh Double))
 -> ReaderT (sh, Ptr Highs) IO (Array sh Double))
-> ((sh, Ptr Highs) -> IO (Array sh Double))
-> ReaderT (sh, Ptr Highs) IO (Array sh Double)
forall a b. (a -> b) -> a -> b
$ \(sh
shape,Ptr Highs
model) ->
   sh -> (Int -> Ptr Double -> IO ()) -> IO (Array sh Double)
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO ()) -> m (Array sh a)
ArrayMonadic.unsafeCreateWithSize sh
shape ((Int -> Ptr Double -> IO ()) -> IO (Array sh Double))
-> (Int -> Ptr Double -> IO ()) -> IO (Array sh Double)
forall a b. (a -> b) -> a -> b
$ \Int
numCols Ptr Double
arrPtr ->
      ((HighsInt -> Int) -> IO HighsInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HighsInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr Highs -> IO HighsInt
forall highs. Ptr highs -> IO HighsInt
Highs.getNumRow Ptr Highs
model) IO Int -> (Int -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ) ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
numRows ->
      Int -> (Ptr CDouble -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
ForeignArray.alloca Int
numCols ((Ptr CDouble -> IO ()) -> IO ())
-> (Ptr CDouble -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
colValuePtr ->
      Int -> (Ptr CDouble -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
ForeignArray.alloca Int
numCols ((Ptr CDouble -> IO ()) -> IO ())
-> (Ptr CDouble -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
colDualPtr  ->
      Int -> (Ptr CDouble -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
ForeignArray.alloca Int
numRows ((Ptr CDouble -> IO ()) -> IO ())
-> (Ptr CDouble -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
rowValuePtr ->
      Int -> (Ptr CDouble -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
ForeignArray.alloca Int
numRows ((Ptr CDouble -> IO ()) -> IO ())
-> (Ptr CDouble -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
rowDualPtr  -> do

      IO Status -> IO ()
checkStatus (IO Status -> IO ()) -> IO Status -> IO ()
forall a b. (a -> b) -> a -> b
$
         Ptr Highs
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> IO Status
Highs.getSolution Ptr Highs
model Ptr CDouble
colValuePtr Ptr CDouble
colDualPtr Ptr CDouble
rowValuePtr Ptr CDouble
rowDualPtr

      Int -> Ptr CDouble -> Ptr Double -> IO ()
doubleFromCDoubleBuffer Int
numCols Ptr CDouble
colValuePtr Ptr Double
arrPtr

getSolutionVectors ::
   (Shape.C sh) =>
   Query sh
      ((Array sh Double, Array sh Double),
       (Array ShapeInt Double, Array ShapeInt Double))
getSolutionVectors :: forall sh.
C sh =>
Query
  sh
  ((Array sh Double, Array sh Double),
   (Array ShapeInt Double, Array ShapeInt Double))
getSolutionVectors =
   ReaderT
  (sh, Ptr Highs)
  IO
  ((Array sh Double, Array sh Double),
   (Array ShapeInt Double, Array ShapeInt Double))
-> Query
     sh
     ((Array sh Double, Array sh Double),
      (Array ShapeInt Double, Array ShapeInt Double))
forall sh a. ReaderT (sh, Ptr Highs) IO a -> Query sh a
Query (ReaderT
   (sh, Ptr Highs)
   IO
   ((Array sh Double, Array sh Double),
    (Array ShapeInt Double, Array ShapeInt Double))
 -> Query
      sh
      ((Array sh Double, Array sh Double),
       (Array ShapeInt Double, Array ShapeInt Double)))
-> ReaderT
     (sh, Ptr Highs)
     IO
     ((Array sh Double, Array sh Double),
      (Array ShapeInt Double, Array ShapeInt Double))
-> Query
     sh
     ((Array sh Double, Array sh Double),
      (Array ShapeInt Double, Array ShapeInt Double))
forall a b. (a -> b) -> a -> b
$ ((sh, Ptr Highs)
 -> IO
      ((Array sh Double, Array sh Double),
       (Array ShapeInt Double, Array ShapeInt Double)))
-> ReaderT
     (sh, Ptr Highs)
     IO
     ((Array sh Double, Array sh Double),
      (Array ShapeInt Double, Array ShapeInt Double))
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
MR.ReaderT (((sh, Ptr Highs)
  -> IO
       ((Array sh Double, Array sh Double),
        (Array ShapeInt Double, Array ShapeInt Double)))
 -> ReaderT
      (sh, Ptr Highs)
      IO
      ((Array sh Double, Array sh Double),
       (Array ShapeInt Double, Array ShapeInt Double)))
-> ((sh, Ptr Highs)
    -> IO
         ((Array sh Double, Array sh Double),
          (Array ShapeInt Double, Array ShapeInt Double)))
-> ReaderT
     (sh, Ptr Highs)
     IO
     ((Array sh Double, Array sh Double),
      (Array ShapeInt Double, Array ShapeInt Double))
forall a b. (a -> b) -> a -> b
$ \(sh
shape,Ptr Highs
model) ->
   ((Array sh Double,
  (Array sh Double, (Array ShapeInt Double, Array ShapeInt Double)))
 -> ((Array sh Double, Array sh Double),
     (Array ShapeInt Double, Array ShapeInt Double)))
-> IO
     (Array sh Double,
      (Array sh Double, (Array ShapeInt Double, Array ShapeInt Double)))
-> IO
     ((Array sh Double, Array sh Double),
      (Array ShapeInt Double, Array ShapeInt Double))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Array sh Double
colPrimal,(Array sh Double
colDual,(Array ShapeInt Double, Array ShapeInt Double)
row2)) -> ((Array sh Double
colPrimal,Array sh Double
colDual),(Array ShapeInt Double, Array ShapeInt Double)
row2)) (IO
   (Array sh Double,
    (Array sh Double, (Array ShapeInt Double, Array ShapeInt Double)))
 -> IO
      ((Array sh Double, Array sh Double),
       (Array ShapeInt Double, Array ShapeInt Double)))
-> IO
     (Array sh Double,
      (Array sh Double, (Array ShapeInt Double, Array ShapeInt Double)))
-> IO
     ((Array sh Double, Array sh Double),
      (Array ShapeInt Double, Array ShapeInt Double))
forall a b. (a -> b) -> a -> b
$
   sh
-> (Int
    -> Ptr Double
    -> IO
         (Array sh Double, (Array ShapeInt Double, Array ShapeInt Double)))
-> IO
     (Array sh Double,
      (Array sh Double, (Array ShapeInt Double, Array ShapeInt Double)))
forall (m :: * -> *) sh a b.
(PrimMonad m, C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO b) -> m (Array sh a, b)
ArrayMonadic.unsafeCreateWithSizeAndResult sh
shape ((Int
  -> Ptr Double
  -> IO
       (Array sh Double, (Array ShapeInt Double, Array ShapeInt Double)))
 -> IO
      (Array sh Double,
       (Array sh Double, (Array ShapeInt Double, Array ShapeInt Double))))
-> (Int
    -> Ptr Double
    -> IO
         (Array sh Double, (Array ShapeInt Double, Array ShapeInt Double)))
-> IO
     (Array sh Double,
      (Array sh Double, (Array ShapeInt Double, Array ShapeInt Double)))
forall a b. (a -> b) -> a -> b
$ \Int
numCols Ptr Double
colValueArr ->
   sh
-> (Int
    -> Ptr Double -> IO (Array ShapeInt Double, Array ShapeInt Double))
-> IO
     (Array sh Double, (Array ShapeInt Double, Array ShapeInt Double))
forall (m :: * -> *) sh a b.
(PrimMonad m, C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO b) -> m (Array sh a, b)
ArrayMonadic.unsafeCreateWithSizeAndResult sh
shape ((Int
  -> Ptr Double -> IO (Array ShapeInt Double, Array ShapeInt Double))
 -> IO
      (Array sh Double, (Array ShapeInt Double, Array ShapeInt Double)))
-> (Int
    -> Ptr Double -> IO (Array ShapeInt Double, Array ShapeInt Double))
-> IO
     (Array sh Double, (Array ShapeInt Double, Array ShapeInt Double))
forall a b. (a -> b) -> a -> b
$ \Int
_numCols Ptr Double
colDualArr ->
   ((HighsInt -> Int) -> IO HighsInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HighsInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr Highs -> IO HighsInt
forall highs. Ptr highs -> IO HighsInt
Highs.getNumRow Ptr Highs
model) IO Int
-> (Int -> IO (Array ShapeInt Double, Array ShapeInt Double))
-> IO (Array ShapeInt Double, Array ShapeInt Double)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ) ((Int -> IO (Array ShapeInt Double, Array ShapeInt Double))
 -> IO (Array ShapeInt Double, Array ShapeInt Double))
-> (Int -> IO (Array ShapeInt Double, Array ShapeInt Double))
-> IO (Array ShapeInt Double, Array ShapeInt Double)
forall a b. (a -> b) -> a -> b
$ \Int
numRows ->
   let constraintsShape :: ShapeInt
constraintsShape = Int -> ShapeInt
forall n. n -> ZeroBased n
Shape.ZeroBased Int
numRows in
   ShapeInt
-> (Int -> Ptr Double -> IO (Array ShapeInt Double))
-> IO (Array ShapeInt Double, Array ShapeInt Double)
forall (m :: * -> *) sh a b.
(PrimMonad m, C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO b) -> m (Array sh a, b)
ArrayMonadic.unsafeCreateWithSizeAndResult ShapeInt
constraintsShape ((Int -> Ptr Double -> IO (Array ShapeInt Double))
 -> IO (Array ShapeInt Double, Array ShapeInt Double))
-> (Int -> Ptr Double -> IO (Array ShapeInt Double))
-> IO (Array ShapeInt Double, Array ShapeInt Double)
forall a b. (a -> b) -> a -> b
$
      \Int
_numRows Ptr Double
rowValueArr ->
   ShapeInt -> (Ptr Double -> IO ()) -> IO (Array ShapeInt Double)
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
sh -> (Ptr a -> IO ()) -> m (Array sh a)
ArrayMonadic.unsafeCreate ShapeInt
constraintsShape ((Ptr Double -> IO ()) -> IO (Array ShapeInt Double))
-> (Ptr Double -> IO ()) -> IO (Array ShapeInt Double)
forall a b. (a -> b) -> a -> b
$ \Ptr Double
rowDualArr ->
      Int -> (Ptr CDouble -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
ForeignArray.alloca Int
numCols ((Ptr CDouble -> IO ()) -> IO ())
-> (Ptr CDouble -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
colValuePtr ->
      Int -> (Ptr CDouble -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
ForeignArray.alloca Int
numCols ((Ptr CDouble -> IO ()) -> IO ())
-> (Ptr CDouble -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
colDualPtr  ->
      Int -> (Ptr CDouble -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
ForeignArray.alloca Int
numRows ((Ptr CDouble -> IO ()) -> IO ())
-> (Ptr CDouble -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
rowValuePtr ->
      Int -> (Ptr CDouble -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
ForeignArray.alloca Int
numRows ((Ptr CDouble -> IO ()) -> IO ())
-> (Ptr CDouble -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
rowDualPtr  -> do

      IO Status -> IO ()
checkStatus (IO Status -> IO ()) -> IO Status -> IO ()
forall a b. (a -> b) -> a -> b
$
         Ptr Highs
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> IO Status
Highs.getSolution Ptr Highs
model Ptr CDouble
colValuePtr Ptr CDouble
colDualPtr Ptr CDouble
rowValuePtr Ptr CDouble
rowDualPtr

      Int -> Ptr CDouble -> Ptr Double -> IO ()
doubleFromCDoubleBuffer Int
numCols Ptr CDouble
colValuePtr Ptr Double
colValueArr
      Int -> Ptr CDouble -> Ptr Double -> IO ()
doubleFromCDoubleBuffer Int
numCols Ptr CDouble
colDualPtr Ptr Double
colDualArr
      Int -> Ptr CDouble -> Ptr Double -> IO ()
doubleFromCDoubleBuffer Int
numRows Ptr CDouble
rowValuePtr Ptr Double
rowValueArr
      Int -> Ptr CDouble -> Ptr Double -> IO ()
doubleFromCDoubleBuffer Int
numRows Ptr CDouble
rowDualPtr Ptr Double
rowDualArr

getBasisStatus ::
   (Shape.C sh) =>
   Query sh (Array sh Highs.BasisStatus, Array ShapeInt Highs.BasisStatus)
getBasisStatus :: forall sh.
C sh =>
Query sh (Array sh BasisStatus, Array ShapeInt BasisStatus)
getBasisStatus =
   ReaderT
  (sh, Ptr Highs)
  IO
  (Array sh BasisStatus, Array ShapeInt BasisStatus)
-> Query sh (Array sh BasisStatus, Array ShapeInt BasisStatus)
forall sh a. ReaderT (sh, Ptr Highs) IO a -> Query sh a
Query (ReaderT
   (sh, Ptr Highs)
   IO
   (Array sh BasisStatus, Array ShapeInt BasisStatus)
 -> Query sh (Array sh BasisStatus, Array ShapeInt BasisStatus))
-> ReaderT
     (sh, Ptr Highs)
     IO
     (Array sh BasisStatus, Array ShapeInt BasisStatus)
-> Query sh (Array sh BasisStatus, Array ShapeInt BasisStatus)
forall a b. (a -> b) -> a -> b
$ ((sh, Ptr Highs)
 -> IO (Array sh BasisStatus, Array ShapeInt BasisStatus))
-> ReaderT
     (sh, Ptr Highs)
     IO
     (Array sh BasisStatus, Array ShapeInt BasisStatus)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
MR.ReaderT (((sh, Ptr Highs)
  -> IO (Array sh BasisStatus, Array ShapeInt BasisStatus))
 -> ReaderT
      (sh, Ptr Highs)
      IO
      (Array sh BasisStatus, Array ShapeInt BasisStatus))
-> ((sh, Ptr Highs)
    -> IO (Array sh BasisStatus, Array ShapeInt BasisStatus))
-> ReaderT
     (sh, Ptr Highs)
     IO
     (Array sh BasisStatus, Array ShapeInt BasisStatus)
forall a b. (a -> b) -> a -> b
$ \(sh
shape,Ptr Highs
model) ->
   sh
-> (Int -> Ptr BasisStatus -> IO (Array ShapeInt BasisStatus))
-> IO (Array sh BasisStatus, Array ShapeInt BasisStatus)
forall (m :: * -> *) sh a b.
(PrimMonad m, C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO b) -> m (Array sh a, b)
ArrayMonadic.unsafeCreateWithSizeAndResult sh
shape ((Int -> Ptr BasisStatus -> IO (Array ShapeInt BasisStatus))
 -> IO (Array sh BasisStatus, Array ShapeInt BasisStatus))
-> (Int -> Ptr BasisStatus -> IO (Array ShapeInt BasisStatus))
-> IO (Array sh BasisStatus, Array ShapeInt BasisStatus)
forall a b. (a -> b) -> a -> b
$ \Int
_numCols Ptr BasisStatus
colStatusPtr ->
   ((HighsInt -> Int) -> IO HighsInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HighsInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr Highs -> IO HighsInt
forall highs. Ptr highs -> IO HighsInt
Highs.getNumRow Ptr Highs
model) IO Int
-> (Int -> IO (Array ShapeInt BasisStatus))
-> IO (Array ShapeInt BasisStatus)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ) ((Int -> IO (Array ShapeInt BasisStatus))
 -> IO (Array ShapeInt BasisStatus))
-> (Int -> IO (Array ShapeInt BasisStatus))
-> IO (Array ShapeInt BasisStatus)
forall a b. (a -> b) -> a -> b
$ \Int
numRows ->
   ShapeInt
-> (Ptr BasisStatus -> IO ()) -> IO (Array ShapeInt BasisStatus)
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
sh -> (Ptr a -> IO ()) -> m (Array sh a)
ArrayMonadic.unsafeCreate (Int -> ShapeInt
forall n. n -> ZeroBased n
Shape.ZeroBased Int
numRows) ((Ptr BasisStatus -> IO ()) -> IO (Array ShapeInt BasisStatus))
-> (Ptr BasisStatus -> IO ()) -> IO (Array ShapeInt BasisStatus)
forall a b. (a -> b) -> a -> b
$ \Ptr BasisStatus
rowStatusPtr ->
      IO Status -> IO ()
checkStatus (IO Status -> IO ()) -> IO Status -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Highs -> Ptr BasisStatus -> Ptr BasisStatus -> IO Status
Highs.getBasis Ptr Highs
model Ptr BasisStatus
colStatusPtr Ptr BasisStatus
rowStatusPtr



type Result sh = (ModelStatus, Maybe (Double, Array sh Double))

examineStatus :: (Shape.C sh) =>
   Query sh a -> sh -> Ptr Highs -> Highs.Status -> IO (ModelStatus, Maybe a)
examineStatus :: forall sh a.
C sh =>
Query sh a
-> sh -> Ptr Highs -> Status -> IO (ModelStatus, Maybe a)
examineStatus (Query ReaderT (sh, Ptr Highs) IO a
query) sh
shape Ptr Highs
model Status
status =
   (ModelStatus -> Maybe a -> (ModelStatus, Maybe a))
-> IO ModelStatus -> IO (Maybe a) -> IO (ModelStatus, Maybe a)
forall a b c. (a -> b -> c) -> IO a -> IO b -> IO c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) ((ModelStatus -> ModelStatus) -> IO ModelStatus -> IO ModelStatus
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModelStatus -> ModelStatus
modelStatusFromC (IO ModelStatus -> IO ModelStatus)
-> IO ModelStatus -> IO ModelStatus
forall a b. (a -> b) -> a -> b
$ Ptr Highs -> IO ModelStatus
Highs.getModelStatus Ptr Highs
model) (IO (Maybe a) -> IO (ModelStatus, Maybe a))
-> IO (Maybe a) -> IO (ModelStatus, Maybe a)
forall a b. (a -> b) -> a -> b
$
   Maybe () -> (() -> IO a) -> IO (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
Trav.for (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
Highs.statusError)) ((() -> IO a) -> IO (Maybe a)) -> (() -> IO a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ \() ->
      ReaderT (sh, Ptr Highs) IO a -> (sh, Ptr Highs) -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
MR.runReaderT ReaderT (sh, Ptr Highs) IO a
query (sh
shape,Ptr Highs
model)