{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Numeric.Optimization.MIP.Solution.CPLEX
-- Copyright   :  (c) Masahiro Sakai 2017
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
module Numeric.Optimization.MIP.Solution.CPLEX
  ( Solution (..)
  , parse
  , readFile
  ) where

import Prelude hiding (readFile)
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Data.Default.Class
import Data.Interned
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
import Data.Maybe
import Data.Scientific (Scientific)
import Data.String
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Text.XML as XML
import Text.XML.Cursor
import Numeric.Optimization.MIP (Solution)
import qualified Numeric.Optimization.MIP.Base as MIP

parseDoc :: XML.Document -> MIP.Solution Scientific
parseDoc :: Document -> Solution Scientific
parseDoc Document
doc =
  Solution :: forall r. Status -> Maybe r -> Map Var r -> Solution r
MIP.Solution
  { solStatus :: Status
MIP.solStatus = Status
status
  , solObjectiveValue :: Maybe Scientific
MIP.solObjectiveValue = Maybe Scientific
obj
  , solVariables :: Map Var Scientific
MIP.solVariables = [(Var, Scientific)] -> Map Var Scientific
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Var, Scientific)]
vs
  }
  where
    obj :: Maybe Scientific
    obj :: Maybe Scientific
obj = [Scientific] -> Maybe Scientific
forall a. [a] -> Maybe a
listToMaybe
      ([Scientific] -> Maybe Scientific)
-> [Scientific] -> Maybe Scientific
forall a b. (a -> b) -> a -> b
$  Document -> Cursor
fromDocument Document
doc
      Cursor -> (Cursor -> [Scientific]) -> [Scientific]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| Name -> Axis
element Name
"CPLEXSolution"
      Axis -> (Cursor -> [Scientific]) -> Cursor -> [Scientific]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element Name
"header"
      Axis -> (Cursor -> [Scientific]) -> Cursor -> [Scientific]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Cursor -> [Text]
attribute Name
"objectiveValue"
      (Cursor -> [Text])
-> (Text -> Scientific) -> Cursor -> [Scientific]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| (String -> Scientific
forall a. Read a => String -> a
read (String -> Scientific) -> (Text -> String) -> Text -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)

    status :: MIP.Status
    status :: Status
status = [Status] -> Status
forall a. [a] -> a
head
      ([Status] -> Status) -> [Status] -> Status
forall a b. (a -> b) -> a -> b
$  Document -> Cursor
fromDocument Document
doc
      Cursor -> (Cursor -> [Status]) -> [Status]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| Name -> Axis
element Name
"CPLEXSolution"
      Axis -> (Cursor -> [Status]) -> Cursor -> [Status]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element Name
"header"
      Axis -> (Cursor -> [Status]) -> Cursor -> [Status]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Cursor -> [Text]
attribute Name
"solutionStatusValue"
      (Cursor -> [Text]) -> (Text -> Status) -> Cursor -> [Status]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| ((Key -> IntMap Status -> Status) -> IntMap Status -> Key -> Status
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Status -> Key -> IntMap Status -> Status
forall a. a -> Key -> IntMap a -> a
IntMap.findWithDefault Status
MIP.StatusUnknown) IntMap Status
table (Key -> Status) -> (Text -> Key) -> Text -> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Key
forall a. Read a => String -> a
read (String -> Key) -> (Text -> String) -> Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)

    f :: Cursor -> [(MIP.Var, Scientific)]
    f :: Cursor -> [(Var, Scientific)]
f Cursor
x
      | XML.NodeElement Element
e <- Cursor -> Node
forall node. Cursor node -> node
node Cursor
x = Maybe (Var, Scientific) -> [(Var, Scientific)]
forall a. Maybe a -> [a]
maybeToList (Maybe (Var, Scientific) -> [(Var, Scientific)])
-> Maybe (Var, Scientific) -> [(Var, Scientific)]
forall a b. (a -> b) -> a -> b
$ do
          let m :: Map Name Text
m = Element -> Map Name Text
XML.elementAttributes Element
e
          Text
name <- Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
"name" Map Name Text
m
          Scientific
value <- String -> Scientific
forall a. Read a => String -> a
read (String -> Scientific) -> (Text -> String) -> Text -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Scientific) -> Maybe Text -> Maybe Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
"value" Map Name Text
m
          (Var, Scientific) -> Maybe (Var, Scientific)
