1 -- | The FunctionValues module contains the 'FunctionValues' type and
2 -- the functions used to manipulate it.
3 module FunctionValues (
10 function_values_properties,
15 import Prelude hiding (LT)
16 import Test.HUnit (Assertion)
17 import Test.Framework (Test, testGroup)
18 import Test.Framework.Providers.HUnit (testCase)
19 import Test.Framework.Providers.QuickCheck2 (testProperty)
20 import Test.QuickCheck (Arbitrary(..), choose)
22 import Assertions (assertTrue)
23 import Cardinal ( Cardinal(..), cwx, cwy, cwz )
24 import Examples (trilinear)
25 import Values (Values3D, dims, idx)
27 -- | The FunctionValues type represents the value of our function f at
28 -- the 27 points surrounding (and including) the center of a
29 -- cube. Each value of f can be accessed by the name of its
32 FunctionValues { front :: Double,
39 front_right :: Double,
50 front_left_down :: Double,
51 front_left_top :: Double,
52 front_right_down :: Double,
53 front_right_top :: Double,
54 back_left_down :: Double,
55 back_left_top :: Double,
56 back_right_down :: Double,
57 back_right_top :: Double,
62 instance Arbitrary FunctionValues where
64 front' <- choose (min_double, max_double)
65 back' <- choose (min_double, max_double)
66 left' <- choose (min_double, max_double)
67 right' <- choose (min_double, max_double)
68 top' <- choose (min_double, max_double)
69 down' <- choose (min_double, max_double)
70 front_left' <- choose (min_double, max_double)
71 front_right' <- choose (min_double, max_double)
72 front_top' <- choose (min_double, max_double)
73 front_down' <- choose (min_double, max_double)
74 back_left' <- choose (min_double, max_double)
75 back_right' <- choose (min_double, max_double)
76 back_top' <- choose (min_double, max_double)
77 back_down' <- choose (min_double, max_double)
78 left_top' <- choose (min_double, max_double)
79 left_down' <- choose (min_double, max_double)
80 right_top' <- choose (min_double, max_double)
81 right_down' <- choose (min_double, max_double)
82 front_left_top' <- choose (min_double, max_double)
83 front_left_down' <- choose (min_double, max_double)
84 front_right_top' <- choose (min_double, max_double)
85 front_right_down' <- choose (min_double, max_double)
86 back_left_top' <- choose (min_double, max_double)
87 back_left_down' <- choose (min_double, max_double)
88 back_right_top' <- choose (min_double, max_double)
89 back_right_down' <- choose (min_double, max_double)
90 interior' <- choose (min_double, max_double)
92 return empty_values { front = front',
98 front_left = front_left',
99 front_right = front_right',
100 front_top = front_top',
101 front_down = front_down',
102 back_left = back_left',
103 back_right = back_right',
104 back_top = back_top',
105 back_down = back_down',
106 left_top = left_top',
107 left_down = left_down',
108 right_top = right_top',
109 right_down = right_down',
110 front_left_top = front_left_top',
111 front_left_down = front_left_down',
112 front_right_top = front_right_top',
113 front_right_down = front_right_down',
114 back_left_top = back_left_top',
115 back_left_down = back_left_down',
116 back_right_top = back_right_top',
117 back_right_down = back_right_down',
118 interior = interior' }
120 -- | We perform addition with the function values contained in a
121 -- FunctionValues object. If we choose random doubles near the machine
122 -- min/max, we risk overflowing or underflowing the 'Double'. This
123 -- places a reasonably safe limit on the maximum size of our generated
128 -- | See 'max_double'.
130 min_double = (-1) * max_double
133 -- | Return a 'FunctionValues' with a bunch of zeros for data points.
134 empty_values :: FunctionValues
136 FunctionValues 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
139 -- | The eval function is where the magic happens for the
140 -- FunctionValues type. Given a 'Cardinal' direction and a
141 -- 'FunctionValues' object, eval will return the value of the
142 -- function f in that 'Cardinal' direction. Note that 'Cardinal' can
143 -- be a composite type; eval is what performs the \"arithmetic\" on
144 -- 'Cardinal' directions.
145 eval :: FunctionValues -> Cardinal -> Double
152 eval f FL = front_left f
153 eval f FR = front_right f
154 eval f FD = front_down f
155 eval f FT = front_top f
156 eval f BL = back_left f
157 eval f BR = back_right f
158 eval f BD = back_down f
159 eval f BT = back_top f
160 eval f LD = left_down f
161 eval f LT = left_top f
162 eval f RD = right_down f
163 eval f RT = right_top f
164 eval f FLD = front_left_down f
165 eval f FLT = front_left_top f
166 eval f FRD = front_right_down f
167 eval f FRT = front_right_top f
168 eval f BLD = back_left_down f
169 eval f BLT = back_left_top f
170 eval f BRD = back_right_down f
171 eval f BRT = back_right_top f
172 eval f I = interior f
173 eval _ (Scalar x) = x
174 eval f (Sum x y) = (eval f x) + (eval f y)
175 eval f (Difference x y) = (eval f x) - (eval f y)
176 eval f (Product x y) = (eval f x) * (eval f y)
177 eval f (Quotient x y) = (eval f x) / (eval f y)
180 -- | Takes a three-dimensional list of 'Double' and a set of 3D
181 -- coordinates (i,j,k), and returns the value at (i,j,k) in the
182 -- supplied list. If there is no such value, we calculate one
183 -- according to Sorokina and Zeilfelder, remark 7.3, p. 99.
185 -- We specifically do not consider values more than one unit away
190 -- >>> value_at Examples.trilinear 0 0 0
193 -- >>> value_at Examples.trilinear (-1) 0 0
196 -- >>> value_at Examples.trilinear 0 0 4
199 -- >>> value_at Examples.trilinear 1 3 0
202 value_at :: Values3D -> Int -> Int -> Int -> Double
204 -- Put the most common case first!
205 | (valid_i i) && (valid_j j) && (valid_k k) =
208 -- The next three are from the first line in (7.3). Analogous cases
209 -- have been added where the indices are one-too-big. These are the
210 -- "one index is bad" cases.
214 -- We're one-dimensional in our first coordinate, so just
215 -- return the data point that we do have. If we try to use
216 -- the formula from remark 7.3, we go into an infinite loop.
221 2*(value_at v3d 0 j k) - (value_at v3d 1 j k)
223 2*(value_at v3d (i-1) j k) - (value_at v3d (i-2) j k)
228 -- We're one-dimensional in our second coordinate, so just
229 -- return the data point that we do have. If we try to use
230 -- the formula from remark 7.3, we go into an infinite loop.
235 2*(value_at v3d i 0 k) - (value_at v3d i 1 k)
237 2*(value_at v3d i (j-1) k) - (value_at v3d i (j-2) k)
242 -- We're one-dimensional in our third coordinate, so just
243 -- return the data point that we do have. If we try to use
244 -- the formula from remark 7.3, we go into an infinite loop.
249 2*(value_at v3d i j 0) - (value_at v3d i j 1)
251 2*(value_at v3d i j (k-1)) - (value_at v3d i j (k-2))
257 coordstr = "(" ++ istr ++ "," ++ jstr ++ "," ++ kstr ++ ")"
259 error $ "value_at called outside of domain: " ++ coordstr
261 (dim_i, dim_j, dim_k) = dims v3d
263 valid_i :: Int -> Bool
264 valid_i i' = (i' >= 0) && (i' < dim_i)
266 valid_j :: Int -> Bool
267 valid_j j' = (j' >= 0) && (j' < dim_j)
269 valid_k :: Int -> Bool
270 valid_k k' = (k' >= 0) && (k' < dim_k)
274 -- | Given a three-dimensional list of 'Double' and a set of 3D
275 -- coordinates (i,j,k), constructs and returns the 'FunctionValues'
276 -- object centered at (i,j,k)
277 make_values :: Values3D -> Int -> Int -> Int -> FunctionValues
278 make_values values i j k =
279 empty_values { front = value_at values (i-1) j k,
280 back = value_at values (i+1) j k,
281 left = value_at values i (j-1) k,
282 right = value_at values i (j+1) k,
283 down = value_at values i j (k-1),
284 top = value_at values i j (k+1),
285 front_left = value_at values (i-1) (j-1) k,
286 front_right = value_at values (i-1) (j+1) k,
287 front_down =value_at values (i-1) j (k-1),
288 front_top = value_at values (i-1) j (k+1),
289 back_left = value_at values (i+1) (j-1) k,
290 back_right = value_at values (i+1) (j+1) k,
291 back_down = value_at values (i+1) j (k-1),
292 back_top = value_at values (i+1) j (k+1),
293 left_down = value_at values i (j-1) (k-1),
294 left_top = value_at values i (j-1) (k+1),
295 right_down = value_at values i (j+1) (k-1),
296 right_top = value_at values i (j+1) (k+1),
297 front_left_down = value_at values (i-1) (j-1) (k-1),
298 front_left_top = value_at values (i-1) (j-1) (k+1),
299 front_right_down = value_at values (i-1) (j+1) (k-1),
300 front_right_top = value_at values (i-1) (j+1) (k+1),
301 back_left_down = value_at values (i+1) (j-1) (k-1),
302 back_left_top = value_at values (i+1) (j-1) (k+1),
303 back_right_down = value_at values (i+1) (j+1) (k-1),
304 back_right_top = value_at values (i+1) (j+1) (k+1),
305 interior = value_at values i j k }
307 -- | Takes a 'FunctionValues' and a function that transforms one
308 -- 'Cardinal' to another (called a rotation). Then it applies the
309 -- rotation to each element of the 'FunctionValues' object, and
310 -- returns the result.
311 rotate :: (Cardinal -> Cardinal) -> FunctionValues -> FunctionValues
313 FunctionValues { front = eval fv (rotation F),
314 back = eval fv (rotation B),
315 left = eval fv (rotation L),
316 right = eval fv (rotation R),
317 down = eval fv (rotation D),
318 top = eval fv (rotation T),
319 front_left = eval fv (rotation FL),
320 front_right = eval fv (rotation FR),
321 front_down = eval fv (rotation FD),
322 front_top = eval fv (rotation FT),
323 back_left = eval fv (rotation BL),
324 back_right = eval fv (rotation BR),
325 back_down = eval fv (rotation BD),
326 back_top = eval fv (rotation BT),
327 left_down = eval fv (rotation LD),
328 left_top = eval fv (rotation LT),
329 right_down = eval fv (rotation RD),
330 right_top = eval fv (rotation RT),
331 front_left_down = eval fv (rotation FLD),
332 front_left_top = eval fv (rotation FLT),
333 front_right_down = eval fv (rotation FRD),
334 front_right_top = eval fv (rotation FRT),
335 back_left_down = eval fv (rotation BLD),
336 back_left_top = eval fv (rotation BLT),
337 back_right_down = eval fv (rotation BRD),
338 back_right_top = eval fv (rotation BRT),
339 interior = interior fv }
343 -- | Ensure that the trilinear values wind up where we think they
345 test_directions :: Assertion
347 assertTrue "all direction functions work" (and equalities)
349 fvs = make_values trilinear 1 1 1
350 equalities = [ interior fvs == 4,
358 front_right fvs == 1,
362 back_right fvs == 11,
369 front_left_down fvs == 1,
370 front_left_top fvs == 1,
371 front_right_down fvs == 1,
372 front_right_top fvs == 1,
373 back_left_down fvs == 3,
374 back_left_top fvs == 3,
375 back_right_down fvs == 7,
376 back_right_top fvs == 15]
379 function_values_tests :: Test.Framework.Test
380 function_values_tests =
381 testGroup "FunctionValues Tests"
382 [ testCase "test directions" test_directions ]
385 prop_x_rotation_doesnt_affect_front :: FunctionValues -> Bool
386 prop_x_rotation_doesnt_affect_front fv0 =
393 prop_x_rotation_doesnt_affect_back :: FunctionValues -> Bool
394 prop_x_rotation_doesnt_affect_back fv0 =
402 prop_y_rotation_doesnt_affect_left :: FunctionValues -> Bool
403 prop_y_rotation_doesnt_affect_left fv0 =
410 prop_y_rotation_doesnt_affect_right :: FunctionValues -> Bool
411 prop_y_rotation_doesnt_affect_right fv0 =
419 prop_z_rotation_doesnt_affect_down :: FunctionValues -> Bool
420 prop_z_rotation_doesnt_affect_down fv0 =
428 prop_z_rotation_doesnt_affect_top :: FunctionValues -> Bool
429 prop_z_rotation_doesnt_affect_top fv0 =
437 function_values_properties :: Test.Framework.Test
438 function_values_properties =
439 let tp = testProperty
441 testGroup "FunctionValues Properties" [
442 tp "x rotation doesn't affect front" prop_x_rotation_doesnt_affect_front,
443 tp "x rotation doesn't affect back" prop_x_rotation_doesnt_affect_back,
444 tp "y rotation doesn't affect left" prop_y_rotation_doesnt_affect_left,
445 tp "y rotation doesn't affect right" prop_y_rotation_doesnt_affect_right,
446 tp "z rotation doesn't affect top" prop_z_rotation_doesnt_affect_top,
447 tp "z rotation doesn't affect down" prop_z_rotation_doesnt_affect_down ]