X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTetrahedron.hs;h=2a4227a7f1bbee2d10a99baa66a07904e1e16c15;hb=c02ac1bf9295e4ead58e9294af7f883a6fdcf119;hp=0ea0ffb7b1f5743c0fd0f174b7b7f6d9dac86258;hpb=f0f481c02b007a086bd09b05dacb6d603dff6c12;p=spline3.git diff --git a/src/Tetrahedron.hs b/src/Tetrahedron.hs index 0ea0ffb..2a4227a 100644 --- a/src/Tetrahedron.hs +++ b/src/Tetrahedron.hs @@ -5,7 +5,9 @@ module Tetrahedron ( b1, -- Cube test b2, -- Cube test b3, -- Cube test + barycenter, c, + contains_point, polynomial, tetrahedron_properties, tetrahedron_tests, @@ -30,7 +32,6 @@ import FunctionValues (FunctionValues(..), empty_values) import Misc (factorial) import Point (Point(..), scale) import RealFunction (RealFunction, cmult, fexp) -import ThreeDimensional (ThreeDimensional(..)) data Tetrahedron = Tetrahedron { function_values :: FunctionValues, @@ -67,34 +68,40 @@ instance Show Tetrahedron where " v3: " ++ (show (v3 t)) ++ "\n" -instance ThreeDimensional Tetrahedron where - center (Tetrahedron _ v0' v1' v2' v3' _) = - (v0' + v1' + v2' + v3') `scale` (1/4) - - -- contains_point is only used in tests. - contains_point t p0 = - b0_unscaled `nearly_ge` 0 && - b1_unscaled `nearly_ge` 0 && - b2_unscaled `nearly_ge` 0 && - b3_unscaled `nearly_ge` 0 +-- | Find the barycenter of the given tetrahedron. +-- We just average the four vertices. +barycenter :: Tetrahedron -> Point +barycenter (Tetrahedron _ v0' v1' v2' v3' _) = + (v0' + v1' + v2' + v3') `scale` (1/4) + +-- | A point is internal to a tetrahedron if all of its barycentric +-- coordinates with respect to that tetrahedron are non-negative. +contains_point :: Tetrahedron -> Point -> Bool +contains_point t p0 = + b0_unscaled `nearly_ge` 0 && + b1_unscaled `nearly_ge` 0 && + b2_unscaled `nearly_ge` 0 && + b3_unscaled `nearly_ge` 0 + where + -- Drop the useless division and volume calculation that we + -- would do if we used the regular b0,..b3 functions. + b0_unscaled :: Double + b0_unscaled = volume inner_tetrahedron where - -- Drop the useless division and volume calculation that we - -- would do if we used the regular b0,..b3 functions. - b0_unscaled :: Double - b0_unscaled = volume inner_tetrahedron - where inner_tetrahedron = t { v0 = p0 } + inner_tetrahedron = t { v0 = p0 } + + b1_unscaled :: Double + b1_unscaled = volume inner_tetrahedron + where inner_tetrahedron = t { v1 = p0 } - b1_unscaled :: Double - b1_unscaled = volume inner_tetrahedron - where inner_tetrahedron = t { v1 = p0 } + b2_unscaled :: Double + b2_unscaled = volume inner_tetrahedron + where inner_tetrahedron = t { v2 = p0 } - b2_unscaled :: Double - b2_unscaled = volume inner_tetrahedron - where inner_tetrahedron = t { v2 = p0 } + b3_unscaled :: Double + b3_unscaled = volume inner_tetrahedron + where inner_tetrahedron = t { v3 = p0 } - b3_unscaled :: Double - b3_unscaled = volume inner_tetrahedron - where inner_tetrahedron = t { v3 = p0 } {-# INLINE polynomial #-} polynomial :: Tetrahedron -> (RealFunction Point) @@ -125,10 +132,8 @@ polynomial t = -- | The Bernstein polynomial on t with indices i,j,k,l. Denoted by a -- capital 'B' in the Sorokina/Zeilfelder paper. beta :: Tetrahedron -> Int -> Int -> Int -> Int -> (RealFunction Point) -beta t i j k l - | (i + j + k + l == 3) = - coefficient `cmult` (b0_term * b1_term * b2_term * b3_term) - | otherwise = error "basis function index out of bounds" +beta t i j k l = + coefficient `cmult` (b0_term * b1_term * b2_term * b3_term) where denominator = (factorial i)*(factorial j)*(factorial k)*(factorial l) coefficient = 6 / (fromIntegral denominator) @@ -141,8 +146,8 @@ beta t i j k l -- | The coefficient function. c t i j k l returns the coefficient -- c_ijkl with respect to the tetrahedron t. The definition uses -- pattern matching to mimic the definitions given in Sorokina and --- Zeilfelder, pp. 84-86. If incorrect indices are supplied, the --- function will simply error. +-- Zeilfelder, pp. 84-86. If incorrect indices are supplied, the world +-- will end. This is for performance reasons. c :: Tetrahedron -> Int -> Int -> Int -> Int -> Double c !t !i !j !k !l = coefficient i j k l @@ -271,8 +276,6 @@ c !t !i !j !k !l = + (1/96)*(lt + fl + ft + rt + bt + fr) + (1/96)*(fd + ld + bd + br + rd + bl) - coefficient _ _ _ _ = error "coefficient index out of bounds" - -- | Compute the determinant of the 4x4 matrix, @@ -310,20 +313,8 @@ det p0 p1 p2 p3 = -- page 436. {-# INLINE volume #-} volume :: Tetrahedron -> Double -volume t - | v0' == v1' = 0 - | v0' == v2' = 0 - | v0' == v3' = 0 - | v1' == v2' = 0 - | v1' == v3' = 0 - | v2' == v3' = 0 - | otherwise = (1/6)*(det v0' v1' v2' v3') - where - v0' = v0 t - v1' = v1 t - v2' = v2 t - v3' = v3 t - +volume (Tetrahedron _ v0' v1' v2' v3' _) = + (1/6)*(det v0' v1' v2' v3') -- | The barycentric coordinates of a point with respect to v0. {-# INLINE b0 #-} @@ -646,9 +637,8 @@ p78_24_properties = where -- | Returns the domain point of t with indices i,j,k,l. domain_point :: Tetrahedron -> Int -> Int -> Int -> Int -> Point - domain_point t i j k l - | i + j + k + l == 3 = weighted_sum `scale` (1/3) - | otherwise = error "domain point index out of bounds" + domain_point t i j k l = + weighted_sum `scale` (1/3) where v0' = (v0 t) `scale` (fromIntegral i) v1' = (v1 t) `scale` (fromIntegral j)