limp 0.1.0.0 → 0.3.0.0

raw patch · 14 files changed

+341/−125 lines, 14 filesdep −lensdep −template-haskelldep −vectorPVP ok

version bump matches the API change (PVP)

Dependencies removed: lens, template-haskell, vector, void

API changes (from Hackage documentation)

Files

• limp.cabal +8/−9
• src/Numeric/Limp/Canon.hs +18/−5
• src/Numeric/Limp/Canon/Constraint.hs +8/−0
• src/Numeric/Limp/Canon/Convert.hs +28/−6
• src/Numeric/Limp/Canon/Linear.hs +5/−0
• src/Numeric/Limp/Canon/Program.hs +7/−6
• src/Numeric/Limp/Program.hs +24/−6
• src/Numeric/Limp/Program/Bounds.hs +11/−0
• src/Numeric/Limp/Program/Constraint.hs +26/−36
• src/Numeric/Limp/Program/Eval.hs +53/−0
• src/Numeric/Limp/Program/Linear.hs +39/−41
• src/Numeric/Limp/Program/Program.hs +30/−11
• src/Numeric/Limp/Program/ResultKind.hs +38/−0
• src/Numeric/Limp/Rep.hs +46/−5

@@ -1,8 +1,8 @@ name:                limp-version:             0.1.0.0+version:             0.3.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.+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@@ -26,8 +26,10 @@          Numeric.Limp.Program.Bounds         Numeric.Limp.Program.Constraint+        Numeric.Limp.Program.Eval         Numeric.Limp.Program.Linear         Numeric.Limp.Program.Program+        Numeric.Limp.Program.ResultKind         Numeric.Limp.Program          Numeric.Limp.Canon.Linear@@ -39,12 +41,9 @@   -- other-modules:          build-depends:         base        < 5,-        containers  == 0.5.*,-        lens        == 4.2.*,-        vector      == 0.10.*,-        void,-        template-haskell+        containers  == 0.5.*+   ghc-options: -Wall -fno-warn-orphans   default-language: Haskell2010-  default-extensions:       TemplateHaskell TypeFamilies FlexibleContexts GeneralizedNewtypeDeriving DataKinds GADTs RankNTypes+  default-extensions:       TemplateHaskell TypeFamilies FlexibleContexts GeneralizedNewtypeDeriving DataKinds GADTs RankNTypes StandaloneDeriving FlexibleInstances 

@@ -1,8 +1,21 @@+-- | A simpler representation of programs.+-- The frontend representation ("Numeric.Limp.Program") has many different kinds of constraints+-- (@<=@, @<@, @==@, @between@), as well as constant additions on each linear function+-- (eg. @x + 2y + 5@).+-- The so-called canonical representation removes the constant addition from each linear constraint,+-- and converts each constraint (@Lin Op Lin@) to (@Num <= Lin <= Num@).+--+-- The most interesting function here is 'Numeric.Limp.Canon.Convert.program' for converting+-- from Program representation to Canon. module Numeric.Limp.Canon-    (module X) where+    ( module Numeric.Limp.Canon.Linear+    , module Numeric.Limp.Canon.Constraint+    , module Numeric.Limp.Canon.Program+    , module Numeric.Limp.Canon.Convert+    ) 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+import Numeric.Limp.Canon.Linear+import Numeric.Limp.Canon.Constraint+import Numeric.Limp.Canon.Program+import Numeric.Limp.Canon.Convert 

