X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FGrid.hs;h=624dd840672eb598eed7f574adffb7169f47da50;hb=34bd61af15ba657cdbca796ed14c1798907f8635;hp=0131a64b8460ad42010346b4a87ae3a4d6482f99;hpb=de6759db987b07efdd5bf1f238f2d0d9eb8d3d4c;p=spline3.git

diff --git a/src/Grid.hs b/src/Grid.hs
index 0131a64..624dd84 100644
--- a/src/Grid.hs
+++ b/src/Grid.hs
@@ -1,17 +1,17 @@
+{-# LANGUAGE BangPatterns #-}
 -- | The Grid module just contains the Grid type and two constructors
 --   for it. We hide the main Grid constructor because we don't want
 --   to allow instantiation of a grid with h <= 0.
 module Grid (
   cube_at,
   grid_tests,
-  make_grid,
   slow_tests,
   zoom
   )
 where
 
 import qualified Data.Array.Repa as R
-import Test.HUnit
+import Test.HUnit (Assertion, assertEqual)
 import Test.Framework (Test, testGroup)
 import Test.Framework.Providers.HUnit (testCase)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
@@ -21,18 +21,21 @@ import Test.QuickCheck ((==>),
                         Positive(..),
                         Property,
                         choose)
-import Assertions
-import Comparisons
+import Assertions (assertAlmostEqual, assertTrue)
+import Comparisons ((~=))
 import Cube (Cube(Cube),
              find_containing_tetrahedron,
              tetrahedra,
              tetrahedron)
-import Examples
-import FunctionValues
-import Point (Point)
-import ScaleFactor
-import Tetrahedron (Tetrahedron, c, polynomial, v0, v1, v2, v3)
-import ThreeDimensional
+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,
+  polynomial,
+  )
 import Values (Values3D, dims, empty3d, zoom_shape)
 
 
@@ -42,43 +45,30 @@ import Values (Values3D, dims, empty3d, zoom_shape)
 --   another in each direction (x,y,z).
 data Grid = Grid { h :: Double, -- MUST BE GREATER THAN ZERO!
                    function_values :: Values3D }
