]> gitweb.michael.orlitzky.com - spline3.git/blob - Tetrahedron.hs
d4b7b9bb719a04653ecabb42f04b7a5d2cdf3ed4
[spline3.git] / Tetrahedron.hs
1 module Tests.Tetrahedron
2 where
3
4 import Test.HUnit
5 import Test.QuickCheck
6
7 import Comparisons
8 import Point
9 import FunctionValues
10 import Tests.FunctionValues()
11 import Tetrahedron
12 import ThreeDimensional
13
14 instance Arbitrary Tetrahedron where
15 arbitrary = do
16 rnd_v0 <- arbitrary :: Gen Point
17 rnd_v1 <- arbitrary :: Gen Point
18 rnd_v2 <- arbitrary :: Gen Point
19 rnd_v3 <- arbitrary :: Gen Point
20 rnd_fv <- arbitrary :: Gen FunctionValues
21 return (Tetrahedron rnd_fv rnd_v0 rnd_v1 rnd_v2 rnd_v3)
22
23 -- HUnit Tests
24
25 -- Since p0, p1, p2 are in clockwise order, we expect the volume here
26 -- to be negative.
27 test_volume1 :: Test
28 test_volume1 =
29 TestCase $ assertEqual "volume is correct" True (vol ~= (-1/3))
30 where
31 p0 = (0, -0.5, 0)
32 p1 = (0, 0.5, 0)
33 p2 = (2, 0, 0)
34 p3 = (1, 0, 1)
35 t = Tetrahedron { v0 = p0,
36 v1 = p1,
37 v2 = p2,
38 v3 = p3,
39 fv = empty_values }
40 vol = volume t
41
42
43 -- Now, p0, p1, and p2 are in counter-clockwise order. The volume
44 -- should therefore be positive.
45 test_volume2 :: Test
46 test_volume2 =
47 TestCase $ assertEqual "volume is correct" True (vol ~= (1/3))
48 where
49 p0 = (0, -0.5, 0)
50 p1 = (2, 0, 0)
51 p2 = (0, 0.5, 0)
52 p3 = (1, 0, 1)
53 t = Tetrahedron { v0 = p0,
54 v1 = p1,
55 v2 = p2,
56 v3 = p3,
57 fv = empty_values }
58 vol = volume t
59
60 test_contains_point1 :: Test
61 test_contains_point1 =
62 TestCase $ assertEqual "contains an inner point" True (contains_point t inner_point)
63 where
64 p0 = (0, -0.5, 0)
65 p1 = (0, 0.5, 0)
66 p2 = (2, 0, 0)
67 p3 = (1, 0, 1)
68 inner_point = (1, 0, 0.5)
69 t = Tetrahedron { v0 = p0,
70 v1 = p1,
71 v2 = p2,
72 v3 = p3,
73 fv = empty_values }
74
75
76 test_doesnt_contain_point1 :: Test
77 test_doesnt_contain_point1 =
78 TestCase $ assertEqual "doesn't contain an exterior point" False (contains_point t exterior_point)
79 where
80 p0 = (0, -0.5, 0)
81 p1 = (0, 0.5, 0)
82 p2 = (2, 0, 0)
83 p3 = (1, 0, 1)
84 exterior_point = (5, 2, -9.0212)
85 t = Tetrahedron { v0 = p0,
86 v1 = p1,
87 v2 = p2,
88 v3 = p3,
89 fv = empty_values }
90
91
92 test_doesnt_contain_point2 :: Test
93 test_doesnt_contain_point2 =
94 TestCase $ assertEqual "doesn't contain an exterior point" False (contains_point t exterior_point)
95 where
96 p0 = (0, 1, 1)
97 p1 = (1, 1, 1)
98 p2 = (0.5, 0.5, 1)
99 p3 = (0.5, 0.5, 0.5)
100 exterior_point = (0, 0, 0)
101 t = Tetrahedron { v0 = p0,
102 v1 = p1,
103 v2 = p2,
104 v3 = p3,
105 fv = empty_values }
106
107 test_doesnt_contain_point3 :: Test
108 test_doesnt_contain_point3 =
109 TestCase $ assertEqual "doesn't contain an exterior point" False (contains_point t exterior_point)
110 where
111 p0 = (1, 1, 1)
112 p1 = (1, 0, 1)
113 p2 = (0.5, 0.5, 1)
114 p3 = (0.5, 0.5, 0.5)
115 exterior_point = (0, 0, 0)
116 t = Tetrahedron { v0 = p0,
117 v1 = p1,
118 v2 = p2,
119 v3 = p3,
120 fv = empty_values }
121
122 test_doesnt_contain_point4 :: Test
123 test_doesnt_contain_point4 =
124 TestCase $ assertEqual "doesn't contain an exterior point" False (contains_point t exterior_point)
125 where
126 p0 = (1, 0, 1)
127 p1 = (0, 0, 1)
128 p2 = (0.5, 0.5, 1)
129 p3 = (0.5, 0.5, 0.5)
130 exterior_point = (0, 0, 0)
131 t = Tetrahedron { v0 = p0,
132 v1 = p1,
133 v2 = p2,
134 v3 = p3,
135 fv = empty_values }
136
137 test_doesnt_contain_point5 :: Test
138 test_doesnt_contain_point5 =
139 TestCase $ assertEqual "doesn't contain an exterior point" False (contains_point t exterior_point)
140 where
141 p0 = (0, 0, 1)
142 p1 = (0, 1, 1)
143 p2 = (0.5, 0.5, 1)
144 p3 = (0.5, 0.5, 0.5)
145 exterior_point = (0, 0, 0)
146 t = Tetrahedron { v0 = p0,
147 v1 = p1,
148 v2 = p2,
149 v3 = p3,
150 fv = empty_values }
151
152 tetrahedron_tests :: [Test]
153 tetrahedron_tests = [test_volume1,
154 test_volume2,
155 test_contains_point1,
156 test_doesnt_contain_point1,
157 test_doesnt_contain_point2,
158 test_doesnt_contain_point3,
159 test_doesnt_contain_point4,
160 test_doesnt_contain_point5 ]
161
162 prop_b0_v0_always_unity :: Tetrahedron -> Property
163 prop_b0_v0_always_unity t =
164 (volume t) > 0 ==> (b0 t) (v0 t) ~= 1.0
165
166 prop_b0_v1_always_zero :: Tetrahedron -> Property
167 prop_b0_v1_always_zero t =
168 (volume t) > 0 ==> (b0 t) (v1 t) ~= 0
169
170 prop_b0_v2_always_zero :: Tetrahedron -> Property
171 prop_b0_v2_always_zero t =
172 (volume t) > 0 ==> (b0 t) (v2 t) ~= 0
173
174 prop_b0_v3_always_zero :: Tetrahedron -> Property
175 prop_b0_v3_always_zero t =
176 (volume t) > 0 ==> (b0 t) (v3 t) ~= 0
177
178 prop_b1_v1_always_unity :: Tetrahedron -> Property
179 prop_b1_v1_always_unity t =
180 (volume t) > 0 ==> (b1 t) (v1 t) ~= 1.0
181
182 prop_b1_v0_always_zero :: Tetrahedron -> Property
183 prop_b1_v0_always_zero t =
184 (volume t) > 0 ==> (b1 t) (v0 t) ~= 0
185
186 prop_b1_v2_always_zero :: Tetrahedron -> Property
187 prop_b1_v2_always_zero t =
188 (volume t) > 0 ==> (b1 t) (v2 t) ~= 0
189
190 prop_b1_v3_always_zero :: Tetrahedron -> Property
191 prop_b1_v3_always_zero t =
192 (volume t) > 0 ==> (b1 t) (v3 t) ~= 0
193
194 prop_b2_v2_always_unity :: Tetrahedron -> Property
195 prop_b2_v2_always_unity t =
196 (volume t) > 0 ==> (b2 t) (v2 t) ~= 1.0
197
198 prop_b2_v0_always_zero :: Tetrahedron -> Property
199 prop_b2_v0_always_zero t =
200 (volume t) > 0 ==> (b2 t) (v0 t) ~= 0
201
202 prop_b2_v1_always_zero :: Tetrahedron -> Property
203 prop_b2_v1_always_zero t =
204 (volume t) > 0 ==> (b2 t) (v1 t) ~= 0
205
206 prop_b2_v3_always_zero :: Tetrahedron -> Property
207 prop_b2_v3_always_zero t =
208 (volume t) > 0 ==> (b2 t) (v3 t) ~= 0
209
210 prop_b3_v3_always_unity :: Tetrahedron -> Property
211 prop_b3_v3_always_unity t =
212 (volume t) > 0 ==> (b3 t) (v3 t) ~= 1.0
213
214 prop_b3_v0_always_zero :: Tetrahedron -> Property
215 prop_b3_v0_always_zero t =
216 (volume t) > 0 ==> (b3 t) (v0 t) ~= 0
217
218 prop_b3_v1_always_zero :: Tetrahedron -> Property
219 prop_b3_v1_always_zero t =
220 (volume t) > 0 ==> (b3 t) (v1 t) ~= 0
221
222 prop_b3_v2_always_zero :: Tetrahedron -> Property
223 prop_b3_v2_always_zero t =
224 (volume t) > 0 ==> (b3 t) (v2 t) ~= 0
225
226
227 -- Used for convenience in the next few tests.
228 p :: Tetrahedron -> Int -> Int -> Int -> Int -> Double
229 p t i j k l = (polynomial t) (xi t i j k l)
230
231 -- | Given in Sorokina and Zeilfelder, p. 78.
232 prop_c3000_identity :: Tetrahedron -> Property
233 prop_c3000_identity t =
234 (volume t) > 0 ==>
235 c t 3 0 0 0 ~= p t 3 0 0 0
236
237 -- | Given in Sorokina and Zeilfelder, p. 78.
238 prop_c2100_identity :: Tetrahedron -> Property
239 prop_c2100_identity t =
240 (volume t) > 0 ==>
241 c t 2 1 0 0 ~= (term1 - term2 + term3 - term4)
242 where
243 term1 = (1/3)*(p t 0 3 0 0)
244 term2 = (5/6)*(p t 3 0 0 0)
245 term3 = 3*(p t 2 1 0 0)
246 term4 = (3/2)*(p t 1 2 0 0)
247
248 -- | Given in Sorokina and Zeilfelder, p. 78.
249 prop_c1110_identity :: Tetrahedron -> Property
250 prop_c1110_identity t =
251 (volume t) > 0 ==>
252 c t 1 1 1 0 ~= (term1 + term2 - term3 - term4)
253 where
254 term1 = (1/3)*((p t 3 0 0 0) + (p t 0 3 0 0) + (p t 0 0 3 0))
255 term2 = (9/2)*(p t 1 1 1 0)
256 term3 = (3/4)*((p t 2 1 0 0) + (p t 1 2 0 0) + (p t 2 0 1 0))
257 term4 = (3/4)*((p t 1 0 2 0) + (p t 0 2 1 0) + (p t 0 1 2 0))