X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTetrahedron.hs;h=9f68364042e7563a3b10d23f01e72f2845ba74af;hb=4a7ea6313df073bfd41fd69552a338c7d7cd6f47;hp=d468f0c570a920fe3967fdd7e20973ef2cd9945e;hpb=c8994e4028a753c901271a1238b579a2f609707f;p=spline3.git diff --git a/src/Tetrahedron.hs b/src/Tetrahedron.hs index d468f0c..9f68364 100644 --- 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.