-          deriving (Eq, Show)
+          deriving (Show)
 
 
 instance Arbitrary Grid where
     arbitrary = do
       (Positive h') <- arbitrary :: Gen (Positive Double)
       fvs <- arbitrary :: Gen Values3D
-      return (make_grid h' fvs)
-
-
--- | The constructor that we want people to use. If we're passed a
---   non-positive grid size, we throw an error.
-make_grid :: Double -> Values3D -> Grid
-make_grid grid_size values
-    | grid_size <= 0 = error "grid size must be positive"
-    | otherwise = Grid grid_size values
+      return $ Grid h' fvs
 
 
 
 -- | Takes a grid and a position as an argument and returns the cube
---   centered on that position. If there is no cube there (i.e. the
---   position is outside of the grid), it will throw an error.
+--   centered on that position. If there is no cube there, well, you
+--   shouldn't have done that. The omitted "otherwise" case actually
+--   does improve performance.
 cube_at :: Grid -> Int -> Int -> Int -> Cube
-cube_at g i j k
-    | i < 0      = error "i < 0 in cube_at"
-    | i >= xsize = error "i >= xsize in cube_at"
-    | j < 0      = error "j < 0 in cube_at"
-    | j >= ysize = error "j >= ysize in cube_at"
-    | k < 0      = error "k < 0 in cube_at"
-    | k >= zsize = error "k >= zsize in cube_at"
-    | otherwise = Cube delta i j k fvs' tet_vol
-      where
-        fvs = function_values g
-        (xsize, ysize, zsize) = dims fvs
-        fvs' = make_values fvs i j k
-        delta = h g
-        tet_vol = (1/24)*(delta^(3::Int))
+cube_at !g !i !j !k =
+   Cube delta i j k fvs' tet_vol
+   where
+     fvs = function_values g
+     fvs' = make_values fvs i j k
+     delta = h g
+     tet_vol = (1/24)*(delta^(3::Int))
+
 
 --   The first cube along any axis covers (-h/2, h/2). The second
 --   covers (h/2, 3h/2).  The third, (3h/2, 5h/2), and so on.
@@ -104,10 +94,9 @@ calculate_containing_cube_coordinate g coord
 --   Since our grid is rectangular, we can figure this out without having
 --   to check every cube.
 find_containing_cube :: Grid -> Point -> Cube
-find_containing_cube g p =
+find_containing_cube g (Point x y z) =
     cube_at g i j k
     where
-      (x, y, z) = p
       i = calculate_containing_cube_coordinate g x
       j = calculate_containing_cube_coordinate g y
       k = calculate_containing_cube_coordinate g z
@@ -122,12 +111,12 @@ zoom_result :: Values3D -> ScaleFactor -> R.DIM3 -> Double
 zoom_result v3d (sfx, sfy, sfz) (R.Z R.:. m R.:. n R.:. o) =
   f p
   where
-    g = make_grid 1 v3d
+    g = Grid 1 v3d
     offset = (h g)/2
     m' = (fromIntegral m) / (fromIntegral sfx) - offset
     n' = (fromIntegral n) / (fromIntegral sfy) - offset
     o' = (fromIntegral o) / (fromIntegral sfz) - offset
-    p  = (m', n', o') :: Point
+    p  = Point m' n' o'
     cube = find_containing_cube g p
     t = find_containing_tetrahedron cube p
     f = polynomial t
@@ -137,7 +126,7 @@ zoom :: Values3D -> ScaleFactor -> Values3D
 zoom v3d scale_factor
     | xsize == 0 || ysize == 0 || zsize == 0 = empty3d
     | otherwise =
-        R.force $ R.unsafeTraverse v3d transExtent f
+        R.compute $ R.unsafeTraverse v3d transExtent f
           where
             (xsize, ysize, zsize) = dims v3d
             transExtent = zoom_shape scale_factor
@@ -183,7 +172,7 @@ trilinear_c0_t0_tests =
        testCase "v3 is correct" test_trilinear_f0_t0_v3]
     ]
   where
-    g = make_grid 1 trilinear
+    g = Grid 1 trilinear
     cube = cube_at g 1 1 1
     t = tetrahedron cube 0
 
@@ -269,25 +258,25 @@ trilinear_c0_t0_tests =
 
     test_trilinear_f0_t0_v0 :: Assertion
     test_trilinear_f0_t0_v0 =
-      assertEqual "v0 is correct" (v0 t) (1, 1, 1)
+      assertEqual "v0 is correct" (v0 t) (Point 1 1 1)
 
     test_trilinear_f0_t0_v1 :: Assertion
     test_trilinear_f0_t0_v1 =
-      assertEqual "v1 is correct" (v1 t) (0.5, 1, 1)
+      assertEqual "v1 is correct" (v1 t) (Point 0.5 1 1)
 
     test_trilinear_f0_t0_v2 :: Assertion
     test_trilinear_f0_t0_v2 =
-      assertEqual "v2 is correct" (v2 t) (0.5, 0.5, 1.5)
+      assertEqual "v2 is correct" (v2 t) (Point 0.5 0.5 1.5)
 
     test_trilinear_f0_t0_v3 :: Assertion
     test_trilinear_f0_t0_v3 =
-      assertClose "v3 is correct" (v3 t) (0.5, 1.5, 1.5)
+      assertEqual "v3 is correct" (v3 t) (Point 0.5 1.5 1.5)
 
 
 test_trilinear_reproduced :: Assertion
 test_trilinear_reproduced =
     assertTrue "trilinears are reproduced correctly" $
-             and [p (i', j', k') ~= value_at trilinear i j k
+             and [p (Point i' j' k') ~= value_at trilinear i j k
                     | i <- [0..2],
                       j <- [0..2],
                       k <- [0..2],
@@ -298,14 +287,14 @@ test_trilinear_reproduced =
                       let j' = fromIntegral j,
                       let k' = fromIntegral k]
     where
-      g = make_grid 1 trilinear
+      g = Grid 1 trilinear
       cs = [ cube_at g ci cj ck | ci <- [0..2], cj <- [0..2], ck <- [0..2] ]
 
 
 test_zeros_reproduced :: Assertion
 test_zeros_reproduced =
     assertTrue "the zero function is reproduced correctly" $
-             and [p (i', j', k') ~= value_at zeros i j k
+             and [p (Point i' j' k') ~= value_at zeros i j k
                     | i <- [0..2],
                       j <- [0..2],
                       k <- [0..2],
@@ -316,7 +305,7 @@ test_zeros_reproduced =
                       t0 <- tetrahedra c0,
                       let p = polynomial t0 ]
     where
-      g = make_grid 1 zeros
+      g = Grid 1 zeros
       cs = [ cube_at g ci cj ck | ci <- [0..2], cj <- [0..2], ck <- [0..2] ]
 
 
@@ -324,7 +313,7 @@ test_zeros_reproduced =
 test_trilinear9x9x9_reproduced :: Assertion
 test_trilinear9x9x9_reproduced =
     assertTrue "trilinear 9x9x9 is reproduced correctly" $
-      and [p (i', j', k') ~= value_at trilinear9x9x9 i j k
+      and [p (Point i' j' k') ~= value_at trilinear9x9x9 i j k
             | i <- [0..8],
               j <- [0..8],
               k <- [0..8],
@@ -334,29 +323,10 @@ test_trilinear9x9x9_reproduced =
               let j' = (fromIntegral j) * 0.5,
               let k' = (fromIntegral k) * 0.5]
     where
-      g = make_grid 1 trilinear
+      g = Grid 1 trilinear
       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 = (0, 17.5, 0.5) :: Point
-    t20 = tetrahedron cube 20
-
 
 prop_cube_indices_never_go_out_of_bounds :: Grid -> Gen Bool
 prop_cube_indices_never_go_out_of_bounds g =
@@ -497,8 +467,6 @@ grid_tests =
     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 ]