{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE RankNTypes #-}

-- |
-- Module      : Linear.Simplex.Prettify
-- Description : Prettifier for "Linear.Simplex.Types" types
-- Copyright   : (c) Junaid Rasheed, 2020-2023
-- 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 Control.Lens
import Data.Generics.Labels ()
import Data.Map qualified as M
import Data.Ratio
import Linear.Simplex.Types

-- | Convert a 'VarConstMap' into a human-readable 'String'
prettyShowVarConstMap :: VarLitMapSum -> String
prettyShowVarConstMap :: VarLitMapSum -> [Char]
prettyShowVarConstMap = forall {a} {a}.
(Integral a, Show a, Show a) =>
[(a, Ratio a)] -> [Char]
aux forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList
  where
    aux :: [(a, Ratio a)] -> [Char]
aux [] = [Char]
""
    aux ((a
vName, Ratio a
vCoeff) : [(a, Ratio a)]
vs) = forall {a}. (Integral a, Show a) => Ratio a -> [Char]
prettyShowRational Ratio a
vCoeff forall a. [a] -> [a] -> [a]
++ [Char]
" * " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
vName forall a. [a] -> [a] -> [a]
++ [Char]
" + " forall a. [a] -> [a] -> [a]
++ [(a, Ratio a)] -> [Char]
aux [(a, Ratio a)]
vs
      where
        prettyShowRational :: Ratio a -> [Char]
prettyShowRational Ratio a
r =
          if Ratio a
r forall a. Ord a => a -> a -> Bool
< Ratio a
0
            then [Char]
"(" forall a. [a] -> [a] -> [a]
++ [Char]
r' forall a. [a] -> [a] -> [a]
++ [Char]
")"
            else [Char]
r'
          where
            r' :: [Char]
r' = if forall a. Ratio a -> a
denominator Ratio a
r forall a. Eq a => a -> a -> Bool
== a
1 then forall a. Show a => a -> [Char]
show (forall a. Ratio a -> a
numerator Ratio a
r) else forall a. Show a => a -> [Char]
show (forall a. Ratio a -> a
numerator Ratio a
r) forall a. [a] -> [a] -> [a]
++ [Char]
" / " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. Ratio a -> a
numerator Ratio a
r)

-- | Convert a 'PolyConstraint' into a human-readable 'String'
prettyShowPolyConstraint :: PolyConstraint -> String
prettyShowPolyConstraint :: PolyConstraint -> [Char]
prettyShowPolyConstraint (LEQ VarLitMapSum
vcm SimplexNum
r) = VarLitMapSum -> [Char]
prettyShowVarConstMap VarLitMapSum
vcm forall a. [a] -> [a] -> [a]
++ [Char]
" <= " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SimplexNum
r
prettyShowPolyConstraint (GEQ VarLitMapSum
vcm SimplexNum
r) = VarLitMapSum -> [Char]
prettyShowVarConstMap VarLitMapSum
vcm forall a. [a] -> [a] -> [a]
++ [Char]
" >= " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SimplexNum
r
prettyShowPolyConstraint (Linear.Simplex.Types.EQ VarLitMapSum
vcm SimplexNum
r) = VarLitMapSum -> [Char]
prettyShowVarConstMap VarLitMapSum
vcm forall a. [a] -> [a] -> [a]
++ [Char]
" == " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SimplexNum
r

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