{-|
Module      : Linear.Simplex.Prettify
Description : Prettifier for "Linear.Simplex.Types" types
Copyright   : (c) Junaid Rasheed, 2020-2022
License     : BSD-3
Maintainer  : jrasheed178@gmail.com
Stability   : experimental

Converts "Linear.Simplex.Types" types into human-readable 'String's 
-}
module Linear.Simplex.Prettify where

import Linear.Simplex.Types as T
import Data.Ratio

-- |Convert a 'VarConstMap' into a human-readable 'String'
prettyShowVarConstMap :: VarConstMap -> String
prettyShowVarConstMap :: VarConstMap -> String
prettyShowVarConstMap [] = String
""
prettyShowVarConstMap [(Integer
v, Rational
c)]  = Rational -> String
forall {a}. (Integral a, Show a) => Ratio a -> String
prettyShowRational Rational
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" * x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
""
  where
    prettyShowRational :: Ratio a -> String
prettyShowRational Ratio a
r = 
      if Ratio a
r Ratio a -> Ratio a -> Bool
forall a. Ord a => a -> a -> Bool
< Ratio a
0
        then String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
r' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
        else String
r'
      where
        r' :: String
r' = if Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 then a -> String
forall a. Show a => a -> String
show (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r) else a -> String
forall a. Show a => a -> String
show (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" / " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r)

prettyShowVarConstMap ((Integer
v, Rational
c) : VarConstMap
vcs) = VarConstMap -> String
prettyShowVarConstMap [(Integer
v, Rational
c)] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VarConstMap -> String
prettyShowVarConstMap VarConstMap
vcs

-- |Convert a 'PolyConstraint' into a human-readable 'String'
prettyShowPolyConstraint :: PolyConstraint -> String
prettyShowPolyConstraint :: PolyConstraint -> String
prettyShowPolyConstraint (LEQ VarConstMap
vcm Rational
r) = VarConstMap -> String
prettyShowVarConstMap VarConstMap
vcm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" <= " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Rational -> String
forall a. Show a => a -> String
show Rational
r
prettyShowPolyConstraint (GEQ VarConstMap
vcm Rational
r) = VarConstMap -> String
prettyShowVarConstMap VarConstMap
vcm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" >= " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Rational -> String
forall a. Show a => a -> String
show Rational
r
prettyShowPolyConstraint (T.EQ VarConstMap
vcm Rational
r)  = VarConstMap -> String
prettyShowVarConstMap VarConstMap
vcm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" == " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Rational -> String
forall a. Show a => a -> String
show Rational
r

-- |Convert an 'ObjectiveFunction' into a human-readable 'String'
prettyShowObjectiveFunction :: ObjectiveFunction -> String
prettyShowObjectiveFunction :: ObjectiveFunction -> String
prettyShowObjectiveFunction (Min VarConstMap
vcm) = String
"min: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VarConstMap -> String
prettyShowVarConstMap VarConstMap
vcm
prettyShowObjectiveFunction (Max VarConstMap
vcm) = String
"max: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VarConstMap -> String
prettyShowVarConstMap VarConstMap
vcm