exp-pairs-0.1.6.0: Linear programming over exponent pairs

Copyright(c) Andrew Lelechenko 2014-2015
LicenseGPL-3
Maintainerandrew.lelechenko@gmail.com
Stabilityexperimental
PortabilityPOSIX
Safe HaskellSafe
LanguageHaskell2010

Math.ExpPairs.LinearForm

Description

Provides types for rational forms (to hold objective functions in Math.ExpPairs) and linear contraints (to hold constraints of optimization). Both of them are built atop of projective linear forms.

Synopsis

Documentation

data LinearForm t Source #

Define an affine linear form of three variables: a*k + b*l + c*m. First argument of LinearForm stands for a, second for b and third for c. Linear forms form a monoid by addition.

Constructors

LinearForm !t !t !t 

Instances

Functor LinearForm Source # 

Methods

fmap :: (a -> b) -> LinearForm a -> LinearForm b #

(<$) :: a -> LinearForm b -> LinearForm a #

Foldable LinearForm Source # 

Methods

fold :: Monoid m => LinearForm m -> m #

foldMap :: Monoid m => (a -> m) -> LinearForm a -> m #

foldr :: (a -> b -> b) -> b -> LinearForm a -> b #

foldr' :: (a -> b -> b) -> b -> LinearForm a -> b #

foldl :: (b -> a -> b) -> b -> LinearForm a -> b #

foldl' :: (b -> a -> b) -> b -> LinearForm a -> b #

foldr1 :: (a -> a -> a) -> LinearForm a -> a #

foldl1 :: (a -> a -> a) -> LinearForm a -> a #

toList :: LinearForm a -> [a] #

null :: LinearForm a -> Bool #

length :: LinearForm a -> Int #

elem :: Eq a => a -> LinearForm a -> Bool #

maximum :: Ord a => LinearForm a -> a #

minimum :: Ord a => LinearForm a -> a #

sum :: Num a => LinearForm a -> a #

product :: Num a => LinearForm a -> a #

Eq t => Eq (LinearForm t) Source # 

Methods

(==) :: LinearForm t -> LinearForm t -> Bool #

(/=) :: LinearForm t -> LinearForm t -> Bool #

Num t => Num (LinearForm t) Source # 
Show t => Show (LinearForm t) Source # 
Generic (LinearForm t) Source # 

Associated Types

type Rep (LinearForm t) :: * -> * #

Methods

from :: LinearForm t -> Rep (LinearForm t) x #

to :: Rep (LinearForm t) x -> LinearForm t #

Num t => Semigroup (LinearForm t) Source # 
Num t => Monoid (LinearForm t) Source # 
NFData t => NFData (LinearForm t) Source # 

Methods

rnf :: LinearForm t -> () #

(Num t, Eq t, Pretty t) => Pretty (LinearForm t) Source # 

Methods

pretty :: LinearForm t -> Doc ann #

prettyList :: [LinearForm t] -> Doc ann #

type Rep (LinearForm t) Source # 
type Rep (LinearForm t) = D1 * (MetaData "LinearForm" "Math.ExpPairs.LinearForm" "exp-pairs-0.1.6.0-Gtd6e9LEtfhDqv5Iz3ymUo" False) (C1 * (MetaCons "LinearForm" PrefixI False) ((:*:) * (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * t)) ((:*:) * (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * t)) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * t)))))

scaleLF :: (Num t, Eq t) => t -> LinearForm t -> LinearForm t Source #

Multiply a linear form by a given coefficient.

evalLF :: Num t => (t, t, t) -> LinearForm t -> t Source #

Evaluate a linear form a*k + b*l + c*m for given k, l and m.

substituteLF :: (Eq t, Num t) => (LinearForm t, LinearForm t, LinearForm t) -> LinearForm t -> LinearForm t Source #

Substitute linear forms k, l and m into a given linear form a*k + b*l + c*m to obtain a new linear form.

data RationalForm t Source #

Define a rational form of two variables, equal to the ratio of two LinearForm.

Constructors

(LinearForm t) :/: (LinearForm t) infix 5 

Instances

Functor RationalForm Source # 

Methods

fmap :: (a -> b) -> RationalForm a -> RationalForm b #

(<$) :: a -> RationalForm b -> RationalForm a #

Foldable RationalForm Source # 

Methods

fold :: Monoid m => RationalForm m -> m #

foldMap :: Monoid m => (a -> m) -> RationalForm a -> m #

foldr :: (a -> b -> b) -> b -> RationalForm a -> b #

foldr' :: (a -> b -> b) -> b -> RationalForm a -> b #

foldl :: (b -> a -> b) -> b -> RationalForm a -> b #

foldl' :: (b -> a -> b) -> b -> RationalForm a -> b #

