X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FGrid.hs;fp=src%2FGrid.hs;h=26f44251d4a5f08612317788afa223cb723a24e2;hb=d9eed953bd810f6928de536617dc21121a8a645b;hp=66275491fd5c58d64fd0db110c15702211862b1a;hpb=4d82669d840c49e162f1101ddd9a25c5f3234f92;p=spline3.git diff --git a/src/Grid.hs b/src/Grid.hs index 6627549..26f4425 100644 --- a/src/Grid.hs +++ b/src/Grid.hs @@ -1,7 +1,6 @@ {-# 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 contains the Grid type, its tests, and the 'zoom' +-- function used to build the interpolation. module Grid ( cube_at, grid_tests, @@ -18,7 +17,6 @@ import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck ((==>), Arbitrary(..), Gen, - Positive(..), Property, choose) import Assertions (assertAlmostEqual, assertTrue) @@ -40,19 +38,18 @@ import Values (Values3D, dims, empty3d, zoom_shape) -- | Our problem is defined on a Grid. The grid size is given by the --- positive number h. The function values are the values of the --- function at the grid points, which are distance h from one --- another in each direction (x,y,z). -data Grid = Grid { h :: Double, -- MUST BE GREATER THAN ZERO! - function_values :: Values3D } +-- positive number h, which we have defined to always be 1 for +-- performance reasons (and simplicity). The function values are the +-- values of the function at the grid points, which are distance h=1 +-- from one another in each direction (x,y,z). +data Grid = Grid { function_values :: Values3D } deriving (Show) instance Arbitrary Grid where arbitrary = do - (Positive h') <- arbitrary :: Gen (Positive Double) fvs <- arbitrary :: Gen Values3D - return $ Grid h' fvs + return $ Grid fvs @@ -62,19 +59,18 @@ instance Arbitrary Grid where -- does improve performance. cube_at :: Grid -> Int -> Int -> Int -> Cube cube_at !g !i !j !k = - Cube delta i j k fvs' tet_vol + Cube 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)) + tet_vol = 1/24 --- 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 (-1/2, 1/2). The second +-- covers (1/2, 3/2). The third, (3/2, 5/2), and so on. -- --- We translate the (x,y,z) coordinates forward by 'h/2' so that the --- first covers (0, h), the second covers (h, 2h), etc. This makes +-- We translate the (x,y,z) coordinates forward by 1/2 so that the +-- first covers (0, 1), the second covers (1, 2), etc. This makes -- it easy to figure out which cube contains the given point. calculate_containing_cube_coordinate :: Grid -> Double -> Int calculate_containing_cube_coordinate g coord @@ -83,11 +79,10 @@ calculate_containing_cube_coordinate g coord -- exists. | coord < offset = 0 | coord == offset && (xsize > 1 && ysize > 1 && zsize > 1) = 1 - | otherwise = (ceiling ( (coord + offset) / cube_width )) - 1 + | otherwise = (ceiling (coord + offset)) - 1 where (xsize, ysize, zsize) = dims (function_values g) - cube_width = (h g) - offset = cube_width / 2 + offset = 1/2 -- | Takes a 'Grid', and returns a 'Cube' containing the given 'Point'. @@ -111,8 +106,8 @@ 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 = Grid 1 v3d - offset = (h g)/2 + g = Grid v3d + offset = 1/2 m' = (fromIntegral m) / (fromIntegral sfx) - offset n' = (fromIntegral n) / (fromIntegral sfy) - offset o' = (fromIntegral o) / (fromIntegral sfz) - offset @@ -172,7 +167,7 @@ trilinear_c0_t0_tests = testCase "v3 is correct" test_trilinear_f0_t0_v3] ] where - g = Grid 1 trilinear + g = Grid trilinear cube = cube_at g 1 1 1 t = tetrahedron cube 0 @@ -287,7 +282,7 @@ test_trilinear_reproduced = let j' = fromIntegral j, let k' = fromIntegral k] where - g = Grid 1 trilinear + g = Grid trilinear cs = [ cube_at g ci cj ck | ci <- [0..2], cj <- [0..2], ck <- [0..2] ] @@ -305,7 +300,7 @@ test_zeros_reproduced = t0 <- tetrahedra c0, let p = polynomial t0 ] where - g = Grid 1 zeros + g = Grid zeros cs = [ cube_at g ci cj ck | ci <- [0..2], cj <- [0..2], ck <- [0..2] ] @@ -323,7 +318,7 @@ test_trilinear9x9x9_reproduced = let j' = (fromIntegral j) * 0.5, let k' = (fromIntegral k) * 0.5] where - g = Grid 1 trilinear + g = Grid trilinear c0 = cube_at g 1 1 1 @@ -331,13 +326,12 @@ test_trilinear9x9x9_reproduced = prop_cube_indices_never_go_out_of_bounds :: Grid -> Gen Bool prop_cube_indices_never_go_out_of_bounds g = do - let delta = Grid.h g - let coordmin = negate (delta/2) + let coordmin = negate (1/2) let (xsize, ysize, zsize) = dims $ function_values g - let xmax = delta*(fromIntegral xsize) - (delta/2) - let ymax = delta*(fromIntegral ysize) - (delta/2) - let zmax = delta*(fromIntegral zsize) - (delta/2) + let xmax = (fromIntegral xsize) - (1/2) + let ymax = (fromIntegral ysize) - (1/2) + let zmax = (fromIntegral zsize) - (1/2) x <- choose (coordmin, xmax) y <- choose (coordmin, ymax)