module Cube where import Cardinal import Face (Face(Face, v0, v1, v2, v3)) import FunctionValues import Point import Tetrahedron (Tetrahedron(Tetrahedron), fv) import ThreeDimensional data Cube = Cube { h :: Double, i :: Int, j :: Int, k :: Int, fv :: FunctionValues } deriving (Eq) instance Show Cube where show c = "Cube_" ++ subscript ++ "\n" ++ " h: " ++ (show (h c)) ++ "\n" ++ " Center: " ++ (show (center c)) ++ "\n" ++ " xmin: " ++ (show (xmin c)) ++ "\n" ++ " xmax: " ++ (show (xmax c)) ++ "\n" ++ " ymin: " ++ (show (ymin c)) ++ "\n" ++ " ymax: " ++ (show (ymax c)) ++ "\n" ++ " zmin: " ++ (show (zmin c)) ++ "\n" ++ " zmax: " ++ (show (zmax c)) ++ "\n" where subscript = (show (i c)) ++ "," ++ (show (j c)) ++ "," ++ (show (k c)) empty_cube :: Cube empty_cube = Cube 0 0 0 0 empty_values -- | The left-side boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. xmin :: Cube -> Double xmin c = (2*i' - 1)*delta / 2 where i' = fromIntegral (i c) :: Double delta = h c -- | The right-side boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. xmax :: Cube -> Double xmax c = (2*i' + 1)*delta / 2 where i' = fromIntegral (i c) :: Double delta = h c -- | The front boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. ymin :: Cube -> Double ymin c = (2*j' - 1)*delta / 2 where j' = fromIntegral (j c) :: Double delta = h c -- | The back boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. ymax :: Cube -> Double ymax c = (2*j' + 1)*delta / 2 where j' = fromIntegral (j c) :: Double delta = h c -- | The bottom boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. zmin :: Cube -> Double zmin c = (2*k' - 1)*delta / 2 where k' = fromIntegral (k c) :: Double delta = h c -- | The top boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. zmax :: Cube -> Double zmax c = (2*k' + 1)*delta / 2 where k' = fromIntegral (k c) :: Double delta = h c instance ThreeDimensional Cube where -- | The center of Cube_ijk coincides with v_ijk at -- (ih, jh, kh). See Sorokina and Zeilfelder, p. 76. center c = (x, y, z) where delta = h c i' = fromIntegral (i c) :: Double j' = fromIntegral (j c) :: Double k' = fromIntegral (k c) :: Double x = delta * i' y = delta * j' z = delta * k' contains_point c p | (x_coord p) < (xmin c) = False | (x_coord p) > (xmax c) = False | (y_coord p) < (ymin c) = False | (y_coord p) > (ymax c) = False | (z_coord p) < (zmin c) = False | (z_coord p) > (zmax c) = False | otherwise = True -- instance Num Cube where -- (Cube g1 i1 j1 k1 d1) + (Cube _ i2 j2 k2 d2) = -- Cube g1 (i1 + i2) (j1 + j2) (k1 + k2) (d1 + d2) -- (Cube g1 i1 j1 k1 d1) - (Cube _ i2 j2 k2 d2) = -- Cube g1 (i1 - i2) (j1 - j2) (k1 - k2) (d1 - d2) -- (Cube g1 i1 j1 k1 d1) * (Cube _ i2 j2 k2 d2) = -- Cube g1 (i1 * i2) (j1 * j2) (k1 * k2) (d1 * d2) -- abs (Cube g1 i1 j1 k1 d1) = -- Cube g1 (abs i1) (abs j1) (abs k1) (abs d1) -- signum (Cube g1 i1 j1 k1 d1) = -- Cube g1 (signum i1) (signum j1) (signum k1) (signum d1) -- fromInteger x = empty_cube { datum = (fromIntegral x) } -- instance Fractional Cube where -- (Cube g1 i1 j1 k1 d1) / (Cube _ _ _ _ d2) = -- Cube g1 i1 j1 k1 (d1 / d2) -- recip (Cube g1 i1 j1 k1 d1) = -- Cube g1 i1 j1 k1 (recip d1) -- fromRational q = empty_cube { datum = fromRational q } -- | Return the cube corresponding to the grid point i,j,k. The list -- of cubes is stored as [z][y][x] but we'll be requesting it by -- [x][y][z] so we flip the indices in the last line. -- cube_at :: Grid -> Int -> Int -> Int -> Cube -- cube_at g i' j' k' -- | i' >= length (function_values g) = Cube g i' j' k' 0 -- | i' < 0 = Cube g i' j' k' 0 -- | j' >= length ((function_values g) !! i') = Cube g i' j' k' 0 -- | j' < 0 = Cube g i' j' k' 0 -- | k' >= length (((function_values g) !! i') !! j') = Cube g i' j' k' 0 -- | k' < 0 = Cube g i' j' k' 0 -- | otherwise = -- (((cubes g) !! k') !! j') !! i' -- Face stuff. -- | The top (in the direction of z) face of the cube. top_face :: Cube -> Face top_face c = Face v0' v1' v2' v3' where delta = (1/2)*(h c) v0' = (center c) + (delta, delta, delta) v1' = (center c) + (delta, -delta, delta) v2' = (center c) + (-delta, -delta, delta) v3' = (center c) + (-delta, delta, delta) -- | The back (in the direction of x) face of the cube. back_face :: Cube -> Face back_face c = Face v0' v1' v2' v3' where delta = (1/2)*(h c) v0' = (center c) + (delta, delta, delta) v1' = (center c) + (delta, delta, -delta) v2' = (center c) + (delta, -delta, -delta) v3' = (center c) + (delta, -delta, delta) -- The bottom face (in the direction of -z) of the cube. down_face :: Cube -> Face down_face c = Face v0' v1' v2' v3' where delta = (1/2)*(h c) v0' = (center c) + (delta, delta, -delta) v1' = (center c) + (-delta, delta, -delta) v2' = (center c) + (-delta, -delta, -delta) v3' = (center c) + (delta, -delta, -delta) -- | The front (in the direction of -x) face of the cube. front_face :: Cube -> Face front_face c = Face v0' v1' v2' v3' where delta = (1/2)*(h c) v0' = (center c) + (-delta, -delta, delta) v1' = (center c) + (-delta, delta, delta) v2' = (center c) + (-delta, delta, -delta) v3' = (center c) + (-delta, -delta, -delta) -- | The left (in the direction of -y) face of the cube. left_face :: Cube -> Face left_face c = Face v0' v1' v2' v3' where delta = (1/2)*(h c) v0' = (center c) + (-delta, -delta, delta) v1' = (center c) + (delta, -delta, delta) v2' = (center c) + (delta, -delta, -delta) v3' = (center c) + (-delta, -delta, -delta) -- | The right (in the direction of y) face of the cube. right_face :: Cube -> Face right_face c = Face v0' v1' v2' v3' where delta = (1/2)*(h c) v0' = (center c) + (-delta, delta, -delta) v1' = (center c) + (delta, delta, -delta) v2' = (center c) + (delta, delta, delta) v3' = (center c) + (-delta, delta, delta) tetrahedron0 :: Cube -> Tetrahedron tetrahedron0 c = Tetrahedron (Cube.fv c) v0' v1' v2' v3' where v0' = center c v1' = center (front_face c) v2' = v0 (front_face c) v3' = v1 (front_face c) tetrahedron1 :: Cube -> Tetrahedron tetrahedron1 c = Tetrahedron fv' v0' v1' v2' v3' where v0' = center c v1' = center (front_face c) v2' = v1 (front_face c) v3' = v2 (front_face c) fv' = rotate (Cube.fv c) ccwx tetrahedron2 :: Cube -> Tetrahedron tetrahedron2 c = Tetrahedron fv' v0' v1' v2' v3' where v0' = center c v1' = center (front_face c) v2' = v2 (front_face c) v3' = v3 (front_face c) fv' = rotate (Cube.fv c) (ccwx . ccwx) tetrahedron3 :: Cube -> Tetrahedron tetrahedron3 c = Tetrahedron fv' v0' v1' v2' v3' where v0' = center c v1' = center (front_face c) v2' = v3 (front_face c) v3' = v1 (front_face c) fv' = rotate (Cube.fv c) cwx tetrahedron4 :: Cube -> Tetrahedron tetrahedron4 c = Tetrahedron fv' v0' v1' v2' v3' where v0' = center c v1' = center (top_face c) v2' = v0 (front_face c) v3' = v1 (front_face c) fv' = rotate (Cube.fv c) cwy tetrahedron5 :: Cube -> Tetrahedron tetrahedron5 c = Tetrahedron fv' v0' v1' v2' v3' where v0' = center c v1' = center (top_face c) v2' = v1 (top_face c) v3' = v2 (top_face c) fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) ccwx tetrahedron6 :: Cube -> Tetrahedron tetrahedron6 c = Tetrahedron fv' v0' v1' v2' v3' where v0' = center c v1' = center (top_face c) v2' = v2 (top_face c) v3' = v3 (top_face c) fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) (ccwx . ccwx) tetrahedron7 :: Cube -> Tetrahedron tetrahedron7 c = Tetrahedron fv' v0' v1' v2' v3' where v0' = center c v1' = center (top_face c) v2' = v3 (top_face c) v3' = v1 (top_face c) fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) cwx tetrahedrons :: Cube -> [Tetrahedron] tetrahedrons c = [tetrahedron0 c, tetrahedron1 c, tetrahedron2 c, tetrahedron3 c, tetrahedron4 c, tetrahedron5 c, tetrahedron6 c, tetrahedron7 c -- , -- tetrahedron8 c, -- tetrahedron9 c, -- tetrahedron10 c, -- tetrahedron11 c, -- tetrahedron12 c, -- tetrahedron13 c, -- tetrahedron14 c, -- tetrahedron15 c, -- tetrahedron16 c, -- tetrahedron17 c, -- tetrahedron18 c, -- tetrahedron19 c, -- tetrahedron20 c, -- tetrahedron21 c, -- tetrahedron21 c, -- tetrahedron22 c, -- tetrahedron23 c, -- tetrahedron24 c ]