-- |
-- Module      : Linear.Simplex.Types
-- Description : Custom types
-- Copyright   : (c) Junaid Rasheed, 2020-2023
-- License     : BSD-3
-- Maintainer  : jrasheed178@gmail.com
-- Stability   : experimental
module Linear.Simplex.Types where

import Control.Lens
import Data.Generics.Labels ()
import Data.List (sort)
import qualified Data.Map as M
import GHC.Generics (Generic)

type Var = Int

type SimplexNum = Rational

type SystemRow = PolyConstraint

type System = [SystemRow]

-- A 'Tableau' where the basic variable may be empty.
-- All non-empty basic vars are slack vars
data SystemWithSlackVarRow = SystemInStandardFormRow
  { SystemWithSlackVarRow -> Maybe Var
mSlackVar :: Maybe Var
  -- ^ This is Nothing iff the row does not have a slack variable
  , SystemWithSlackVarRow -> TableauRow
row :: TableauRow
  }

type SystemWithSlackVars = [SystemWithSlackVarRow]

data FeasibleSystem = FeasibleSystem
  { FeasibleSystem -> Dict
dict :: Dict
  , FeasibleSystem -> [Var]
slackVars :: [Var]
  , FeasibleSystem -> [Var]
artificialVars :: [Var]
  , FeasibleSystem -> Var
objectiveVar :: Var
  }
  deriving (Var -> FeasibleSystem -> ShowS
[FeasibleSystem] -> ShowS
FeasibleSystem -> String
forall a.
(Var -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FeasibleSystem] -> ShowS
$cshowList :: [FeasibleSystem] -> ShowS
show :: FeasibleSystem -> String
$cshow :: FeasibleSystem -> String
showsPrec :: Var -> FeasibleSystem -> ShowS
$cshowsPrec :: Var -> FeasibleSystem -> ShowS
Show, ReadPrec [FeasibleSystem]
ReadPrec FeasibleSystem
Var -> ReadS FeasibleSystem
ReadS [FeasibleSystem]
forall a.
(Var -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FeasibleSystem]
$creadListPrec :: ReadPrec [FeasibleSystem]
readPrec :: ReadPrec FeasibleSystem
$creadPrec :: ReadPrec FeasibleSystem
readList :: ReadS [FeasibleSystem]
$creadList :: ReadS [FeasibleSystem]
readsPrec :: Var -> ReadS FeasibleSystem
$creadsPrec :: Var -> ReadS FeasibleSystem
Read, FeasibleSystem -> FeasibleSystem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FeasibleSystem -> FeasibleSystem -> Bool
$c/= :: FeasibleSystem -> FeasibleSystem -> Bool
== :: FeasibleSystem -> FeasibleSystem -> Bool
$c== :: FeasibleSystem -> FeasibleSystem -> Bool
Eq, forall x. Rep FeasibleSystem x -> FeasibleSystem
forall x. FeasibleSystem -> Rep FeasibleSystem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FeasibleSystem x -> FeasibleSystem
$cfrom :: forall x. FeasibleSystem -> Rep FeasibleSystem x
Generic)

