X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FCube.hs;h=1c654ffd72763010bbb56352022160f61a0257c6;hb=610d0f0af8a802c26d51231d6e2426a72e40fd2d;hp=7b139a4741aff80a5bae666395aa61c5d45aff5d;hpb=2813bba7169c1457e630b3870858e96fd4bf61da;p=spline3.git diff --git a/src/Cube.hs b/src/Cube.hs index 7b139a4..1c654ff 100644 --- a/src/Cube.hs +++ b/src/Cube.hs @@ -25,26 +25,18 @@ import Test.QuickCheck (Arbitrary(..), Gen, Positive(..), choose) import Cardinal import Comparisons ((~=), (~~=)) import qualified Face (Face(Face, v0, v1, v2, v3)) -import FunctionValues +import FunctionValues (FunctionValues, eval, rotate) import Misc (all_equal, disjoint) import Point -import Tetrahedron ( - Tetrahedron(..), - c, - b0, - b1, - b2, - b3, - volume - ) +import Tetrahedron (Tetrahedron(..), c, volume) import ThreeDimensional -data Cube = Cube { h :: Double, - i :: Int, - j :: Int, - k :: Int, - fv :: FunctionValues, - tetrahedra_volume :: Double } +data Cube = Cube { h :: !Double, + i :: !Int, + j :: !Int, + k :: !Int, + fv :: !FunctionValues, + tetrahedra_volume :: !Double } deriving (Eq) @@ -57,9 +49,13 @@ instance Arbitrary Cube where fv' <- arbitrary :: Gen FunctionValues (Positive tet_vol) <- arbitrary :: Gen (Positive Double) return (Cube h' i' j' k' fv' tet_vol) - where - coordmin = -268435456 -- -(2^29 / 2) - coordmax = 268435456 -- +(2^29 / 2) + where + -- The idea here is that, when cubed in the volume formula, + -- these numbers don't overflow 64 bits. This number is not + -- magic in any other sense than that it does not cause test + -- failures, while 2^23 does. + coordmax = 4194304 -- 2^22 + coordmin = -coordmax instance Show Cube where @@ -72,8 +68,7 @@ instance Show Cube where " ymin: " ++ (show (ymin cube)) ++ "\n" ++ " ymax: " ++ (show (ymax cube)) ++ "\n" ++ " zmin: " ++ (show (zmin cube)) ++ "\n" ++ - " zmax: " ++ (show (zmax cube)) ++ "\n" ++ - " fv: " ++ (show (Cube.fv cube)) ++ "\n" + " zmax: " ++ (show (zmax cube)) ++ "\n" where subscript = (show (i cube)) ++ "," ++ (show (j cube)) ++ "," ++ (show (k cube)) @@ -82,7 +77,7 @@ instance Show Cube where -- | The left-side boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. xmin :: Cube -> Double -xmin cube = (2*i' - 1)*delta / 2 +xmin cube = (i' - 1/2)*delta where i' = fromIntegral (i cube) :: Double delta = h cube @@ -90,7 +85,7 @@ xmin cube = (2*i' - 1)*delta / 2 -- | The right-side boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. xmax :: Cube -> Double -xmax cube = (2*i' + 1)*delta / 2 +xmax cube = (i' + 1/2)*delta where i' = fromIntegral (i cube) :: Double delta = h cube @@ -98,7 +93,7 @@ xmax cube = (2*i' + 1)*delta / 2 -- | The front boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. ymin :: Cube -> Double -ymin cube = (2*j' - 1)*delta / 2 +ymin cube = (j' - 1/2)*delta where j' = fromIntegral (j cube) :: Double delta = h cube @@ -106,7 +101,7 @@ ymin cube = (2*j' - 1)*delta / 2 -- | The back boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. ymax :: Cube -> Double -ymax cube = (2*j' + 1)*delta / 2 +ymax cube = (j' + 1/2)*delta where j' = fromIntegral (j cube) :: Double delta = h cube @@ -114,7 +109,7 @@ ymax cube = (2*j' + 1)*delta / 2 -- | The bottom boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. zmin :: Cube -> Double -zmin cube = (2*k' - 1)*delta / 2 +zmin cube = (k' - 1/2)*delta where k' = fromIntegral (k cube) :: Double delta = h cube @@ -122,7 +117,7 @@ zmin cube = (2*k' - 1)*delta / 2 -- | The top boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. zmax :: Cube -> Double -zmax cube = (2*k' + 1)*delta / 2 +zmax cube = (k' + 1/2)*delta where k' = fromIntegral (k cube) :: Double delta = h cube @@ -160,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 + (delta, -delta, delta) + v1' = cc + (delta, delta, delta) + v2' = cc + (-delta, delta, delta) + v3' = cc + (-delta, -delta, delta) @@ -172,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 + (delta, -delta, -delta) + v1' = cc + (delta, delta, -delta) + v2' = cc + (delta, delta, delta) + v3' = cc + (delta, -delta, delta) -- The bottom face (in the direction of -z) of the cube. @@ -183,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 + (-delta, -delta, -delta) + v1' = cc + (-delta, delta, -delta) + v2' = cc + (delta, delta, -delta) + v3' = cc + (delta, -delta, -delta) @@ -195,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 + (-delta, -delta, delta) + v1' = cc + (-delta, delta, delta) + v2' = cc + (-delta, delta, -delta) + v3' = cc + (-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 + (delta, -delta, delta) + v1' = cc + (-delta, -delta, delta) + v2' = cc + (-delta, -delta, -delta) + v3' = cc + (delta, -delta, -delta) -- | The right (in the direction of y) face of the cube. @@ -216,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 + (-delta, delta, delta) + v1' = cc + (delta, delta, delta) + v2' = cc + (delta, delta, -delta) + v3' = cc + (-delta, delta, -delta) tetrahedron :: Cube -> Int -> Tetrahedron @@ -228,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 @@ -247,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 @@ -257,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 @@ -267,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 @@ -277,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 @@ -287,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 @@ -299,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 @@ -309,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 @@ -319,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 @@ -331,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 @@ -345,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 @@ -357,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 @@ -367,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 @@ -377,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 @@ -389,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 @@ -399,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 @@ -409,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 @@ -419,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 @@ -431,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 @@ -442,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 @@ -452,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 @@ -462,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 @@ -474,9 +498,10 @@ 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 @@ -630,8 +655,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 @@ -673,15 +699,15 @@ prop_opposite_octant_tetrahedra_disjoint6 cube = -- | Since the grid size is necessarily positive, all tetrahedra --- (which comprise cubes of positive volume) must have positive volume --- as well. +-- (which comprise cubes of positive volume) must have positive +-- volume as well. prop_all_volumes_positive :: Cube -> Bool prop_all_volumes_positive cube = - null nonpositive_volumes + all (>= 0) volumes where ts = tetrahedra cube volumes = map volume ts - nonpositive_volumes = filter (<= 0) volumes + -- | In fact, since all of the tetrahedra are identical, we should -- already know their volumes. There's 24 tetrahedra to a cube, so