maxent 0.3.0.1 → 0.3.1.1

raw patch · 3 files changed

+49/−27 lines, 3 filesdep ~vector

Dependency ranges changed: vector

Files

• maxent.cabal +2/−2
• src/MaxEnt.hs +4/−2
• src/MaxEnt/Internal.hs +43/−23

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.3.0.1+version:             0.3.1.1  -- A short (one-line) description of the package. synopsis:            Compute Maximum Entropy Distributions@@ -91,7 +91,7 @@   -- Other library packages from which modules are imported.   build-depends: base ==4.6.*,                  nonlinear-optimization ==0.3.*,-                 vector ==0.9.*, +                 vector ==0.10.*,                   ad ==3.2.*      -- Directories containing source files.

@@ -42,7 +42,8 @@     average,     variance,     maxent,-    maxentLinear+    maxentLinear,+    generalMaxent ) where import MaxEnt.Internal (Constraint,                         ExpectationFunction,@@ -50,4 +51,5 @@                         average,                         variance,                         maxent,-                        maxentLinear)+                        maxentLinear,+                        generalMaxent)

@@ -8,6 +8,7 @@ import Data.Traversable import Numeric.AD.Types import Numeric.AD.Internal.Classes+--import Numeric.AD.Lagrangian  sumMap :: Num b => (a -> b) -> [a] -> b  sumMap f = sum . map f@@ -82,41 +83,40 @@ entropy :: Floating a => [a] -> a entropy = negate . sumMap (\p -> p * log p)  ++-- This a functions that takes in a list of values and +-- a list of probabilities type GeneralConstraint a = [a] -> [a] -> a + lagrangian :: Floating a-             => [a] -             -> [GeneralConstraint a] -             -> [a] +             => ([a], [GeneralConstraint a], [a])               -> [a]               -> a-lagrangian values fs constants lamsAndProbs = result where-    result = entropy ps + (sum $ zipWith (*) lams (sumsToOne ps : constraints))+lagrangian (values, fs, constants) lamsAndProbs = result where+    result = entropy ps + (sum $ zipWith (*) lams constraints)     constraints        = zipWith (-) appliedConstraints constants     appliedConstraints = map (\f -> f values ps) fs-    -    --This constraint is always needed for probability problems-    sumsToOne xs = sumMap id xs - 1-    +             -- split the args list     ps   = take (length values) lamsAndProbs     lams = drop (length values) lamsAndProbs  squaredGrad :: Num a              => (forall s. Mode s => [AD s a] -> AD s a) -> [a] -> a-squaredGrad f vs = sumMap (\x -> x*x) . grad f $ vs+squaredGrad f vs = sumMap (\x -> x*x) (grad f vs) -{-                                  -generalObjectiveFunc :: Floating a-             => (forall b. Floating b => ([b],-             [GeneralConstraint b] -             ,[b] -             ,[b])) +generalObjectiveFunc :: Floating a => (forall b. Floating b => +             ([b], [GeneralConstraint b], [b]))+             -> [a]               -> a-generalObjectiveFunc (values, fs, moments, lamsAndProbs) = -    squaredGrad (lagrangian values fs moments) $ lamsAndProbs where--}+generalObjectiveFunc params lamsAndProbs = +    squaredGrad lang lamsAndProbs  where+        +    lang :: Floating a => (forall s. Mode s => [AD s a] -> AD s a)+    lang = lagrangian params + toFunction :: (forall a. Floating a => [a] -> a) -> Function Simple toFunction f = VFunction (f . U.toList) @@ -164,7 +164,7 @@        -> Either (Result, Statistics) [Double] -- ^ Either the a discription of what wrong or the probability distribution generalMaxent params = result where    obj :: Floating a => [a] -> a-   obj = uncurry undefined fsmoments+   obj = generalObjectiveFunc objInput     values :: Floating a => [a]    values = fst params@@ -174,6 +174,24 @@     fsmoments :: Floating a => ([GeneralConstraint a], [a])    fsmoments = unzip constraints +   +   --The new constraint is always needed for probability problems+   +   sumToOne :: Floating a => GeneralConstraint a+   sumToOne _ xs = sumMap id xs+   +   gcons' :: Floating a => [GeneralConstraint a]+   gcons' = fst fsmoments+   +   gcons :: Floating a => [GeneralConstraint a]+   gcons = sumToOne : gcons'+   +   moments :: Floating a => [a]+   moments = 1 : snd fsmoments+   +   +   objInput :: Floating b => ([b], [GeneralConstraint b], [b])+   objInput = (values, gcons, moments)     fs :: [[Double] -> [Double] -> Double]    fs = fst fsmoments@@ -183,9 +201,12 @@        (length fs) (1.0 :: Double)      result = case unsafePerformIO (optimize defaultParameters 0.00001 guess -                        undefined undefined+                        (toFunction obj)+                        (toGradient obj)                        Nothing) of-       (vs, ToleranceStatisfied, _) -> Right $ take (length values) (S.toList vs)+       -- Not sure what is supposed to happen here+       -- I guess I can plug the lambdas back in+       (vs, ToleranceStatisfied, _) -> Right $  (S.toList vs)        (_, x, y) -> Left (x, y)                @@ -265,7 +286,6 @@         (vs, ToleranceStatisfied, _) -> Right $ probs values fs (S.toList vs)         (_, x, y) -> Left (x, y) ---test = maxent ([1.0,2.0,3.0], [average 1.5])