forall (m :: * -> *) a. Monad m => a -> m a
return (Uninterned Var -> Var
forall t. Interned t => Uninterned t -> t
intern Text
Uninterned Var
name, Scientific
value)
      | Bool
otherwise = []
    vs :: [(Var, Scientific)]
vs = Document -> Cursor
fromDocument Document
doc
      Cursor -> (Cursor -> [(Var, Scientific)]) -> [(Var, Scientific)]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| Name -> Axis
element Name
"CPLEXSolution"
      Axis
-> (Cursor -> [(Var, Scientific)]) -> Cursor -> [(Var, Scientific)]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element Name
"variables"
      Axis
-> (Cursor -> [(Var, Scientific)]) -> Cursor -> [(Var, Scientific)]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element Name
"variable"
      Axis
-> (Cursor -> [(Var, Scientific)]) -> Cursor -> [(Var, Scientific)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [(Var, Scientific)]
f

-- https://www.ibm.com/support/knowledgecenter/en/SSSA5P_12.7.0/ilog.odms.cplex.help/refcallablelibrary/macros/Solution_status_codes.html
table :: IntMap MIP.Status
table :: IntMap Status
table = [(Key, Status)] -> IntMap Status
forall a. [(Key, a)] -> IntMap a
IntMap.fromList
  [ (Key
1,   Status
MIP.StatusOptimal)               -- CPX_STAT_OPTIMAL
  , (Key
2,   Status
MIP.StatusUnbounded)             -- CPX_STAT_UNBOUNDED
  , (Key
3,   Status
MIP.StatusInfeasible)            -- CPX_STAT_INFEASIBLE
  , (Key
4,   Status
MIP.StatusInfeasibleOrUnbounded) -- CPX_STAT_INForUNBD
  , (Key
5,   Status
MIP.StatusOptimal)               -- CPX_STAT_OPTIMAL_INFEAS
{-
  , (6,   ) -- CPX_STAT_NUM_BEST
  , (10,  ) -- CPX_STAT_ABORT_IT_LIM
  , (11,  ) -- CPX_STAT_ABORT_TIME_LIM
  , (12,  ) -- CPX_STAT_ABORT_OBJ_LIM
  , (13,  ) -- CPX_STAT_ABORT_USER
  , (14,  ) -- CPX_STAT_FEASIBLE_RELAXED_SUM
  , (15,  ) -- CPX_STAT_OPTIMAL_RELAXED_SUM
  , (16,  ) -- CPX_STAT_FEASIBLE_RELAXED_INF
  , (17,  ) -- CPX_STAT_OPTIMAL_RELAXED_INF
  , (18,  ) -- CPX_STAT_FEASIBLE_RELAXED_QUAD
  , (19,  ) -- CPX_STAT_OPTIMAL_RELAXED_QUAD
  , (20,  ) -- CPX_STAT_OPTIMAL_FACE_UNBOUNDED
  , (21,  ) -- CPX_STAT_ABORT_PRIM_OBJ_LIM
  , (22,  ) -- CPX_STAT_ABORT_DUAL_OBJ_LIM
  , (23,  ) -- CPX_STAT_FEASIBLE
-}
  , (Key
24,  Status
MIP.StatusFeasible) -- CPX_STAT_FIRSTORDER
{-
  , (25,  ) -- CPX_STAT_ABORT_DETTIME_LIM
  , (30,  ) -- CPX_STAT_CONFLICT_FEASIBLE
  , (31,  ) -- CPX_STAT_CONFLICT_MINIMAL
  , (32,  ) -- CPX_STAT_CONFLICT_ABORT_CONTRADICTION
  , (33,  ) -- CPX_STAT_CONFLICT_ABORT_TIME_LIM
  , (34,  ) -- CPX_STAT_CONFLICT_ABORT_IT_LIM
  , (35,  ) -- CPX_STAT_CONFLICT_ABORT_NODE_LIM
  , (36,  ) -- CPX_STAT_CONFLICT_ABORT_OBJ_LIM
  , (37,  ) -- CPX_STAT_CONFLICT_ABORT_MEM_LIM
  , (38,  ) -- CPX_STAT_CONFLICT_ABORT_USER
  , (39,  ) -- CPX_STAT_CONFLICT_ABORT_DETTIME_LIM
-}
  , (Key
40,  Status
MIP.StatusInfeasibleOrUnbounded) -- CPX_STAT_BENDERS_MASTER_UNBOUNDED
--  , (41,  ) -- CPX_STAT_BENDERS_NUM_BEST
  , (Key
101, Status
MIP.StatusOptimal)               -- CPXMIP_OPTIMAL
  , (Key
102, Status
MIP.StatusOptimal)               -- CPXMIP_OPTIMAL_TOL
  , (Key
103, Status
MIP.StatusInfeasible)            -- CPXMIP_INFEASIBLE
--  , (104, ) -- CPXMIP_SOL_LIM
  , (Key
105, Status
MIP.StatusFeasible)              -- CPXMIP_NODE_LIM_FEAS
--  , (106, ) -- CPXMIP_NODE_LIM_INFEAS
  , (Key
107, Status
MIP.StatusFeasible)              -- CPXMIP_TIME_LIM_FEAS
--  , (108, ) -- CPXMIP_TIME_LIM_INFEAS
  , (Key
109, Status
MIP.StatusFeasible)              -- CPXMIP_FAIL_FEAS
--  , (110, ) -- CPXMIP_FAIL_INFEAS
  , (Key
111, Status
MIP.StatusFeasible)              -- CPXMIP_MEM_LIM_FEAS
--  , (112, ) -- CPXMIP_MEM_LIM_INFEAS
  , (Key
113, Status
MIP.StatusFeasible)              -- CPXMIP_ABORT_FEAS
--  , (114, ) -- CPXMIP_ABORT_INFEAS
  , (Key
115, Status
MIP.StatusOptimal)               -- CPXMIP_OPTIMAL_INFEAS
  , (Key
116, Status
MIP.StatusFeasible)              -- CPXMIP_FAIL_FEAS_NO_TREE
--  , (117, ) -- CPXMIP_FAIL_INFEAS_NO_TREE
  , (Key
118, Status
MIP.StatusUnbounded)             -- CPXMIP_UNBOUNDED
  , (Key
119, Status
MIP.StatusInfeasibleOrUnbounded) -- CPXMIP_INForUNBD
{-
  , (120, ) -- CPXMIP_FEASIBLE_RELAXED_SUM
  , (121, ) -- CPXMIP_OPTIMAL_RELAXED_SUM
  , (122, ) -- CPXMIP_FEASIBLE_RELAXED_INF
  , (123, ) -- CPXMIP_OPTIMAL_RELAXED_INF
  , (124, ) -- CPXMIP_FEASIBLE_RELAXED_QUAD
  , (125, ) -- CPXMIP_OPTIMAL_RELAXED_QUAD
  , (126, ) -- CPXMIP_ABORT_RELAXED
-}
  , (Key
127, Status
MIP.StatusFeasible)              -- CPXMIP_FEASIBLE
--  , (128, ) -- CPXMIP_POPULATESOL_LIM
  , (Key
129, Status
MIP.StatusOptimal)               -- CPXMIP_OPTIMAL_POPULATED
  , (Key
130, Status
MIP.StatusOptimal)               -- CPXMIP_OPTIMAL_POPULATED_TOL
  , (Key
131, Status
MIP.StatusFeasible)              -- CPXMIP_DETTIME_LIM_FEAS
--  , (132, ) -- CPXMIP_DETTIME_LIM_INFEAS
  , (Key
133, Status
MIP.StatusInfeasibleOrUnbounded) -- CPXMIP_ABORT_RELAXATION_UNBOUNDED
  ]

parse :: TL.Text -> MIP.Solution Scientific
parse :: Text -> Solution Scientific
parse Text
t = Document -> Solution Scientific
parseDoc (Document -> Solution Scientific)
-> Document -> Solution Scientific
forall a b. (a -> b) -> a -> b
$ ParseSettings -> Text -> Document
XML.parseText_ ParseSettings
forall a. Default a => a
def Text
t

readFile :: FilePath -> IO (MIP.Solution Scientific)
readFile :: String -> IO (Solution Scientific)
readFile String
fname = Document -> Solution Scientific
parseDoc (Document -> Solution Scientific)
-> IO Document -> IO (Solution Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseSettings -> String -> IO Document
XML.readFile ParseSettings
forall a. Default a => a
def (String -> String
forall a. IsString a => String -> a
fromString String
fname)