Remove all "otherwise -> error" cases for performance reasons.

[spline3.git] / src / Grid.hs

diff --git a/src/Grid.hs b/src/Grid.hs
index ca66437a6bb13b73d591b68d1b16d3ead8d60c89..a1058d07f2fa4c89d5bcab914e05a428dccb52f8 100644 (file)
--- a/src/Grid.hs
+++ b/src/Grid.hs
@@ -1,3 +1,4 @@
+{-# 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.
 -- | 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.


@@ -21,7 +22,7 @@ import Test.QuickCheck ((==>),
                         Positive(..),
                         Property,
                         choose)
                         Positive(..),
                         Property,
                         choose)

-import Assertions (assertAlmostEqual, assertClose, assertTrue)
+import Assertions (assertAlmostEqual, assertTrue)

 import Comparisons ((~=))
 import Cube (Cube(Cube),
              find_containing_tetrahedron,
 import Comparisons ((~=))
 import Cube (Cube(Cube),
              find_containing_tetrahedron,


@@ -29,7 +30,7 @@ import Cube (Cube(Cube),
              tetrahedron)
 import Examples (trilinear, trilinear9x9x9, zeros, naturals_1d)
 import FunctionValues (make_values, value_at)
              tetrahedron)
 import Examples (trilinear, trilinear9x9x9, zeros, naturals_1d)
 import FunctionValues (make_values, value_at)

-import Point (Point)
+import Point (Point(..))

 import ScaleFactor (ScaleFactor)
 import Tetrahedron (Tetrahedron, c, polynomial, v0, v1, v2, v3)
 import ThreeDimensional (ThreeDimensional(..))
 import ScaleFactor (ScaleFactor)
 import Tetrahedron (Tetrahedron, c, polynomial, v0, v1, v2, v3)
 import ThreeDimensional (ThreeDimensional(..))


@@ -42,7 +43,7 @@ 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 }
 --   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
 
 
 instance Arbitrary Grid where


@@ -52,33 +53,27 @@ instance Arbitrary Grid where
       return (make_grid h' fvs)
 
 
       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.
+-- | The constructor that we want people to use.
+--   Ignore non-positive grid sizes for performance.

 make_grid :: Double -> Values3D -> Grid
 make_grid :: Double -> Values3D -> Grid

-make_grid grid_size values
-    | grid_size <= 0 = error "grid size must be positive"
-    | otherwise = Grid grid_size values
+make_grid grid_size values =
+  Grid grid_size values

 
 
 
 -- | Takes a grid and a position as an argument and returns the cube
 
 
 
 -- | 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 :: 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.
 
 --   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 +99,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
 --   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
     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
       i = calculate_containing_cube_coordinate g x
       j = calculate_containing_cube_coordinate g y
       k = calculate_containing_cube_coordinate g z


@@ -127,7 +121,7 @@ zoom_result v3d (sfx, sfy, sfz) (R.Z R.:. m R.:. n R.:. o) =
     m' = (fromIntegral m) / (fromIntegral sfx) - offset
     n' = (fromIntegral n) / (fromIntegral sfy) - offset
     o' = (fromIntegral o) / (fromIntegral sfz) - offset
     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
     cube = find_containing_cube g p
     t = find_containing_tetrahedron cube p
     f = polynomial t


@@ -137,7 +131,7 @@ zoom :: Values3D -> ScaleFactor -> Values3D
 zoom v3d scale_factor
     | xsize == 0 || ysize == 0 || zsize == 0 = empty3d
     | otherwise =
 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
           where
             (xsize, ysize, zsize) = dims v3d
             transExtent = zoom_shape scale_factor


@@ -269,25 +263,25 @@ trilinear_c0_t0_tests =
 
     test_trilinear_f0_t0_v0 :: Assertion
     test_trilinear_f0_t0_v0 =
 
     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 =
 
     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 =
 
     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 =
 
     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" $
 
 
 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],
                     | i <- [0..2],
                       j <- [0..2],
                       k <- [0..2],


@@ -305,7 +299,7 @@ test_trilinear_reproduced =
 test_zeros_reproduced :: Assertion
 test_zeros_reproduced =
     assertTrue "the zero function is reproduced correctly" $
 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],
                     | i <- [0..2],
                       j <- [0..2],
                       k <- [0..2],


@@ -324,7 +318,7 @@ test_zeros_reproduced =
 test_trilinear9x9x9_reproduced :: Assertion
 test_trilinear9x9x9_reproduced =
     assertTrue "trilinear 9x9x9 is reproduced correctly" $
 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],
             | i <- [0..8],
               j <- [0..8],
               k <- [0..8],


@@ -354,7 +348,7 @@ test_tetrahedra_collision_sensitivity =
   where
     g = make_grid 1 naturals_1d
     cube = cube_at g 0 18 0
   where
     g = make_grid 1 naturals_1d
     cube = cube_at g 0 18 0

-    p = (0, 17.5, 0.5) :: Point
+    p = Point 0 17.5 0.5

     t20 = tetrahedron cube 20
 
 
     t20 = tetrahedron cube 20