{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# 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)
import Data.Default.Class
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 =
  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]
&| (FilePath -> Scientific
forall a. Read a => FilePath -> a
read (FilePath -> Scientific)
-> (Text -> FilePath) -> Text -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack)

    status :: MIP.Status
    status :: Status
status = [Status] -> Status
forall a. HasCallStack => [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
. FilePath -> Key
forall a. Read a => FilePath -> a
read (FilePath -> Key) -> (Text -> FilePath) -> Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
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 <- FilePath -> Scientific
forall a. Read a => FilePath -> a
read (FilePath -> Scientific)
-> (Text -> FilePath) -> Text -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
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 a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Var
MIP.Var Text
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 :: FilePath -> IO (Solution Scientific)
readFile FilePath
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 -> FilePath -> IO Document
XML.readFile ParseSettings
forall a. Default a => a
def (FilePath -> FilePath
forall a. IsString a => FilePath -> a
fromString FilePath
fname)