4 import Data.List ( (\\) )
5 import Test.QuickCheck (Arbitrary(..), Gen, Positive(..), choose)
8 import qualified Face (Face(Face, v0, v1, v2, v3))
11 import Tetrahedron hiding (c)
12 import ThreeDimensional
14 data Cube = Cube { h :: Double,
18 fv :: FunctionValues }
22 instance Arbitrary Cube where
24 (Positive h') <- arbitrary :: Gen (Positive Double)
25 i' <- choose (coordmin, coordmax)
26 j' <- choose (coordmin, coordmax)
27 k' <- choose (coordmin, coordmax)
28 fv' <- arbitrary :: Gen FunctionValues
29 return (Cube h' i' j' k' fv')
31 coordmin = -268435456 -- -(2^29 / 2)
32 coordmax = 268435456 -- +(2^29 / 2)
35 instance Show Cube where
37 "Cube_" ++ subscript ++ "\n" ++
38 " h: " ++ (show (h c)) ++ "\n" ++
39 " Center: " ++ (show (center c)) ++ "\n" ++
40 " xmin: " ++ (show (xmin c)) ++ "\n" ++
41 " xmax: " ++ (show (xmax c)) ++ "\n" ++
42 " ymin: " ++ (show (ymin c)) ++ "\n" ++
43 " ymax: " ++ (show (ymax c)) ++ "\n" ++
44 " zmin: " ++ (show (zmin c)) ++ "\n" ++
45 " zmax: " ++ (show (zmax c)) ++ "\n" ++
46 " fv: " ++ (show (Cube.fv c)) ++ "\n"
49 (show (i c)) ++ "," ++ (show (j c)) ++ "," ++ (show (k c))
52 -- | Returns an empty 'Cube'.
54 empty_cube = Cube 0 0 0 0 empty_values
57 -- | The left-side boundary of the cube. See Sorokina and Zeilfelder,
59 xmin :: Cube -> Double
60 xmin c = (2*i' - 1)*delta / 2
62 i' = fromIntegral (i c) :: Double
65 -- | The right-side boundary of the cube. See Sorokina and Zeilfelder,
67 xmax :: Cube -> Double
68 xmax c = (2*i' + 1)*delta / 2
70 i' = fromIntegral (i c) :: Double
73 -- | The front boundary of the cube. See Sorokina and Zeilfelder,
75 ymin :: Cube -> Double
76 ymin c = (2*j' - 1)*delta / 2
78 j' = fromIntegral (j c) :: Double
81 -- | The back boundary of the cube. See Sorokina and Zeilfelder,
83 ymax :: Cube -> Double
84 ymax c = (2*j' + 1)*delta / 2
86 j' = fromIntegral (j c) :: Double
89 -- | The bottom boundary of the cube. See Sorokina and Zeilfelder,
91 zmin :: Cube -> Double
92 zmin c = (2*k' - 1)*delta / 2
94 k' = fromIntegral (k c) :: Double
97 -- | The top boundary of the cube. See Sorokina and Zeilfelder,
99 zmax :: Cube -> Double
100 zmax c = (2*k' + 1)*delta / 2
102 k' = fromIntegral (k c) :: Double
105 instance ThreeDimensional Cube where
106 -- | The center of Cube_ijk coincides with v_ijk at
107 -- (ih, jh, kh). See Sorokina and Zeilfelder, p. 76.
111 i' = fromIntegral (i c) :: Double
112 j' = fromIntegral (j c) :: Double
113 k' = fromIntegral (k c) :: Double
118 -- | It's easy to tell if a point is within a cube; just make sure
119 -- that it falls on the proper side of each of the cube's faces.
120 contains_point c (x, y, z)
121 | x < (xmin c) = False
122 | x > (xmax c) = False
123 | y < (ymin c) = False
124 | y > (ymax c) = False
125 | z < (zmin c) = False
126 | z > (zmax c) = False
133 -- | The top (in the direction of z) face of the cube.
134 top_face :: Cube -> Face.Face
135 top_face c = Face.Face v0' v1' v2' v3'
138 v0' = (center c) + (delta, -delta, delta)
139 v1' = (center c) + (delta, delta, delta)
140 v2' = (center c) + (-delta, delta, delta)
141 v3' = (center c) + (-delta, -delta, delta)
145 -- | The back (in the direction of x) face of the cube.
146 back_face :: Cube -> Face.Face
147 back_face c = Face.Face v0' v1' v2' v3'
150 v0' = (center c) + (delta, -delta, -delta)
151 v1' = (center c) + (delta, delta, -delta)
152 v2' = (center c) + (delta, delta, delta)
153 v3' = (center c) + (delta, -delta, delta)
156 -- The bottom face (in the direction of -z) of the cube.
157 down_face :: Cube -> Face.Face
158 down_face c = Face.Face v0' v1' v2' v3'
161 v0' = (center c) + (-delta, -delta, -delta)
162 v1' = (center c) + (-delta, delta, -delta)
163 v2' = (center c) + (delta, delta, -delta)
164 v3' = (center c) + (delta, -delta, -delta)
168 -- | The front (in the direction of -x) face of the cube.
169 front_face :: Cube -> Face.Face
170 front_face c = Face.Face v0' v1' v2' v3'
173 v0' = (center c) + (-delta, -delta, delta)
174 v1' = (center c) + (-delta, delta, delta)
175 v2' = (center c) + (-delta, delta, -delta)
176 v3' = (center c) + (-delta, -delta, -delta)
178 -- | The left (in the direction of -y) face of the cube.
179 left_face :: Cube -> Face.Face
180 left_face c = Face.Face v0' v1' v2' v3'
183 v0' = (center c) + (delta, -delta, delta)
184 v1' = (center c) + (-delta, -delta, delta)
185 v2' = (center c) + (-delta, -delta, -delta)
186 v3' = (center c) + (delta, -delta, -delta)
189 -- | The right (in the direction of y) face of the cube.
190 right_face :: Cube -> Face.Face
191 right_face c = Face.Face v0' v1' v2' v3'
194 v0' = (center c) + (-delta, delta, delta)
195 v1' = (center c) + (delta, delta, delta)
196 v2' = (center c) + (delta, delta, -delta)
197 v3' = (center c) + (-delta, delta, -delta)
200 tetrahedron0 :: Cube -> Tetrahedron
202 Tetrahedron (Cube.fv c) v0' v1' v2' v3' vol
205 v1' = center (front_face c)
206 v2' = Face.v0 (front_face c)
207 v3' = Face.v1 (front_face c)
210 tetrahedron1 :: Cube -> Tetrahedron
212 Tetrahedron fv' v0' v1' v2' v3' vol
215 v1' = center (front_face c)
216 v2' = Face.v1 (front_face c)
217 v3' = Face.v2 (front_face c)
218 fv' = rotate ccwx (Cube.fv c)
221 tetrahedron2 :: Cube -> Tetrahedron
223 Tetrahedron fv' v0' v1' v2' v3' vol
226 v1' = center (front_face c)
227 v2' = Face.v2 (front_face c)
228 v3' = Face.v3 (front_face c)
229 fv' = rotate ccwx $ rotate ccwx $ Cube.fv c
232 tetrahedron3 :: Cube -> Tetrahedron
234 Tetrahedron fv' v0' v1' v2' v3' vol
237 v1' = center (front_face c)
238 v2' = Face.v3 (front_face c)
239 v3' = Face.v0 (front_face c)
240 fv' = rotate cwx (Cube.fv c)
243 tetrahedron4 :: Cube -> Tetrahedron
245 Tetrahedron fv' v0' v1' v2' v3' vol
248 v1' = center (top_face c)
249 v2' = Face.v0 (top_face c)
250 v3' = Face.v1 (top_face c)
251 fv' = rotate cwy (Cube.fv c)
254 tetrahedron5 :: Cube -> Tetrahedron
256 Tetrahedron fv' v0' v1' v2' v3' vol
259 v1' = center (top_face c)
260 v2' = Face.v1 (top_face c)
261 v3' = Face.v2 (top_face c)
262 fv' = rotate cwy $ rotate cwz $ Tetrahedron.fv (tetrahedron0 c)
265 tetrahedron6 :: Cube -> Tetrahedron
267 Tetrahedron fv' v0' v1' v2' v3' vol
270 v1' = center (top_face c)
271 v2' = Face.v2 (top_face c)
272 v3' = Face.v3 (top_face c)
273 fv' = rotate cwy $ rotate cwz
275 $ Tetrahedron.fv (tetrahedron0 c)
278 tetrahedron7 :: Cube -> Tetrahedron
280 Tetrahedron fv' v0' v1' v2' v3' vol
283 v1' = center (top_face c)
284 v2' = Face.v3 (top_face c)
285 v3' = Face.v0 (top_face c)
286 fv' = rotate cwy $ rotate ccwz $ Tetrahedron.fv (tetrahedron0 c)
289 tetrahedron8 :: Cube -> Tetrahedron
291 Tetrahedron fv' v0' v1' v2' v3' vol
294 v1' = center (back_face c)
295 v2' = Face.v0 (back_face c)
296 v3' = Face.v1 (back_face c)
297 fv' = rotate cwy $ rotate cwy $ Tetrahedron.fv (tetrahedron0 c)
300 tetrahedron9 :: Cube -> Tetrahedron
302 Tetrahedron fv' v0' v1' v2' v3' vol
305 v1' = center (back_face c)
306 v2' = Face.v1 (back_face c)
307 v3' = Face.v2 (back_face c)
308 fv' = rotate cwy $ rotate cwy
310 $ Tetrahedron.fv (tetrahedron0 c)
313 tetrahedron10 :: Cube -> Tetrahedron
315 Tetrahedron fv' v0' v1' v2' v3' vol
318 v1' = center (back_face c)
319 v2' = Face.v2 (back_face c)
320 v3' = Face.v3 (back_face c)
321 fv' = rotate cwy $ rotate cwy
324 $ Tetrahedron.fv (tetrahedron0 c)
328 tetrahedron11 :: Cube -> Tetrahedron
330 Tetrahedron fv' v0' v1' v2' v3' vol
333 v1' = center (back_face c)
334 v2' = Face.v3 (back_face c)
335 v3' = Face.v0 (back_face c)
336 fv' = rotate cwy $ rotate cwy
338 $ Tetrahedron.fv (tetrahedron0 c)
342 tetrahedron12 :: Cube -> Tetrahedron
344 Tetrahedron fv' v0' v1' v2' v3' vol
347 v1' = center (down_face c)
348 v2' = Face.v0 (down_face c)
349 v3' = Face.v1 (down_face c)
350 fv' = rotate ccwy (Tetrahedron.fv (tetrahedron0 c))
354 tetrahedron13 :: Cube -> Tetrahedron
356 Tetrahedron fv' v0' v1' v2' v3' vol
359 v1' = center (down_face c)
360 v2' = Face.v1 (down_face c)
361 v3' = Face.v2 (down_face c)
362 fv' = rotate ccwy $ rotate ccwz $ Tetrahedron.fv (tetrahedron0 c)
366 tetrahedron14 :: Cube -> Tetrahedron
368 Tetrahedron fv' v0' v1' v2' v3' vol
371 v1' = center (down_face c)
372 v2' = Face.v2 (down_face c)
373 v3' = Face.v3 (down_face c)
374 fv' = rotate ccwy $ rotate ccwz
376 $ Tetrahedron.fv (tetrahedron0 c)
380 tetrahedron15 :: Cube -> Tetrahedron
382 Tetrahedron fv' v0' v1' v2' v3' vol
385 v1' = center (down_face c)
386 v2' = Face.v3 (down_face c)
387 v3' = Face.v0 (down_face c)
388 fv' = rotate ccwy $ rotate cwz $ Tetrahedron.fv (tetrahedron0 c)
392 tetrahedron16 :: Cube -> Tetrahedron
394 Tetrahedron fv' v0' v1' v2' v3' vol
397 v1' = center (right_face c)
398 v2' = Face.v0 (right_face c)
399 v3' = Face.v1 (right_face c)
400 fv' = rotate ccwz (Tetrahedron.fv (tetrahedron0 c))
404 tetrahedron17 :: Cube -> Tetrahedron
406 Tetrahedron fv' v0' v1' v2' v3' vol
409 v1' = center (right_face c)
410 v2' = Face.v1 (right_face c)
411 v3' = Face.v2 (right_face c)
412 fv' = rotate ccwz $ rotate cwy $ Tetrahedron.fv (tetrahedron0 c)
416 tetrahedron18 :: Cube -> Tetrahedron
418 Tetrahedron fv' v0' v1' v2' v3' vol
421 v1' = center (right_face c)
422 v2' = Face.v2 (right_face c)
423 v3' = Face.v3 (right_face c)
424 fv' = rotate ccwz $ rotate cwy
426 $ Tetrahedron.fv (tetrahedron0 c)
430 tetrahedron19 :: Cube -> Tetrahedron
432 Tetrahedron fv' v0' v1' v2' v3' vol
435 v1' = center (right_face c)
436 v2' = Face.v3 (right_face c)
437 v3' = Face.v0 (right_face c)
438 fv' = rotate ccwz $ rotate ccwy
439 $ Tetrahedron.fv (tetrahedron0 c)
443 tetrahedron20 :: Cube -> Tetrahedron
445 Tetrahedron fv' v0' v1' v2' v3' vol
448 v1' = center (left_face c)
449 v2' = Face.v0 (left_face c)
450 v3' = Face.v1 (left_face c)
451 fv' = rotate cwz (Tetrahedron.fv (tetrahedron0 c))
455 tetrahedron21 :: Cube -> Tetrahedron
457 Tetrahedron fv' v0' v1' v2' v3' vol
460 v1' = center (left_face c)
461 v2' = Face.v1 (left_face c)
462 v3' = Face.v2 (left_face c)
463 fv' = rotate cwz $ rotate ccwy $ Tetrahedron.fv (tetrahedron0 c)
467 tetrahedron22 :: Cube -> Tetrahedron
469 Tetrahedron fv' v0' v1' v2' v3' vol
472 v1' = center (left_face c)
473 v2' = Face.v2 (left_face c)
474 v3' = Face.v3 (left_face c)
475 fv' = rotate cwz $ rotate ccwy
477 $ Tetrahedron.fv (tetrahedron0 c)
481 tetrahedron23 :: Cube -> Tetrahedron
483 Tetrahedron fv' v0' v1' v2' v3' vol
486 v1' = center (left_face c)
487 v2' = Face.v3 (left_face c)
488 v3' = Face.v0 (left_face c)
489 fv' = rotate cwz $ rotate cwy
490 $ Tetrahedron.fv (tetrahedron0 c)
494 tetrahedra :: Cube -> [Tetrahedron]
521 -- | All completely contained in the front half of the cube.
522 front_half_tetrahedra :: Cube -> [Tetrahedron]
523 front_half_tetrahedra c =
534 -- | All tetrahedra completely contained in the top half of the cube.
535 top_half_tetrahedra :: Cube -> [Tetrahedron]
536 top_half_tetrahedra c =
547 -- | All tetrahedra completely contained in the back half of the cube.
548 back_half_tetrahedra :: Cube -> [Tetrahedron]
549 back_half_tetrahedra c =
560 -- | All tetrahedra completely contained in the down half of the cube.
561 down_half_tetrahedra :: Cube -> [Tetrahedron]
562 down_half_tetrahedra c =
573 -- | All tetrahedra completely contained in the right half of the cube.
574 right_half_tetrahedra :: Cube -> [Tetrahedron]
575 right_half_tetrahedra c =
586 -- | All tetrahedra completely contained in the left half of the cube.
587 left_half_tetrahedra :: Cube -> [Tetrahedron]
588 left_half_tetrahedra c =
599 in_top_half :: Cube -> Point -> Bool
600 in_top_half c (_,_,z) =
601 distance_from_top <= distance_from_bottom
603 distance_from_top = abs $ (zmax c) - z
604 distance_from_bottom = abs $ (zmin c) - z
606 in_front_half :: Cube -> Point -> Bool
607 in_front_half c (x,_,_) =
608 distance_from_front <= distance_from_back
610 distance_from_front = abs $ (xmin c) - x
611 distance_from_back = abs $ (xmax c) - x
614 in_left_half :: Cube -> Point -> Bool
615 in_left_half c (_,y,_) =
616 distance_from_left <= distance_from_right
618 distance_from_left = abs $ (ymin c) - y
619 distance_from_right = abs $ (ymax c) - y
622 -- | Takes a 'Cube', and returns the Tetrahedra belonging to it that
623 -- contain the given 'Point'. This should be faster than checking
624 -- every tetrahedron individually, since we determine which half
625 -- (hemisphere?) of the cube the point lies in three times: once in
626 -- each dimension. This allows us to eliminate non-candidates
629 -- This can throw an exception, but the use of 'head' might
630 -- save us some unnecessary computations.
632 find_containing_tetrahedron :: Cube -> Point -> Tetrahedron
633 find_containing_tetrahedron c p =
634 head containing_tetrahedra
636 candidates = tetrahedra c
638 if (in_front_half c p) then
639 back_half_tetrahedra c
641 front_half_tetrahedra c
643 candidates_x = candidates \\ non_candidates_x
646 if (in_left_half c p) then
647 right_half_tetrahedra c
649 left_half_tetrahedra c
651 candidates_xy = candidates_x \\ non_candidates_y
654 if (in_top_half c p) then
655 down_half_tetrahedra c
657 top_half_tetrahedra c
659 candidates_xyz = candidates_xy \\ non_candidates_z
661 contains_our_point = flip contains_point p
662 containing_tetrahedra = filter contains_our_point candidates_xyz