]> gitweb.michael.orlitzky.com - spline3.git/blob - FunctionValues.hs
3694f03c5ba0aa6aa5c56df85b90eddb321a1939
[spline3.git] / FunctionValues.hs
1 module Tests.FunctionValues
2 where
3
4 import Test.HUnit
5 import Test.QuickCheck
6
7 import Assertions
8 import Examples
9 import FunctionValues
10
11 -- | We perform addition with the function values contained in a
12 -- FunctionValues object. If we choose random doubles near the machine
13 -- min/max, we risk overflowing or underflowing the 'Double'. This
14 -- places a reasonably safe limit on the maximum size of our generated
15 -- 'Double' members.
16 max_double :: Double
17 max_double = 10000.0
18
19 -- | See 'max_double'.
20 min_double :: Double
21 min_double = (-1) * max_double
22
23
24 instance Arbitrary FunctionValues where
25 arbitrary = do
26 front' <- choose (min_double, max_double)
27 back' <- choose (min_double, max_double)
28 left' <- choose (min_double, max_double)
29 right' <- choose (min_double, max_double)
30 top' <- choose (min_double, max_double)
31 down' <- choose (min_double, max_double)
32 front_left' <- choose (min_double, max_double)
33 front_right' <- choose (min_double, max_double)
34 front_top' <- choose (min_double, max_double)
35 front_down' <- choose (min_double, max_double)
36 back_left' <- choose (min_double, max_double)
37 back_right' <- choose (min_double, max_double)
38 back_top' <- choose (min_double, max_double)
39 back_down' <- choose (min_double, max_double)
40 left_top' <- choose (min_double, max_double)
41 left_down' <- choose (min_double, max_double)
42 right_top' <- choose (min_double, max_double)
43 right_down' <- choose (min_double, max_double)
44 front_left_top' <- choose (min_double, max_double)
45 front_left_down' <- choose (min_double, max_double)
46 front_right_top' <- choose (min_double, max_double)
47 front_right_down' <- choose (min_double, max_double)
48 back_left_top' <- choose (min_double, max_double)
49 back_left_down' <- choose (min_double, max_double)
50 back_right_top' <- choose (min_double, max_double)
51 back_right_down' <- choose (min_double, max_double)
52 interior' <- choose (min_double, max_double)
53
54 return empty_values { front = front',
55 back = back',
56 left = left',
57 right = right',
58 top = top',
59 down = down',
60 front_left = front_left',
61 front_right = front_right',
62 front_top = front_top',
63 front_down = front_down',
64 back_left = back_left',
65 back_right = back_right',
66 back_top = back_top',
67 back_down = back_down',
68 left_top = left_top',
69 left_down = left_down',
70 right_top = right_top',
71 right_down = right_down',
72 front_left_top = front_left_top',
73 front_left_down = front_left_down',
74 front_right_top = front_right_top',
75 front_right_down = front_right_down',
76 back_left_top = back_left_top',
77 back_left_down = back_left_down',
78 back_right_top = back_right_top',
79 back_right_down = back_right_down',
80 interior = interior' }
81
82
83
84
85 test_directions :: Test
86 test_directions =
87 TestCase $ assertTrue "all direction functions work" (and equalities)
88 where
89 fvs = make_values trilinear 1 1 1
90 equalities = [ interior fvs == 4,
91 front fvs == 1,
92 back fvs == 7,
93 left fvs == 2,
94 right fvs == 6,
95 down fvs == 3,
96 top fvs == 5,
97 front_left fvs == 1,
98 front_right fvs == 1,
99 front_down fvs == 1,
100 front_top fvs == 1,
101 back_left fvs == 3,
102 back_right fvs == 11,
103 back_down fvs == 5,
104 back_top fvs == 9,
105 left_down fvs == 2,
106 left_top fvs == 2,
107 right_down fvs == 4,
108 right_top fvs == 8,
109 front_left_down fvs == 1,
110 front_left_top fvs == 1,
111 front_right_down fvs == 1,
112 front_right_top fvs == 1,
113 back_left_down fvs == 3,
114 back_left_top fvs == 3,
115 back_right_down fvs == 7,
116 back_right_top fvs == 15]
117
118 function_values_tests :: [Test]
119 function_values_tests = [test_directions]