diff --git a/limp.cabal b/limp.cabal --- a/limp.cabal +++ b/limp.cabal @@ -1,5 +1,5 @@ name: limp -version: 0.3.1.0 +version: 0.3.2.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. @@ -23,6 +23,7 @@ hs-source-dirs: src exposed-modules: Numeric.Limp.Rep + Numeric.Limp.Error Numeric.Limp.Program.Bounds Numeric.Limp.Program.Constraint diff --git a/src/Numeric/Limp/Canon/Analyse/Constants.hs b/src/Numeric/Limp/Canon/Analyse/Constants.hs --- a/src/Numeric/Limp/Canon/Analyse/Constants.hs +++ b/src/Numeric/Limp/Canon/Analyse/Constants.hs @@ -2,13 +2,14 @@ module Numeric.Limp.Canon.Analyse.Constants where import Numeric.Limp.Canon.Program import Numeric.Limp.Rep +import Numeric.Limp.Error import qualified Data.Map as M -- | Find the constants in a program, only by looking at the bounds with lo==up. -- (See "Numeric.Limp.Canon.Simplify.Stride" to convert constraints to bounds) -constantsProgram :: (Ord z, Ord r, Rep c) => Program z r c -> Assignment z r c +constantsProgram :: (Ord z, Ord r, Rep c) => Program z r c -> Either Infeasible (Assignment z r c) constantsProgram p = mkAss $ concatMap eq $ M.toList $ _bounds p where @@ -21,21 +22,27 @@ = [] mkAss ms - = Assignment - (M.fromList $ concatMap tkLeft ms) - (M.fromList $ concatMap tkRight ms) + = do zs <- mapM tkLeft ms + rs <- mapM tkRight ms + return $ Assignment (M.fromList $ concat zs) + (M.fromList $ concat rs) tkLeft (Left z, v) + -- Wow! What if the bounds aren't integral? -- Well, I guess the ILP solver will eventually figure out it's infeasible. -- Maybe it would be nice to trigger that error here. - | v == (fromZ $ truncate v) - = [(z, truncate v)] + | v /= (fromZ $ truncate v) + = Left InfeasibleNotIntegral + + | otherwise + = return [(z, truncate v)] + tkLeft _ - = [] + = return [] tkRight (Right r, v) - = [(r, v)] + = return [(r, v)] tkRight _ - = [] + = return [] diff --git a/src/Numeric/Limp/Canon/Simplify.hs b/src/Numeric/Limp/Canon/Simplify.hs --- a/src/Numeric/Limp/Canon/Simplify.hs +++ b/src/Numeric/Limp/Canon/Simplify.hs @@ -2,6 +2,7 @@ module Numeric.Limp.Canon.Simplify where import Numeric.Limp.Canon.Program import Numeric.Limp.Rep +import Numeric.Limp.Error import Numeric.Limp.Canon.Analyse.Constants @@ -11,17 +12,17 @@ import Data.Monoid -simplify :: (Ord z, Ord r, Rep c) => Program z r c -> (Assignment z r c, Program z r c) +simplify :: (Ord z, Ord r, Rep c) => Program z r c -> Either Infeasible (Assignment z r c, Program z r c) simplify p = simplify' mempty p -simplify' :: (Ord z, Ord r, Rep c) => Assignment z r c -> Program z r c -> (Assignment z r c, Program z r c) +simplify' :: (Ord z, Ord r, Rep c) => Assignment z r c -> Program z r c -> Either Infeasible (Assignment z r c, Program z r c) simplify' sub1 p - = let p' = crunchProgram p - p'' = bounderProgram p' - sub2 = constantsProgram p'' - in if assSize sub2 == 0 - then (sub1, p'') + = do let p' = crunchProgram p + p'' <- bounderProgram p' + sub2 <- constantsProgram p'' + if assSize sub2 == 0 + then return (sub1, p'') else simplify' (sub1 <> sub2) (substProgram sub2 p'') diff --git a/src/Numeric/Limp/Canon/Simplify/Bounder.hs b/src/Numeric/Limp/Canon/Simplify/Bounder.hs --- a/src/Numeric/Limp/Canon/Simplify/Bounder.hs +++ b/src/Numeric/Limp/Canon/Simplify/Bounder.hs @@ -4,7 +4,9 @@ import Numeric.Limp.Canon.Linear import Numeric.Limp.Canon.Program import Numeric.Limp.Rep +import Numeric.Limp.Error +import Control.Applicative import Data.Either import qualified Data.Map as M @@ -19,7 +21,10 @@ -- > bounder $ Constraint (5 <= 2y <= 10) -- > == Bound (Just 2.5) y (Just 5) -- -bounderConstraint1 :: (Ord z, Ord r, Rep c) => Constraint1 z r c -> Maybe (Bound z r c) +-- > bounder $ Constraint (10 <= 2y <= 5) +-- > == Left InfeasibleBoundEmpty +-- +bounderConstraint1 :: (Ord z, Ord r, Rep c) => Constraint1 z r c -> Either Infeasible (Maybe (Bound z r c)) bounderConstraint1 (C1 low (Linear mf) upp) | M.size mf == 1 , [(k,c)] <- M.toList mf @@ -32,31 +37,40 @@ = (low',upp') | otherwise = (upp',low') - in Just (k, bounds) + valid + | (Just lo, Just hi) <- bounds + = lo <= hi + | otherwise + = True + + in if valid + then Right $ Just (k, bounds) + else Left InfeasibleNotIntegral + | otherwise - = Nothing + = Right Nothing -bounderConstraint :: (Ord z, Ord r, Rep c) => Constraint z r c -> (Constraint z r c, [Bound z r c]) +bounderConstraint :: (Ord z, Ord r, Rep c) => Constraint z r c -> Either Infeasible (Constraint z r c, [Bound z r c]) bounderConstraint (Constraint cs) - = let (cs', bs) = partitionEithers $ map bounderC cs - in (Constraint cs', bs) + = do (cs', bs) <- partitionEithers <$> mapM bounderC cs + return (Constraint cs', bs) where bounderC c - = case bounderConstraint1 c of - Nothing -> Left c - Just b -> Right b + = do c' <- bounderConstraint1 c + return $ case c' of + Nothing -> Left c + Just b -> Right b -- -bounderProgram :: (Ord z, Ord r, Rep c) => Program z r c -> Program z r c +bounderProgram :: (Ord z, Ord r, Rep c) => Program z r c -> Either Infeasible (Program z r c) bounderProgram p - = let (c',bs) = bounderConstraint $ _constraints p - in p - { _constraints = c' - , _bounds = foldl merge (_bounds p) bs } - + = do (c',bs) <- bounderConstraint $ _constraints p + return $ p + { _constraints = c' + , _bounds = foldl merge (_bounds p) bs } where merge m (k,v) = case M.lookup k m of diff --git a/src/Numeric/Limp/Error.hs b/src/Numeric/Limp/Error.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/Limp/Error.hs @@ -0,0 +1,10 @@ +-- | Reasons an analysis, simplification or solution could fail +module Numeric.Limp.Error where + +-- | Give reason for being infeasible, if possible +data Infeasible + = InfeasibleNotIntegral + -- ^ An integer variable is constrained to be equal to a non-int + | InfeasibleBoundEmpty + -- ^ The bound on a variable or constraint is empty - lower bound is above upper. + deriving (Eq,Show)