From e69710027d85a2d644d28e3e526330ad171d9983 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Sat, 27 Aug 2011 20:04:20 -0400 Subject: [PATCH] Make cube_at either return a cube or error instead of returning a (Maybe Cube). --- src/Grid.hs | 52 +++++++++++++++++++++++++------------------- src/Tests/Grid.hs | 55 +++++++++++++++++++++++------------------------ 2 files changed, 57 insertions(+), 50 deletions(-) diff --git a/src/Grid.hs b/src/Grid.hs index 8ce2430..7996319 100644 --- a/src/Grid.hs +++ b/src/Grid.hs @@ -4,6 +4,7 @@ module Grid where +import qualified Data.Array.Repa as R import Test.QuickCheck (Arbitrary(..), Gen, Positive(..)) import Cube (Cube(Cube), find_containing_tetrahedra) @@ -12,7 +13,6 @@ import Point (Point) import Tetrahedron (polynomial) import Values (Values3D, dims, empty3d, zoom_shape) -import qualified Data.Array.Repa as R -- | 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 @@ -59,17 +59,26 @@ cubes g -- | 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 return 'Nothing'. -cube_at :: Grid -> Int -> Int -> Int -> Maybe Cube +-- position is outside of the grid), it will throw an error. +cube_at :: Grid -> Int -> Int -> Int -> Cube cube_at g i j k - | i < 0 = Nothing - | j < 0 = Nothing - | k < 0 = Nothing - | k >= length (cubes g) = Nothing - | j >= length ((cubes g) !! k) = Nothing - | i >= length (((cubes g) !! k) !! j) = Nothing - | otherwise = Just $ (((cubes g) !! k) !! j) !! i - + | i < 0 = error "i < 0 in cube_at" + | j < 0 = error "j < 0 in cube_at" + | k < 0 = error "k < 0 in cube_at" + | otherwise = + let zsize = length (cubes g) in + if k >= zsize then + error "k >= xsize in cube_at" + else + let ysize = length ((cubes g) !! k) in + if j >= ysize then + error "j >= ysize in cube_at" + else + let xsize = length (((cubes g) !! k) !! j) in + if i >= xsize then + error "i >= xsize in cube_at" + else + (((cubes g) !! k) !! j) !! i -- The first cube along any axis covers (-h/2, h/2). The second @@ -96,9 +105,7 @@ calculate_containing_cube_coordinate g coord -- to check every cube. find_containing_cube :: Grid -> Point -> Cube find_containing_cube g p = - case cube_at g i j k of - Just c -> c - Nothing -> error "No cube contains the given point." + cube_at g i j k where (x, y, z) = p i = calculate_containing_cube_coordinate g x @@ -107,18 +114,19 @@ find_containing_cube g p = {-# INLINE zoom_lookup #-} -zoom_lookup :: Grid -> a -> (R.DIM3 -> Double) -zoom_lookup g _ = zoom_result g +zoom_lookup :: Grid -> Int -> a -> (R.DIM3 -> Double) +zoom_lookup g scale_factor _ = zoom_result g scale_factor {-# INLINE zoom_result #-} -zoom_result :: Grid -> R.DIM3 -> Double -zoom_result g (R.Z R.:. i R.:. j R.:. k) = +zoom_result :: Grid -> Int -> R.DIM3 -> Double +zoom_result g scale_factor (R.Z R.:. i R.:. j R.:. k) = f p where - i' = fromIntegral i - j' = fromIntegral j - k' = fromIntegral k + sf = fromIntegral scale_factor + i' = fromIntegral i / sf + j' = fromIntegral j / sf + k' = fromIntegral k / sf p = (i', j', k') :: Point c = find_containing_cube g p t = head (find_containing_tetrahedra c p) @@ -129,7 +137,7 @@ zoom :: Grid -> Int -> Values3D zoom g scale_factor | xsize == 0 || ysize == 0 || zsize == 0 = empty3d | otherwise = - R.force $ R.traverse arr transExtent (zoom_lookup g) + R.force $ R.traverse arr transExtent (zoom_lookup g scale_factor) where arr = function_values g (xsize, ysize, zsize) = dims arr diff --git a/src/Tests/Grid.hs b/src/Tests/Grid.hs index 92ba20e..3cc316a 100644 --- a/src/Tests/Grid.hs +++ b/src/Tests/Grid.hs @@ -1,7 +1,6 @@ module Tests.Grid where -import Data.Maybe (fromJust) import Test.HUnit import Assertions @@ -23,7 +22,7 @@ test_trilinear_c0030 = assertAlmostEqual "c0030 is correct" (c t 0 0 3 0) (17/8) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -35,7 +34,7 @@ test_trilinear_c0003 = assertAlmostEqual "c0003 is correct" (c t 0 0 0 3) (27/8) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -47,7 +46,7 @@ test_trilinear_c0021 = assertAlmostEqual "c0021 is correct" (c t 0 0 2 1) (61/24) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -59,7 +58,7 @@ test_trilinear_c0012 = assertAlmostEqual "c0012 is correct" (c t 0 0 1 2) (71/24) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -71,7 +70,7 @@ test_trilinear_c0120 = assertAlmostEqual "c0120 is correct" (c t 0 1 2 0) (55/24) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -83,7 +82,7 @@ test_trilinear_c0102 = assertAlmostEqual "c0102 is correct" (c t 0 1 0 2) (73/24) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -95,7 +94,7 @@ test_trilinear_c0111 = assertAlmostEqual "c0111 is correct" (c t 0 1 1 1) (8/3) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -107,7 +106,7 @@ test_trilinear_c0210 = assertAlmostEqual "c0210 is correct" (c t 0 2 1 0) (29/12) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -119,7 +118,7 @@ test_trilinear_c0201 = assertAlmostEqual "c0201 is correct" (c t 0 2 0 1) (11/4) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -131,7 +130,7 @@ test_trilinear_c0300 = assertAlmostEqual "c0300 is correct" (c t 0 3 0 0) (5/2) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -143,7 +142,7 @@ test_trilinear_c1020 = assertAlmostEqual "c1020 is correct" (c t 1 0 2 0) (8/3) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -155,7 +154,7 @@ test_trilinear_c1002 = assertAlmostEqual "c1002 is correct" (c t 1 0 0 2) (23/6) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -167,7 +166,7 @@ test_trilinear_c1011 = assertAlmostEqual "c1011 is correct" (c t 1 0 1 1) (13/4) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -179,7 +178,7 @@ test_trilinear_c1110 = assertAlmostEqual "c1110 is correct" (c t 1 1 1 0) (23/8) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -191,7 +190,7 @@ test_trilinear_c1101 = assertAlmostEqual "c1101 is correct" (c t 1 1 0 1) (27/8) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -203,7 +202,7 @@ test_trilinear_c1200 = assertAlmostEqual "c1200 is correct" (c t 1 2 0 0) 3 where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -215,7 +214,7 @@ test_trilinear_c2010 = assertAlmostEqual "c2010 is correct" (c t 2 0 1 0) (10/3) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -227,7 +226,7 @@ test_trilinear_c2001 = assertAlmostEqual "c2001 is correct" (c t 2 0 0 1) 4 where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -239,7 +238,7 @@ test_trilinear_c2100 = assertAlmostEqual "c2100 is correct" (c t 2 1 0 0) (7/2) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -251,7 +250,7 @@ test_trilinear_c3000 = assertAlmostEqual "c3000 is correct" (c t 3 0 0 0) 4 where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -263,7 +262,7 @@ test_trilinear_f0_t0_v0 = assertEqual "v0 is correct" (v0 t) (1, 1, 1) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -275,7 +274,7 @@ test_trilinear_f0_t0_v1 = assertEqual "v1 is correct" (v1 t) (0.5, 1, 1) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -287,7 +286,7 @@ test_trilinear_f0_t0_v2 = assertEqual "v2 is correct" (v2 t) (0.5, 0.5, 1.5) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -299,7 +298,7 @@ test_trilinear_f0_t0_v3 = assertClose "v3 is correct" (v3 t) (0.5, 1.5, 1.5) where g = make_grid 1 trilinear - cube = fromJust $ cube_at g 1 1 1 + cube = cube_at g 1 1 1 t = tetrahedron0 cube @@ -317,7 +316,7 @@ test_trilinear_reproduced = let k' = fromIntegral k] where g = make_grid 1 trilinear - c0 = fromJust $ cube_at g 1 1 1 + c0 = cube_at g 1 1 1 test_zeros_reproduced :: Assertion @@ -332,7 +331,7 @@ test_zeros_reproduced = let k' = fromIntegral k] where g = make_grid 1 zeros - c0 = fromJust $ cube_at g 1 1 1 + c0 = cube_at g 1 1 1 t0 = tetrahedron0 c0 p = polynomial t0 @@ -352,7 +351,7 @@ test_trilinear9x9x9_reproduced = let k' = (fromIntegral k) * 0.5] where g = make_grid 1 trilinear - c0 = fromJust $ cube_at g 1 1 1 + c0 = cube_at g 1 1 1 -- | The point 'p' in this test lies on the boundary of tetrahedra 12 and 15. -- 2.43.2