data Result = Result
  { Result -> Var
objectiveVar :: Var
  , Result -> VarLitMap
varValMap :: VarLitMap
  -- TODO:
  -- Maybe VarLitMap
  -- , feasible :: Bool
  -- , optimisable :: Bool
  }
  deriving (Var -> Result -> ShowS
[Result] -> ShowS
Result -> String
forall a.
(Var -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Var -> Result -> ShowS
$cshowsPrec :: Var -> Result -> ShowS
Show, ReadPrec [Result]
ReadPrec Result
Var -> ReadS Result
ReadS [Result]
forall a.
(Var -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Result]
$creadListPrec :: ReadPrec [Result]
readPrec :: ReadPrec Result
$creadPrec :: ReadPrec Result
readList :: ReadS [Result]
$creadList :: ReadS [Result]
readsPrec :: Var -> ReadS Result
$creadsPrec :: Var -> ReadS Result
Read, Result -> Result -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq, forall x. Rep Result x -> Result
forall x. Result -> Rep Result x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Result x -> Result
$cfrom :: forall x. Result -> Rep Result x
Generic)

data SimplexMeta = SimplexMeta
  { SimplexMeta -> ObjectiveFunction
objective :: ObjectiveFunction
  , SimplexMeta -> Maybe FeasibleSystem
feasibleSystem :: Maybe FeasibleSystem
  , SimplexMeta -> Maybe Result
optimisedResult :: Maybe Result
  }

type VarLitMap = M.Map Var SimplexNum

-- | List of variables with their 'SimplexNum' coefficients.
--   There is an implicit addition between elements in this list.
--
--   Example: [Var "x" 3, Var "y" -1, Var "z" 1] is equivalent to 3x + (-y) + z.
type VarLitMapSum = VarLitMap

-- | For specifying constraints in a system.
--   The LHS is a 'Vars', and the RHS, is a 'SimplexNum' number.
--   LEQ [(1, 2), (2, 1)] 3.5 is equivalent to 2x1 + x2 <= 3.5.
--   Users must only provide positive integer variables.
--
--   Example: LEQ [Var "x" 3, Var "y" -1, Var "x" 1] 12.3 is equivalent to 3x + (-y) + x <= 12.3.
data PolyConstraint
  = LEQ {PolyConstraint -> VarLitMap
lhs :: VarLitMapSum, PolyConstraint -> Ratio Integer
rhs :: SimplexNum}
  | GEQ {lhs :: VarLitMapSum, rhs :: SimplexNum}
  | EQ {lhs :: VarLitMapSum, rhs :: SimplexNum}
  deriving (Var -> PolyConstraint -> ShowS
[PolyConstraint] -> ShowS
PolyConstraint -> String
forall a.
(Var -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PolyConstraint] -> ShowS
$cshowList :: [PolyConstraint] -> ShowS
show :: PolyConstraint -> String
$cshow :: PolyConstraint -> String
showsPrec :: Var -> PolyConstraint -> ShowS
$cshowsPrec :: Var -> PolyConstraint -> ShowS
Show, ReadPrec [PolyConstraint]
ReadPrec PolyConstraint
Var -> ReadS PolyConstraint
ReadS [PolyConstraint]
forall a.
(Var -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PolyConstraint]
$creadListPrec :: ReadPrec [PolyConstraint]
readPrec :: ReadPrec PolyConstraint
$creadPrec :: ReadPrec PolyConstraint
readList :: ReadS [PolyConstraint]
$creadList :: ReadS [PolyConstraint]
readsPrec :: Var -> ReadS PolyConstraint
$creadsPrec :: Var -> ReadS PolyConstraint
Read, PolyConstraint -> PolyConstraint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolyConstraint -> PolyConstraint -> Bool
$c/= :: PolyConstraint -> PolyConstraint -> Bool
== :: PolyConstraint -> PolyConstraint -> Bool
$c== :: PolyConstraint -> PolyConstraint -> Bool
Eq, forall x. Rep PolyConstraint x -> PolyConstraint
forall x. PolyConstraint -> Rep PolyConstraint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PolyConstraint x -> PolyConstraint
$cfrom :: forall x. PolyConstraint -> Rep PolyConstraint x
Generic)

-- | Create an objective function.
--   We can either 'Max'imize or 'Min'imize a 'VarTermSum'.
data ObjectiveFunction = Max {ObjectiveFunction -> VarLitMap
objective :: VarLitMapSum} | Min {objective :: VarLitMapSum}
  deriving (Var -> ObjectiveFunction -> ShowS
[ObjectiveFunction] -> ShowS
ObjectiveFunction -> String
forall a.
(Var -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObjectiveFunction] -> ShowS
$cshowList :: [ObjectiveFunction] -> ShowS
show :: ObjectiveFunction -> String
$cshow :: ObjectiveFunction -> String
showsPrec :: Var -> ObjectiveFunction -> ShowS
$cshowsPrec :: Var -> ObjectiveFunction -> ShowS
Show, ReadPrec [ObjectiveFunction]
ReadPrec ObjectiveFunction
Var -> ReadS ObjectiveFunction
ReadS [ObjectiveFunction]
forall a.
(Var -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ObjectiveFunction]
$creadListPrec :: ReadPrec [ObjectiveFunction]
readPrec :: ReadPrec ObjectiveFunction
$creadPrec :: ReadPrec ObjectiveFunction
readList :: ReadS [ObjectiveFunction]
$creadList :: ReadS [ObjectiveFunction]
readsPrec :: Var -> ReadS ObjectiveFunction
$creadsPrec :: Var -> ReadS ObjectiveFunction
Read, ObjectiveFunction -> ObjectiveFunction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectiveFunction -> ObjectiveFunction -> Bool
$c/= :: ObjectiveFunction -> ObjectiveFunction -> Bool
== :: ObjectiveFunction -> ObjectiveFunction -> Bool
$c== :: ObjectiveFunction -> ObjectiveFunction -> Bool
Eq, forall x. Rep ObjectiveFunction x -> ObjectiveFunction
forall x. ObjectiveFunction -> Rep ObjectiveFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ObjectiveFunction x -> ObjectiveFunction
$cfrom :: forall x. ObjectiveFunction -> Rep ObjectiveFunction x
Generic)

-- | TODO: Maybe we want this type
-- TODO: A better/alternative name
data Equation = Equation
  { Equation -> VarLitMap
lhs :: VarLitMapSum
  , Equation -> Ratio Integer
rhs :: SimplexNum
  }

-- | Value for 'Tableau'. lhs = rhs.
data TableauRow = TableauRow
  { TableauRow -> VarLitMap
lhs :: VarLitMapSum
  , TableauRow -> Ratio Integer
rhs :: SimplexNum
  }
  deriving (Var -> TableauRow -> ShowS
[TableauRow] -> ShowS
TableauRow -> String
forall a.
(Var -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableauRow] -> ShowS
$cshowList :: [TableauRow] -> ShowS
show :: TableauRow -> String
$cshow :: TableauRow -> String
showsPrec :: Var -> TableauRow -> ShowS
$cshowsPrec :: Var -> TableauRow -> ShowS
Show, ReadPrec [TableauRow]
ReadPrec TableauRow
Var -> ReadS TableauRow
ReadS [TableauRow]
forall a.
(Var -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TableauRow]
$creadListPrec :: ReadPrec [TableauRow]
readPrec :: ReadPrec TableauRow
$creadPrec :: ReadPrec TableauRow
readList :: ReadS [TableauRow]
$creadList :: ReadS [TableauRow]
readsPrec :: Var -> ReadS TableauRow
$creadsPrec :: Var -> ReadS TableauRow
Read, TableauRow -> TableauRow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableauRow -> TableauRow -> Bool
$c/= :: TableauRow -> TableauRow -> Bool
== :: TableauRow -> TableauRow -> Bool
$c== :: TableauRow -> TableauRow -> Bool
Eq, forall x. Rep TableauRow x -> TableauRow
forall x. TableauRow -> Rep TableauRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TableauRow x -> TableauRow
$cfrom :: forall x. TableauRow -> Rep TableauRow x
Generic)

-- | A simplex 'Tableu' of equations.
--   Each entry in the map is a row.
type Tableau = M.Map Var TableauRow

-- | Values for a 'Dict'.
data DictValue = DictValue
  { DictValue -> VarLitMap
varMapSum :: VarLitMapSum
  , DictValue -> Ratio Integer
constant :: SimplexNum
  }
  deriving (Var -> DictValue -> ShowS
[DictValue] -> ShowS
DictValue -> String
forall a.
(Var -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DictValue] -> ShowS
$cshowList :: [DictValue] -> ShowS
show :: DictValue -> String
$cshow :: DictValue -> String
showsPrec :: Var -> DictValue -> ShowS
$cshowsPrec :: Var -> DictValue -> ShowS
Show, ReadPrec [DictValue]
ReadPrec DictValue
Var -> ReadS DictValue
ReadS [DictValue]
forall a.
(Var -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DictValue]
$creadListPrec :: ReadPrec [DictValue]
readPrec :: ReadPrec DictValue
$creadPrec :: ReadPrec DictValue
readList :: ReadS [DictValue]
$creadList :: ReadS [DictValue]
readsPrec :: Var -> ReadS DictValue
$creadsPrec :: Var -> ReadS DictValue
Read, DictValue -> DictValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DictValue -> DictValue -> Bool
$c/= :: DictValue -> DictValue -> Bool
== :: DictValue -> DictValue -> Bool
$c== :: DictValue -> DictValue -> Bool
Eq, forall x. Rep DictValue x -> DictValue
forall x. DictValue -> Rep DictValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DictValue x -> DictValue
$cfrom :: forall x. DictValue -> Rep DictValue x
Generic)

-- | A simplex 'Dict'
--   One quation represents the objective function.
--   Each pair in the list is one equation in the system we're working with.
-- data Dict = Dict
--   { objective :: DictObjective
--   , entries :: DictEntries
--   }
--   deriving (Show, Read, Eq, Generic)
type Dict = M.Map Var DictValue

data PivotObjective = PivotObjective
  { PivotObjective -> Var
variable :: Var
  , PivotObjective -> VarLitMap
function :: VarLitMapSum
  , PivotObjective -> Ratio Integer
constant :: SimplexNum
  }
  deriving (Var -> PivotObjective -> ShowS
[PivotObjective] -> ShowS
PivotObjective -> String
forall a.
(Var -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PivotObjective] -> ShowS
$cshowList :: [PivotObjective] -> ShowS
show :: PivotObjective -> String
$cshow :: PivotObjective -> String
showsPrec :: Var -> PivotObjective -> ShowS
$cshowsPrec :: Var -> PivotObjective -> ShowS
Show, ReadPrec [PivotObjective]
ReadPrec PivotObjective
Var -> ReadS PivotObjective
ReadS [PivotObjective]
forall a.
(Var -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PivotObjective]
$creadListPrec :: ReadPrec [PivotObjective]
readPrec :: ReadPrec PivotObjective
$creadPrec :: ReadPrec PivotObjective
readList :: ReadS [PivotObjective]
$creadList :: ReadS [PivotObjective]
readsPrec :: Var -> ReadS PivotObjective
$creadsPrec :: Var -> ReadS PivotObjective
Read, PivotObjective -> PivotObjective -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PivotObjective -> PivotObjective -> Bool
$c/= :: PivotObjective -> PivotObjective -> Bool
== :: PivotObjective -> PivotObjective -> Bool
$c== :: PivotObjective -> PivotObjective -> Bool
Eq, forall x. Rep PivotObjective x -> PivotObjective
forall x. PivotObjective -> Rep PivotObjective x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PivotObjective x -> PivotObjective
$cfrom :: forall x. PivotObjective -> Rep PivotObjective x
Generic)