find_containing_tetrahedron,
tetrahedra,
tetrahedron)
-import Examples (trilinear, trilinear9x9x9, zeros, naturals_1d)
+import Examples (trilinear, trilinear9x9x9, zeros)
import FunctionValues (make_values, value_at)
import Point (Point(..))
import ScaleFactor (ScaleFactor)
import Tetrahedron (
Tetrahedron(v0,v1,v2,v3),
c,
- contains_point,
polynomial,
)
import Values (Values3D, dims, empty3d, zoom_shape)
c0 = cube_at g 1 1 1
--- | The point 'p' in this test lies on the boundary of tetrahedra 12 and 15.
--- However, the 'contains_point' test fails due to some numerical innacuracy.
--- This bug should have been fixed by setting a positive tolerance level.
---
--- Example from before the fix:
---
--- b1 (tetrahedron c 20) (0, 17.5, 0.5)
--- -0.0
---
-test_tetrahedra_collision_sensitivity :: Assertion
-test_tetrahedra_collision_sensitivity =
- assertTrue "tetrahedron collision tests isn't too sensitive" $
- contains_point t20 p
- where
- g = make_grid 1 naturals_1d
- cube = cube_at g 0 18 0
- p = Point 0 17.5 0.5
- t20 = tetrahedron cube 20
-
prop_cube_indices_never_go_out_of_bounds :: Grid -> Gen Bool
prop_cube_indices_never_go_out_of_bounds g =
testGroup "Grid Tests" [
trilinear_c0_t0_tests,
p80_29_properties,
- testCase "tetrahedra collision test isn't too sensitive"
- test_tetrahedra_collision_sensitivity,
testProperty "cube indices within bounds"
prop_cube_indices_never_go_out_of_bounds ]
b3, -- Cube test
barycenter,
c,
- contains_point,
polynomial,
tetrahedron_properties,
tetrahedron_tests,
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 #-}
--- 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 ]