]> gitweb.michael.orlitzky.com - spline3.git/blob - src/FunctionValues.hs
Remove the Tetrahedron 'number' field from tests.
[spline3.git] / src / FunctionValues.hs
1 -- | The FunctionValues module contains the 'FunctionValues' type and
2 -- the functions used to manipulate it.
3 module FunctionValues (
4 FunctionValues,
5 empty_values,
6 eval,
7 make_values,
8 rotate,
9 function_values_tests,
10 function_values_properties,
11 value_at
12 )
13 where
14
15 import Prelude hiding (LT)
16 import Test.HUnit
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)
21
22 import Assertions (assertTrue)
23 import Cardinal ( Cardinal(..), cwx, cwy, cwz )
24 import Examples (trilinear)
25 import Values (Values3D, dims, idx)
26
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
30 -- direction.
31 data FunctionValues =
32 FunctionValues { front :: Double,
33 back :: Double,
34 left :: Double,
35 right :: Double,
36 top :: Double,
37 down :: Double,
38 front_left :: Double,
39 front_right :: Double,
40 front_down :: Double,
41 front_top :: Double,
42 back_left :: Double,
43 back_right :: Double,
44 back_down :: Double,
45 back_top :: Double,
46 left_down :: Double,
47 left_top :: Double,
48 right_down :: Double,
49 right_top :: 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,
58 interior :: Double }
59 deriving (Eq, Show)
60
61
62 instance Arbitrary FunctionValues where
63 arbitrary = do
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)
91
92 return empty_values { front = front',
93 back = back',
94 left = left',
95 right = right',
96 top = top',
97 down = down',
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' }
119 where
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
124 -- 'Double' members.
125 max_double :: Double
126 max_double = 10000.0
127
128 -- | See 'max_double'.
129 min_double :: Double
130 min_double = (-1) * max_double
131
132
133 -- | Return a 'FunctionValues' with a bunch of zeros for data points.
134 empty_values :: FunctionValues
135 empty_values =
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
137
138 -- | The eval function is where the magic happens for the
139 -- FunctionValues type. Given a 'Cardinal' direction and a
140 -- 'FunctionValues' object, eval will return the value of the
141 -- function f in that 'Cardinal' direction. Note that 'Cardinal' can
142 -- be a composite type; eval is what performs the \"arithmetic\" on
143 -- 'Cardinal' directions.
144 eval :: FunctionValues -> Cardinal -> Double
145 eval f F = front f
146 eval f B = back f
147 eval f L = left f
148 eval f R = right f
149 eval f T = top f
150 eval f D = down f
151 eval f FL = front_left f
152 eval f FR = front_right f
153 eval f FD = front_down f
154 eval f FT = front_top f
155 eval f BL = back_left f
156 eval f BR = back_right f
157 eval f BD = back_down f
158 eval f BT = back_top f
159 eval f LD = left_down f
160 eval f LT = left_top f
161 eval f RD = right_down f
162 eval f RT = right_top f
163 eval f FLD = front_left_down f
164 eval f FLT = front_left_top f
165 eval f FRD = front_right_down f
166 eval f FRT = front_right_top f
167 eval f BLD = back_left_down f
168 eval f BLT = back_left_top f
169 eval f BRD = back_right_down f
170 eval f BRT = back_right_top f
171 eval f I = interior f
172 eval _ (Scalar x) = x
173 eval f (Sum x y) = (eval f x) + (eval f y)
174 eval f (Difference x y) = (eval f x) - (eval f y)
175 eval f (Product x y) = (eval f x) * (eval f y)
176 eval f (Quotient x y) = (eval f x) / (eval f y)
177
178 -- | Takes a three-dimensional list of 'Double' and a set of 3D
179 -- coordinates (i,j,k), and returns the value at (i,j,k) in the
180 -- supplied list. If there is no such value, we choose a nearby
181 -- point and use its value.
182 --
183 -- Examples:
184 --
185 -- >>> value_at Examples.trilinear 0 0 0
186 -- 1.0
187 --
188 -- >>> value_at Examples.trilinear (-1) 0 0
189 -- 1.0
190 --
191 -- >>> value_at Examples.trilinear 0 0 4
192 -- 1.0
193 --
194 -- >>> value_at Examples.trilinear 1 3 0
195 -- 4.0
196 --
197 value_at :: Values3D -> Int -> Int -> Int -> Double
198 value_at v3d i j k
199 | i < 0 = value_at v3d 0 j k
200 | j < 0 = value_at v3d i 0 k
201 | k < 0 = value_at v3d i j 0
202 | xsize <= i = value_at v3d (xsize - 1) j k
203 | ysize <= j = value_at v3d i (ysize - 1) k
204 | zsize <= k = value_at v3d i j (zsize - 1)
205 | otherwise = idx v3d i j k
206 where
207 (xsize, ysize, zsize) = dims v3d
208
209
210 -- | Given a three-dimensional list of 'Double' and a set of 3D
211 -- coordinates (i,j,k), constructs and returns the 'FunctionValues'
212 -- object centered at (i,j,k)
213 make_values :: Values3D -> Int -> Int -> Int -> FunctionValues
214 make_values values i j k =
215 empty_values { front = value_at values (i-1) j k,
216 back = value_at values (i+1) j k,
217 left = value_at values i (j-1) k,
218 right = value_at values i (j+1) k,
219 down = value_at values i j (k-1),
220 top = value_at values i j (k+1),
221 front_left = value_at values (i-1) (j-1) k,
222 front_right = value_at values (i-1) (j+1) k,
223 front_down =value_at values (i-1) j (k-1),
224 front_top = value_at values (i-1) j (k+1),
225 back_left = value_at values (i+1) (j-1) k,
226 back_right = value_at values (i+1) (j+1) k,
227 back_down = value_at values (i+1) j (k-1),
228 back_top = value_at values (i+1) j (k+1),
229 left_down = value_at values i (j-1) (k-1),
230 left_top = value_at values i (j-1) (k+1),
231 right_down = value_at values i (j+1) (k-1),
232 right_top = value_at values i (j+1) (k+1),
233 front_left_down = value_at values (i-1) (j-1) (k-1),
234 front_left_top = value_at values (i-1) (j-1) (k+1),
235 front_right_down = value_at values (i-1) (j+1) (k-1),
236 front_right_top = value_at values (i-1) (j+1) (k+1),
237 back_left_down = value_at values (i+1) (j-1) (k-1),
238 back_left_top = value_at values (i+1) (j-1) (k+1),
239 back_right_down = value_at values (i+1) (j+1) (k-1),
240 back_right_top = value_at values (i+1) (j+1) (k+1),
241 interior = value_at values i j k }
242
243 -- | Takes a 'FunctionValues' and a function that transforms one
244 -- 'Cardinal' to another (called a rotation). Then it applies the
245 -- rotation to each element of the 'FunctionValues' object, and
246 -- returns the result.
247 rotate :: (Cardinal -> Cardinal) -> FunctionValues -> FunctionValues
248 rotate rotation fv =
249 FunctionValues { front = eval fv (rotation F),
250 back = eval fv (rotation B),
251 left = eval fv (rotation L),
252 right = eval fv (rotation R),
253 down = eval fv (rotation D),
254 top = eval fv (rotation T),
255 front_left = eval fv (rotation FL),
256 front_right = eval fv (rotation FR),
257 front_down = eval fv (rotation FD),
258 front_top = eval fv (rotation FT),
259 back_left = eval fv (rotation BL),
260 back_right = eval fv (rotation BR),
261 back_down = eval fv (rotation BD),
262 back_top = eval fv (rotation BT),
263 left_down = eval fv (rotation LD),
264 left_top = eval fv (rotation LT),
265 right_down = eval fv (rotation RD),
266 right_top = eval fv (rotation RT),
267 front_left_down = eval fv (rotation FLD),
268 front_left_top = eval fv (rotation FLT),
269 front_right_down = eval fv (rotation FRD),
270 front_right_top = eval fv (rotation FRT),
271 back_left_down = eval fv (rotation BLD),
272 back_left_top = eval fv (rotation BLT),
273 back_right_down = eval fv (rotation BRD),
274 back_right_top = eval fv (rotation BRT),
275 interior = interior fv }
276
277
278
279 -- | Ensure that the trilinear values wind up where we think they
280 -- should.
281 test_directions :: Assertion
282 test_directions =
283 assertTrue "all direction functions work" (and equalities)
284 where
285 fvs = make_values trilinear 1 1 1
286 equalities = [ interior fvs == 4,
287 front fvs == 1,
288 back fvs == 7,
289 left fvs == 2,
290 right fvs == 6,
291 down fvs == 3,
292 top fvs == 5,
293 front_left fvs == 1,
294 front_right fvs == 1,
295 front_down fvs == 1,
296 front_top fvs == 1,
297 back_left fvs == 3,
298 back_right fvs == 11,
299 back_down fvs == 5,
300 back_top fvs == 9,
301 left_down fvs == 2,
302 left_top fvs == 2,
303 right_down fvs == 4,
304 right_top fvs == 8,
305 front_left_down fvs == 1,
306 front_left_top fvs == 1,
307 front_right_down fvs == 1,
308 front_right_top fvs == 1,
309 back_left_down fvs == 3,
310 back_left_top fvs == 3,
311 back_right_down fvs == 7,
312 back_right_top fvs == 15]
313
314
315 function_values_tests :: Test.Framework.Test
316 function_values_tests =
317 testGroup "FunctionValues Tests"
318 [ testCase "test directions" test_directions ]
319
320
321 prop_x_rotation_doesnt_affect_front :: FunctionValues -> Bool
322 prop_x_rotation_doesnt_affect_front fv0 =
323 expr1 == expr2
324 where
325 fv1 = rotate cwx fv0
326 expr1 = front fv0
327 expr2 = front fv1
328
329 prop_x_rotation_doesnt_affect_back :: FunctionValues -> Bool
330 prop_x_rotation_doesnt_affect_back fv0 =
331 expr1 == expr2
332 where
333 fv1 = rotate cwx fv0
334 expr1 = back fv0
335 expr2 = back fv1
336
337
338 prop_y_rotation_doesnt_affect_left :: FunctionValues -> Bool
339 prop_y_rotation_doesnt_affect_left fv0 =
340 expr1 == expr2
341 where
342 fv1 = rotate cwy fv0
343 expr1 = left fv0
344 expr2 = left fv1
345
346 prop_y_rotation_doesnt_affect_right :: FunctionValues -> Bool
347 prop_y_rotation_doesnt_affect_right fv0 =
348 expr1 == expr2
349 where
350 fv1 = rotate cwy fv0
351 expr1 = right fv0
352 expr2 = right fv1
353
354
355 prop_z_rotation_doesnt_affect_down :: FunctionValues -> Bool
356 prop_z_rotation_doesnt_affect_down fv0 =
357 expr1 == expr2
358 where
359 fv1 = rotate cwz fv0
360 expr1 = down fv0
361 expr2 = down fv1
362
363
364 prop_z_rotation_doesnt_affect_top :: FunctionValues -> Bool
365 prop_z_rotation_doesnt_affect_top fv0 =
366 expr1 == expr2
367 where
368 fv1 = rotate cwz fv0
369 expr1 = top fv0
370 expr2 = top fv1
371
372
373 function_values_properties :: Test.Framework.Test
374 function_values_properties =
375 let tp = testProperty
376 in
377 testGroup "FunctionValues Properties" [
378 tp "x rotation doesn't affect front" prop_x_rotation_doesnt_affect_front,
379 tp "x rotation doesn't affect back" prop_x_rotation_doesnt_affect_back,
380 tp "y rotation doesn't affect left" prop_y_rotation_doesnt_affect_left,
381 tp "y rotation doesn't affect right" prop_y_rotation_doesnt_affect_right,
382 tp "z rotation doesn't affect top" prop_z_rotation_doesnt_affect_top,
383 tp "z rotation doesn't affect down" prop_z_rotation_doesnt_affect_down ]