Add some convenience functions to write chunks/slices to bitmaps.

[spline3.git] / src / Tetrahedron.hs

diff --git a/src/Tetrahedron.hs b/src/Tetrahedron.hs
index d468f0c570a920fe3967fdd7e20973ef2cd9945e..9f68364042e7563a3b10d23f01e72f2845ba74af 100644 (file)
--- a/src/Tetrahedron.hs
+++ b/src/Tetrahedron.hs
@@ -1,9 +1,14 @@
 module Tetrahedron
 where
 
+import qualified Data.Vector as V (
+  singleton,
+  snoc,
+  sum
+  )
 import Numeric.LinearAlgebra hiding (i, scale)
 import Prelude hiding (LT)
-import Test.QuickCheck (Arbitrary(..), Gen, choose)
+import Test.QuickCheck (Arbitrary(..), Gen)
 
 import Cardinal
 import Comparisons (nearly_ge)
@@ -19,12 +24,7 @@ data Tetrahedron =
                 v1 :: Point,
                 v2 :: Point,
                 v3 :: Point,
-                precomputed_volume :: Double,
-
-                -- | Between 0 and 23; used to quickly determine which
-                --   tetrahedron I am in the parent 'Cube' without
-                --   having to compare them all.
-                number :: Int
+                precomputed_volume :: Double
               }
     deriving (Eq)
 
@@ -36,13 +36,12 @@ instance Arbitrary Tetrahedron where
       rnd_v2 <- arbitrary :: Gen Point
       rnd_v3 <- arbitrary :: Gen Point
       rnd_fv <- arbitrary :: Gen FunctionValues
-      rnd_no <- choose (0,23)
 
       -- We can't assign an incorrect precomputed volume,
       -- so we have to calculate the correct one here.
-      let t' = Tetrahedron rnd_fv rnd_v0 rnd_v1 rnd_v2 rnd_v3 0 rnd_no
+      let t' = Tetrahedron rnd_fv rnd_v0 rnd_v1 rnd_v2 rnd_v3 0
       let vol = volume t'
-      return (Tetrahedron rnd_fv rnd_v0 rnd_v1 rnd_v2 rnd_v3 vol rnd_no)
+      return (Tetrahedron rnd_fv rnd_v0 rnd_v1 rnd_v2 rnd_v3 vol)
 
 
 instance Show Tetrahedron where
@@ -55,7 +54,9 @@ instance Show Tetrahedron where
 
 
 instance ThreeDimensional Tetrahedron where
-    center t = ((v0 t) + (v1 t) + (v2 t) + (v3 t)) `scale` (1/4)
+    center (Tetrahedron _ v0' v1' v2' v3' _) =
+        (v0' + v1' + v2' + v3') `scale` (1/4)
+
     contains_point t p =
       b0_unscaled `nearly_ge` 0 &&
       b1_unscaled `nearly_ge` 0 &&
@@ -83,11 +84,26 @@ instance ThreeDimensional Tetrahedron where
 
 polynomial :: Tetrahedron -> (RealFunction Point)
 polynomial t =
-    sum [ (c t i j k l) `cmult` (beta t i j k l) | i <- [0..3],
-                                                   j <- [0..3],
-                                                   k <- [0..3],
-                                                   l <- [0..3],
-                                                   i + j + k + l == 3]
+    V.sum $ V.singleton ((c t 0 0 0 3) `cmult` (beta t 0 0 0 3)) `V.snoc`
+            ((c t 0 0 1 2) `cmult` (beta t 0 0 1 2)) `V.snoc`
+            ((c t 0 0 2 1) `cmult` (beta t 0 0 2 1)) `V.snoc`
+            ((c t 0 0 3 0) `cmult` (beta t 0 0 3 0)) `V.snoc`
+            ((c t 0 1 0 2) `cmult` (beta t 0 1 0 2)) `V.snoc`
+            ((c t 0 1 1 1) `cmult` (beta t 0 1 1 1)) `V.snoc`
+            ((c t 0 1 2 0) `cmult` (beta t 0 1 2 0)) `V.snoc`
+            ((c t 0 2 0 1) `cmult` (beta t 0 2 0 1)) `V.snoc`
+            ((c t 0 2 1 0) `cmult` (beta t 0 2 1 0)) `V.snoc`
+            ((c t 0 3 0 0) `cmult` (beta t 0 3 0 0)) `V.snoc`
+            ((c t 1 0 0 2) `cmult` (beta t 1 0 0 2)) `V.snoc`
+            ((c t 1 0 1 1) `cmult` (beta t 1 0 1 1)) `V.snoc`
+            ((c t 1 0 2 0) `cmult` (beta t 1 0 2 0)) `V.snoc`
+            ((c t 1 1 0 1) `cmult` (beta t 1 1 0 1)) `V.snoc`
+            ((c t 1 1 1 0) `cmult` (beta t 1 1 1 0)) `V.snoc`
+            ((c t 1 2 0 0) `cmult` (beta t 1 2 0 0)) `V.snoc`
+            ((c t 2 0 0 1) `cmult` (beta t 2 0 0 1)) `V.snoc`
+            ((c t 2 0 1 0) `cmult` (beta t 2 0 1 0)) `V.snoc`
+            ((c t 2 1 0 0) `cmult` (beta t 2 1 0 0)) `V.snoc`
+            ((c t 3 0 0 0) `cmult` (beta t 3 0 0 0))
 
 
 -- | Returns the domain point of t with indices i,j,k,l.