{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Numeric.LinearProgramming.Common (
   Term(..), (.*),
   Inequality(..),
   Bound(..),
   Bounds,
   Constraints,
   Direction(..),
   Objective,
   free, (<=.), (>=.), (==.), (>=<.),
   objectiveFromTerms,
   ) where

import qualified Data.Array.Comfort.Storable as Array
import qualified Data.Array.Comfort.Shape as Shape
import Data.Array.Comfort.Storable (Array)



data Term a ix = Term a ix
   deriving (Int -> Term a ix -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a ix. (Show a, Show ix) => Int -> Term a ix -> ShowS
forall a ix. (Show a, Show ix) => [Term a ix] -> ShowS
forall a ix. (Show a, Show ix) => Term a ix -> String
showList :: [Term a ix] -> ShowS
$cshowList :: forall a ix. (Show a, Show ix) => [Term a ix] -> ShowS
show :: Term a ix -> String
$cshow :: forall a ix. (Show a, Show ix) => Term a ix -> String
showsPrec :: Int -> Term a ix -> ShowS
$cshowsPrec :: forall a ix. (Show a, Show ix) => Int -> Term a ix -> ShowS
Show)


infix 7 .*

(.*) :: a -> ix -> Term a ix
.* :: forall a ix. a -> ix -> Term a ix
(.*) = forall a ix. a -> ix -> Term a ix
Term


data Inequality x = Inequality x Bound
   deriving Int -> Inequality x -> ShowS
forall x. Show x => Int -> Inequality x -> ShowS
forall x. Show x => [Inequality x] -> ShowS
forall x. Show x => Inequality x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inequality x] -> ShowS
$cshowList :: forall x. Show x => [Inequality x] -> ShowS
show :: Inequality x -> String
$cshow :: forall x. Show x => Inequality x -> String
showsPrec :: Int -> Inequality x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> Inequality x -> ShowS
Show

data Bound =
     LessEqual Double
   | GreaterEqual Double
   | Between Double Double
   | Equal Double
   | Free
   deriving Int -> Bound -> ShowS
[Bound] -> ShowS
Bound -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bound] -> ShowS
$cshowList :: [Bound] -> ShowS
show :: Bound -> String
$cshow :: Bound -> String
showsPrec :: Int -> Bound -> ShowS
$cshowsPrec :: Int -> Bound -> ShowS
Show

instance Functor Inequality where
   fmap :: forall a b. (a -> b) -> Inequality a -> Inequality b
fmap a -> b
f (Inequality a
x Bound
bnd)  =  forall x. x -> Bound -> Inequality x
Inequality (a -> b
f a
x) Bound
bnd

type Bounds ix = [Inequality ix]

type Constraints a ix = [Inequality [Term a ix]]

data Direction = Minimize | Maximize
   deriving (Direction -> Direction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Int -> Direction
Direction -> Int
Direction -> [Direction]
Direction -> Direction
Direction -> Direction -> [Direction]
Direction -> Direction -> Direction -> [Direction]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
$cenumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
enumFromTo :: Direction -> Direction -> [Direction]
$cenumFromTo :: Direction -> Direction -> [Direction]
enumFromThen :: Direction -> Direction -> [Direction]
$cenumFromThen :: Direction -> Direction -> [Direction]
enumFrom :: Direction -> [Direction]
$cenumFrom :: Direction -> [Direction]
fromEnum :: Direction -> Int
$cfromEnum :: Direction -> Int
toEnum :: Int -> Direction
$ctoEnum :: Int -> Direction
pred :: Direction -> Direction
$cpred :: Direction -> Direction
succ :: Direction -> Direction
$csucc :: Direction -> Direction
Enum, Direction
forall a. a -> a -> Bounded a
maxBound :: Direction
$cmaxBound :: Direction
minBound :: Direction
$cminBound :: Direction
Bounded, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show)

type Objective sh = Array sh Double



infix 4 <=., >=., >=<., ==.

(<=.), (>=.), (==.) :: x -> Double -> Inequality x
x
x <=. :: forall x. x -> Double -> Inequality x
<=. Double
bnd = forall x. x -> Bound -> Inequality x
Inequality x
x forall a b. (a -> b) -> a -> b
$ Double -> Bound
LessEqual Double
bnd
x
x >=. :: forall x. x -> Double -> Inequality x
>=. Double
bnd = forall x. x -> Bound -> Inequality x
Inequality x
x forall a b. (a -> b) -> a -> b
$ Double -> Bound
GreaterEqual Double
bnd
x
x ==. :: forall x. x -> Double -> Inequality x
==. Double
bnd = forall x. x -> Bound -> Inequality x
Inequality x
x forall a b. (a -> b) -> a -> b
$ Double -> Bound
Equal Double
bnd

(>=<.) :: x -> (Double,Double) -> Inequality x
x
x >=<. :: forall x. x -> (Double, Double) -> Inequality x
>=<. (Double, Double)
bnd = forall x. x -> Bound -> Inequality x
Inequality x
x forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> Bound
Between (Double, Double)
bnd

free :: x -> Inequality x
free :: forall x. x -> Inequality x
free x
x = forall x. x -> Bound -> Inequality x
Inequality x
x Bound
Free



objectiveFromTerms ::
   (Shape.Indexed sh, Shape.Index sh ~ ix) =>
   sh -> [Term Double ix] -> Objective sh
objectiveFromTerms :: forall sh ix.
(Indexed sh, Index sh ~ ix) =>
sh -> [Term Double ix] -> Objective sh
objectiveFromTerms sh
sh =
   forall sh a.
(Indexed sh, Storable a) =>
a -> sh -> [(Index sh, a)] -> Array sh a
Array.fromAssociations Double
0 sh
sh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Term Double
x ix
ix) -> (ix
ix,Double
x))