Replace the 'find_containing_tetrahedra' function with a more-efficient 'find_contain...

diff --git a/src/Cube.hs b/src/Cube.hs
index 3f1669b619a5cbbb0ee262bd6b5f63b4c4a24355..0122aea298157326439dafebbabb0109ed758476 100644 (file)
--- 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 6a9a8e5edd9ee62907a1486e29c25b334bedc041..ab698c1ba537a96a7971fbd8b2505548bfde9c30 100644 (file)
--- 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