@@ -1,15 +1,22 @@+-- | Representation of linear constraints module Numeric.Limp.Canon.Constraint where import Numeric.Limp.Rep import Numeric.Limp.Canon.Linear  import qualified Data.Set as S +-- | Conjunction of simple constraints data Constraint z r c  = Constraint [Constraint1 z r c] +-- | A simple constraint data Constraint1 z r c+ -- | Maybe a lower bound, a linear function, and maybe an upper bound.+ --+ -- In order to be meaningful, at least one of lower or upper bound should be @Just@.  = C1 (Maybe (R c)) (Linear z r c) (Maybe (R c)) +-- | Check whether an assignment satisfies the constraint check :: (Rep c, Ord z, Ord r) => Assignment z r c -> Constraint z r c -> Bool check a (Constraint cs) = all go cs  where@@ -21,6 +28,7 @@      &&  maybe True (lin' <=) upper  +-- | Get set of variables in constraint varsOfConstraint :: (Ord z, Ord r) => Constraint z r c -> S.Set (Either z r) varsOfConstraint (Constraint cs)  = S.unions

@@ -1,3 +1,4 @@+-- | Convert from "Numeric.Limp.Program" representation to simpler, so-called canonical representation. module Numeric.Limp.Canon.Convert where  import Numeric.Limp.Rep@@ -12,9 +13,14 @@ import qualified Numeric.Limp.Program.Program    as P  import Control.Applicative-import Control.Lens import qualified Data.Map as M ++-- | Convert a Frontend 'P.Linear' into a Canon 'Linear'.+-- Returns the constant summand as well, as Canon Linear do not have these.+--+-- Should satisfy that+-- @forall a l. P.evalR a l == evalR a (fst $ linear l) + (snd $ linear l)@ 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)@@ -23,6 +29,10 @@ linear (P.LR ls co)  = (mkLinear ls, co) +-- | Convert a Frontend 'P.Constraint' into a Canon 'Constraint'.+--+-- Should satisfy that+-- @forall a c. P.check a c == check a (constraint c)@ constraint :: (Rep c, Ord z, Ord r) => P.Constraint z r c -> Constraint z r c constraint z  = Constraint $ go z@@ -69,28 +79,40 @@   go  P.CTrue    = [] --- lemma: check a (constraint c) == P.check a c  +-- | Convert a Frontend 'P.Program' into a Canon 'Program'.+--+-- If we had a solve function that worked on either, it would ideally satisfy+-- @forall p. P.solve p == solve (program p)@+--+-- However, due to potential non-determinism in solving functions, it could be possible to get a different, but still optimal, solution:+--+-- > forall p. let aP = P.solve p+-- >                p' = program p+-- >                a  =   solve p'+-- >            in P.eval aP (P._objective p) == eval a (_objective p')+-- >            &&  check a (P._constraints p) && check ...+-- 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+   = case P._direction p of         P.Minimise -> fst $ linear $       obj_orig         P.Maximise -> fst $ linear $ P.neg obj_orig   obj_orig-   = p ^. P.objective+   = P._objective p    constr-   = constraint $ p ^. P.constraints+   = constraint $ P._constraints p    bnds    = M.fromListWith merge    $ map extract-   $ p ^. P.bounds+   $ P._bounds p    merge (l1,u1) (l2,u2)    = ( mmaybe max l1 l2

@@ -1,3 +1,4 @@+-- | Representation of subset of linear functions: only variables and coefficients, no constant summand module Numeric.Limp.Canon.Linear where import Numeric.Limp.Rep @@ -5,9 +6,11 @@ import qualified Data.Set as S  +-- | Linear function is represented as a map from either a integral variable or an real variable, to a real coefficient. data Linear z r c  = Linear (M.Map (Either z r) (R c)) +-- | Create linear function from list of variables and coefficients mkLinear :: (Ord z, Ord r)          => [(Either z r, R c)]          -> Linear z r c@@ -15,6 +18,7 @@  = Linear (M.fromList zrs)  +-- | Evaluate linear function with given assignment 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)@@ -22,6 +26,7 @@   get (l, co) = zrOf a l * co  +-- | Find set of all variables mentioned in function varsOfLinear :: (Ord z, Ord r) => Linear z r c -> S.Set (Either z r) varsOfLinear (Linear m)  = M.keysSet m

