b3, -- Cube test
barycenter,
c,
- contains_point,
polynomial,
tetrahedron_properties,
tetrahedron_tests,
import Test.HUnit (Assertion, assertEqual)
import Test.QuickCheck (Arbitrary(..), Gen, Property, (==>))
-import Comparisons ((~=), nearly_ge)
+import Comparisons ((~=))
import FunctionValues (FunctionValues(..), empty_values)
import Misc (factorial)
import Point (Point(..), scale)
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
- inner_tetrahedron = t { v0 = 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 }
-
- b3_unscaled :: Double
- b3_unscaled = volume inner_tetrahedron
- where inner_tetrahedron = t { v3 = p0 }
{-# INLINE polynomial #-}
-- 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 #-}
--- Tests
-
-
-- | Check the volume of a particular tetrahedron (computed by hand)
--- and whether or not it contains a specific point chosen to be
--- outside of it. Its vertices are in clockwise order, so the volume
--- should be negative.
+-- Its vertices are in clockwise order, so the volume should be
+-- negative.
tetrahedron1_geometry_tests :: Test.Framework.Test
tetrahedron1_geometry_tests =
testGroup "tetrahedron1 geometry"
- [ testCase "volume1" volume1,
- testCase "doesn't contain point1" doesnt_contain_point1]
+ [ testCase "volume1" volume1 ]
where
p0 = Point 0 (-0.5) 0
p1 = Point 0 0.5 0
where
vol = volume t
- doesnt_contain_point1 :: Assertion
- doesnt_contain_point1 =
- assertEqual "doesn't contain an exterior point" False contained
- where
- exterior_point = Point 5 2 (-9.0212)
- contained = contains_point t exterior_point
-
-- | Check the volume of a particular tetrahedron (computed by hand)
--- and whether or not it contains a specific point chosen to be
--- inside of it. Its vertices are in counter-clockwise order, so the
--- volume should be positive.
+-- Its vertices are in counter-clockwise order, so the volume should
+-- be positive.
tetrahedron2_geometry_tests :: Test.Framework.Test
tetrahedron2_geometry_tests =
testGroup "tetrahedron2 geometry"
- [ testCase "volume1" volume1,
- testCase "contains point1" contains_point1]
+ [ testCase "volume1" volume1 ]
where
p0 = Point 0 (-0.5) 0
p1 = Point 2 0 0
where
vol = volume t
- contains_point1 :: Assertion
- contains_point1 = assertEqual "contains an inner point" True contained
- where
- inner_point = Point 1 0 0.5
- contained = contains_point t inner_point
-
-
--- | Ensure that tetrahedra do not contain a particular point chosen to
--- be outside of them.
-containment_tests :: Test.Framework.Test
-containment_tests =
- testGroup "containment tests"
- [ testCase "doesn't contain point2" doesnt_contain_point2,
- testCase "doesn't contain point3" doesnt_contain_point3,
- testCase "doesn't contain point4" doesnt_contain_point4,
- testCase "doesn't contain point5" doesnt_contain_point5]
- where
- p2 = Point 0.5 0.5 1
- p3 = Point 0.5 0.5 0.5
- exterior_point = Point 0 0 0
-
- doesnt_contain_point2 :: Assertion
- doesnt_contain_point2 =
- assertEqual "doesn't contain an exterior point" False contained
- where
- p0 = Point 0 1 1
- p1 = Point 1 1 1
- t = Tetrahedron { v0 = p0,
- v1 = p1,
- v2 = p2,
- v3 = p3,
- function_values = empty_values,
- precomputed_volume = 0 }
- contained = contains_point t exterior_point
-
-
- doesnt_contain_point3 :: Assertion
- doesnt_contain_point3 =
- assertEqual "doesn't contain an exterior point" False contained
- where
- p0 = Point 1 1 1
- p1 = Point 1 0 1
- t = Tetrahedron { v0 = p0,
- v1 = p1,
- v2 = p2,
- v3 = p3,
- function_values = empty_values,
- precomputed_volume = 0 }
- contained = contains_point t exterior_point
-
-
- doesnt_contain_point4 :: Assertion
- doesnt_contain_point4 =
- assertEqual "doesn't contain an exterior point" False contained
- where
- p0 = Point 1 0 1
- p1 = Point 0 0 1
- t = Tetrahedron { v0 = p0,
- v1 = p1,
- v2 = p2,
- v3 = p3,
- function_values = empty_values,
- precomputed_volume = 0 }
- contained = contains_point t exterior_point
-
-
- doesnt_contain_point5 :: Assertion
- doesnt_contain_point5 =
- assertEqual "doesn't contain an exterior point" False contained
- where
- p0 = Point 0 0 1
- p1 = Point 0 1 1
- t = Tetrahedron { v0 = p0,
- v1 = p1,
- v2 = p2,
- v3 = p3,
- function_values = empty_values,
- precomputed_volume = 0 }
- contained = contains_point t exterior_point
-- | The barycentric coordinate of v0 with respect to itself should
tetrahedron_tests =
testGroup "Tetrahedron Tests" [
tetrahedron1_geometry_tests,
- tetrahedron2_geometry_tests,
- containment_tests ]
+ tetrahedron2_geometry_tests ]
testProperty "b3_v0_always_zero" prop_b3_v0_always_zero,
testProperty "b3_v1_always_zero" prop_b3_v1_always_zero,
testProperty "b3_v2_always_zero" prop_b3_v2_always_zero,
- testProperty "swapping_vertices_doesnt_affect_coefficients1" $
+ testProperty "swapping_vertices_doesnt_affect_coefficients1"
prop_swapping_vertices_doesnt_affect_coefficients1,
- testProperty "swapping_vertices_doesnt_affect_coefficients2" $
+ testProperty "swapping_vertices_doesnt_affect_coefficients2"
prop_swapping_vertices_doesnt_affect_coefficients2,
- testProperty "swapping_vertices_doesnt_affect_coefficients3" $
+ testProperty "swapping_vertices_doesnt_affect_coefficients3"
prop_swapping_vertices_doesnt_affect_coefficients3,
- testProperty "swapping_vertices_doesnt_affect_coefficients4" $
+ testProperty "swapping_vertices_doesnt_affect_coefficients4"
prop_swapping_vertices_doesnt_affect_coefficients4 ]
projects / spline3.git / blobdiff