X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FCube.hs;h=9f931431b93bafb4ca6e0a13c0940bc036a3e01a;hb=1bf996325008f79215a607d765adb042026f7444;hp=bec49b4086a09947697ec183ff97459e76f43122;hpb=e0bc55b3ed14d49a1745d71cd8dcd0fe58cc7867;p=spline3.git diff --git a/src/Cube.hs b/src/Cube.hs index bec49b4..9f93143 100644 --- a/src/Cube.hs +++ b/src/Cube.hs @@ -27,7 +27,7 @@ import Comparisons ((~=), (~~=)) import qualified Face (Face(Face, v0, v1, v2, v3)) import FunctionValues (FunctionValues, eval, rotate) import Misc (all_equal, disjoint) -import Point +import Point (Point(..), dot) import Tetrahedron (Tetrahedron(..), c, volume) import ThreeDimensional @@ -125,7 +125,7 @@ zmax cube = (k' + 1/2)*delta instance ThreeDimensional Cube where -- | The center of Cube_ijk coincides with v_ijk at -- (ih, jh, kh). See Sorokina and Zeilfelder, p. 76. - center cube = (x, y, z) + center cube = Point x y z where delta = h cube i' = fromIntegral (i cube) :: Double @@ -137,7 +137,7 @@ instance ThreeDimensional Cube where -- | It's easy to tell if a point is within a cube; just make sure -- that it falls on the proper side of each of the cube's faces. - contains_point cube (x, y, z) + contains_point cube (Point x y z) | x < (xmin cube) = False | x > (xmax cube) = False | y < (ymin cube) = False @@ -155,10 +155,11 @@ top_face :: Cube -> Face.Face top_face cube = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h cube) - v0' = (center cube) + (delta, -delta, delta) - v1' = (center cube) + (delta, delta, delta) - v2' = (center cube) + (-delta, delta, delta) - v3' = (center cube) + (-delta, -delta, delta) + cc = center cube + v0' = cc + ( Point delta (-delta) delta ) + v1' = cc + ( Point delta delta delta ) + v2' = cc + ( Point (-delta) delta delta ) + v3' = cc + ( Point (-delta) (-delta) delta ) @@ -167,10 +168,11 @@ back_face :: Cube -> Face.Face back_face cube = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h cube) - v0' = (center cube) + (delta, -delta, -delta) - v1' = (center cube) + (delta, delta, -delta) - v2' = (center cube) + (delta, delta, delta) - v3' = (center cube) + (delta, -delta, delta) + cc = center cube + v0' = cc + ( Point delta (-delta) (-delta) ) + v1' = cc + ( Point delta delta (-delta) ) + v2' = cc + ( Point delta delta delta ) + v3' = cc + ( Point delta (-delta) delta ) -- The bottom face (in the direction of -z) of the cube. @@ -178,10 +180,11 @@ down_face :: Cube -> Face.Face down_face cube = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h cube) - v0' = (center cube) + (-delta, -delta, -delta) - v1' = (center cube) + (-delta, delta, -delta) - v2' = (center cube) + (delta, delta, -delta) - v3' = (center cube) + (delta, -delta, -delta) + cc = center cube + v0' = cc + ( Point (-delta) (-delta) (-delta) ) + v1' = cc + ( Point (-delta) delta (-delta) ) + v2' = cc + ( Point delta delta (-delta) ) + v3' = cc + ( Point delta (-delta) (-delta) ) @@ -190,20 +193,22 @@ front_face :: Cube -> Face.Face front_face cube = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h cube) - v0' = (center cube) + (-delta, -delta, delta) - v1' = (center cube) + (-delta, delta, delta) - v2' = (center cube) + (-delta, delta, -delta) - v3' = (center cube) + (-delta, -delta, -delta) + cc = center cube + v0' = cc + ( Point (-delta) (-delta) delta ) + v1' = cc + ( Point (-delta) delta delta ) + v2' = cc + ( Point (-delta) delta (-delta) ) + v3' = cc + ( Point (-delta) (-delta) (-delta) ) -- | The left (in the direction of -y) face of the cube. left_face :: Cube -> Face.Face left_face cube = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h cube) - v0' = (center cube) + (delta, -delta, delta) - v1' = (center cube) + (-delta, -delta, delta) - v2' = (center cube) + (-delta, -delta, -delta) - v3' = (center cube) + (delta, -delta, -delta) + cc = center cube + v0' = cc + ( Point delta (-delta) delta ) + v1' = cc + ( Point (-delta) (-delta) delta ) + v2' = cc + ( Point (-delta) (-delta) (-delta) ) + v3' = cc + ( Point delta (-delta) (-delta) ) -- | The right (in the direction of y) face of the cube. @@ -211,10 +216,11 @@ right_face :: Cube -> Face.Face right_face cube = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h cube) - v0' = (center cube) + (-delta, delta, delta) - v1' = (center cube) + (delta, delta, delta) - v2' = (center cube) + (delta, delta, -delta) - v3' = (center cube) + (-delta, delta, -delta) + cc = center cube + v0' = cc + ( Point (-delta) delta delta) + v1' = cc + ( Point delta delta delta ) + v2' = cc + ( Point delta delta (-delta) ) + v3' = cc + ( Point (-delta) delta (-delta) ) tetrahedron :: Cube -> Int -> Tetrahedron @@ -223,18 +229,20 @@ tetrahedron cube 0 = Tetrahedron (fv cube) v0' v1' v2' v3' vol where v0' = center cube - v1' = center (front_face cube) - v2' = Face.v0 (front_face cube) - v3' = Face.v1 (front_face cube) + ff = front_face cube + v1' = center ff + v2' = Face.v0 ff + v3' = Face.v1 ff vol = tetrahedra_volume cube tetrahedron cube 1 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (front_face cube) - v2' = Face.v1 (front_face cube) - v3' = Face.v2 (front_face cube) + ff = front_face cube + v1' = center ff + v2' = Face.v1 ff + v3' = Face.v2 ff fv' = rotate ccwx (fv cube) vol = tetrahedra_volume cube @@ -242,9 +250,10 @@ tetrahedron cube 2 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (front_face cube) - v2' = Face.v2 (front_face cube) - v3' = Face.v3 (front_face cube) + ff = front_face cube + v1' = center ff + v2' = Face.v2 ff + v3' = Face.v3 ff fv' = rotate ccwx $ rotate ccwx $ fv cube vol = tetrahedra_volume cube @@ -252,9 +261,10 @@ tetrahedron cube 3 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (front_face cube) - v2' = Face.v3 (front_face cube) - v3' = Face.v0 (front_face cube) + ff = front_face cube + v1' = center ff + v2' = Face.v3 ff + v3' = Face.v0 ff fv' = rotate cwx (fv cube) vol = tetrahedra_volume cube @@ -262,9 +272,10 @@ tetrahedron cube 4 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (top_face cube) - v2' = Face.v0 (top_face cube) - v3' = Face.v1 (top_face cube) + tf = top_face cube + v1' = center tf + v2' = Face.v0 tf + v3' = Face.v1 tf fv' = rotate cwy (fv cube) vol = tetrahedra_volume cube @@ -272,9 +283,10 @@ tetrahedron cube 5 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (top_face cube) - v2' = Face.v1 (top_face cube) - v3' = Face.v2 (top_face cube) + tf = top_face cube + v1' = center tf + v2' = Face.v1 tf + v3' = Face.v2 tf fv' = rotate cwy $ rotate cwz $ fv cube vol = tetrahedra_volume cube @@ -282,9 +294,10 @@ tetrahedron cube 6 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (top_face cube) - v2' = Face.v2 (top_face cube) - v3' = Face.v3 (top_face cube) + tf = top_face cube + v1' = center tf + v2' = Face.v2 tf + v3' = Face.v3 tf fv' = rotate cwy $ rotate cwz $ rotate cwz $ fv cube @@ -294,9 +307,10 @@ tetrahedron cube 7 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (top_face cube) - v2' = Face.v3 (top_face cube) - v3' = Face.v0 (top_face cube) + tf = top_face cube + v1' = center tf + v2' = Face.v3 tf + v3' = Face.v0 tf fv' = rotate cwy $ rotate ccwz $ fv cube vol = tetrahedra_volume cube @@ -304,9 +318,10 @@ tetrahedron cube 8 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (back_face cube) - v2' = Face.v0 (back_face cube) - v3' = Face.v1 (back_face cube) + bf = back_face cube + v1' = center bf + v2' = Face.v0 bf + v3' = Face.v1 bf fv' = rotate cwy $ rotate cwy $ fv cube vol = tetrahedra_volume cube @@ -314,9 +329,10 @@ tetrahedron cube 9 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (back_face cube) - v2' = Face.v1 (back_face cube) - v3' = Face.v2 (back_face cube) + bf = back_face cube + v1' = center bf + v2' = Face.v1 bf + v3' = Face.v2 bf fv' = rotate cwy $ rotate cwy $ rotate cwx $ fv cube @@ -326,9 +342,10 @@ tetrahedron cube 10 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (back_face cube) - v2' = Face.v2 (back_face cube) - v3' = Face.v3 (back_face cube) + bf = back_face cube + v1' = center bf + v2' = Face.v2 bf + v3' = Face.v3 bf fv' = rotate cwy $ rotate cwy $ rotate cwx $ rotate cwx @@ -340,9 +357,10 @@ tetrahedron cube 11 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (back_face cube) - v2' = Face.v3 (back_face cube) - v3' = Face.v0 (back_face cube) + bf = back_face cube + v1' = center bf + v2' = Face.v3 bf + v3' = Face.v0 bf fv' = rotate cwy $ rotate cwy $ rotate ccwx $ fv cube @@ -352,9 +370,10 @@ tetrahedron cube 12 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (down_face cube) - v2' = Face.v0 (down_face cube) - v3' = Face.v1 (down_face cube) + df = down_face cube + v1' = center df + v2' = Face.v0 df + v3' = Face.v1 df fv' = rotate ccwy $ fv cube vol = tetrahedra_volume cube @@ -362,9 +381,10 @@ tetrahedron cube 13 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (down_face cube) - v2' = Face.v1 (down_face cube) - v3' = Face.v2 (down_face cube) + df = down_face cube + v1' = center df + v2' = Face.v1 df + v3' = Face.v2 df fv' = rotate ccwy $ rotate ccwz $ fv cube vol = tetrahedra_volume cube @@ -372,9 +392,10 @@ tetrahedron cube 14 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (down_face cube) - v2' = Face.v2 (down_face cube) - v3' = Face.v3 (down_face cube) + df = down_face cube + v1' = center df + v2' = Face.v2 df + v3' = Face.v3 df fv' = rotate ccwy $ rotate ccwz $ rotate ccwz $ fv cube @@ -384,9 +405,10 @@ tetrahedron cube 15 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (down_face cube) - v2' = Face.v3 (down_face cube) - v3' = Face.v0 (down_face cube) + df = down_face cube + v1' = center df + v2' = Face.v3 df + v3' = Face.v0 df fv' = rotate ccwy $ rotate cwz $ fv cube vol = tetrahedra_volume cube @@ -394,9 +416,10 @@ tetrahedron cube 16 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (right_face cube) - v2' = Face.v0 (right_face cube) - v3' = Face.v1 (right_face cube) + rf = right_face cube + v1' = center rf + v2' = Face.v0 rf + v3' = Face.v1 rf fv' = rotate ccwz $ fv cube vol = tetrahedra_volume cube @@ -404,9 +427,10 @@ tetrahedron cube 17 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (right_face cube) - v2' = Face.v1 (right_face cube) - v3' = Face.v2 (right_face cube) + rf = right_face cube + v1' = center rf + v2' = Face.v1 rf + v3' = Face.v2 rf fv' = rotate ccwz $ rotate cwy $ fv cube vol = tetrahedra_volume cube @@ -414,9 +438,10 @@ tetrahedron cube 18 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (right_face cube) - v2' = Face.v2 (right_face cube) - v3' = Face.v3 (right_face cube) + rf = right_face cube + v1' = center rf + v2' = Face.v2 rf + v3' = Face.v3 rf fv' = rotate ccwz $ rotate cwy $ rotate cwy $ fv cube @@ -426,9 +451,10 @@ tetrahedron cube 19 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (right_face cube) - v2' = Face.v3 (right_face cube) - v3' = Face.v0 (right_face cube) + rf = right_face cube + v1' = center rf + v2' = Face.v3 rf + v3' = Face.v0 rf fv' = rotate ccwz $ rotate ccwy $ fv cube vol = tetrahedra_volume cube @@ -437,9 +463,10 @@ tetrahedron cube 20 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (left_face cube) - v2' = Face.v0 (left_face cube) - v3' = Face.v1 (left_face cube) + lf = left_face cube + v1' = center lf + v2' = Face.v0 lf + v3' = Face.v1 lf fv' = rotate cwz $ fv cube vol = tetrahedra_volume cube @@ -447,9 +474,10 @@ tetrahedron cube 21 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (left_face cube) - v2' = Face.v1 (left_face cube) - v3' = Face.v2 (left_face cube) + lf = left_face cube + v1' = center lf + v2' = Face.v1 lf + v3' = Face.v2 lf fv' = rotate cwz $ rotate ccwy $ fv cube vol = tetrahedra_volume cube @@ -457,9 +485,10 @@ tetrahedron cube 22 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (left_face cube) - v2' = Face.v2 (left_face cube) - v3' = Face.v3 (left_face cube) + lf = left_face cube + v1' = center lf + v2' = Face.v2 lf + v3' = Face.v3 lf fv' = rotate cwz $ rotate ccwy $ rotate ccwy $ fv cube @@ -469,16 +498,14 @@ tetrahedron cube 23 = Tetrahedron fv' v0' v1' v2' v3' vol where v0' = center cube - v1' = center (left_face cube) - v2' = Face.v3 (left_face cube) - v3' = Face.v0 (left_face cube) + lf = left_face cube + v1' = center lf + v2' = Face.v3 lf + v3' = Face.v0 lf fv' = rotate cwz $ rotate cwy $ fv cube vol = tetrahedra_volume cube --- Feels dirty, but whatever. -tetrahedron _ _ = error "asked for a nonexistent tetrahedron" - -- Only used in tests, so we don't need the added speed -- of Data.Vector. @@ -558,14 +585,14 @@ back_right_down_tetrahedra cube = (tetrahedron cube 18) in_top_half :: Cube -> Point -> Bool -in_top_half cube (_,_,z) = +in_top_half cube (Point _ _ z) = distance_from_top <= distance_from_bottom where distance_from_top = abs $ (zmax cube) - z distance_from_bottom = abs $ (zmin cube) - z in_front_half :: Cube -> Point -> Bool -in_front_half cube (x,_,_) = +in_front_half cube (Point x _ _) = distance_from_front <= distance_from_back where distance_from_front = abs $ (xmin cube) - x @@ -573,7 +600,7 @@ in_front_half cube (x,_,_) = in_left_half :: Cube -> Point -> Bool -in_left_half cube (_,y,_) = +in_left_half cube (Point _ y _) = distance_from_left <= distance_from_right where distance_from_left = abs $ (ymin cube) - y @@ -590,6 +617,7 @@ in_left_half cube (_,y,_) = -- This can throw an exception, but the use of 'head' might -- save us some unnecessary computations. -- +{-# INLINE find_containing_tetrahedron #-} find_containing_tetrahedron :: Cube -> Point -> Tetrahedron find_containing_tetrahedron cube p = candidates `V.unsafeIndex` (fromJust lucky_idx) @@ -625,8 +653,9 @@ find_containing_tetrahedron cube p = else back_right_down_tetrahedra cube - -- Use the dot product instead of 'distance' here to save a - -- sqrt(). So, "distances" below really means "distances squared." + -- Use the dot product instead of Euclidean distance here to save + -- a sqrt(). So, "distances" below really means "distances + -- squared." distances = V.map ((dot p) . center) candidates shortest_distance = V.minimum distances lucky_idx = V.findIndex