@@ -1,16 +1,17 @@-{-# LANGUAGE TemplateHaskell #-}+-- | Canon representation of linear program 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 +-- | A program represented by objective, constraints and bounds.+-- There is no need for an optimisation direction; the objective is just negated. data Program z r c  = Program    { _objective     :: Linear z r c@@ -18,12 +19,12 @@    , _bounds        :: Map (Either z r) (Maybe (R c), Maybe (R c))    } -makeLenses ''Program +-- | Find set of all variables mentioned in 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      ]+ [ varsOfLinear     $ _objective   p+ , varsOfConstraint $ _constraints p+ , M.keysSet        $ _bounds      p ] 

@@ -1,9 +1,27 @@-{-# LANGUAGE TemplateHaskell #-}+-- | Front-end representation of programs.+-- See 'Numeric.Limp.Program.Program.Program' for the entire program;+-- 'Numeric.Limp.Program.Constraint.Constraint' for constraints such as less than or equal, greater than, etc;+-- and 'Numeric.Limp.Program.Linear.Linear' for linear functions. module Numeric.Limp.Program-    (module X) where+    ( -- | Each variable can have a lower or upper bound.+      module Numeric.Limp.Program.Bounds+      -- | Constraints such as less than or equal, greater than or equal, between,...+    , module Numeric.Limp.Program.Constraint+      -- | Functions for evaluating linear functions constraints for a given assignment of variables.+    , module Numeric.Limp.Program.Eval+      -- | Linear functions with constant coefficients on variables, and a constant addition.+    , module Numeric.Limp.Program.Linear+      -- | An entire program.+    , module Numeric.Limp.Program.Program+      -- | Linear functions are classified as either int-valued or real-valued,+      -- so we define @KZ@ and @KR@ as data kinds to denote this in the type.+    , module Numeric.Limp.Program.ResultKind+    ) 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+import Numeric.Limp.Program.Bounds+import Numeric.Limp.Program.Constraint+import Numeric.Limp.Program.Eval+import Numeric.Limp.Program.Linear+import Numeric.Limp.Program.Program+import Numeric.Limp.Program.ResultKind 

@@ -1,37 +1,48 @@+-- | Define upper and lower bounds of program variables. module Numeric.Limp.Program.Bounds where import Numeric.Limp.Rep +-- | Define upper and lower bounds of program variables.+-- Bounds may be specified multiple times: the intersection of all bounds is used. data Bounds z r c  = BoundZ (B (Z c) z)  | BoundR (B (R c) r) +-- | Maybe a lower bound, the variable's name, and maybe an upper bound. type B rep v  = (Maybe rep, v, Maybe rep) +-- | Create a lower and upper bound for an integer variable. lowerUpperZ :: Rep c => Z c -> z -> Z c -> Bounds z r c lowerUpperZ l v u  = BoundZ (Just l, v, Just u) +-- | Create only a lower bound for an integer variable.  lowerZ :: Rep c => Z c -> z -> Bounds z r c lowerZ l v  = BoundZ (Just l, v, Nothing) +-- | Create only an upper bound for an integer variable.  upperZ :: Rep c => z -> Z c -> Bounds z r c upperZ v u  = BoundZ (Nothing, v, Just u) +-- | A binary integer variable: can only be @0@ or @1@. binary :: Rep c => z -> Bounds z r c binary v  = BoundZ (Just 0, v, Just 1) +-- | Create a lower and upper bound for a real variable. lowerUpperR :: Rep c => R c -> r -> R c -> Bounds z r c lowerUpperR l v u  = BoundR (Just l, v, Just u) +-- | Create only a lower bound for a real variable.  lowerR :: Rep c => R c -> r -> Bounds z r c lowerR l v  = BoundR (Just l, v, Nothing) +-- | Create only an upper bound for a real variable.  upperR :: Rep c => r -> R c -> Bounds z r c upperR v u  = BoundR (Nothing, v, Just u)

@@ -1,9 +1,34 @@ module Numeric.Limp.Program.Constraint where-import Numeric.Limp.Rep import Numeric.Limp.Program.Linear+import Numeric.Limp.Program.ResultKind  import Data.Monoid +-- | Different kind of constraints.+--+-- These are not all necessary, but I have a hunch that keeping some structure may be helpful in the future.+--+-- Constructors:+--+--   [@:==@]    Equality constraint+--+--   [@:<=@]    Less than or equal+--+--   [@:<@]     Strictly less than: this is only allowed for purely integer functions+--+--   [@:>=@]    Greater than or equal+--+--   [@:>@]     Strictly greater than: this is only allowed for purely integer functions+--+--   [@Between@] @Between a b c@ is equivalent to @a :<= b :&& b :<= c@+-- +--   [@:&&@]    Conjunction of two constraints+--+--   [@:!@]     @"name" :! constr@ Annotate a constraint with a name, or other useless information+--+--   [@CTrue@]  Trivially true constraint+--+ 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@@ -14,10 +39,6 @@  (:&&)   :: 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 :<=@@ -26,37 +47,6 @@ 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

@@ -0,0 +1,53 @@+-- | Functions for evaluating linear functions and checking constraints.+module Numeric.Limp.Program.Eval where+import Numeric.Limp.Rep+import Numeric.Limp.Program.Constraint+import Numeric.Limp.Program.Linear+import Numeric.Limp.Program.ResultKind++-- | Evaluate a linear function with given assignment.+-- If the linear function is purely integral, a @Z@ will be returned; otherwise, @R@.+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+++-- | Evaluate a linear function with given assignment, returning real value.+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+++-- | Check whether assignment satisfies constraint.+check :: (Rep c, Ord z, Ord r) => Assignment z r c -> Constraint z r c -> Bool+check ass = go+ where+  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

@@ -1,29 +1,27 @@-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+-- | Representation, constructors and limited arithmetic on linear functions.+--+-- The linear function is indexed by its result type: either purely integer (@KZ@) or mixed/real (@KR@).+-- This index is used to allow strictly-less-than constraints only on integer functions,+-- and to allow retrieving integer values from purely integer functions.+--+module Numeric.Limp.Program.Linear+    ( Linear(..)+    , toR --- | 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+    , z, z1+    , r, r1 --- | The upper bound of two kinds is real, unless both are integral-type family KRep (a :: K) :: * -> * where- KRep KZ = Z- KRep KR = R+    , con, conZ, conR+    , c0, c1 +    , neg+    , (.*), (*.)+    , (.+.), (.-.) )+     where+import Numeric.Limp.Rep+import Numeric.Limp.Program.ResultKind --- | Any linear function can be made into a real, as it is the upper bound / top+-- | Any linear function can be converted into a real linear function. toR :: Rep c => Linear z r c k -> Linear z r c KR toR (LZ ls co) = LR (map go ls) (fromZ co)  where@@ -31,9 +29,6 @@ toR l@(LR{}) =        l  ---------------------------- Creation functions- -- | Integral variable z :: Rep c => z -> Z c -> Linear z r c KZ z z' c@@ -55,16 +50,28 @@  = r r' 1  --- | An integral constant+-- | An integral constant summand con :: Rep c => Z c -> Linear z r c KZ con c'  = LZ [] c' +-- | An integral constant summand+conZ :: Rep c => Z c -> Linear z r c KZ+conZ = con++-- | Constant @0@ c0 :: Rep c => Linear z r c KZ c0 = con 0+-- | Constant @1@ c1 :: Rep c => Linear z r c KZ c1 = con 1 +-- | A real constant+conR :: Rep c => R c -> Linear z r c KR+conR c'+ = LR [] c'++-- | Helper for applying function to second element of tuple on2 :: (b -> c) -> (a, b) -> (a, c) on2 f (a,b) = (a, f b) @@ -77,16 +84,21 @@  = LR (map (on2 negate) ls) (negate c)  +-- | Multiply a linear function by some constant.+--+-- Note that you cannot multiply a linear function by another linear function, as the result would likely be non-linear! (.*) :: 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') +-- | Multiply a linear function by some constant. (*.) :: Rep c => KRep k c -> Linear z r c k -> Linear z r c k (*.) = flip (.*)  +-- | Add two linear functions together. They can have different result types. (.+.) :: 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@@ -103,6 +115,7 @@   +-- | Subtract one linear function from another. They can have different result types. (.-.) :: Rep c => Linear z r c k1 -> Linear z r c k2 -> Linear z r c (KMerge k1 k2) (.-.) a b  = a .+. neg b@@ -112,19 +125,4 @@ 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 

@@ -1,27 +1,46 @@-{-# LANGUAGE TemplateHaskell #-}+-- | Definition of a whole program module Numeric.Limp.Program.Program where -import Numeric.Limp.Program.Linear-import Numeric.Limp.Program.Constraint import Numeric.Limp.Program.Bounds--import Control.Lens+import Numeric.Limp.Program.Constraint+import Numeric.Limp.Program.Linear+import Numeric.Limp.Program.ResultKind+import Numeric.Limp.Rep +-- | Direction to optimise program in: minimise or maximise. data Direction  = Minimise  | Maximise +-- | Whole program, parameterised by:+--+--   [@z@] type of integer variables+--   [@r@] type of real variables+--   [@c@] representation of integers and reals (see 'Numeric.Limp.Rep.Rep')+-- data Program z r c- = Program-   { _objective     :: Linear z r c KR-   , _direction     :: Direction+ = Program {+   -- | Optimisation direction+     _direction     :: Direction+   -- | The objective function+   , _objective     :: Linear z r c KR+   -- | All constraints bundled up with @:&&@.    , _constraints   :: Constraint z r c+   -- | Upper and lower bounds of variables.+   -- Not all variables need to be mentioned, and if variables are mentioned multiple times, the intersection is used.    , _bounds        :: [Bounds z r c]    } -makeLenses ''Program+program :: Rep c => Direction -> Linear z r c k -> Constraint z r c -> [Bounds z r c] -> Program z r c+program dir obj constr bounds+ = Program dir (toR obj) constr bounds +minimise :: Rep c => Linear z r c k -> Constraint z r c -> [Bounds z r c] -> Program z r c+minimise+ = program Minimise+  --- relax :: Program z r -> Program Void (Either z r)--- relax = undefined+maximise :: Rep c => Linear z r c k -> Constraint z r c -> [Bounds z r c] -> Program z r c+maximise+ = program Maximise 

@@ -0,0 +1,38 @@+-- | Type-level functions on result types.+--+-- Linear functions are classified as either int-valued or real-valued,+-- so we define @KZ@ and @KR@ as data kinds to denote this in the type.+--+module Numeric.Limp.Program.ResultKind where+import Numeric.Limp.Rep+++-- | Classify the result type of a linear function to either integral or real:+data K+ -- | Integral @Z@+ = KZ+ -- | Real or mixed @R@+ | KR+++-- | Representation of either integral of real linear functions:+-- a list of variables with coefficients, plus a constant summand.+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+++-- | Find the result type of merging, or adding, two linear functions:+-- adding two integers produces an integer, while adding a real on either side produces a real.+type family KMerge (a :: K) (b :: K) :: K where+ KMerge KZ KZ = KZ+ KMerge KR b  = KR+ KMerge a  KR = KR++-- | Convert a @K@ to its actual representation (@Z@ or @R@).+type family KRep (a :: K) :: * -> * where+ KRep KZ = Z+ KRep KR = R+++

@@ -1,38 +1,79 @@+-- | Representation of integers (Z) and reals (R) of similar precision.+-- Programs are abstracted over this, so that ideally in the future we could have a+-- solver that produces Integers and Rationals, instead of just Ints and Doubles.+--+-- We bundle Z and R up into a single representation instead of abstracting over both,+-- because we must be able to convert from Z to R without loss.+-- module Numeric.Limp.Rep where  import Data.Map (Map) import qualified Data.Map as M +-- | The Representation class. Requires its members @Z c@ and @R c@ to be @Num@, @Ord@ and @Eq@.+--+-- For some reason, for type inference to work, the members must be @data@ instead of @type@.+-- This gives some minor annoyances when unpacking them. See 'unwrapR' below.+-- 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+      , Num (R c), Ord (R c), Eq (R c), RealFrac (R c)) => Rep c where++ -- | Integers  data Z c+ -- | Real numbers  data R c + -- | Convert an integer to a real. This should not lose any precision.+ -- (whereas @fromIntegral 1000 :: Word8@ would lose precision)  fromZ :: Z c -> R c  fromZ = fromIntegral ++-- | An assignment from variables to values.+-- Maps integer variables to integers, and real variables to reals. data Assignment z r c  = Assignment (Map z (Z c)) (Map r (R c)) +deriving instance (Show (Z c), Show (R c), Show z, Show r) => Show (Assignment z r c)+++-- | Retrieve value of integer variable - or 0, if there is no value. zOf :: (Rep c, Ord z) => Assignment z r c -> z -> Z c zOf (Assignment zs _) z- = zs M.! z+ = maybe 0 id $ M.lookup z zs +-- | Retrieve value of real variable - or 0, if there is no value. rOf :: (Rep c, Ord r) => Assignment z r c -> r -> R c rOf (Assignment _ rs) r- = rs M.! r+ = maybe 0 id $ M.lookup r rs +-- | Retrieve value of an integer or real variable, with result cast to a real regardless. zrOf :: (Rep c, Ord z, Ord r) => Assignment z r c -> Either z r -> R c zrOf a = either (fromZ . zOf a) (rOf a) +++-- | A representation that uses native 64-bit ints and 64-bit doubles.+-- Really, this should be 32-bit ints. data IntDouble  instance Rep IntDouble where+ -- | Automatically defer numeric operations to the native int.  newtype Z IntDouble = Z Int-    deriving (Ord,Eq,Show,Read,Integral,Real,Num,Enum)+    deriving (Ord,Eq,Integral,Real,Num,Enum)  newtype R IntDouble = R Double-    deriving (Ord,Eq,Show,Read,Num,Enum)+    deriving (Ord,Eq,Num,Enum,Fractional,Real,RealFrac) +-- | Define show manually, so we can strip out the "Z" and "R" prefixes.+instance Show (Z IntDouble) where+ show (Z i) = show i++instance Show (R IntDouble) where+ show (R i) = show i++++-- | Convert a wrapped (R IntDouble) to an actual Double. unwrapR :: R IntDouble -> Double unwrapR (R d) = d