foldr1 :: (a -> a -> a) -> RationalForm a -> a #

foldl1 :: (a -> a -> a) -> RationalForm a -> a #

toList :: RationalForm a -> [a] #

null :: RationalForm a -> Bool #

length :: RationalForm a -> Int #

elem :: Eq a => a -> RationalForm a -> Bool #

maximum :: Ord a => RationalForm a -> a #

minimum :: Ord a => RationalForm a -> a #

sum :: Num a => RationalForm a -> a #

product :: Num a => RationalForm a -> a #

Eq t => Eq (RationalForm t) Source # 
Num t => Fractional (RationalForm t) Source # 
Num t => Num (RationalForm t) Source # 
Show t => Show (RationalForm t) Source # 
Generic (RationalForm t) Source # 

Associated Types

type Rep (RationalForm t) :: * -> * #

Methods

from :: RationalForm t -> Rep (RationalForm t) x #

to :: Rep (RationalForm t) x -> RationalForm t #

NFData t => NFData (RationalForm t) Source # 

Methods

rnf :: RationalForm t -> () #

(Num t, Eq t, Pretty t) => Pretty (RationalForm t) Source # 

Methods

pretty :: RationalForm t -> Doc ann #

prettyList :: [RationalForm t] -> Doc ann #

type Rep (RationalForm t) Source # 
type Rep (RationalForm t) = D1 * (MetaData "RationalForm" "Math.ExpPairs.LinearForm" "exp-pairs-0.1.6.0-Gtd6e9LEtfhDqv5Iz3ymUo" False) (C1 * (MetaCons ":/:" (InfixI NotAssociative 5) False) ((:*:) * (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (LinearForm t))) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (LinearForm t)))))

evalRF :: Real t => (Integer, Integer, Integer) -> RationalForm t -> RationalInf Source #

Evaluate a rational form (a*k + b*l + c*m) / (a'*k + b'*l + c'*m) for given k, l and m.

data IneqType Source #

Constants to specify the strictness of Constraint.

Constructors

Strict

Strict inequality (>0).

NonStrict

Non-strict inequality (≥0).

data Constraint t Source #

A linear constraint of two variables.

Constructors

Constraint !(LinearForm t) !IneqType 

Instances

Functor Constraint Source # 

Methods

fmap :: (a -> b) -> Constraint a -> Constraint b #

(<$) :: a -> Constraint b -> Constraint a #

Foldable Constraint Source # 

Methods

fold :: Monoid m => Constraint m -> m #

foldMap :: Monoid m => (a -> m) -> Constraint a -> m #

foldr :: (a -> b -> b) -> b -> Constraint a -> b #

foldr' :: (a -> b -> b) -> b -> Constraint a -> b #

foldl :: (b -> a -> b) -> b -> Constraint a -> b #

foldl' :: (b -> a -> b) -> b -> Constraint a -> b #

foldr1 :: (a -> a -> a) -> Constraint a -> a #

foldl1 :: (a -> a -> a) -> Constraint a -> a #

toList :: Constraint a -> [a] #

null :: Constraint a -> Bool #

length :: Constraint a -> Int #

elem :: Eq a => a -> Constraint a -> Bool #

maximum :: Ord a => Constraint a -> a #

minimum :: Ord a => Constraint a -> a #

sum :: Num a => Constraint a -> a #

product :: Num a => Constraint a -> a #

Eq t => Eq (Constraint t) Source # 

Methods

(==) :: Constraint t -> Constraint t -> Bool #

(/=) :: Constraint t -> Constraint t -> Bool #

Show t => Show (Constraint t) Source # 
Generic (Constraint t) Source # 

Associated Types

type Rep (Constraint t) :: * -> * #

Methods

from :: Constraint t -> Rep (Constraint t) x #

to :: Rep (Constraint t) x -> Constraint t #

NFData t => NFData (Constraint t) Source # 

Methods

rnf :: Constraint t -> () #

(Num t, Eq t, Pretty t) => Pretty (Constraint t) Source # 

Methods

pretty :: Constraint t -> Doc ann #

prettyList :: [Constraint t] -> Doc ann #

type Rep (Constraint t) Source # 
type Rep (Constraint t) = D1 * (MetaData "Constraint" "Math.ExpPairs.LinearForm" "exp-pairs-0.1.6.0-Gtd6e9LEtfhDqv5Iz3ymUo" False) (C1 * (MetaCons "Constraint" PrefixI False) ((:*:) * (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * (LinearForm t))) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * IneqType))))

checkConstraint :: (Num t, Ord t) => (Integer, Integer, Integer) -> Constraint t -> Bool Source #

Evaluate a rational form of constraint and compare its value with 0. Strictness depends on the given IneqType.