Broken commit.

Trying to write functions which use both the Direction and Velocity
members of the space class. GHC is not able to match the expected and derived types.

src/MiniApp/Model.hs

@@ -27,10 +27,6 @@ import MiniApp.Physics
 import MiniApp.Tally
 
 
--- | We usually need the weighted particle momentum 
-weightedMomentum :: (Mesh m) => Particle m -> Momentum (MeshSpace m)
-weightedMomentum particle = undefined
-
 -- * Aliases for the MonteCarlo types.
 
 type Outcome m    = MC.Outcome    (Event m) (Particle m)

src/MiniApp/Particle.hs

@@ -24,11 +24,14 @@ data (Mesh mesh) => Particle mesh = Particle
     , location     :: !(MeshSpace mesh) -- ^ Location in mesh's space.
     , time         :: !Time             -- ^ Elapsed Time
     , energy       :: !Energy           -- ^ Particle energy
-    , weight       :: !EnergyWeight     -- ^ Particle's significance weighting
+    , 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
@@ -42,6 +45,10 @@ instance (Mesh m) => P.Particle (Particle m) where
 weightedEnergy :: (Mesh m) => Particle m -> Energy
 weightedEnergy particle = applyWeight (weight particle) (energy particle)
 
+weightedMomentum :: (Space (MeshSpace m), Mesh m) => Particle m -> MomentumM m
+weightedMomentum particle = scale (direction $ location particle) $
+                            (engwValue $ weight particle)*(spValue $ speed particle) 
+
 deriving instance ( Mesh mesh
                   , Show (MeshSpace mesh)
                   , Show (MeshCell mesh)) => Show (Particle mesh)

src/MiniApp/Tally.hs

@@ -19,7 +19,7 @@ import MiniApp.Particle
 
 -- * Aliases
 
-type MomentumM m = Momentum (MeshSpace m)
+type MomentumM m = Velocity (MeshSpace m)
 
 
 -- * Tally data structures

src/MonteCarlo.hs

@@ -25,7 +25,7 @@ import Properties
 
 -- | Outcomes are a distance to an event, the event and the next
 -- particle state.
-data Outcome e p = Outcome { distance :: Distance
+data Outcome e p = Outcome { distance :: !Distance -- ^ Strict, becuase we use it to select winners.
                            , event    :: e
                            , particle :: p
                            }
@@ -42,6 +42,11 @@ result :: Outcome ev part -> (ev, part)
 result (Outcome _ event particle) = (event, particle)
 
 
+-- ??? Just use Outcome instead of (event, particle) elsewhere?  This
+-- doesn't seem any more restritive than requiring apps to use the
+-- Contractor type and (e,p). The higher level functions can still be
+-- written polymorphicaly over the tally, particle and outcome types.
+
 
 -- | Contractors are functions which take a model, a particle and
 -- return a candidate Outcome for stepping the particle.
@@ -68,10 +73,6 @@ stream stepper continue p = next p
           let (e, p') = stepper p
           in  (e, p') : if continue e then next p' else []
 
-
-streamMany :: (p -> [(e,p)]) -> [p] -> [[(e,p)]]
-streamMany = map
-
-createTally :: ( (e,p) -> t -> (e,p) ) -> t -> [(e,p)] -> t
-createTally = foldl
-
+executeMC :: (p->o) -> (o->t) -> (t->t->t) -> [p] -> t
+executeMC stream collapse combine initial =
+    foldl1 combine (map (collapse . stream) initial)

src/Space/Classes.hs

@@ -8,11 +8,11 @@ import Approx ()
 class Space s where
   type Position  s :: *
   type Direction s :: *
-  type Momentum  s :: *
+  type Velocity  s :: *
   stream    :: s -> Distance -> s
   position  :: s -> Position s
   direction :: s -> Direction s
-  scale     :: Direction s -> Double -> Momentum s
+  scale     :: Direction s -> Double -> Velocity s
   make      :: Position s -> Direction s -> s
 
 -- | Infix operator for streaming.

src/Space/Spherical1D.hs

@@ -42,7 +42,7 @@ type Spherical1D = Vector2
 instance Space Spherical1D where
     type Position  Spherical1D = Radius
     type Direction Spherical1D = Normalized Vector2
-    type Momentum  Spherical1D = Vector2
+    type Velocity  Spherical1D = Vector2
     stream (Vector2 x y) (Distance d) = Vector2 (x+d) y
     position s  = Radius $ vmag s
     direction s = normalize s