{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Numeric.LinearProgramming.Format (
   Identifier,
   mathProg,
   ) where

import qualified Numeric.LinearProgramming.Common as LP
import Numeric.LinearProgramming.Common
         (Bound(..), Inequality(Inequality),
          Bounds, Direction(..), Objective, (.*))

import qualified Data.Array.Comfort.Storable as Array
import qualified Data.Array.Comfort.Shape as Shape
import qualified Data.List as List

import Text.Printf (printf)

import Prelude hiding (sum)



type Term = LP.Term Double

type Constraints ix = LP.Constraints Double ix


class Identifier ix where
   identifier :: ix -> String

instance Identifier Char where
   identifier :: Char -> String
identifier Char
x = [Char
x]

instance Identifier c => Identifier [c] where
   identifier :: [c] -> String
identifier = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall ix. Identifier ix => ix -> String
identifier

instance Identifier Int where
   identifier :: Int -> String
identifier = forall r. PrintfType r => String -> r
printf String
"x%d"

instance Identifier Integer where
   identifier :: Integer -> String
identifier = forall r. PrintfType r => String -> r
printf String
"x%d"


bound :: (Identifier ix) => Inequality ix -> String
bound :: forall ix. Identifier ix => Inequality ix -> String
bound (Inequality ix
ix Bound
bnd) =
   forall r. PrintfType r => String -> r
printf String
"var %s%s;" (forall ix. Identifier ix => ix -> String
identifier ix
ix) forall a b. (a -> b) -> a -> b
$
   case Bound
bnd of
      LessEqual Double
up -> forall r. PrintfType r => String -> r
printf String
", <=%f" Double
up
      GreaterEqual Double
lo -> forall r. PrintfType r => String -> r
printf String
", >=%f" Double
lo
      Between Double
lo Double
up -> forall r. PrintfType r => String -> r
printf String
", >=%f, <=%f" Double
lo Double
up
      Equal Double
x -> forall r. PrintfType r => String -> r
printf String
", =%f" Double
x
      Bound
Free -> String
""


sum :: (Identifier ix) => [Term ix] -> String
sum :: forall ix. Identifier ix => [Term ix] -> String
sum [] = String
"0"
sum [Term ix]
xs =
   let formatTerm :: Term t ix -> t
formatTerm (LP.Term t
c ix
ix) = forall r. PrintfType r => String -> r
printf String
"%f*%s" t
c (forall ix. Identifier ix => ix -> String
identifier ix
ix) in
   forall a. [a] -> [[a]] -> [a]
List.intercalate String
"+" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {t} {t} {ix}.
(PrintfArg t, PrintfType t, Identifier ix) =>
Term t ix -> t
formatTerm [Term ix]
xs

constraint :: (Identifier ix) => Inequality [Term ix] -> String
constraint :: forall ix. Identifier ix => Inequality [Term ix] -> String
constraint (Inequality [Term ix]
terms Bound
bnd) =
   let sumStr :: String
sumStr = forall ix. Identifier ix => [Term ix] -> String
sum [Term ix]
terms in
   case Bound
bnd of
      LessEqual Double
up -> forall r. PrintfType r => String -> r
printf String
"%s <= %f" String
sumStr Double
up
      GreaterEqual Double
lo -> forall r. PrintfType r => String -> r
printf String
"%f <= %s" Double
lo String
sumStr
      Between Double
lo Double
up -> forall r. PrintfType r => String -> r
printf String
"%f <= %s <= %f" Double
lo String
sumStr Double
up
      Equal Double
x -> forall r. PrintfType r => String -> r
printf String
"%s = %f" String
sumStr Double
x
      Bound
Free -> String
sumStr

direction :: Direction -> String
direction :: Direction -> String
direction Direction
Minimize = String
"minimize"
direction Direction
Maximize = String
"maximize"

objective ::
   (Shape.Indexed sh, Shape.Index sh ~ ix, Identifier ix) =>
   Objective sh -> String
objective :: forall sh ix.
(Indexed sh, Index sh ~ ix, Identifier ix) =>
Objective sh -> String
objective =
   forall ix. Identifier ix => [Term ix] -> String
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(ix
ix,Double
c) -> Double
c forall a ix. a -> ix -> Term a ix
.* ix
ix) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sh a.
(Indexed sh, Storable a) =>
Array sh a -> [(Index sh, a)]
Array.toAssociations

mathProg ::
   (Shape.Indexed sh, Shape.Index sh ~ ix, Identifier ix) =>
   Bounds ix -> Constraints ix ->
   (Direction, Objective sh) -> [String]
mathProg :: forall sh ix.
(Indexed sh, Index sh ~ ix, Identifier ix) =>
Bounds ix
-> Constraints ix -> (Direction, Objective sh) -> [String]
mathProg Bounds ix
bounds Constraints ix
constrs (Direction
dir,Objective sh
obj) =
   forall a b. (a -> b) -> [a] -> [b]
map forall ix. Identifier ix => Inequality ix -> String
bound Bounds ix
bounds forall a. [a] -> [a] -> [a]
++
   String
"" forall a. a -> [a] -> [a]
:
   Direction -> String
direction Direction
dir forall a. a -> [a] -> [a]
:
   forall r. PrintfType r => String -> r
printf String
"value: %s;" (forall sh ix.
(Indexed sh, Index sh ~ ix, Identifier ix) =>
Objective sh -> String
objective Objective sh
obj) forall a. a -> [a] -> [a]
:
   String
"" forall a. a -> [a] -> [a]
:
   String
"subject to" forall a. a -> [a] -> [a]
:
   forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
      (\Int
k Inequality [Term ix]
constr -> forall r. PrintfType r => String -> r
printf String
"constr%d: %s;" Int
k forall a b. (a -> b) -> a -> b
$ forall ix. Identifier ix => Inequality [Term ix] -> String
constraint Inequality [Term ix]
constr)
      [(Int
0::Int)..] Constraints ix
constrs forall a. [a] -> [a] -> [a]
++
   String
"" forall a. a -> [a] -> [a]
:
   String
"end;" forall a. a -> [a] -> [a]
:
   []