{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE FunctionalDependencies #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Numeric.Optimization.MIP.Solver.Base
-- Copyright   :  (c) Masahiro Sakai 2017
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
module Numeric.Optimization.MIP.Solver.Base
  (
  -- * Solver type
    IsSolver (..)
  , SolveOptions (..)
  -- * Utilities
  , Default (..)
  ) where

import Data.Default.Class
import Data.Scientific (Scientific)
import Numeric.Optimization.MIP.Base as MIP
import qualified Data.Map as Map

-- | Options for 'solve' function
data SolveOptions
  = SolveOptions
  { SolveOptions -> Maybe Double
solveTimeLimit :: Maybe Double
    -- ^ time limit in seconds
  , SolveOptions -> Maybe (Tol Scientific)
solveTol :: Maybe (MIP.Tol Scientific)
    -- ^ tolerance
  , SolveOptions -> String -> IO ()
solveLogger :: String -> IO ()
    -- ^ invoked when a solver output a line
  , SolveOptions -> String -> IO ()
solveErrorLogger :: String -> IO ()
    -- ^ invoked when a solver output a line to stderr
  , SolveOptions -> Bool
solveCondensedSolution :: Bool
    -- ^ potentially omit variables set to zero from the solution
  }

instance Default SolveOptions where
  def :: SolveOptions
def =
    SolveOptions
    { solveTimeLimit :: Maybe Double
solveTimeLimit = Maybe Double
forall a. Maybe a
Nothing
    , solveTol :: Maybe (Tol Scientific)
solveTol = Maybe (Tol Scientific)
forall a. Maybe a
Nothing
    , solveLogger :: String -> IO ()
solveLogger = IO () -> String -> IO ()
forall a b. a -> b -> a
const (IO () -> String -> IO ()) -> IO () -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    , solveErrorLogger :: String -> IO ()
solveErrorLogger = IO () -> String -> IO ()
forall a b. a -> b -> a
const (IO () -> String -> IO ()) -> IO () -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    , solveCondensedSolution :: Bool
solveCondensedSolution = Bool
False
    }


-- | Type class for solvers
--
-- 
class Monad m => IsSolver s m | s -> m where
  -- | Low level version of 'solve'' that allows omission of variables with a value 0.
  --
  -- Implementor of the type class must implement this method.
  solve' :: s -> SolveOptions -> MIP.Problem Scientific -> m (MIP.Solution Scientific)

  -- | A method for solving 'MIP.Problem'
  --
  -- This method is a bit higher level than 'solve'' in that it does not omit variables
  -- with a value @0@ unless 'solveCondensedSolution' is set to @True@.
  -- Implementor of the type class can override this method as @solve = solve'@ if the
  -- solver always returns all variables.
  solve  :: s -> SolveOptions -> MIP.Problem Scientific -> m (MIP.Solution Scientific)
  solve s
s SolveOptions
opts Problem Scientific
problem = (if SolveOptions -> Bool
solveCondensedSolution SolveOptions
opts then Solution Scientific -> Solution Scientific
forall a. a -> a
id else Problem Scientific -> Solution Scientific -> Solution Scientific
addZeroes Problem Scientific
problem) (Solution Scientific -> Solution Scientific)
-> m (Solution Scientific) -> m (Solution Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> SolveOptions -> Problem Scientific -> m (Solution Scientific)
forall s (m :: * -> *).
IsSolver s m =>
s -> SolveOptions -> Problem Scientific -> m (Solution Scientific)
solve' s
s SolveOptions
opts Problem Scientific
problem
  {-# MINIMAL solve' #-}

-- Several solvers (at least CBC) do not include any variables set to 0 in their solution.
-- TODO: for solvers that do return all variables, add @solve = solve'@
-- for a minor performance improvement.
addZeroes :: MIP.Problem Scientific -> MIP.Solution Scientific -> MIP.Solution Scientific
addZeroes :: Problem Scientific -> Solution Scientific -> Solution Scientific
addZeroes Problem Scientific
problem (Solution Status
stat Maybe Scientific
obj Map Var Scientific
solmap) = 
  -- Map.union is left-biased: only values not present in the solution are added.
  Status
-> Maybe Scientific -> Map Var Scientific -> Solution Scientific
forall r. Status -> Maybe r -> Map Var r -> Solution r
Solution Status
stat Maybe Scientific
obj (Map Var Scientific -> Solution Scientific)
-> Map Var Scientific -> Solution Scientific
forall a b. (a -> b) -> a -> b
$ Map Var Scientific -> Map Var Scientific -> Map Var Scientific
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Var Scientific
solmap ((Var -> Scientific) -> Set Var -> Map Var Scientific
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Scientific -> Var -> Scientific
forall a b. a -> b -> a
const Scientific
0) (Problem Scientific -> Set Var
forall a. Variables a => a -> Set Var
vars Problem Scientific
problem))