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,
19 tetrahedra_volume :: Double }
23 instance Arbitrary Cube where
25 (Positive h') <- arbitrary :: Gen (Positive Double)
26 i' <- choose (coordmin, coordmax)
27 j' <- choose (coordmin, coordmax)
28 k' <- choose (coordmin, coordmax)
29 fv' <- arbitrary :: Gen FunctionValues
30 (Positive tet_vol) <- arbitrary :: Gen (Positive Double)
31 return (Cube h' i' j' k' fv' tet_vol)
33 coordmin = -268435456 -- -(2^29 / 2)
34 coordmax = 268435456 -- +(2^29 / 2)
37 instance Show Cube where
39 "Cube_" ++ subscript ++ "\n" ++
40 " h: " ++ (show (h c)) ++ "\n" ++
41 " Center: " ++ (show (center c)) ++ "\n" ++
42 " xmin: " ++ (show (xmin c)) ++ "\n" ++
43 " xmax: " ++ (show (xmax c)) ++ "\n" ++
44 " ymin: " ++ (show (ymin c)) ++ "\n" ++
45 " ymax: " ++ (show (ymax c)) ++ "\n" ++
46 " zmin: " ++ (show (zmin c)) ++ "\n" ++
47 " zmax: " ++ (show (zmax c)) ++ "\n" ++
48 " fv: " ++ (show (Cube.fv c)) ++ "\n"
51 (show (i c)) ++ "," ++ (show (j c)) ++ "," ++ (show (k c))
54 -- | Returns an empty 'Cube'.
56 empty_cube = Cube 0 0 0 0 empty_values 0
59 -- | The left-side boundary of the cube. See Sorokina and Zeilfelder,
61 xmin :: Cube -> Double
62 xmin c = (2*i' - 1)*delta / 2
64 i' = fromIntegral (i c) :: Double
67 -- | The right-side boundary of the cube. See Sorokina and Zeilfelder,
69 xmax :: Cube -> Double
70 xmax c = (2*i' + 1)*delta / 2
72 i' = fromIntegral (i c) :: Double
75 -- | The front boundary of the cube. See Sorokina and Zeilfelder,
77 ymin :: Cube -> Double
78 ymin c = (2*j' - 1)*delta / 2
80 j' = fromIntegral (j c) :: Double
83 -- | The back boundary of the cube. See Sorokina and Zeilfelder,
85 ymax :: Cube -> Double
86 ymax c = (2*j' + 1)*delta / 2
88 j' = fromIntegral (j c) :: Double
91 -- | The bottom boundary of the cube. See Sorokina and Zeilfelder,
93 zmin :: Cube -> Double
94 zmin c = (2*k' - 1)*delta / 2
96 k' = fromIntegral (k c) :: Double
99 -- | The top boundary of the cube. See Sorokina and Zeilfelder,
101 zmax :: Cube -> Double
102 zmax c = (2*k' + 1)*delta / 2
104 k' = fromIntegral (k c) :: Double
107 instance ThreeDimensional Cube where
108 -- | The center of Cube_ijk coincides with v_ijk at
109 -- (ih, jh, kh). See Sorokina and Zeilfelder, p. 76.
113 i' = fromIntegral (i c) :: Double
114 j' = fromIntegral (j c) :: Double
115 k' = fromIntegral (k c) :: Double
120 -- | It's easy to tell if a point is within a cube; just make sure
121 -- that it falls on the proper side of each of the cube's faces.
122 contains_point c (x, y, z)
123 | x < (xmin c) = False
124 | x > (xmax c) = False
125 | y < (ymin c) = False
126 | y > (ymax c) = False
127 | z < (zmin c) = False
128 | z > (zmax c) = False
135 -- | The top (in the direction of z) face of the cube.
136 top_face :: Cube -> Face.Face
137 top_face c = Face.Face v0' v1' v2' v3'
140 v0' = (center c) + (delta, -delta, delta)
141 v1' = (center c) + (delta, delta, delta)
142 v2' = (center c) + (-delta, delta, delta)
143 v3' = (center c) + (-delta, -delta, delta)
147 -- | The back (in the direction of x) face of the cube.
148 back_face :: Cube -> Face.Face
149 back_face c = Face.Face v0' v1' v2' v3'
152 v0' = (center c) + (delta, -delta, -delta)
153 v1' = (center c) + (delta, delta, -delta)
154 v2' = (center c) + (delta, delta, delta)
155 v3' = (center c) + (delta, -delta, delta)
158 -- The bottom face (in the direction of -z) of the cube.
159 down_face :: Cube -> Face.Face
160 down_face c = Face.Face v0' v1' v2' v3'
163 v0' = (center c) + (-delta, -delta, -delta)
164 v1' = (center c) + (-delta, delta, -delta)
165 v2' = (center c) + (delta, delta, -delta)
166 v3' = (center c) + (delta, -delta, -delta)
170 -- | The front (in the direction of -x) face of the cube.
171 front_face :: Cube -> Face.Face
172 front_face c = Face.Face v0' v1' v2' v3'
175 v0' = (center c) + (-delta, -delta, delta)
176 v1' = (center c) + (-delta, delta, delta)
177 v2' = (center c) + (-delta, delta, -delta)
178 v3' = (center c) + (-delta, -delta, -delta)
180 -- | The left (in the direction of -y) face of the cube.
181 left_face :: Cube -> Face.Face
182 left_face c = Face.Face v0' v1' v2' v3'
185 v0' = (center c) + (delta, -delta, delta)
186 v1' = (center c) + (-delta, -delta, delta)
187 v2' = (center c) + (-delta, -delta, -delta)
188 v3' = (center c) + (delta, -delta, -delta)
191 -- | The right (in the direction of y) face of the cube.
192 right_face :: Cube -> Face.Face
193 right_face c = Face.Face v0' v1' v2' v3'
196 v0' = (center c) + (-delta, delta, delta)
197 v1' = (center c) + (delta, delta, delta)
198 v2' = (center c) + (delta, delta, -delta)
199 v3' = (center c) + (-delta, delta, -delta)
202 make_tetrahedron :: Cube -> Point -> Point -> Point -> Point -> Tetrahedron
203 make_tetrahedron c v0 v1 v2 v3 =
204 Tetrahedron (Cube.fv c) v0 v1 v2 v3 (tetrahedra_volume c)
207 tetrahedron0 :: Cube -> Tetrahedron
209 make_tetrahedron c v0' v1' v2' v3'
212 v1' = center (front_face c)
213 v2' = Face.v0 (front_face c)
214 v3' = Face.v1 (front_face c)
216 tetrahedron1 :: Cube -> Tetrahedron
218 make_tetrahedron c v0' v1' v2' v3'
221 v1' = center (front_face c)
222 v2' = Face.v1 (front_face c)
223 v3' = Face.v2 (front_face c)
224 fv' = rotate ccwx (Cube.fv c)
226 tetrahedron2 :: Cube -> Tetrahedron
228 make_tetrahedron c v0' v1' v2' v3'
231 v1' = center (front_face c)
232 v2' = Face.v2 (front_face c)
233 v3' = Face.v3 (front_face c)
234 fv' = rotate ccwx $ rotate ccwx $ Cube.fv c
236 tetrahedron3 :: Cube -> Tetrahedron
238 make_tetrahedron c v0' v1' v2' v3'
241 v1' = center (front_face c)
242 v2' = Face.v3 (front_face c)
243 v3' = Face.v0 (front_face c)
244 fv' = rotate cwx (Cube.fv c)
246 tetrahedron4 :: Cube -> Tetrahedron
248 make_tetrahedron c v0' v1' v2' v3'
251 v1' = center (top_face c)
252 v2' = Face.v0 (top_face c)
253 v3' = Face.v1 (top_face c)
254 fv' = rotate cwy (Cube.fv c)
256 tetrahedron5 :: Cube -> Tetrahedron
258 make_tetrahedron c v0' v1' v2' v3'
261 v1' = center (top_face c)
262 v2' = Face.v1 (top_face c)
263 v3' = Face.v2 (top_face c)
264 fv' = rotate cwy $ rotate cwz $ Tetrahedron.fv (tetrahedron0 c)
266 tetrahedron6 :: Cube -> Tetrahedron
268 make_tetrahedron c v0' v1' v2' v3'
271 v1' = center (top_face c)
272 v2' = Face.v2 (top_face c)
273 v3' = Face.v3 (top_face c)
274 fv' = rotate cwy $ rotate cwz
276 $ Tetrahedron.fv (tetrahedron0 c)
278 tetrahedron7 :: Cube -> Tetrahedron
280 make_tetrahedron c v0' v1' v2' v3'
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)
288 tetrahedron8 :: Cube -> Tetrahedron
290 make_tetrahedron c v0' v1' v2' v3'
293 v1' = center (back_face c)
294 v2' = Face.v0 (back_face c)
295 v3' = Face.v1 (back_face c)
296 fv' = rotate cwy $ rotate cwy $ Tetrahedron.fv (tetrahedron0 c)
298 tetrahedron9 :: Cube -> Tetrahedron
300 make_tetrahedron c v0' v1' v2' v3'
303 v1' = center (back_face c)
304 v2' = Face.v1 (back_face c)
305 v3' = Face.v2 (back_face c)
306 fv' = rotate cwy $ rotate cwy
308 $ Tetrahedron.fv (tetrahedron0 c)
310 tetrahedron10 :: Cube -> Tetrahedron
312 make_tetrahedron c v0' v1' v2' v3'
315 v1' = center (back_face c)
316 v2' = Face.v2 (back_face c)
317 v3' = Face.v3 (back_face c)
318 fv' = rotate cwy $ rotate cwy
321 $ Tetrahedron.fv (tetrahedron0 c)
324 tetrahedron11 :: Cube -> Tetrahedron
326 make_tetrahedron c v0' v1' v2' v3'
329 v1' = center (back_face c)
330 v2' = Face.v3 (back_face c)
331 v3' = Face.v0 (back_face c)
332 fv' = rotate cwy $ rotate cwy
334 $ Tetrahedron.fv (tetrahedron0 c)
337 tetrahedron12 :: Cube -> Tetrahedron
339 make_tetrahedron c v0' v1' v2' v3'
342 v1' = center (down_face c)
343 v2' = Face.v0 (down_face c)
344 v3' = Face.v1 (down_face c)
345 fv' = rotate ccwy (Tetrahedron.fv (tetrahedron0 c))
348 tetrahedron13 :: Cube -> Tetrahedron
350 make_tetrahedron c v0' v1' v2' v3'
353 v1' = center (down_face c)
354 v2' = Face.v1 (down_face c)
355 v3' = Face.v2 (down_face c)
356 fv' = rotate ccwy $ rotate ccwz $ Tetrahedron.fv (tetrahedron0 c)
359 tetrahedron14 :: Cube -> Tetrahedron
361 make_tetrahedron c v0' v1' v2' v3'
364 v1' = center (down_face c)
365 v2' = Face.v2 (down_face c)
366 v3' = Face.v3 (down_face c)
367 fv' = rotate ccwy $ rotate ccwz
369 $ Tetrahedron.fv (tetrahedron0 c)
372 tetrahedron15 :: Cube -> Tetrahedron
374 make_tetrahedron c v0' v1' v2' v3'
377 v1' = center (down_face c)
378 v2' = Face.v3 (down_face c)
379 v3' = Face.v0 (down_face c)
380 fv' = rotate ccwy $ rotate cwz $ Tetrahedron.fv (tetrahedron0 c)
383 tetrahedron16 :: Cube -> Tetrahedron
385 make_tetrahedron c v0' v1' v2' v3'
388 v1' = center (right_face c)
389 v2' = Face.v0 (right_face c)
390 v3' = Face.v1 (right_face c)
391 fv' = rotate ccwz (Tetrahedron.fv (tetrahedron0 c))
394 tetrahedron17 :: Cube -> Tetrahedron
396 make_tetrahedron c v0' v1' v2' v3'
399 v1' = center (right_face c)
400 v2' = Face.v1 (right_face c)
401 v3' = Face.v2 (right_face c)
402 fv' = rotate ccwz $ rotate cwy $ Tetrahedron.fv (tetrahedron0 c)
405 tetrahedron18 :: Cube -> Tetrahedron
407 make_tetrahedron c v0' v1' v2' v3'
410 v1' = center (right_face c)
411 v2' = Face.v2 (right_face c)
412 v3' = Face.v3 (right_face c)
413 fv' = rotate ccwz $ rotate cwy
415 $ Tetrahedron.fv (tetrahedron0 c)
418 tetrahedron19 :: Cube -> Tetrahedron
420 make_tetrahedron c v0' v1' v2' v3'
423 v1' = center (right_face c)
424 v2' = Face.v3 (right_face c)
425 v3' = Face.v0 (right_face c)
426 fv' = rotate ccwz $ rotate ccwy
427 $ Tetrahedron.fv (tetrahedron0 c)
430 tetrahedron20 :: Cube -> Tetrahedron
432 make_tetrahedron c v0' v1' v2' v3'
435 v1' = center (left_face c)
436 v2' = Face.v0 (left_face c)
437 v3' = Face.v1 (left_face c)
438 fv' = rotate cwz (Tetrahedron.fv (tetrahedron0 c))
441 tetrahedron21 :: Cube -> Tetrahedron
443 make_tetrahedron c v0' v1' v2' v3'
446 v1' = center (left_face c)
447 v2' = Face.v1 (left_face c)
448 v3' = Face.v2 (left_face c)
449 fv' = rotate cwz $ rotate ccwy $ Tetrahedron.fv (tetrahedron0 c)
452 tetrahedron22 :: Cube -> Tetrahedron
454 make_tetrahedron c v0' v1' v2' v3'
457 v1' = center (left_face c)
458 v2' = Face.v2 (left_face c)
459 v3' = Face.v3 (left_face c)
460 fv' = rotate cwz $ rotate ccwy
462 $ Tetrahedron.fv (tetrahedron0 c)
465 tetrahedron23 :: Cube -> Tetrahedron
467 make_tetrahedron c v0' v1' v2' v3'
470 v1' = center (left_face c)
471 v2' = Face.v3 (left_face c)
472 v3' = Face.v0 (left_face c)
473 fv' = rotate cwz $ rotate cwy
474 $ Tetrahedron.fv (tetrahedron0 c)
477 tetrahedra :: Cube -> [Tetrahedron]
504 -- | All completely contained in the front half of the cube.
505 front_half_tetrahedra :: Cube -> [Tetrahedron]
506 front_half_tetrahedra c =
517 -- | All tetrahedra completely contained in the top half of the cube.
518 top_half_tetrahedra :: Cube -> [Tetrahedron]
519 top_half_tetrahedra c =
530 -- | All tetrahedra completely contained in the back half of the cube.
531 back_half_tetrahedra :: Cube -> [Tetrahedron]
532 back_half_tetrahedra c =
543 -- | All tetrahedra completely contained in the down half of the cube.
544 down_half_tetrahedra :: Cube -> [Tetrahedron]
545 down_half_tetrahedra c =
556 -- | All tetrahedra completely contained in the right half of the cube.
557 right_half_tetrahedra :: Cube -> [Tetrahedron]
558 right_half_tetrahedra c =
569 -- | All tetrahedra completely contained in the left half of the cube.
570 left_half_tetrahedra :: Cube -> [Tetrahedron]
571 left_half_tetrahedra c =
582 in_top_half :: Cube -> Point -> Bool
583 in_top_half c (_,_,z) =
584 distance_from_top <= distance_from_bottom
586 distance_from_top = abs $ (zmax c) - z
587 distance_from_bottom = abs $ (zmin c) - z
589 in_front_half :: Cube -> Point -> Bool
590 in_front_half c (x,_,_) =
591 distance_from_front <= distance_from_back
593 distance_from_front = abs $ (xmin c) - x
594 distance_from_back = abs $ (xmax c) - x
597 in_left_half :: Cube -> Point -> Bool
598 in_left_half c (_,y,_) =
599 distance_from_left <= distance_from_right
601 distance_from_left = abs $ (ymin c) - y
602 distance_from_right = abs $ (ymax c) - y
605 -- | Takes a 'Cube', and returns the Tetrahedra belonging to it that
606 -- contain the given 'Point'. This should be faster than checking
607 -- every tetrahedron individually, since we determine which half
608 -- (hemisphere?) of the cube the point lies in three times: once in
609 -- each dimension. This allows us to eliminate non-candidates
612 -- This can throw an exception, but the use of 'head' might
613 -- save us some unnecessary computations.
615 find_containing_tetrahedron :: Cube -> Point -> Tetrahedron
616 find_containing_tetrahedron c p =
617 head containing_tetrahedra
619 candidates = tetrahedra c
621 if (in_front_half c p) then
622 back_half_tetrahedra c
624 front_half_tetrahedra c
626 candidates_x = candidates \\ non_candidates_x
629 if (in_left_half c p) then
630 right_half_tetrahedra c
632 left_half_tetrahedra c
634 candidates_xy = candidates_x \\ non_candidates_y
637 if (in_top_half c p) then
638 down_half_tetrahedra c
640 top_half_tetrahedra c
642 candidates_xyz = candidates_xy \\ non_candidates_z
644 contains_our_point = flip contains_point p
645 containing_tetrahedra = filter contains_our_point candidates_xyz