X-Git-Url: https://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FCube.hs;h=6652e8b6331f039cd90cd9c7791dab61f2fd3f58;hb=d9eed953bd810f6928de536617dc21121a8a645b;hp=d863c290f2084ef8c79c0dc944dbb7c0c5c6c191;hpb=4d82669d840c49e162f1101ddd9a25c5f3234f92;p=spline3.git diff --git a/src/Cube.hs b/src/Cube.hs index d863c29..6652e8b 100644 --- a/src/Cube.hs +++ b/src/Cube.hs @@ -30,8 +30,7 @@ import Misc (all_equal, disjoint) import Point (Point(..), dot) import Tetrahedron (Tetrahedron(..), barycenter, c, volume) -data Cube = Cube { h :: !Double, - i :: !Int, +data Cube = Cube { i :: !Int, j :: !Int, k :: !Int, fv :: !FunctionValues, @@ -41,13 +40,12 @@ data Cube = Cube { h :: !Double, instance Arbitrary Cube where arbitrary = do - (Positive h') <- arbitrary :: Gen (Positive Double) i' <- choose (coordmin, coordmax) j' <- choose (coordmin, coordmax) k' <- choose (coordmin, coordmax) fv' <- arbitrary :: Gen FunctionValues (Positive tet_vol) <- arbitrary :: Gen (Positive Double) - return (Cube h' i' j' k' fv' tet_vol) + return (Cube i' j' k' fv' tet_vol) where -- The idea here is that, when cubed in the volume formula, -- these numbers don't overflow 64 bits. This number is not @@ -60,7 +58,6 @@ instance Arbitrary Cube where instance Show Cube where show cube = "Cube_" ++ subscript ++ "\n" ++ - " h: " ++ (show (h cube)) ++ "\n" ++ " Center: " ++ (show (center cube)) ++ "\n" ++ " xmin: " ++ (show (xmin cube)) ++ "\n" ++ " xmax: " ++ (show (xmax cube)) ++ "\n" ++ @@ -76,65 +73,55 @@ instance Show Cube where -- | The left-side boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. xmin :: Cube -> Double -xmin cube = (i' - 1/2)*delta +xmin cube = (i' - 1/2) where i' = fromIntegral (i cube) :: Double - delta = h cube -- | The right-side boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. xmax :: Cube -> Double -xmax cube = (i' + 1/2)*delta +xmax cube = (i' + 1/2) where i' = fromIntegral (i cube) :: Double - delta = h cube -- | The front boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. ymin :: Cube -> Double -ymin cube = (j' - 1/2)*delta +ymin cube = (j' - 1/2) where j' = fromIntegral (j cube) :: Double - delta = h cube -- | The back boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. ymax :: Cube -> Double -ymax cube = (j' + 1/2)*delta +ymax cube = (j' + 1/2) where j' = fromIntegral (j cube) :: Double - delta = h cube -- | The bottom boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. zmin :: Cube -> Double -zmin cube = (k' - 1/2)*delta +zmin cube = (k' - 1/2) where k' = fromIntegral (k cube) :: Double - delta = h cube -- | The top boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. zmax :: Cube -> Double -zmax cube = (k' + 1/2)*delta +zmax cube = (k' + 1/2) where k' = fromIntegral (k cube) :: Double - delta = h cube -- | The center of Cube_ijk coincides with v_ijk at --- (ih, jh, kh). See Sorokina and Zeilfelder, p. 76. +-- (i, j, k). See Sorokina and Zeilfelder, p. 76. center :: Cube -> Point center cube = Point x y z where - delta = h cube - i' = fromIntegral (i cube) :: Double - j' = fromIntegral (j cube) :: Double - k' = fromIntegral (k cube) :: Double - x = delta * i' - y = delta * j' - z = delta * k' + x = fromIntegral (i cube) :: Double + y = fromIntegral (j cube) :: Double + z = fromIntegral (k cube) :: Double -- Face stuff. @@ -143,7 +130,7 @@ center cube = top_face :: Cube -> Face.Face top_face cube = Face.Face v0' v1' v2' v3' where - delta = (1/2)*(h cube) + delta = 1/2 cc = center cube v0' = cc + ( Point delta (-delta) delta ) v1' = cc + ( Point delta delta delta ) @@ -156,7 +143,7 @@ top_face cube = Face.Face v0' v1' v2' v3' back_face :: Cube -> Face.Face back_face cube = Face.Face v0' v1' v2' v3' where - delta = (1/2)*(h cube) + delta = 1/2 cc = center cube v0' = cc + ( Point delta (-delta) (-delta) ) v1' = cc + ( Point delta delta (-delta) ) @@ -168,7 +155,7 @@ back_face cube = Face.Face v0' v1' v2' v3' down_face :: Cube -> Face.Face down_face cube = Face.Face v0' v1' v2' v3' where - delta = (1/2)*(h cube) + delta = 1/2 cc = center cube v0' = cc + ( Point (-delta) (-delta) (-delta) ) v1' = cc + ( Point (-delta) delta (-delta) ) @@ -181,7 +168,7 @@ down_face cube = Face.Face v0' v1' v2' v3' front_face :: Cube -> Face.Face front_face cube = Face.Face v0' v1' v2' v3' where - delta = (1/2)*(h cube) + delta = 1/2 cc = center cube v0' = cc + ( Point (-delta) (-delta) delta ) v1' = cc + ( Point (-delta) delta delta ) @@ -192,7 +179,7 @@ front_face cube = Face.Face v0' v1' v2' v3' left_face :: Cube -> Face.Face left_face cube = Face.Face v0' v1' v2' v3' where - delta = (1/2)*(h cube) + delta = 1/2 cc = center cube v0' = cc + ( Point delta (-delta) delta ) v1' = cc + ( Point (-delta) (-delta) delta ) @@ -204,7 +191,7 @@ left_face cube = Face.Face v0' v1' v2' v3' right_face :: Cube -> Face.Face right_face cube = Face.Face v0' v1' v2' v3' where - delta = (1/2)*(h cube) + delta = 1/2 cc = center cube v0' = cc + ( Point (-delta) delta delta) v1' = cc + ( Point delta delta delta ) @@ -709,12 +696,10 @@ prop_all_volumes_positive cube = -- | In fact, since all of the tetrahedra are identical, we should -- already know their volumes. There's 24 tetrahedra to a cube, so --- we'd expect the volume of each one to be (1/24)*h^3. +-- we'd expect the volume of each one to be 1/24. prop_all_volumes_exact :: Cube -> Bool prop_all_volumes_exact cube = - and [volume t ~~= (1/24)*(delta^(3::Int)) | t <- tetrahedra cube] - where - delta = h cube + and [volume t ~~= 1/24 | t <- tetrahedra cube] -- | All tetrahedron should have their v0 located at the center of the -- cube.