-
Notifications
You must be signed in to change notification settings - Fork 8
/
Particle.hs
89 lines (75 loc) · 3.1 KB
/
Particle.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, UndecidableInstances, NoMonomorphismRestriction, StandaloneDeriving #-}
module MiniApp.Particle where
import Data.Function
import Control.Applicative
import System.Random.Mersenne.Pure64
import Mesh.Classes
import Space.Classes
import qualified Particle.Classes as P
import RandomSamples
import RandomNumbers
import Properties
import Utils.Combinators
import Approx
-- | Data type for a particle moving through a space with a
-- mesh. Indexed on the mesh itself.
data Particle mesh = Particle
{
cell :: !(MeshCell mesh) -- ^ Current cell in mesh.
, location :: !(MeshSpace mesh) -- ^ Location in mesh's space.
, time :: !Time -- ^ Elapsed Time
, energy :: !Energy -- ^ Particle energy
, weight :: !EnergyWeight -- ^ Particle's energy weight
, speed :: !Speed -- ^ Speed of motion.
, rand :: !PureMT -- ^ Source of Particle's random behavior
}
type MomentumM m = Velocity (MeshSpace m)
instance (Mesh m) => P.Particle (Particle m) where
-- | Move the particle the given distance. Assume cell and other
-- properties remain unchanged. Updating these has to be taken care of
-- by the model.
move particle distance =
let elapsedTime = goingAt distance (speed particle)
in particle{ location = (location particle) +-> distance
, time = (time particle) + elapsedTime
}
weightedEnergy :: (Mesh m) => Particle m -> Energy
weightedEnergy particle = applyWeight (weight particle) (energy particle)
weightedMomentum :: (Mesh m) => Particle m -> MomentumM m
weightedMomentum particle =
scale (location particle) (direction $ location particle) $
(engwValue $ weight particle) * (spValue $ speed particle)
deriving instance ( Mesh mesh
, Show (MeshSpace mesh)
, Show (MeshCell mesh)) => Show (Particle mesh)
sampleDistance :: (Mesh m) => Opacity -> Particle m -> (Distance, Particle m)
sampleDistance opacity particle = let
(distance, rng) = sampleExponential (1.0/(opValue opacity)) (rand particle)
particle' = particle{rand=rng}
in (Distance distance, particle')
instance (Approx (MeshSpace mesh), Mesh mesh) => Approx (Particle mesh) where
within_eps epsilon a b = close time
&& close energy
&& close location
&& close weight
&& close speed
&& exact cell
where close f = ((within_eps epsilon) `on` f) a b
exact f = f a == f b
createParticle :: (Mesh m) => m
-> (MeshSpace m)
-> Time
-> Energy
-> EnergyWeight
-> Speed
-> Seed
-> Maybe (Particle m)
createParticle mesh location time energy weight speed seed =
Particle <$> cell
<*^> location
<*^> time
<*^> energy
<*^> weight
<*^> speed
<*^> (makePureMT seed)
where cell = cell_find mesh location