Permalink
Browse files

works with probably-0.2. Some changes to mode. Had to disable somethi…

…gn related to textures
  • Loading branch information...
1 parent 2734331 commit aa43b9ec5b538815057b8f402b51d8962b96ed38 Tom Nielsen committed Sep 9, 2011
View
0 Charts.hs 100755 → 100644
No changes.
View
0 Comedi/Comedi.hs 100755 → 100644
No changes.
View
0 Comedi/comedi_hs_helper.c 100755 → 100644
No changes.
View
0 Comedi/comedi_hs_helper.h 100755 → 100644
No changes.
View
6 Compiler.hs 100755 → 100644
@@ -36,12 +36,12 @@ compileDec (Let (PatVar nm _) (Switch ses ser)) =
unSig (Sig se) = se
unSig e = e
compileDec rs@(ReadSource nm ("adc", _)) = compileAdcSrc rs
-compileDec (ReadSource nm ("loadTexture", (Const fnm))) =
+{-compileDec (ReadSource nm ("loadTexture", (Const fnm))) =
[RunInGLThread $ \env -> do
- setTexture $ unsafeReify fnm
+ setTexture $ (unsafeReify fnm)::String
print "HELLLOOOO!!!!!!!!!!!!"
update env nm $ BoxV (p3 1 1 1) (p3 (-0.5) (-0.5) 0) (p3 1 1 1)
- return () ]
+ return () ] -}
compileDec (ReadSource nm (srcNm, (Const arg))) = [ReadSrcAction nm $ genSrc srcNm arg]
compileDec (Let (PatVar nm _) e) = [Env nm $ unVal e]
compileDec (SinkConnect (Var nm) (snkNm,_)) = [SigSnkConn nm snkNm]
View
0 Database.hs 100755 → 100644
No changes.
View
0 Depreciated/MemDatabase.hs 100755 → 100644
No changes.
View
0 Depreciated/Run.hs 100755 → 100644
No changes.
View
@@ -49,7 +49,8 @@ main = do
whenM (doesFileExist $ cmdFile ds) $ removeFile (cmdFile ds)
- forkOS (initGlScreen (not $ "-w" `elem` args) dispPullMv runningMv (return ()))
+ forkOS (initGlScreen (not $ "-w" `elem` args) dispPullMv runningMv
+ ((return ())::IO ()))
waitSecs 0.5
catchForever $ (loop ds >> hFlush stdout)
View
0 Eval.hs 100755 → 100644
No changes.
View
0 EvalM.hs 100755 → 100644
No changes.
View
0 Expr.hs 100755 → 100644
No changes.
View
0 GenC/initComedi.sh 100755 → 100644
No changes.
View
0 ImpInterpret.hs 100755 → 100644
No changes.
View
0 Numbers.hs 100755 → 100644
No changes.
View
0 OpenGL.hs 100755 → 100644
No changes.
View
@@ -47,6 +47,7 @@ import System.Environment
--import System.Console.Readline
import System.IO
import Math.Probably.Student
+import Math.Probably.Sampler
import Math.Probably.FoldingStats
import Text.Printf
import NewSignal
@@ -289,8 +290,8 @@ inLastSession sma = do
inSession :: (MonadIO m, Functor m) => Session -> StateT QState m a -> m a
inSession s sma = do args <- liftIO $ getArgs
- gen <- liftIO $ getStdGen
- rnds <- liftIO $ randoms gen
+-- gen <- liftIO $ getStdGen
+ rnds <- liftIO $ getSeedIO
fst `liftM` (runStateT sma $ QState s 0 0 True args Nothing rnds False False 0)
changeToSession :: (MonadIO m, Functor m) => Session -> StateT QState m ()
@@ -303,8 +304,8 @@ inSessionFromArgs :: (MonadIO m, Functor m) => StateT QState m a -> m a
inSessionFromArgs sma = do allargs <- liftIO $ getArgs
let (opts, nm:args) = partition beginsWithHyphen allargs
sess <- liftIO $ loadApproxSession sessionsRootDir nm
- gen <- liftIO $ getStdGen
- rnds <- liftIO $ randoms gen
+-- gen <- liftIO $ getStdGen
+ rnds <- liftIO $ getSeedIO
fst `liftM` (runStateT sma $ QState sess 0 0 True (opts++args) Nothing rnds False False 0)
View
@@ -64,7 +64,7 @@ data QState = QState { qsSess:: Session,
realTime :: Bool,
shArgs :: [String],
remoteCmdFile :: Maybe String,
- rnds :: [Double],
+ rnds :: Seed,
forLiterate :: Bool,
forTable :: Bool,
loadShift :: Double
@@ -75,7 +75,7 @@ type QueryM = StateT QState IO
sampleNQ :: MonadIO m => Int -> Sampler a -> StateT QState m [a]
sampleNQ n sf = do
rans <- rnds `liftM` get
- modify $ \s-> s {rnds = []}
+-- modify $ \s-> s {rnds = []}
let (vls, rans') = sam n rans sf []
modify $ \s-> s {rnds = rans'}
return vls
View
@@ -30,7 +30,7 @@ instance Distribution RandomSignal where
k = dim mu
sigma = (realToFrac noise) * ident k
in \obsSig -> P.multiNormal mu sigma $ sigToVector $ forceSigEq obsSig -}
- SV.foldl1' (+) $ SV.zipWith (\muval obsVal -> P.logGaussD muval noise obsVal) muArr obsArr
+ SV.foldl1' (+) $ SV.zipWith (\muval obsVal -> P.gaussD muval noise obsVal) muArr obsArr
{-instance ProperDistribution RandomSignal where
sampler (RandomSignal meansig@(Signal t1 t2 dt _ _) noise) =
@@ -54,12 +54,12 @@ instance Distribution RandomSignalFast where
altPdfRSF1 :: RandomSignalFast -> Signal Double -> Double
altPdfRSF1 (RandomSignalFast meansigf noise) (Signal t1 t2 dt obsArr Eq)=
- let f i obsVal = P.logGaussD (meansigf . (*dt) . realToFrac $ i) noise obsVal
+ let f i obsVal = P.gaussD (meansigf . (*dt) . realToFrac $ i) noise obsVal
in SV.foldl1' (+) $ SV.mapIndexed f obsArr
altPdfRSF :: RandomSignalFast -> Signal Double -> Double
altPdfRSF (RandomSignalFast meansigf noise) (Signal t1 t2 dt obsArr Eq)=
- let facc obsVal (sm, i) = (sm+P.logGaussD (meansigf . (*dt) . realToFrac $ i) noise obsVal, i+1)
+ let facc obsVal (sm, i) = (sm+P.gaussD (meansigf . (*dt) . realToFrac $ i) noise obsVal, i+1)
in fst $ SV.foldr facc (0,0) obsArr
{-longPdfRSF :: RandomSignalFast -> Signal Double -> Double
View
0 SrcSinks.hs 100755 → 100644
No changes.
View
0 Stages.hs 100755 → 100644
No changes.
View
@@ -229,75 +229,6 @@ manyLikeOver durs lh1 = \obs-> \theta-> sum $ map (lh1 theta) $ chopAndReset dur
-{-instance (MutateGaussian a, UA a )=> MutateGaussian (UArr a) where
- mutGauss cv xs = toU `fmap` mutGaussMany cv (fromU xs)
- mutGaussAbs x0 cv xs = toU `fmap` mutGaussAbs (fromU x0) cv (fromU xs)
- nearlyEq tol xs ys = lengthU xs == lengthU ys && (allU (uncurryS $ nearlyEq tol) $ zipU xs ys ) -}
-
-class MutateGaussian a where
- mutGauss :: Double -> a -> Sampler a
- mutGauss cv x = mutGaussAbs x cv x
- mutGaussAbs :: a -> Double -> a -> Sampler a
- --mutGaussAbs _ = mutGauss
- mutGaussMany :: Double -> [a] -> Sampler [a]
- mutGaussMany cv = mapM (mutGauss cv)
- nearlyEq :: Double -> a -> a -> Bool
-
-instance MutateGaussian Double where
- mutGauss cv x = gaussD x (cv*x)
- mutGaussAbs x0 cv x = gaussD x (cv*x0)
- mutGaussMany cv xs = gaussManyD (map (\x-> (x,cv*x)) xs)
- nearlyEq tol x y = abs(x-y)<tol
-
-instance MutateGaussian Int where
- mutGaussAbs _ cv' x = do
- u <- unitSample
- let cv = 0.5 -- max 0 $ min 0.4 (1/cv')
- case u of
- _ | u < 0.5 -> return $ x-1
--- | u > 0.5 -> return $ x+1
- | otherwise -> return $ x+1
- nearlyEq _ x y = x==y
-
-{-instance MutateGaussian Int where
- mutGauss cv x = round `fmap` gaussD (realToFrac x) (cv*realToFrac x)
- nearlyEq tol x y = x==y -}
-
-instance MutateGaussian a => MutateGaussian [a] where
- mutGauss cv xs = mutGaussMany cv xs
- mutGaussAbs xs0 cv xs = mapM (\(x0,x)-> mutGaussAbs x0 cv x) $ zip xs0 xs
- nearlyEq tol xs ys = length xs == length ys && (all (uncurry $ nearlyEq tol) $ zip xs ys )
-
-instance (MutateGaussian a, MutateGaussian b) => MutateGaussian (a,b) where
- mutGauss cv (x,y) = liftM2 (,) (mutGauss cv x) (mutGauss cv y)
- mutGaussAbs (x0, y0) cv (x,y) = liftM2 (,) (mutGaussAbs x0 cv x) (mutGaussAbs y0 cv y)
- nearlyEq t (x,y) (x1,y1) = nearlyEq t x x1 && nearlyEq t y y1
-
-instance (MutateGaussian a, MutateGaussian b, MutateGaussian c) => MutateGaussian (a,b,c) where
- mutGauss cv (x,y,z) = liftM3 (,,) (mutGauss cv x) (mutGauss cv y) (mutGauss cv z)
- mutGaussAbs (x0, y0, z0) cv (x,y,z) =
- liftM3 (,,) (mutGaussAbs x0 cv x) (mutGaussAbs y0 cv y) (mutGaussAbs z0 cv z)
- nearlyEq t (x,y, z) (x1,y1, z1) = nearlyEq t x x1 && nearlyEq t y y1 && nearlyEq t z z1
-
-instance (MutateGaussian a, MutateGaussian b, MutateGaussian c, MutateGaussian d) => MutateGaussian (a,b,c,d) where
- mutGauss cv (x,y,z,w) = liftM4 (,,,) (mutGauss cv x) (mutGauss cv y) (mutGauss cv z) (mutGauss cv w)
- mutGaussAbs (x0, y0, z0, w0) cv (x,y,z,w) =
- liftM4 (,,,) (mutGaussAbs x0 cv x) (mutGaussAbs y0 cv y) (mutGaussAbs z0 cv z) (mutGaussAbs w0 cv w)
- nearlyEq t (x,y, z, w) (x1,y1, z1, w1) = nearlyEq t x x1 && nearlyEq t y y1 && nearlyEq t z z1 && nearlyEq t w w1
-
-
-instance (MutateGaussian a, U.Unbox a )=> MutateGaussian (U.Vector a) where
- mutGauss cv xs = U.fromList `fmap` mutGaussMany cv (U.toList xs)
- mutGaussAbs x0 cv xs = U.fromList `fmap` mutGaussAbs (U.toList x0) cv (U.toList xs)
- nearlyEq tol xs ys = U.length xs == U.length ys && (U.all (uncurry $ nearlyEq tol) $ U.zip xs ys )
-
-
-instance (MutateGaussian a, Storable a )=> MutateGaussian (SV.Vector a) where
- mutGauss cv xs = SV.pack `fmap` mutGaussMany cv (SV.unpack xs)
- mutGaussAbs x0 cv xs = SV.pack `fmap` mutGaussAbs (SV.unpack x0) cv (SV.unpack xs)
- nearlyEq tol xs ys = SV.length xs == SV.length ys && (all (uncurry $ nearlyEq tol) $ SV.zip xs ys )
-
-
{-instance ChopByDur (UArr Double) where
chopByDur durs arr = map (\((t1,t2),_)->filterU (\t->t>t1 && t<t2 ) arr) durs-}
@@ -377,7 +308,7 @@ f >-> g = \x -> f x >>= g
metSampleP s = metSample1P s depSam
--metSamplePx0 x0 = metSample1P (depSamx0 x0)
-metSamplePCL s = metSample1PCL s depSam
+--metSamplePCL s = metSample1PCL s depSam
depSam w x0 = mutGaussAbs x0 $ w*0.005
depSamx0 x0 w _ = mutGaussAbs x0 $ w*0.005
View
0 Test.hs 100755 → 100644
No changes.
View
0 Test2.hs 100755 → 100644
No changes.
View
0 Transform.hs 100755 → 100644
No changes.
View
0 Traverse.hs 100755 → 100644
No changes.
View
0 Types.hs 100755 → 100644
No changes.
View
@@ -31,7 +31,7 @@ Library
if flag(nodaq)
ghc-options: -DNODAQ
other-modules: Eval, BNFC.LexBugpan, BNFC.ParBugpan, BNFC.SkelBugpan,BNFC.PrintBugpan,BNFC.LayoutBugpan ,BNFC.ErrM,UnitTesting, BNFC.AbsBugpan,BuiltIn, TypeCheck, CompiledSrcsSinks, GenC.Backend, GenC.Syntax
- Build-depends: tnutils, probably<0.2, process, directory, regex-posix, random, base, bytestring, binary, old-time, storablevector>0.2.4, mtl, data-binary-ieee754, mersenne-random, storable-tuple, hmatrix, vector, syb, array, haskell98, utility-ht
+ Build-depends: tnutils, probably, process, directory, regex-posix, random, base, bytestring, binary, old-time, storablevector>0.2.4, mtl, data-binary-ieee754, mersenne-random, storable-tuple, hmatrix, vector, syb, array, haskell98, utility-ht
--if !flag(onlylib)
@@ -42,13 +42,13 @@ Executable bugsess
if flag(nodaq)
ghc-options: -DNODAQ
other-modules: EvalM, Parse, Types,Database,Eval,Expr, Traverse, Transform, HaskSyntaxUntyped, ValueIO, PrettyPrint, BNFC.LexBugpan, BNFC.ParBugpan, BNFC.SkelBugpan,BNFC.PrintBugpan,BNFC.LayoutBugpan ,BNFC.ErrM,UnitTesting, BNFC.AbsBugpan,BuiltIn, TypeCheck
- Build-depends: array, tnutils, probably<0.2, haskell98, process, directory, regex-posix, random, base>4.0, bytestring, binary, old-time, storablevector>0.2.4, mtl, data-binary-ieee754, SHA, mersenne-random, storable-tuple, syb, utility-ht
+ Build-depends: array, tnutils, probably, haskell98, process, directory, regex-posix, random, base>4.0, bytestring, binary, old-time, storablevector>0.2.4, mtl, data-binary-ieee754, SHA, mersenne-random, storable-tuple, syb, utility-ht
Executable buganal
-- Hs-source-dirs: prog
Main-Is: BugAnal.hs
other-modules: EvalM, Parse, Types,Database,Eval,Expr, Traverse, Transform, HaskSyntaxUntyped, ValueIO, PrettyPrint, BNFC.LexBugpan, BNFC.ParBugpan, BNFC.SkelBugpan,BNFC.PrintBugpan,BNFC.LayoutBugpan ,BNFC.ErrM,UnitTesting, BNFC.AbsBugpan,BuiltIn, TypeCheck
- Build-depends: array, tnutils, probably<0.2, haskell98, process, directory, regex-posix, random, base>4, bytestring, binary, old-time, storablevector>0.2.4, mtl, data-binary-ieee754, SHA, mersenne-random, storable-tuple, syb, utility-ht
+ Build-depends: array, tnutils, probably, haskell98, process, directory, regex-posix, random, base>4, bytestring, binary, old-time, storablevector>0.2.4, mtl, data-binary-ieee754, SHA, mersenne-random, storable-tuple, syb, utility-ht
Executable bugdriver
-- Hs-source-dirs: prog
@@ -64,11 +64,11 @@ Executable bugdriver
-- extra-lib-dirs: /usr/lib
if flag(nogl)
GHC-Options: -DNOGL
- Build-depends: array, tnutils, probably<0.2, haskell98, process, directory, regex-posix,
+ Build-depends: array, tnutils, probably, haskell98, process, directory, regex-posix,
utility-ht, random, base>4, bytestring, binary, old-time, storablevector>0.2.4,
mtl, data-binary-ieee754, stm, storable-tuple, syb, mersenne-random
else
- Build-depends: array, tnutils, probably<0.2, haskell98, process, directory, regex-posix,
+ Build-depends: array, tnutils, probably, haskell98, process, directory, regex-posix,
utility-ht, random, base>4, bytestring, binary, old-time, storablevector>0.2.4,
mtl, data-binary-ieee754, GLFW>0.3, stm, OpenGL>=2.4, storable-tuple, syb, mersenne-random
@@ -88,11 +88,11 @@ Executable runbugpan
-- ghc-options: -O2 -threaded -lcomedi Comedi/comedi_hs_helper.o
if flag(nogl)
GHC-Options: -DNOGL
- Build-depends: array, tnutils, probably<0.2, haskell98, process, directory, regex-posix,
+ Build-depends: array, tnutils, probably, haskell98, process, directory, regex-posix,
utility-ht, random, base>4, bytestring, binary, old-time, storablevector>0.2.4,
mtl, data-binary-ieee754, stm, storable-tuple, syb, mersenne-random
else
- Build-depends: array, tnutils, probably<0.2, haskell98, process, directory, regex-posix,
+ Build-depends: array, tnutils, probably, haskell98, process, directory, regex-posix,
utility-ht, random, base>4, bytestring, binary, old-time, storablevector>0.2.4,
mtl, data-binary-ieee754, GLFW>0.3, stm, OpenGL>=2.4, storable-tuple, syb, mersenne-random
View
0 keepalive 100755 → 100644
No changes.
View
0 paper/Makefile 100755 → 100644
No changes.
View
0 paper/lhs2tex-braincurry-preamble 100755 → 100644
No changes.

0 comments on commit aa43b9e

Please sign in to comment.