X-Git-Url: https://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FCube.hs;h=23cbe4da70383d80c8fbf1f43d1ccc16a0260620;hb=6fb9ab6b6068870323e996da931fc04c7710e3e4;hp=301128116eb0f9127c5e5012fb5b0a4c9f5552df;hpb=f97dbb52b73bd90a89940b9653ff274654aba9de;p=spline3.git diff --git a/src/Cube.hs b/src/Cube.hs index 3011281..23cbe4d 100644 --- a/src/Cube.hs +++ b/src/Cube.hs @@ -1,59 +1,42 @@ module Cube where -import Grid +import Face +import FunctionValues +--import Grid import Point import ThreeDimensional -class Gridded a where - back :: a -> Cube - down :: a -> Cube - front :: a -> Cube - left :: a -> Cube - right :: a -> Cube - top :: a -> Cube - - -data Cube = Cube { grid :: Grid, +data Cube = Cube { h :: Double, i :: Int, j :: Int, k :: Int, - datum :: Double } + fv :: FunctionValues } deriving (Eq) instance Show Cube where show c = "Cube_" ++ (show (i c)) ++ "," ++ (show (j c)) ++ "," ++ (show (k c)) ++ - " (Grid: " ++ (show (grid c)) ++ ")" ++ " (Center: " ++ (show (center c)) ++ ")" ++ " (xmin: " ++ (show (xmin c)) ++ ")" ++ " (xmax: " ++ (show (xmax c)) ++ ")" ++ " (ymin: " ++ (show (ymin c)) ++ ")" ++ " (ymax: " ++ (show (ymax c)) ++ ")" ++ " (zmin: " ++ (show (zmin c)) ++ ")" ++ - " (zmax: " ++ (show (zmax c)) ++ ")" ++ - " (datum: " ++ (show (datum c)) ++ ")\n\n" + " (zmax: " ++ (show (zmax c)) ++ ")" empty_cube :: Cube -empty_cube = Cube empty_grid 0 0 0 0 +empty_cube = Cube 0 0 0 0 empty_values -instance Gridded Cube where - back c = cube_at (grid c) ((i c) + 1) (j c) (k c) - down c = cube_at (grid c) (i c) (j c) ((k c) - 1) - front c = cube_at (grid c) ((i c) - 1) (j c) (k c) - left c = cube_at (grid c) (i c) ((j c) - 1) (k c) - right c = cube_at (grid c) (i c) ((j c) + 1) (k c) - top c = cube_at (grid c) (i c) (j c) ((k c) + 1) - -- | 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 (grid c) + delta = h c -- | The right-side boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. @@ -61,7 +44,7 @@ xmax :: Cube -> Double xmax c = (2*i' + 1)*delta / 2 where i' = fromIntegral (i c) :: Double - delta = h (grid c) + delta = h c -- | The front boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. @@ -69,7 +52,7 @@ ymin :: Cube -> Double ymin c = (2*j' - 1)*delta / 2 where j' = fromIntegral (j c) :: Double - delta = h (grid c) + delta = h c -- | The back boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. @@ -77,7 +60,7 @@ ymax :: Cube -> Double ymax c = (2*j' + 1)*delta / 2 where j' = fromIntegral (j c) :: Double - delta = h (grid c) + delta = h c -- | The bottom boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. @@ -85,7 +68,7 @@ zmin :: Cube -> Double zmin c = (2*k' - 1)*delta / 2 where k' = fromIntegral (k c) :: Double - delta = h (grid c) + delta = h c -- | The top boundary of the cube. See Sorokina and Zeilfelder, -- p. 76. @@ -93,14 +76,14 @@ zmax :: Cube -> Double zmax c = (2*k' + 1)*delta / 2 where k' = fromIntegral (k c) :: Double - delta = h (grid c) + 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 (grid c) + delta = h c i' = fromIntegral (i c) :: Double j' = fromIntegral (j c) :: Double k' = fromIntegral (k c) :: Double @@ -118,73 +101,120 @@ instance ThreeDimensional Cube where | 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) +-- 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) - (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) +-- 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) +-- signum (Cube g1 i1 j1 k1 d1) = +-- Cube g1 (signum i1) (signum j1) (signum k1) (signum d1) - fromInteger x = empty_cube { datum = (fromIntegral x) } +-- 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) +-- 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) +-- recip (Cube g1 i1 j1 k1 d1) = +-- Cube g1 i1 j1 k1 (recip d1) - fromRational q = empty_cube { datum = fromRational q } +-- fromRational q = empty_cube { datum = fromRational q } --- | Constructs a cube, switching the x and z axes. -reverse_cube :: Grid -> Int -> Int -> Int -> Double -> Cube -reverse_cube g k' j' i' = Cube g i' j' k' -- | 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' - - --- These next three functions basically form a 'for' loop, looping --- through the xs, ys, and zs in that order. - --- | The cubes_from_values function will return a function that takes --- a list of values and returns a list of cubes. It could just as --- well be written to take the values as a parameter; the omission --- of the last parameter is known as an eta reduce. -cubes_from_values :: Grid -> Int -> Int -> ([Double] -> [Cube]) -cubes_from_values g i' j' = - zipWith (reverse_cube g i' j') [0..] - --- | The cubes_from_planes function will return a function that takes --- a list of planes and returns a list of cubes. It could just as --- well be written to take the planes as a parameter; the omission --- of the last parameter is known as an eta reduce. -cubes_from_planes :: Grid -> Int -> ([[Double]] -> [[Cube]]) -cubes_from_planes g i' = - zipWith (cubes_from_values g i') [0..] - --- | Takes a grid as an argument, and returns a three-dimensional list --- of cubes centered on its grid points. -cubes :: Grid -> [[[Cube]]] -cubes g = zipWith (cubes_from_planes g) [0..] (function_values g) +-- 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) +