packages feed

hakaru 0.1 → 0.1.1

raw patch · 12 files changed

+192/−598 lines, 12 files

Files

− Examples/Examples.hs 
@@ -1,44 +0,0 @@-{-# LANGUAGE RankNTypes, DataKinds, NoMonomorphismRestriction, BangPatterns #-}--module Examples where--import Types-import Data.Dynamic-import Control.Monad--import InterpreterMH hiding (main)-import Visual--bayesian_polynomial_regression = undefined--sparse_linear_regression = undefined--logistic_regression = undefined--outlier_detection = undefined--change_point_model = undefined--friends_who_smoke = undefined--latent_dirichelt_allocation = undefined--categorical_mixture = undefined--gaussian_mixture = undefined--naive_bayes = undefined--hidden_markov_model = undefined--matrix_factorization = undefined--rvm = undefined--item_response_theory = undefined--gaussian_process = undefined--hawkes_process = undefined--bayesian_neural_network = undefined
Examples/Tests.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE RankNTypes, NoMonomorphismRestriction, BangPatterns #-} -module Tests where+module Examples.Tests where  import Types import Data.Dynamic
Language/Hakaru/Symbolic.hs view
@@ -69,9 +69,9 @@ -- Borel's Paradox exp3 = unconditioned (uniformD (real 1) (real 2)) `bind` \s ->        unconditioned (uniformC (real (-1)) (real 1)) `bind` \x ->-       let y = (InterpreterSymbolic.sqrt ((real 1 ) `minus` -			   (InterpreterSymbolic.exp s (real 2)))) `mul`-	           (InterpreterSymbolic.sin x) in ret y  +       let y = (Language.Hakaru.Symbolic.sqrt ((real 1 ) `minus` +			   (Language.Hakaru.Symbolic.exp s (real 2)))) `mul`+	           (Language.Hakaru.Symbolic.sin x) in ret y    test = view exp1 test2 = view exp2
+ Language/Hakaru/Syntax.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE TypeFamilies, ConstraintKinds, GADTs, FlexibleContexts #-}++module Language.Hakaru.Syntax where++-- The syntax++import GHC.Exts (Constraint)++-- TODO: The pretty-printing semantics++import qualified Text.PrettyPrint as PP++-- The importance-sampling semantics++import Types (Cond, CSampler)+import Data.Dynamic (Typeable)+import qualified Data.Number.LogFloat as LF+import qualified Language.Hakaru.ImportanceSampler as IS++-- The Metropolis-Hastings semantics++import qualified Language.Hakaru.Metropolis as MH++-- The syntax++data Prob+data Measure a+data Dist a++class Mochastic repr where+  type Type repr a :: Constraint+  real        :: Double -> repr Double+  bool        :: Bool -> repr Bool+  add, mul    :: repr Double -> repr Double -> repr Double+  neg         :: repr Double -> repr Double+  neg         =  mul (real (-1))+  logFloat, logToLogFloat+              :: repr Double -> repr Prob+  unbool      :: repr Bool -> repr c -> repr c+              -> repr c+  pair        :: repr a -> repr b -> repr (a, b)+  unpair      :: repr (a, b) -> (repr a -> repr b -> repr c)+              -> repr c+  inl         :: repr a -> repr (Either a b)+  inr         :: repr b -> repr (Either a b)+  uneither    :: repr (Either a b) -> (repr a -> repr c) -> (repr b -> repr c)+              -> repr c+  nil         :: repr [a]+  cons        :: repr a -> repr [a] -> repr [a]+  unlist      :: repr [a] -> repr c -> (repr a -> repr [a] -> repr c)+              -> repr c+  ret         :: repr a -> repr (Measure a)+  bind        :: repr (Measure a) -> (repr a -> repr (Measure b))+              -> repr (Measure b)+  conditioned, unconditioned :: repr (Dist a) -> repr (Measure a)+  factor      :: repr Prob -> repr (Measure ())+  dirac       :: (Type repr a) => repr a -> repr (Dist a)+  categorical :: (Type repr a) => repr [(a, Prob)] -> repr (Dist a)+  bern        :: (Type repr Bool) => repr Double -> repr (Dist Bool)+  bern p      =  categorical $+                 cons (pair (bool True) (logFloat p)) $+                 cons (pair (bool False) (logFloat (add (real 1) (neg p)))) $+                 nil+  normal, uniform+              :: repr Double -> repr Double -> repr (Dist Double)+  poisson     :: repr Double -> repr (Dist Int)++-- TODO: The initial (AST) "semantics"+-- (Hey Oleg, is there any better way to deal with the Type constraint, so that+-- the AST constructor doesn't have to take a repr constructor argument?)++data AST repr a where+  Real :: Double -> AST repr Double+  Unbool :: AST repr Bool -> AST repr c -> AST repr c -> AST repr c+  Categorical :: (Type repr a) => AST repr [(a, Prob)] -> AST repr (Dist a)+  -- ...++instance (Mochastic repr) => Mochastic (AST repr) where+  type Type (AST repr) a = Type repr a+  real = Real+  unbool = Unbool+  categorical = Categorical+  -- ...++eval :: (Mochastic repr) => AST repr a -> repr a+eval (Real x) = real x+eval (Unbool b x y) = unbool (eval b) (eval x) (eval y)+eval (Categorical xps) = categorical (eval xps)+-- ...++-- TODO: The pretty-printing semantics++newtype PP a = PP (Int -> PP.Doc)++-- The importance-sampling semantics++newtype IS a = IS (IS' a)+type family IS' a+type instance IS' (Measure a)  = IS.Measure (IS' a)+type instance IS' (Dist a)     = CSampler (IS' a)+type instance IS' [a]          = [IS' a]+type instance IS' (a, b)       = (IS' a, IS' b)+type instance IS' (Either a b) = Either (IS' a) (IS' b)+type instance IS' ()           = ()+type instance IS' Bool         = Bool+type instance IS' Double       = Double+type instance IS' Prob         = LF.LogFloat+type instance IS' Int          = Int++instance Mochastic IS where+  type Type IS a = (Eq (IS' a), Typeable (IS' a))+  real                    = IS+  bool                    = IS+  add (IS x) (IS y)       = IS (x + y)+  mul (IS x) (IS y)       = IS (x * y)+  neg (IS x)              = IS (-x)+  logFloat (IS x)         = IS (LF.logFloat x)+  logToLogFloat (IS x)    = IS (LF.logToLogFloat x)+  unbool (IS b) x y       = if b then x else y+  pair (IS x) (IS y)      = IS (x, y)+  unpair (IS (x, y)) c    = c (IS x) (IS y)+  inl (IS x)              = IS (Left x)+  inr (IS x)              = IS (Right x)+  uneither (IS e) c d     = either (c . IS) (d . IS) e+  nil                     = IS []+  cons (IS x) (IS xs)     = IS (x:xs)+  unlist (IS []) n c      = n+  unlist (IS (x:xs)) n c  = c (IS x) (IS xs)+  ret (IS x)              = IS (return x)+  bind (IS m) k           = IS (m >>= \x -> case k (IS x) of IS n -> n)+  conditioned (IS dist)   = IS (IS.conditioned dist)+  unconditioned (IS dist) = IS (IS.unconditioned dist)+  factor (IS p)           = IS (IS.factor p)+  dirac (IS x)            = IS (IS.dirac x)+  categorical (IS xps)    = IS (IS.categorical xps)+  bern (IS p)             = IS (IS.bern p)+  normal (IS m) (IS s)    = IS (IS.normal m s)+  uniform (IS lo) (IS hi) = IS (IS.uniformC lo hi)+  poisson (IS l)          = IS (IS.poisson l)++-- The Metropolis-Hastings semantics++newtype MH a = MH (MH' a)+type family MH' a+type instance MH' (Measure a)  = MH.Measure (MH' a)+type instance MH' (Dist a)     = MH.Cond -> MH.Measure (MH' a)+type instance MH' [a]          = [MH' a]+type instance MH' (a, b)       = (MH' a, MH' b)+type instance MH' (Either a b) = Either (MH' a) (MH' b)+type instance MH' ()           = ()+type instance MH' Bool         = Bool+type instance MH' Double       = Double+type instance MH' Prob         = MH.Likelihood+type instance MH' Int          = Int++instance Mochastic MH where+  type Type MH a = (Eq (MH' a), Typeable (MH' a), Show (MH' a))+  real                    = MH+  bool                    = MH+  add (MH x) (MH y)       = MH (x + y)+  mul (MH x) (MH y)       = MH (x * y)+  neg (MH x)              = MH (-x)+  logFloat (MH x)         = MH (LF.logFromLogFloat (LF.logFloat x))+  logToLogFloat (MH x)    = MH (LF.logFromLogFloat (LF.logToLogFloat x))+  unbool (MH b) x y       = if b then x else y+  pair (MH x) (MH y)      = MH (x, y)+  unpair (MH (x, y)) c    = c (MH x) (MH y)+  inl (MH x)              = MH (Left x)+  inr (MH x)              = MH (Right x)+  uneither (MH e) c d     = either (c . MH) (d . MH) e+  nil                     = MH []+  cons (MH x) (MH xs)     = MH (x:xs)+  unlist (MH []) n c      = n+  unlist (MH (x:xs)) n c  = c (MH x) (MH xs)+  ret (MH x)              = MH (return x)+  bind (MH m) k           = MH (m >>= \x -> case k (MH x) of MH n -> n)+  conditioned (MH dist)   = MH (MH.conditioned dist)+  unconditioned (MH dist) = MH (MH.unconditioned dist)+  factor (MH p)           = MH (MH.factor p)+  dirac (MH x)            = MH (MH.dirac x)+  categorical (MH xps)    = MH (MH.categorical xps)+  bern (MH p)             = MH (MH.bern p)+  normal (MH m) (MH s)    = MH (MH.normal m s)+  uniform (MH lo) (MH hi) = MH (MH.uniform lo hi)+  poisson                 = error "poisson: not implemented for MH" -- TODO
− Sampler.hs 
@@ -1,26 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{-# OPTIONS -W #-}--module Sampler (Sampler, deterministic, sbind, smap) where--import Mixture (Mixture, mnull, empty, scale, point)-import RandomChoice (choose)-import System.Random (RandomGen)---- Sampling procedures that produce one sample--type Sampler a = forall g. (RandomGen g) => g -> (Mixture a, g)--deterministic :: Mixture a -> Sampler a-deterministic m g = (m, g)--sbind :: Sampler a -> (a -> Sampler b) -> Sampler b-sbind s k g0 =-  case s g0 of { (m1, g1) ->-    if mnull m1 then (empty, g1) else-      case choose m1 g1 of { (a, v, g2) ->-        case k a g2 of { (m2, g) ->-          (scale v m2, g) } } }--smap :: (a -> b) -> Sampler a -> Sampler b-smap f s = sbind s (\a -> deterministic (point (f a) 1))
− Syntax.hs 
@@ -1,185 +0,0 @@-{-# LANGUAGE TypeFamilies, ConstraintKinds, GADTs, FlexibleContexts #-}--module Syntax where---- The syntax--import GHC.Exts (Constraint)---- TODO: The pretty-printing semantics--import qualified Text.PrettyPrint as PP---- The importance-sampling semantics--import Types (Cond, CSampler)-import Data.Dynamic (Typeable)-import qualified Data.Number.LogFloat as LF-import qualified InterpreterDynamic as IS---- The Metropolis-Hastings semantics--import qualified InterpreterMH as MH---- The syntax--data Prob-data Measure a-data Dist a--class Mochastic repr where-  type Type repr a :: Constraint-  real        :: Double -> repr Double-  bool        :: Bool -> repr Bool-  add, mul    :: repr Double -> repr Double -> repr Double-  neg         :: repr Double -> repr Double-  neg         =  mul (real (-1))-  logFloat, logToLogFloat-              :: repr Double -> repr Prob-  unbool      :: repr Bool -> repr c -> repr c-              -> repr c-  pair        :: repr a -> repr b -> repr (a, b)-  unpair      :: repr (a, b) -> (repr a -> repr b -> repr c)-              -> repr c-  inl         :: repr a -> repr (Either a b)-  inr         :: repr b -> repr (Either a b)-  uneither    :: repr (Either a b) -> (repr a -> repr c) -> (repr b -> repr c)-              -> repr c-  nil         :: repr [a]-  cons        :: repr a -> repr [a] -> repr [a]-  unlist      :: repr [a] -> repr c -> (repr a -> repr [a] -> repr c)-              -> repr c-  ret         :: repr a -> repr (Measure a)-  bind        :: repr (Measure a) -> (repr a -> repr (Measure b))-              -> repr (Measure b)-  conditioned, unconditioned :: repr (Dist a) -> repr (Measure a)-  factor      :: repr Prob -> repr (Measure ())-  dirac       :: (Type repr a) => repr a -> repr (Dist a)-  categorical :: (Type repr a) => repr [(a, Prob)] -> repr (Dist a)-  bern        :: (Type repr Bool) => repr Double -> repr (Dist Bool)-  bern p      =  categorical $-                 cons (pair (bool True) (logFloat p)) $-                 cons (pair (bool False) (logFloat (add (real 1) (neg p)))) $-                 nil-  normal, uniform-              :: repr Double -> repr Double -> repr (Dist Double)-  poisson     :: repr Double -> repr (Dist Int)---- TODO: The initial (AST) "semantics"--- (Hey Oleg, is there any better way to deal with the Type constraint, so that--- the AST constructor doesn't have to take a repr constructor argument?)--data AST repr a where-  Real :: Double -> AST repr Double-  Unbool :: AST repr Bool -> AST repr c -> AST repr c -> AST repr c-  Categorical :: (Type repr a) => AST repr [(a, Prob)] -> AST repr (Dist a)-  -- ...--instance (Mochastic repr) => Mochastic (AST repr) where-  type Type (AST repr) a = Type repr a-  real = Real-  unbool = Unbool-  categorical = Categorical-  -- ...--eval :: (Mochastic repr) => AST repr a -> repr a-eval (Real x) = real x-eval (Unbool b x y) = unbool (eval b) (eval x) (eval y)-eval (Categorical xps) = categorical (eval xps)--- ...---- TODO: The pretty-printing semantics--newtype PP a = PP (Int -> PP.Doc)---- The importance-sampling semantics--newtype IS a = IS (IS' a)-type family IS' a-type instance IS' (Measure a)  = IS.Measure (IS' a)-type instance IS' (Dist a)     = CSampler (IS' a)-type instance IS' [a]          = [IS' a]-type instance IS' (a, b)       = (IS' a, IS' b)-type instance IS' (Either a b) = Either (IS' a) (IS' b)-type instance IS' ()           = ()-type instance IS' Bool         = Bool-type instance IS' Double       = Double-type instance IS' Prob         = LF.LogFloat-type instance IS' Int          = Int--instance Mochastic IS where-  type Type IS a = (Eq (IS' a), Typeable (IS' a))-  real                    = IS-  bool                    = IS-  add (IS x) (IS y)       = IS (x + y)-  mul (IS x) (IS y)       = IS (x * y)-  neg (IS x)              = IS (-x)-  logFloat (IS x)         = IS (LF.logFloat x)-  logToLogFloat (IS x)    = IS (LF.logToLogFloat x)-  unbool (IS b) x y       = if b then x else y-  pair (IS x) (IS y)      = IS (x, y)-  unpair (IS (x, y)) c    = c (IS x) (IS y)-  inl (IS x)              = IS (Left x)-  inr (IS x)              = IS (Right x)-  uneither (IS e) c d     = either (c . IS) (d . IS) e-  nil                     = IS []-  cons (IS x) (IS xs)     = IS (x:xs)-  unlist (IS []) n c      = n-  unlist (IS (x:xs)) n c  = c (IS x) (IS xs)-  ret (IS x)              = IS (return x)-  bind (IS m) k           = IS (m >>= \x -> case k (IS x) of IS n -> n)-  conditioned (IS dist)   = IS (IS.conditioned dist)-  unconditioned (IS dist) = IS (IS.unconditioned dist)-  factor (IS p)           = IS (IS.factor p)-  dirac (IS x)            = IS (IS.dirac x)-  categorical (IS xps)    = IS (IS.categorical xps)-  bern (IS p)             = IS (IS.bern p)-  normal (IS m) (IS s)    = IS (IS.normal m s)-  uniform (IS lo) (IS hi) = IS (IS.uniformC lo hi)-  poisson (IS l)          = IS (IS.poisson l)---- The Metropolis-Hastings semantics--newtype MH a = MH (MH' a)-type family MH' a-type instance MH' (Measure a)  = MH.Measure (MH' a)-type instance MH' (Dist a)     = MH.Cond -> MH.Measure (MH' a)-type instance MH' [a]          = [MH' a]-type instance MH' (a, b)       = (MH' a, MH' b)-type instance MH' (Either a b) = Either (MH' a) (MH' b)-type instance MH' ()           = ()-type instance MH' Bool         = Bool-type instance MH' Double       = Double-type instance MH' Prob         = MH.Likelihood-type instance MH' Int          = Int--instance Mochastic MH where-  type Type MH a = (Eq (MH' a), Typeable (MH' a), Show (MH' a))-  real                    = MH-  bool                    = MH-  add (MH x) (MH y)       = MH (x + y)-  mul (MH x) (MH y)       = MH (x * y)-  neg (MH x)              = MH (-x)-  logFloat (MH x)         = MH (LF.logFromLogFloat (LF.logFloat x))-  logToLogFloat (MH x)    = MH (LF.logFromLogFloat (LF.logToLogFloat x))-  unbool (MH b) x y       = if b then x else y-  pair (MH x) (MH y)      = MH (x, y)-  unpair (MH (x, y)) c    = c (MH x) (MH y)-  inl (MH x)              = MH (Left x)-  inr (MH x)              = MH (Right x)-  uneither (MH e) c d     = either (c . MH) (d . MH) e-  nil                     = MH []-  cons (MH x) (MH xs)     = MH (x:xs)-  unlist (MH []) n c      = n-  unlist (MH (x:xs)) n c  = c (MH x) (MH xs)-  ret (MH x)              = MH (return x)-  bind (MH m) k           = MH (m >>= \x -> case k (MH x) of MH n -> n)-  conditioned (MH dist)   = MH (MH.conditioned dist)-  unconditioned (MH dist) = MH (MH.unconditioned dist)-  factor (MH p)           = MH (MH.factor p)-  dirac (MH x)            = MH (MH.dirac x)-  categorical (MH xps)    = MH (MH.categorical xps)-  bern (MH p)             = MH (MH.bern p)-  normal (MH m) (MH s)    = MH (MH.normal m s)-  uniform (MH lo) (MH hi) = MH (MH.uniform lo hi)-  poisson                 = error "poisson: not implemented for MH" -- TODO
− Util/Csv.hs 
@@ -1,40 +0,0 @@-{-# LANGUAGE TypeOperators #-}--module Util.Csv ((:::)((:::)), decodeFile, decodeGZipFile,-                 decodeFileStream, decodeGZipFileStream) where--import Data.Csv ( HasHeader(..), FromRecord(..), FromField(..)-                , ToRecord(..), ToField(..), decode)-import qualified Data.Csv.Streaming as CS (decode)-import Codec.Compression.GZip (decompress)-import qualified Data.Foldable as F-import qualified Data.ByteString.Lazy as B-import qualified Data.Vector as V-import Control.Applicative ((<*>), (<$>))--data a ::: b = a ::: b deriving (Eq, Ord, Read, Show)-infixr 5 :::--instance (FromField a, FromRecord b) => FromRecord (a ::: b) where-  parseRecord v | V.null v  = fail "too few fields in input record"-                | otherwise = (:::) <$> parseField (V.head v) <*> parseRecord (V.tail v)--instance (ToField a, ToRecord b) => ToRecord (a ::: b) where-  toRecord (a ::: b) = V.cons (toField a) (toRecord b)--decodeBytes :: FromRecord a => B.ByteString -> [a]-decodeBytes bs = case decode HasHeader bs of-                   Left _ -> []-                   Right v -> V.toList v--decodeFile :: FromRecord a => FilePath -> IO [a]-decodeFile = fmap decodeBytes . B.readFile--decodeGZipFile :: FromRecord a => FilePath -> IO [a]-decodeGZipFile = fmap (decodeBytes . decompress) . B.readFile--decodeFileStream :: FromRecord a => FilePath -> IO [a]-decodeFileStream = fmap (F.toList . CS.decode HasHeader) . B.readFile--decodeGZipFileStream :: FromRecord a => FilePath -> IO [a]-decodeGZipFileStream = fmap (F.toList . CS.decode HasHeader . decompress) . B.readFile
− Util/FileInterpolater.hs 
@@ -1,115 +0,0 @@-{-# LANGUAGE RankNTypes, NoMonomorphismRestriction #-}-{-# OPTIONS -W #-}--module Main where--import System.IO-import Text.ParserCombinators.Parsec-import System.Environment (getArgs, getProgName)-import System.Exit (exitFailure)--data ControlMeas = CM { time1 :: Double, vel :: Double, steer :: Double }-data Sensor = S { time2 :: Double, lat :: Double, long :: Double, orient :: Double }-data Merged = M {cm :: ControlMeas, sens :: Sensor}--type Table1 = [ ControlMeas ]-type Table2 = [ Sensor ]-type MergedT = [ Merged ]---- prev will be Nothing on startup-data Tracking a = Tr {prev :: Maybe a, curr :: a, rest :: [a]}---- interpolate and merge 2 files-main :: IO ()-main = do-  args <- getArgs-  case args of-    [fileName1, fileName2] -> do-      handle1 <- openFile fileName1 ReadMode-      handle2 <- openFile fileName2 ReadMode-      contents1 <- hGetContents handle1-      contents2 <- hGetContents handle2-      let list1 = tail $ convertS (parseCSV contents1)-      let list2 = tail $ convertS (parseCSV contents2)-      let tableM = interpolation (constructTab1 list1) (constructTab2 list2)-      writeFile "output.csv" (unlines (convertTable tableM)) -      putStrLn "Interpolated data written to output.csv"-    _ -> do-      progName <- getProgName-      hPutStrLn stderr ("Usage: " ++ progName ++ " <control filename> <gps filename>")-      hPutStrLn stderr ("Example: " ++ progName ++ " \"slam_control.csv\" \"slam_gps.csv\"")-      exitFailure      ---- parsec (CSV)-csvFile = endBy line eol-line = sepBy cell (char ',')-cell = many (noneOf ",\n")-eol = char '\n'--parseCSV :: String -> Either ParseError [[String]]-parseCSV input = parse csvFile "(unknown)" input---- convert table to output format (CSV)-convertTable :: MergedT -> [String]-convertTable = map convertCSV--convertCSV :: Merged -> String-convertCSV m = show (time1 control) ++ "," ++ -               show (vel control) ++ "," ++ -               show (steer control) ++ "," ++ -               show (lat sensors) ++ "," ++ -               show (long sensors) ++ "," ++ -               show (orient sensors)-    where control = cm m-          sensors = sens m---- Perform Interpolation-interpolation :: Table1 -> Table2 -> MergedT-interpolation [] [] = []-interpolation [] _ = error "not enough data to interpolate"-interpolation _ [] = error "not enough data to interpolate"-interpolation (x1:xs) (y1:ys) =-  go (Tr Nothing x1 xs) (Tr Nothing y1 ys)---- interpolation using current and previous tracking-go :: Tracking ControlMeas -> Tracking Sensor -> MergedT-go (Tr _ _ []) (Tr _ _ _) = []-go (Tr pr1 cur1 rst1) (Tr pr2 cur2 rst2) = -  let t1 = time1 cur1-      t2 = time2 cur2 in-  case compare t1 t2 of-    LT -> M cur1 res : go (Tr (Just cur1) (head rst1) (tail rst1)) (Tr pr2 cur2 rst2)-          where-            S t2p latp longp orientp = maybe (S t1 0 0 0) id pr2-            S t2c latc longc orientc = cur2-            interp x y = ((x-y) / (t2c-t2p)) * (t1-t2p) + y-            res = S t1 (interp latc latp) (interp longc longp) (interp orientc orientp)-    EQ -> M cur1 cur2 : go (Tr (Just cur1) (head rst1) (tail rst1)) (Tr (Just cur2) (head rst2) (tail rst2))-    GT -> M res cur2 : if null rst2 then [] else go (Tr pr1 cur1 rst1) (Tr (Just cur2) (head rst2) (tail rst2))-          where-            CM t1p velp steerp = maybe (CM t2 0 0) id pr1-            CM t1c velc steerc = cur1-            interp x y = ((x-y) / (t1c-t1p)) * (t2-t1p) + y-            res = CM t2 (interp velc velp) (interp steerc steerp) ---- helper functions-readD :: String -> Double-readD x = read x :: Double--convertS :: Either ParseError a -> a-convertS (Left _) = error "something went wrong in the parsing -- FIXME"-convertS (Right s) = s--constructTab1 :: [[String]] -> Table1-constructTab1 = map read3-  where -    read3 :: [String] -> ControlMeas-    read3 (x : y : z : []) = CM (readD x) (readD y) (readD z)-    read3 _ = error "Table 1 should have exactly 3 entries per row"--constructTab2 :: [[String]] -> Table2-constructTab2 = map read4-  where-    read4 :: [String] -> Sensor-    read4 (x : y : z : w : []) = S (readD x) (readD y) (readD z) (readD w)-    read4 _ = error "Table 2 should have exactly 4 entries per row"
− Util/Finite.hs 
@@ -1,85 +0,0 @@-module Util.Finite (Finite(..), enumEverything, enumCardinality, suchThat) where--import Data.List (tails)-import Data.Maybe (fromJust)-import Data.Bits (shiftL)-import qualified Data.Set as S-import qualified Data.Map as M--class (Ord a) => Finite a where-    everything :: [a]-    cardinality :: a -> Integer--enumEverything :: (Enum a, Bounded a) => [a]-enumEverything = [minBound..maxBound]--enumCardinality :: (Enum a, Bounded a) => a -> Integer-enumCardinality dummy = succ-                      $ fromIntegral (fromEnum (maxBound `asTypeOf` dummy))-                      - fromIntegral (fromEnum (minBound `asTypeOf` dummy))--instance Finite () where-    everything = enumEverything-    cardinality = enumCardinality--instance Finite Bool where-    everything = enumEverything-    cardinality = enumCardinality--instance Finite Ordering where-    everything = enumEverything-    cardinality = enumCardinality--instance (Finite a) => Finite (Maybe a) where-    everything = Nothing : map Just everything-    cardinality = succ . cardinality . fromJust--instance (Finite a, Finite b) => Finite (Either a b) where-    everything = map Left everything ++ map Right everything-    cardinality x = cardinality l + cardinality r where-        (Left l, Right r) = (x, x)--instance (Finite a, Finite b) => Finite (a, b) where-    everything = [ (a, b) | a <- everything, b <- everything ]-    cardinality ~(a, b) = cardinality a * cardinality b--instance (Finite a, Finite b, Finite c) => Finite (a, b, c) where-    everything = [ (a, b, c) | a <- everything, b <- everything, c <- everything ]-    cardinality ~(a, b, c) = cardinality a * cardinality b * cardinality c--instance (Finite a, Finite b, Finite c, Finite d) => Finite (a, b, c, d) where-    everything = [ (a, b, c, d) | a <- everything, b <- everything, c <- everything, d <- everything ]-    cardinality ~(a, b, c, d) = cardinality a * cardinality b * cardinality c * cardinality d--instance (Finite a, Finite b, Finite c, Finite d, Finite e) => Finite (a, b, c, d, e) where-    everything = [ (a, b, c, d, e) | a <- everything, b <- everything, c <- everything, d <- everything, e <- everything ]-    cardinality ~(a, b, c, d, e) = cardinality a * cardinality b * cardinality c * cardinality d * cardinality e--instance (Finite a) => Finite (S.Set a) where-    everything = loop everything S.empty where-        loop candidates set = set-            : concat [ loop xs (S.insert x set) | x:xs <- tails candidates ]-    cardinality set = shiftL 1 (fromIntegral (cardinality (S.findMin set)))--instance (Finite a, Eq b) => Eq (a -> b) where-    f == g = all (\x -> f x == g x) everything-    f /= g = any (\x -> f x /= g x) everything--instance (Finite a, Ord b) => Ord (a -> b) where-    f `compare` g = map f everything `compare` map g everything-    f <         g = map f everything <         map g everything-    f >         g = map f everything >         map g everything-    f <=        g = map f everything <=        map g everything-    f >=        g = map f everything >=        map g everything--instance (Finite a, Finite b) => Finite (a -> b) where-    everything = [ (M.!) (M.fromDistinctAscList m)-                 | m <- loop everything ] where-        loop []     = [[]]-        loop (a:as) = [ (a,b):rest | b <- everything, rest <- loop as ]-    cardinality f = cardinality y ^ cardinality x where-        (x, y) = (x, f x)--suchThat :: (Finite a) => (a -> Bool) -> S.Set a-suchThat p = S.fromDistinctAscList (filter p everything)-
− Util/HList.hs 
@@ -1,22 +0,0 @@-{-# LANGUAGE TypeFamilies, DataKinds, TypeOperators #-}-{-# OPTIONS -W #-}--module Util.HList where--class TList (xs :: [*]) where-  data VList (xs :: [*]) :: *-  type Append (xs :: [*]) (ys :: [*]) :: [*]-  append :: VList xs -> VList ys -> VList (Append xs ys)-  vsplit :: VList (Append xs ys) -> (VList xs, VList ys)--instance TList '[] where-  data VList '[] = VNil-  type Append '[] ys = ys-  append VNil ys = ys-  vsplit ys = (VNil, ys)--instance TList xs => TList (x ': xs) where-  data VList (x ': xs) = VCons x (VList xs)-  type Append (x ': xs) ys = x ': Append xs ys-  append (VCons x xs) ys = VCons x (append xs ys)-  vsplit (VCons x zs) = let (xs, ys) = vsplit zs in (VCons x xs, ys)
− Util/Pretty.hs 
@@ -1,74 +0,0 @@-module Util.Pretty (Pretty(..)) where--import Text.PrettyPrint-import Text.Show.Functions-import Data.Ratio (Ratio, numerator, denominator)-import qualified Data.Map as M-import qualified Data.Set as S-import Util.Finite--class (Show a) => Pretty a where-    pretty :: a -> Doc-    pretty = text . show-    prettyList :: [a] -> Doc-    prettyList = brackets . nest 1 . fsep . punctuate comma . map pretty--instance Pretty Bool-instance Pretty Int-instance Pretty Integer-instance Pretty Float-instance Pretty Double-instance Pretty ()-instance Pretty Ordering-instance Pretty Char where prettyList = text . show--instance (Pretty a, Integral a) => Pretty (Ratio a) where-    pretty r | denom == 1 = prnum-	     | otherwise  = cat [prnum, char '/' <> pretty denom]-	where denom = denominator r-	      prnum = pretty (numerator r)--instance (Pretty a) => Pretty [a] where-    pretty = prettyList--instance (Pretty a) => Pretty (Maybe a) where-    pretty Nothing  = text "Nothing"-    pretty (Just x) = text "Just" <+> pretty x--instance (Pretty a, Pretty b) => Pretty (Either a b) where-    pretty (Left  x) = text "Left"  <+> pretty x-    pretty (Right x) = text "Right" <+> pretty x--instance (Finite a, Pretty a, Pretty b) => Pretty (a -> b)-  where-    pretty f = braces $ nest 1 $ sep $ punctuate comma $-               [ hang (pretty x <> colon) 1 (pretty (f x)) | x <- everything ]--instance (Pretty a, Pretty b) => Pretty (M.Map a b)-  where-    pretty m = braces . nest 1 . sep . punctuate comma-        $ [ hang (pretty k <> colon) 1 (pretty v) | (k,v) <- M.assocs m ]--instance (Pretty a) => Pretty (S.Set a)-  where-    pretty = braces . nest 1 . fsep . punctuate comma . map pretty . S.elems--tuple :: [Doc] -> Doc-tuple = parens . nest 1 . fsep . punctuate comma--{- The Haskell code below is generated by the following Perl program.-@a = 'a'..'z';-$" = ", ";-print <<END foreach 2..5;-instance (@{[map "Pretty $_", @a[0..$_-1]]}) => Pretty (@a[0..$_-1]) where-    pretty (@a[0..$_-1]) = tuple [@{[map "pretty $_", @a[0..$_-1]]}]-END--}-instance (Pretty a, Pretty b) => Pretty (a, b) where-    pretty (a, b) = tuple [pretty a, pretty b]-instance (Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) where-    pretty (a, b, c) = tuple [pretty a, pretty b, pretty c]-instance (Pretty a, Pretty b, Pretty c, Pretty d) => Pretty (a, b, c, d) where-    pretty (a, b, c, d) = tuple [pretty a, pretty b, pretty c, pretty d]-instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e) => Pretty (a, b, c, d, e) where-    pretty (a, b, c, d, e) = tuple [pretty a, pretty b, pretty c, pretty d, pretty e]
hakaru.cabal view
@@ -2,9 +2,9 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                hakaru-version:             0.1+version:             0.1.1 synopsis:            A probabilistic programming embedded DSL--- description:         +description:         Hakaru is an embedded DSL for performing probabilistic inference. It supports multiple inference backends. homepage:            http://www.indiana.edu/~ppaml license:             BSD3 license-file:        LICENSE@@ -17,7 +17,7 @@ cabal-version:       >=1.10  library-  exposed-modules:     Types, Visual, Syntax, Mixture, Language.Hakaru.Symbolic, Sampler, RandomChoice, Util.Csv, Util.Extras, Util.Coda, Util.Finite, Util.Pretty, Util.HList, Util.FileInterpolater, Examples.Tests, Examples.Examples, Language.Hakaru.ImportanceSampler, Language.Hakaru.Metropolis+  exposed-modules:     Types, Visual, Language.Hakaru.Syntax, Mixture, Language.Hakaru.Symbolic, RandomChoice, Util.Extras, Util.Coda, Examples.Tests, Language.Hakaru.ImportanceSampler, Language.Hakaru.Metropolis   -- other-modules:          other-extensions:    RankNTypes, BangPatterns, OverloadedStrings, TypeFamilies, ConstraintKinds, GADTs, FlexibleContexts, TypeOperators, DataKinds, NoMonomorphismRestriction, DeriveDataTypeable, ScopedTypeVariables, ExistentialQuantification, StandaloneDeriving   build-depends:       base >=4.6 && <4.7, aeson >=0.7 && <0.8, text >=1.1 && <1.2, bytestring >=0.10 && <0.11, pretty >=1.1 && <1.2, logfloat >=0.12 && <0.13, containers >=0.5 && <0.6, random >=1.0 && <1.1, math-functions >=0.1 && <0.2, vector >=0.10 && <0.11, cassava >=0.4 && <0.5, zlib >=0.5 && <0.6, statistics >=0.11 && <0.12, hmatrix >=0.16 && <0.17, parsec >=3.1 && <3.2