packages feed

limp (empty) → 0.1.0.0

raw patch · 14 files changed

+589/−0 lines, 14 filesdep +basedep +containersdep +lenssetup-changed

Dependencies added: base, containers, lens, template-haskell, vector, void

Files

+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2014 <copyright holders>++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ limp.cabal view
@@ -0,0 +1,50 @@+name:                limp+version:             0.1.0.0+synopsis:            representation of Integer Linear Programs+description:         so far, this package just provides two representations for linear programs: Numeric.Limp.Program, which is what I expect end-users to use, and+                     Numeric.Limp.Canon, which is simpler, but would be less nice for writing linear programs.+                     see the limp-cbc package for a simple solver.++license:             MIT+license-file:        LICENSE+author:              Amos Robinson+maintainer:          amos.robinson@gmail.com+category:            numeric+build-type:          Simple+cabal-version:       >=1.10+homepage:            https://github.com/amosr/limp+++source-repository head+    type: git+    location: git://github.com/amosr/limp.git++library+  hs-source-dirs: src+  exposed-modules:+        Numeric.Limp.Rep++        Numeric.Limp.Program.Bounds+        Numeric.Limp.Program.Constraint+        Numeric.Limp.Program.Linear+        Numeric.Limp.Program.Program+        Numeric.Limp.Program++        Numeric.Limp.Canon.Linear+        Numeric.Limp.Canon.Constraint+        Numeric.Limp.Canon.Convert+        Numeric.Limp.Canon.Program+        Numeric.Limp.Canon++  -- other-modules:       +  build-depends:+        base        < 5,+        containers  == 0.5.*,+        lens        == 4.2.*,+        vector      == 0.10.*,+        void,+        template-haskell+  ghc-options: -Wall -fno-warn-orphans+  default-language: Haskell2010+  default-extensions:       TemplateHaskell TypeFamilies FlexibleContexts GeneralizedNewtypeDeriving DataKinds GADTs RankNTypes+
+ src/Numeric/Limp/Canon.hs view
@@ -0,0 +1,8 @@+module Numeric.Limp.Canon+    (module X) where++import Numeric.Limp.Canon.Linear as X+import Numeric.Limp.Canon.Constraint as X+import Numeric.Limp.Canon.Program as X+import Numeric.Limp.Canon.Convert as X+
+ src/Numeric/Limp/Canon/Constraint.hs view
@@ -0,0 +1,31 @@+module Numeric.Limp.Canon.Constraint where+import Numeric.Limp.Rep+import Numeric.Limp.Canon.Linear++import qualified Data.Set as S++data Constraint z r c+ = Constraint [Constraint1 z r c]++data Constraint1 z r c+ = C1 (Maybe (R c)) (Linear z r c) (Maybe (R c))++check :: (Rep c, Ord z, Ord r) => Assignment z r c -> Constraint z r c -> Bool+check a (Constraint cs) = all go cs+ where+  ev l = evalR a l++  go (C1 lower lin upper)+   = let lin' = ev lin+     in  maybe True (<= lin') lower+     &&  maybe True (lin' <=) upper+++varsOfConstraint :: (Ord z, Ord r) => Constraint z r c -> S.Set (Either z r)+varsOfConstraint (Constraint cs)+ = S.unions+ $ map get cs+ where+  get (C1 _ lin _)+   = varsOfLinear lin+
+ src/Numeric/Limp/Canon/Convert.hs view
@@ -0,0 +1,115 @@+module Numeric.Limp.Canon.Convert where++import Numeric.Limp.Rep++import Numeric.Limp.Canon.Constraint+import Numeric.Limp.Canon.Linear+import Numeric.Limp.Canon.Program++import qualified Numeric.Limp.Program.Bounds     as P+import qualified Numeric.Limp.Program.Constraint as P+import qualified Numeric.Limp.Program.Linear     as P+import qualified Numeric.Limp.Program.Program    as P++import Control.Applicative+import Control.Lens+import qualified Data.Map as M++linear :: (Rep c, Ord z, Ord r) => P.Linear z r c k -> (Linear z r c, R c)+linear (P.LZ ls co)+ = (mkLinear $ map conv ls, fromZ co)+ where+  conv (z,c) = (Left z, fromZ c)+linear (P.LR ls co)+ = (mkLinear ls, co)++constraint :: (Rep c, Ord z, Ord r) => P.Constraint z r c -> Constraint z r c+constraint z+ = Constraint $ go z+ where+  -- a <= b <==> b - a >= 0+  -- x + 1 <= y     ==> 1 <= y - x+  -- x + c <= y + d ==> -(d - c) <= y - x+  --+  -- x + c <= y + d+  --     c <= y + d - x+  -- c - d <= y - x+  -- -(d-c)<= y - x+  --+  cle l r+   = let (lin, co) = linear (r P..-. l)+     in  C1 (Just (-co)) lin Nothing++  -- a == b <==> a - b == 0+  ceq l r+   = let (lin, co) = linear (r P..-. l)+     in  C1 (Just (-co)) lin (Just (-co))++  go (l P.:== r)+   = [ceq l r]+  go (l P.:<= r)+   = [cle l r]+  go (l P.:>= r)+   = [cle r l]++  -- We know from the type of :< that both sides are int.+  -- That means we can safely convert (a < b) to (a + 1 <= b)+  go (l P.:<  r)+   = [cle (l P..+. P.c1) r]+  go (l P.:>  r)+   = [cle (r P..+. P.c1) l]++  go (P.Between a b c)+   = [cle a b, cle b c]+  go (a P.:&& b)+   = go a ++ go b+  go (_ P.:! a)+   = go a++  go  P.CTrue+   = []++-- lemma: check a (constraint c) == P.check a c+++program :: (Rep c, Ord z, Ord r) => P.Program z r c -> Program z r c+program p+ = Program obj constr bnds+ where++  obj+   = case p ^. P.direction of+        P.Minimise -> fst $ linear $       obj_orig+        P.Maximise -> fst $ linear $ P.neg obj_orig+  obj_orig+   = p ^. P.objective++  constr+   = constraint $ p ^. P.constraints++  bnds+   = M.fromListWith merge+   $ map extract+   $ p ^. P.bounds++  merge (l1,u1) (l2,u2)+   = ( mmaybe max l1 l2+     , mmaybe min u1 u2 )++  mmaybe f a b+   = case (a,b) of+     (Nothing, Nothing)+      -> Nothing+     (Nothing, Just b')+      -> Just $ b'+     (Just a', Nothing)+      -> Just $ a'+     (Just a', Just b')+      -> Just $ f a' b'++  extract :: Rep c => P.Bounds z r c -> (Either z r, (Maybe (R c), Maybe (R c)))+  extract (P.BoundZ (l,k,u))+   = (Left k, (fromZ <$> l, fromZ <$> u))+  extract (P.BoundR (l,k,u))+   = (Right k, (l,u))+
+ src/Numeric/Limp/Canon/Linear.hs view
@@ -0,0 +1,28 @@+module Numeric.Limp.Canon.Linear where+import Numeric.Limp.Rep++import qualified Data.Map as M+import qualified Data.Set as S+++data Linear z r c+ = Linear (M.Map (Either z r) (R c))++mkLinear :: (Ord z, Ord r)+         => [(Either z r, R c)]+         -> Linear z r c+mkLinear zrs+ = Linear (M.fromList zrs)+++evalR :: (Rep c, Ord z, Ord r) => Assignment z r c -> Linear z r c -> R c+evalR a (Linear ls)+ = sum (map get $ M.toList ls)+ where+  get (l, co) = zrOf a l * co+++varsOfLinear :: (Ord z, Ord r) => Linear z r c -> S.Set (Either z r)+varsOfLinear (Linear m)+ = M.keysSet m+
+ src/Numeric/Limp/Canon/Program.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE TemplateHaskell #-}+module Numeric.Limp.Canon.Program where++import Numeric.Limp.Canon.Linear+import Numeric.Limp.Canon.Constraint+import Numeric.Limp.Rep++import Control.Lens+import Data.Map (Map)+import qualified Data.Map as M+import Data.Set (Set)+import qualified Data.Set as S++data Program z r c+ = Program+   { _objective     :: Linear z r c+   , _constraints   :: Constraint z r c+   , _bounds        :: Map (Either z r) (Maybe (R c), Maybe (R c))+   }++makeLenses ''Program++varsOfProgram :: (Ord z, Ord r) => Program z r c -> Set (Either z r)+varsOfProgram p+ = S.unions+ [ varsOfLinear     $ p ^. objective+ , varsOfConstraint $ p ^. constraints+ , M.keysSet        $ p ^. bounds      ]+
+ src/Numeric/Limp/Program.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE TemplateHaskell #-}+module Numeric.Limp.Program+    (module X) where++import Numeric.Limp.Program.Bounds      as X+import Numeric.Limp.Program.Linear      as X+import Numeric.Limp.Program.Constraint  as X+import Numeric.Limp.Program.Program     as X+
+ src/Numeric/Limp/Program/Bounds.hs view
@@ -0,0 +1,39 @@+module Numeric.Limp.Program.Bounds where+import Numeric.Limp.Rep++data Bounds z r c+ = BoundZ (B (Z c) z)+ | BoundR (B (R c) r)++type B rep v+ = (Maybe rep, v, Maybe rep)++lowerUpperZ :: Rep c => Z c -> z -> Z c -> Bounds z r c+lowerUpperZ l v u+ = BoundZ (Just l, v, Just u)++lowerZ :: Rep c => Z c -> z -> Bounds z r c+lowerZ l v+ = BoundZ (Just l, v, Nothing)++upperZ :: Rep c => z -> Z c -> Bounds z r c+upperZ v u+ = BoundZ (Nothing, v, Just u)++binary :: Rep c => z -> Bounds z r c+binary v+ = BoundZ (Just 0, v, Just 1)++lowerUpperR :: Rep c => R c -> r -> R c -> Bounds z r c+lowerUpperR l v u+ = BoundR (Just l, v, Just u)++lowerR :: Rep c => R c -> r -> Bounds z r c+lowerR l v+ = BoundR (Just l, v, Nothing)++upperR :: Rep c => r -> R c -> Bounds z r c+upperR v u+ = BoundR (Nothing, v, Just u)++
+ src/Numeric/Limp/Program/Constraint.hs view
@@ -0,0 +1,64 @@+module Numeric.Limp.Program.Constraint where+import Numeric.Limp.Rep+import Numeric.Limp.Program.Linear++import Data.Monoid++data Constraint z r c where+ (:==)   :: Linear z r c k1  -> Linear z r c k2  -> Constraint z r c+ (:<=)   :: Linear z r c k1  -> Linear z r c k2  -> Constraint z r c+ (:<)    :: Linear z r c KZ  -> Linear z r c KZ  -> Constraint z r c+ (:>=)   :: Linear z r c k1  -> Linear z r c k2  -> Constraint z r c+ (:>)    :: Linear z r c KZ  -> Linear z r c KZ  -> Constraint z r c+ Between :: Linear z r c k1  -> Linear z r c k2  -> Linear z r c k3   -> Constraint z r c+ (:&&)   :: Constraint z r c -> Constraint z r c -> Constraint z r c+ (:!)    :: String           -> Constraint z r c -> Constraint z r c+ CTrue   ::                                         Constraint z r c+-- These are not all necessary, but I have a hunch that keeping some structure may be helpful in the future.+-- Also for pretty printing.+--+-- Less than is interesting: we can only construct a < b if both are integral.++infix  5 :==+infix  5 :<=+infix  5 :<+infix  5 :>=+infix  5 :>+infix  4 :!+infixr 3 :&&++check :: (Rep c, Ord z, Ord r) => Assignment z r c -> Constraint z r c -> Bool+check ass = go+ where+  -- ev :: Linear z r c k -> R c+  -- ev l = evalR ass l++  -- TODO should there be tolerance here?+  -- that's probably something that should go in Rep class+  go (a :== b)+   = evalR ass a == evalR ass b+  go (a :<= b)+   = evalR ass a <= evalR ass b+  go (a :>= b)+   = evalR ass a >= evalR ass b++  -- They are both ints, so no conversion to R is necessary+  go (a :<  b)+   = eval  ass a <  eval  ass b+  go (a :>  b)+   = eval  ass a >  eval  ass b++  go (Between a b c)+   = evalR ass a <= evalR ass b && evalR ass b <= evalR ass c+  go (a :&& b)+   = go a && go b+  go (_ :! a)+   = go a++  go CTrue+   = True++instance Monoid (Constraint z r c) where+ mempty  = CTrue+ mappend = (:&&)+
+ src/Numeric/Limp/Program/Linear.hs view
@@ -0,0 +1,130 @@+module Numeric.Limp.Program.Linear where+import Numeric.Limp.Rep++-- import Control.Lens++-- | The kind of a linear function:+-- it can be integral (Z) or real (R).+data K = KZ | KR++data Linear z r c k where+ LZ :: [(z, Z c)]          -> (Z c) -> Linear z r c KZ+ LR :: [(Either z r, R c)] -> (R c) -> Linear z r c KR++-- | The upper bound of two kinds is real, unless both are integral+type family KMerge (a :: K) (b :: K) :: K where+ KMerge KZ KZ = KZ+ KMerge KR b  = KR+ KMerge a  KR = KR++-- | The upper bound of two kinds is real, unless both are integral+type family KRep (a :: K) :: * -> * where+ KRep KZ = Z+ KRep KR = R+++-- | Any linear function can be made into a real, as it is the upper bound / top+toR :: Rep c => Linear z r c k -> Linear z r c KR+toR (LZ ls co) = LR (map go ls) (fromZ co)+ where+  go (z',c') = (Left z', fromZ c')+toR l@(LR{}) =        l+++------------------------+-- Creation functions++-- | Integral variable+z :: Rep c => z -> Z c -> Linear z r c KZ+z z' c+ = LZ [(z', c)] 0++-- | Integral variable with coefficient 1+z1 :: Rep c => z -> Linear z r c KZ+z1 z'+ = z z' 1++-- | Real variable+r :: Rep c => r -> R c -> Linear z r c KR+r r' c+ = LR [(Right r', c)] 0++-- | Real variable with coefficient 1+r1 :: Rep c => r -> Linear z r c KR+r1 r'+ = r r' 1+++-- | An integral constant+con :: Rep c => Z c -> Linear z r c KZ+con c'+ = LZ [] c'++c0 :: Rep c => Linear z r c KZ+c0 = con 0+c1 :: Rep c => Linear z r c KZ+c1 = con 1++on2 :: (b -> c) -> (a, b) -> (a, c)+on2 f (a,b) = (a, f b)++-- | Negate a linear function.+-- Negation does not change the kind.+neg :: Rep c => Linear z r c k -> Linear z r c k+neg (LZ ls c)+ = LZ (map (on2 negate) ls) (negate c)+neg (LR ls c)+ = LR (map (on2 negate) ls) (negate c)+++(.*) :: Rep c => Linear z r c k -> KRep k c -> Linear z r c k+(.*) (LZ ls c) z'+ = LZ (map (on2 (*z')) ls) (c * z')+(.*) (LR ls c) r'+ = LR (map (on2 (*r')) ls) (c * r')++(*.) :: Rep c => KRep k c -> Linear z r c k -> Linear z r c k+(*.) = flip (.*)+++(.+.) :: Rep c => Linear z r c k1 -> Linear z r c k2 -> Linear z r c (KMerge k1 k2)+(.+.) a b+ = case (a,b) of+    (LZ{}, LZ{}) -> add_KZ      a      b+    (LR{}, LZ{}) -> add_KR      a (toR b)+    (LZ{}, LR{}) -> add_KR (toR a)     b+    (LR{}, LR{}) -> add_KR      a      b+ where+  add_KZ :: Rep c => Linear z r c KZ -> Linear z r c KZ -> Linear z r c KZ+  add_KZ (LZ ls lc) (LZ rs rc) = LZ (ls ++ rs) (lc + rc)++  add_KR :: Rep c => Linear z r c KR -> Linear z r c KR -> Linear z r c KR+  add_KR (LR ls lc) (LR rs rc) = LR (ls ++ rs) (lc + rc)++++(.-.) :: Rep c => Linear z r c k1 -> Linear z r c k2 -> Linear z r c (KMerge k1 k2)+(.-.) a b+ = a .+. neg b+++infix  7 *.+infix  7 .*+infixl 6 .+.+infixl 6 .-.++eval :: (Rep c, Ord z, Ord r) => Assignment z r c -> Linear z r c k -> KRep k c+eval a (LZ ls c)+ = sum (map get ls) + c+ where+  get (l, co) = zOf a l * co++eval a (LR ls c)+ = sum (map get ls) + c+ where+  get (l, co) = zrOf a l * co++evalR :: (Rep c, Ord z, Ord r) => Assignment z r c -> Linear z r c k -> R c+evalR a l@(LZ{}) = fromZ (eval a l)+evalR a l@(LR{}) =        eval a l+
+ src/Numeric/Limp/Program/Program.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE TemplateHaskell #-}+module Numeric.Limp.Program.Program where++import Numeric.Limp.Program.Linear+import Numeric.Limp.Program.Constraint+import Numeric.Limp.Program.Bounds++import Control.Lens++data Direction+ = Minimise+ | Maximise++data Program z r c+ = Program+   { _objective     :: Linear z r c KR+   , _direction     :: Direction+   , _constraints   :: Constraint z r c+   , _bounds        :: [Bounds z r c]+   }++makeLenses ''Program+++-- relax :: Program z r -> Program Void (Either z r)+-- relax = undefined+
+ src/Numeric/Limp/Rep.hs view
@@ -0,0 +1,38 @@+module Numeric.Limp.Rep where++import Data.Map (Map)+import qualified Data.Map as M++class ( Num (Z c), Ord (Z c), Eq (Z c), Integral (Z c)+      , Num (R c), Ord (R c), Eq (R c)) => Rep c where+ data Z c+ data R c++ fromZ :: Z c -> R c+ fromZ = fromIntegral++data Assignment z r c+ = Assignment (Map z (Z c)) (Map r (R c))++zOf :: (Rep c, Ord z) => Assignment z r c -> z -> Z c+zOf (Assignment zs _) z+ = zs M.! z++rOf :: (Rep c, Ord r) => Assignment z r c -> r -> R c+rOf (Assignment _ rs) r+ = rs M.! r++zrOf :: (Rep c, Ord z, Ord r) => Assignment z r c -> Either z r -> R c+zrOf a = either (fromZ . zOf a) (rOf a)++data IntDouble++instance Rep IntDouble where+ newtype Z IntDouble = Z Int+    deriving (Ord,Eq,Show,Read,Integral,Real,Num,Enum)+ newtype R IntDouble = R Double+    deriving (Ord,Eq,Show,Read,Num,Enum)++unwrapR :: R IntDouble -> Double+unwrapR (R d) = d+