From 41ad17ad9670eb529549c50d528e59407f438e5c Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Thu, 1 Sep 2011 13:01:45 -0400 Subject: [PATCH] Replace the 'find_containing_tetrahedra' function with a more-efficient 'find_containing_tetrahedron'. --- src/Cube.hs | 164 +++++++++++++++++++++++++++++++++++++++++++++++----- src/Grid.hs | 4 +- 2 files changed, 153 insertions(+), 15 deletions(-) diff --git a/src/Cube.hs b/src/Cube.hs index 3f1669b..0122aea 100644 --- a/src/Cube.hs +++ b/src/Cube.hs @@ -1,8 +1,9 @@ module Cube where +import Data.List ( (\\) ) import Test.QuickCheck (Arbitrary(..), Gen, Positive(..), choose) - + import Cardinal import qualified Face (Face(Face, v0, v1, v2, v3)) import FunctionValues @@ -103,7 +104,7 @@ zmax c = (2*k' + 1)*delta / 2 instance ThreeDimensional Cube where -- | The center of Cube_ijk coincides with v_ijk at - -- (ih, jh, kh). See Sorokina and Zeilfelder, p. 76. + -- (ih, jh, kh). See Sorokina and Zeilfelder, p. 76. center c = (x, y, z) where delta = h c @@ -263,7 +264,9 @@ tetrahedron6 c = v1' = center (top_face c) v2' = Face.v2 (top_face c) v3' = Face.v3 (top_face c) - fv' = rotate cwy $ rotate cwz $ rotate cwz $ Tetrahedron.fv (tetrahedron0 c) + fv' = rotate cwy $ rotate cwz + $ rotate cwz + $ Tetrahedron.fv (tetrahedron0 c) tetrahedron7 :: Cube -> Tetrahedron tetrahedron7 c = @@ -293,7 +296,9 @@ tetrahedron9 c = v1' = center (back_face c) v2' = Face.v1 (back_face c) v3' = Face.v2 (back_face c) - fv' = rotate cwy $ rotate cwy $ rotate cwx $ Tetrahedron.fv (tetrahedron0 c) + fv' = rotate cwy $ rotate cwy + $ rotate cwx + $ Tetrahedron.fv (tetrahedron0 c) tetrahedron10 :: Cube -> Tetrahedron tetrahedron10 c = @@ -489,12 +494,145 @@ tetrahedra c = tetrahedron22 c, tetrahedron23 c] - --- | Takes a 'Cube', and returns all Tetrahedra belonging to it that --- contain the given 'Point'. -find_containing_tetrahedra :: Cube -> Point -> [Tetrahedron] -find_containing_tetrahedra c p = - filter contains_our_point all_tetrahedra - where - contains_our_point = flip contains_point p - all_tetrahedra = tetrahedra c +-- | All completely contained in the front half of the cube. +front_half_tetrahedra :: Cube -> [Tetrahedron] +front_half_tetrahedra c = + [tetrahedron0 c, + tetrahedron1 c, + tetrahedron2 c, + tetrahedron3 c, + tetrahedron6 c, + tetrahedron12 c, + tetrahedron19 c, + tetrahedron21 c] + + +-- | All tetrahedra completely contained in the top half of the cube. +top_half_tetrahedra :: Cube -> [Tetrahedron] +top_half_tetrahedra c = + [tetrahedron4 c, + tetrahedron5 c, + tetrahedron6 c, + tetrahedron7 c, + tetrahedron0 c, + tetrahedron10 c, + tetrahedron16 c, + tetrahedron20 c] + + +-- | All tetrahedra completely contained in the back half of the cube. +back_half_tetrahedra :: Cube -> [Tetrahedron] +back_half_tetrahedra c = + [tetrahedron8 c, + tetrahedron9 c, + tetrahedron10 c, + tetrahedron11 c, + tetrahedron4 c, + tetrahedron14 c, + tetrahedron17 c, + tetrahedron23 c] + + +-- | All tetrahedra completely contained in the down half of the cube. +down_half_tetrahedra :: Cube -> [Tetrahedron] +down_half_tetrahedra c = + [tetrahedron12 c, + tetrahedron13 c, + tetrahedron14 c, + tetrahedron15 c, + tetrahedron2 c, + tetrahedron8 c, + tetrahedron18 c, + tetrahedron22 c] + + +-- | All tetrahedra completely contained in the right half of the cube. +right_half_tetrahedra :: Cube -> [Tetrahedron] +right_half_tetrahedra c = + [tetrahedron16 c, + tetrahedron17 c, + tetrahedron18 c, + tetrahedron19 c, + tetrahedron1 c, + tetrahedron5 c, + tetrahedron9 c, + tetrahedron13 c] + + +-- | All tetrahedra completely contained in the left half of the cube. +left_half_tetrahedra :: Cube -> [Tetrahedron] +left_half_tetrahedra c = + [tetrahedron20 c, + tetrahedron21 c, + tetrahedron22 c, + tetrahedron23 c, + tetrahedron3 c, + tetrahedron7 c, + tetrahedron11 c, + tetrahedron15 c] + + +in_top_half :: Cube -> Point -> Bool +in_top_half c (_,_,z) = + distance_from_top <= distance_from_bottom + where + distance_from_top = abs $ (zmax c) - z + distance_from_bottom = abs $ (zmin c) - z + +in_front_half :: Cube -> Point -> Bool +in_front_half c (x,_,_) = + distance_from_front <= distance_from_back + where + distance_from_front = abs $ (xmin c) - x + distance_from_back = abs $ (xmax c) - x + + +in_left_half :: Cube -> Point -> Bool +in_left_half c (_,y,_) = + distance_from_left <= distance_from_right + where + distance_from_left = abs $ (ymin c) - y + distance_from_right = abs $ (ymax c) - y + + +-- | Takes a 'Cube', and returns the Tetrahedra belonging to it that +-- contain the given 'Point'. This should be faster than checking +-- every tetrahedron individually, since we determine which half +-- (hemisphere?) of the cube the point lies in three times: once in +-- each dimension. This allows us to eliminate non-candidates +-- quickly. +-- +-- This can throw an exception, but the use of 'head' might +-- save us some unnecessary computations. +-- +find_containing_tetrahedron :: Cube -> Point -> Tetrahedron +find_containing_tetrahedron c p = + head containing_tetrahedra + where + candidates = tetrahedra c + non_candidates_x = + if (in_front_half c p) then + back_half_tetrahedra c + else + front_half_tetrahedra c + + candidates_x = candidates \\ non_candidates_x + + non_candidates_y = + if (in_left_half c p) then + right_half_tetrahedra c + else + left_half_tetrahedra c + + candidates_xy = candidates_x \\ non_candidates_y + + non_candidates_z = + if (in_top_half c p) then + down_half_tetrahedra c + else + top_half_tetrahedra c + + candidates_xyz = candidates_xy \\ non_candidates_z + + contains_our_point = flip contains_point p + containing_tetrahedra = filter contains_our_point candidates_xyz diff --git a/src/Grid.hs b/src/Grid.hs index 6a9a8e5..ab698c1 100644 --- a/src/Grid.hs +++ b/src/Grid.hs @@ -7,7 +7,7 @@ where import qualified Data.Array.Repa as R import Test.QuickCheck (Arbitrary(..), Gen, Positive(..)) -import Cube (Cube(Cube), find_containing_tetrahedra) +import Cube (Cube(Cube), find_containing_tetrahedron) import FunctionValues import Point (Point) import ScaleFactor @@ -129,7 +129,7 @@ zoom_result g (sfx, sfy, sfz) (R.Z R.:. i R.:. j R.:. k) = k' = (fromIntegral k) / (fromIntegral sfz) p = (i', j', k') :: Point c = find_containing_cube g p - t = head (find_containing_tetrahedra c p) + t = find_containing_tetrahedron c p f = polynomial t -- 2.43.2