src/Cube.hs

   1 module Cube
   2 where
   3
   4 import Cardinal
   5 import Face (Face(Face, v0, v1, v2, v3))
   6 import FunctionValues
   7 import Point
   8 import Tetrahedron (Tetrahedron(Tetrahedron), fv)
   9 import ThreeDimensional
  10
  11 data Cube = Cube { h :: Double,
  12                    i :: Int,
  13                    j :: Int,
  14                    k :: Int,
  15                    fv :: FunctionValues }
  16             deriving (Eq)
  17
  18
  19 instance Show Cube where
  20     show c =
  21         "Cube_" ++ subscript ++ "\n" ++
  22         " h: " ++ (show (h c)) ++ "\n" ++
  23         " Center: " ++ (show (center c)) ++ "\n" ++
  24         " xmin: " ++ (show (xmin c)) ++ "\n" ++
  25         " xmax: " ++ (show (xmax c)) ++ "\n" ++
  26         " ymin: " ++ (show (ymin c)) ++ "\n" ++
  27         " ymax: " ++ (show (ymax c)) ++ "\n" ++
  28         " zmin: " ++ (show (zmin c)) ++ "\n" ++
  29         " zmax: " ++ (show (zmax c)) ++ "\n"
  30         where
  31           subscript =
  32               (show (i c)) ++ "," ++ (show (j c)) ++ "," ++ (show (k c))
  33
  34
  35 empty_cube :: Cube
  36 empty_cube = Cube 0 0 0 0 empty_values
  37
  38
  39 -- | The left-side boundary of the cube. See Sorokina and Zeilfelder,
  40 --   p. 76.
  41 xmin :: Cube -> Double
  42 xmin c = (2*i' - 1)*delta / 2
  43     where
  44       i' = fromIntegral (i c) :: Double
  45       delta = h c
  46
  47 -- | The right-side boundary of the cube. See Sorokina and Zeilfelder,
  48 --   p. 76.
  49 xmax :: Cube -> Double
  50 xmax c = (2*i' + 1)*delta / 2
  51     where
  52       i' = fromIntegral (i c) :: Double
  53       delta = h c
  54
  55 -- | The front boundary of the cube. See Sorokina and Zeilfelder,
  56 --   p. 76.
  57 ymin :: Cube -> Double
  58 ymin c = (2*j' - 1)*delta / 2
  59     where
  60       j' = fromIntegral (j c) :: Double
  61       delta = h c
  62
  63 -- | The back boundary of the cube. See Sorokina and Zeilfelder,
  64 --   p. 76.
  65 ymax :: Cube -> Double
  66 ymax c = (2*j' + 1)*delta / 2
  67     where
  68       j' = fromIntegral (j c) :: Double
  69       delta = h c
  70
  71 -- | The bottom boundary of the cube. See Sorokina and Zeilfelder,
  72 --   p. 76.
  73 zmin :: Cube -> Double
  74 zmin c = (2*k' - 1)*delta / 2
  75     where
  76       k' = fromIntegral (k c) :: Double
  77       delta = h c
  78
  79 -- | The top boundary of the cube. See Sorokina and Zeilfelder,
  80 --   p. 76.
  81 zmax :: Cube -> Double
  82 zmax c = (2*k' + 1)*delta / 2
  83     where
  84       k' = fromIntegral (k c) :: Double
  85       delta = h c
  86
  87 instance ThreeDimensional Cube where
  88     -- | The center of Cube_ijk coincides with v_ijk at
  89     --   (ih, jh, kh). See Sorokina and Zeilfelder, p. 76.
  90     center c = (x, y, z)
  91            where
  92              delta = h c
  93              i' = fromIntegral (i c) :: Double
  94              j' = fromIntegral (j c) :: Double
  95              k' = fromIntegral (k c) :: Double
  96              x = delta * i'
  97              y = delta * j'
  98              z = delta * k'
  99
 100     contains_point c p
 101         | (x_coord p) < (xmin c) = False
 102         | (x_coord p) > (xmax c) = False
 103         | (y_coord p) < (ymin c) = False
 104         | (y_coord p) > (ymax c) = False
 105         | (z_coord p) < (zmin c) = False
 106         | (z_coord p) > (zmax c) = False
 107         | otherwise = True
 108
 109
 110 -- instance Num Cube where
 111 --     (Cube g1 i1 j1 k1 d1) + (Cube _ i2 j2 k2 d2) =
 112 --         Cube g1 (i1 + i2) (j1 + j2) (k1 + k2) (d1 + d2)
 113
 114 --     (Cube g1 i1 j1 k1 d1) - (Cube _ i2 j2 k2 d2) =
 115 --         Cube g1 (i1 - i2) (j1 - j2) (k1 - k2) (d1 - d2)
 116
 117 --     (Cube g1 i1 j1 k1 d1) * (Cube _ i2 j2 k2 d2) =
 118 --         Cube g1 (i1 * i2) (j1 * j2) (k1 * k2) (d1 * d2)
 119
 120 --     abs (Cube g1 i1 j1 k1 d1) =
 121 --         Cube g1 (abs i1) (abs j1) (abs k1) (abs d1)
 122
 123 --     signum (Cube g1 i1 j1 k1 d1) =
 124 --         Cube g1 (signum i1) (signum j1) (signum k1) (signum d1)
 125
 126 --     fromInteger x = empty_cube { datum = (fromIntegral x) }
 127
 128 -- instance Fractional Cube where
 129 --     (Cube g1 i1 j1 k1 d1) / (Cube _ _ _ _ d2) =
 130 --         Cube g1 i1 j1 k1 (d1 / d2)
 131
 132 --     recip (Cube g1 i1 j1 k1 d1) =
 133 --         Cube g1 i1 j1 k1 (recip d1)
 134
 135 --     fromRational q = empty_cube { datum = fromRational q }
 136
 137
 138
 139 -- | Return the cube corresponding to the grid point i,j,k. The list
 140 --   of cubes is stored as [z][y][x] but we'll be requesting it by
 141 --   [x][y][z] so we flip the indices in the last line.
 142 -- cube_at :: Grid -> Int -> Int -> Int -> Cube
 143 -- cube_at g i' j' k'
 144 --         | i' >= length (function_values g) = Cube g i' j' k' 0
 145 --         | i' < 0                          = Cube g i' j' k' 0
 146 --         | j' >= length ((function_values g) !! i') = Cube g i' j' k' 0
 147 --         | j' < 0                                  = Cube g i' j' k' 0
 148 --         | k' >= length (((function_values g) !! i') !! j') = Cube g i' j' k' 0
 149 --         | k' < 0                                          = Cube g i' j' k' 0
 150 --         | otherwise =
 151 --             (((cubes g) !! k') !! j') !! i'
 152
 153
 154
 155
 156
 157
 158 -- Face stuff.
 159
 160 -- | The top (in the direction of z) face of the cube.
 161 top_face :: Cube -> Face
 162 top_face c = Face v0' v1' v2' v3'
 163     where
 164       delta = (1/2)*(h c)
 165       v0' = (center c) + (delta, delta, delta)
 166       v1' = (center c) + (delta, -delta, delta)
 167       v2' = (center c) + (-delta, -delta, delta)
 168       v3' = (center c) + (-delta, delta, delta)
 169
 170
 171
 172 -- | The back (in the direction of x) face of the cube.
 173 back_face :: Cube -> Face
 174 back_face c = Face v0' v1' v2' v3'
 175     where
 176       delta = (1/2)*(h c)
 177       v0' = (center c) + (delta, delta, delta)
 178       v1' = (center c) + (delta, delta, -delta)
 179       v2' = (center c) + (delta, -delta, -delta)
 180       v3' = (center c) + (delta, -delta, delta)
 181
 182
 183 -- The bottom face (in the direction of -z) of the cube.
 184 down_face :: Cube -> Face
 185 down_face c = Face v0' v1' v2' v3'
 186     where
 187       delta = (1/2)*(h c)
 188       v0' = (center c) + (delta, delta, -delta)
 189       v1' = (center c) + (-delta, delta, -delta)
 190       v2' = (center c) + (-delta, -delta, -delta)
 191       v3' = (center c) + (delta, -delta, -delta)
 192
 193
 194
 195 -- | The front (in the direction of -x) face of the cube.
 196 front_face :: Cube -> Face
 197 front_face c = Face v0' v1' v2' v3'
 198     where
 199       delta = (1/2)*(h c)
 200       v0' = (center c) + (-delta, -delta, delta)
 201       v1' = (center c) + (-delta, delta, delta)
 202       v2' = (center c) + (-delta, delta, -delta)
 203       v3' = (center c) + (-delta, -delta, -delta)
 204
 205
 206 -- | The left (in the direction of -y) face of the cube.
 207 left_face :: Cube -> Face
 208 left_face c = Face v0' v1' v2' v3'
 209     where
 210       delta = (1/2)*(h c)
 211       v0' = (center c) + (-delta, -delta, delta)
 212       v1' = (center c) + (delta, -delta, delta)
 213       v2' = (center c) + (delta, -delta, -delta)
 214       v3' = (center c) + (-delta, -delta, -delta)
 215
 216
 217 -- | The right (in the direction of y) face of the cube.
 218 right_face :: Cube -> Face
 219 right_face c = Face v0' v1' v2' v3'
 220     where
 221       delta = (1/2)*(h c)
 222       v0' = (center c) + (-delta, delta, -delta)
 223       v1' = (center c) + (delta, delta, -delta)
 224       v2' = (center c) + (delta, delta, delta)
 225       v3' = (center c) + (-delta, delta, delta)
 226
 227
 228
 229 tetrahedron0 :: Cube -> Tetrahedron
 230 tetrahedron0 c =
 231     Tetrahedron (Cube.fv c) v0' v1' v2' v3'
 232     where
 233       v0' = center c
 234       v1' = center (front_face c)
 235       v2' = v0 (front_face c)
 236       v3' = v1 (front_face c)
 237
 238 tetrahedron1 :: Cube -> Tetrahedron
 239 tetrahedron1 c =
 240     Tetrahedron fv' v0' v1' v2' v3'
 241     where
 242       v0' = center c
 243       v1' = center (front_face c)
 244       v2' = v1 (front_face c)
 245       v3' = v2 (front_face c)
 246       fv' = rotate (Cube.fv c) ccwx
 247
 248 tetrahedron2 :: Cube -> Tetrahedron
 249 tetrahedron2 c =
 250     Tetrahedron fv' v0' v1' v2' v3'
 251     where
 252       v0' = center c
 253       v1' = center (front_face c)
 254       v2' = v2 (front_face c)
 255       v3' = v3 (front_face c)
 256       fv' = rotate (Cube.fv c) (ccwx . ccwx)
 257
 258 tetrahedron3 :: Cube -> Tetrahedron
 259 tetrahedron3 c =
 260     Tetrahedron fv' v0' v1' v2' v3'
 261     where
 262       v0' = center c
 263       v1' = center (front_face c)
 264       v2' = v3 (front_face c)
 265       v3' = v1 (front_face c)
 266       fv' = rotate (Cube.fv c) cwx
 267
 268 tetrahedron4 :: Cube -> Tetrahedron
 269 tetrahedron4 c =
 270     Tetrahedron fv' v0' v1' v2' v3'
 271     where
 272       v0' = center c
 273       v1' = center (top_face c)
 274       v2' = v0 (front_face c)
 275       v3' = v1 (front_face c)
 276       fv' = rotate (Cube.fv c) cwy
 277
 278 tetrahedron5 :: Cube -> Tetrahedron
 279 tetrahedron5 c =
 280     Tetrahedron fv' v0' v1' v2' v3'
 281     where
 282       v0' = center c
 283       v1' = center (top_face c)
 284       v2' = v1 (top_face c)
 285       v3' = v2 (top_face c)
 286       fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) ccwx
 287
 288 tetrahedron6 :: Cube -> Tetrahedron
 289 tetrahedron6 c =
 290     Tetrahedron fv' v0' v1' v2' v3'
 291     where
 292       v0' = center c
 293       v1' = center (top_face c)
 294       v2' = v2 (top_face c)
 295       v3' = v3 (top_face c)
 296       fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) (ccwx . ccwx)
 297
 298 tetrahedron7 :: Cube -> Tetrahedron
 299 tetrahedron7 c =
 300     Tetrahedron fv' v0' v1' v2' v3'
 301     where
 302       v0' = center c
 303       v1' = center (top_face c)
 304       v2' = v3 (top_face c)
 305       v3' = v1 (top_face c)
 306       fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) cwx
 307
 308 tetrahedrons :: Cube -> [Tetrahedron]
 309 tetrahedrons c =
 310     [tetrahedron0 c,
 311      tetrahedron1 c,
 312      tetrahedron2 c,
 313      tetrahedron3 c,
 314      tetrahedron4 c,
 315      tetrahedron5 c,
 316      tetrahedron6 c,
 317      tetrahedron7 c
 318                 -- ,
 319                 --  tetrahedron8 c,
 320                 --  tetrahedron9 c,
 321                 --  tetrahedron10 c,
 322                 --  tetrahedron11 c,
 323                 --  tetrahedron12 c,
 324                 --  tetrahedron13 c,
 325                 --  tetrahedron14 c,
 326                 --  tetrahedron15 c,
 327                 --  tetrahedron16 c,
 328                 --  tetrahedron17 c,
 329                 --  tetrahedron18 c,
 330                 --  tetrahedron19 c,
 331                 --  tetrahedron20 c,
 332                 --  tetrahedron21 c,
 333                 --  tetrahedron21 c,
 334                 --  tetrahedron22 c,
 335                 --  tetrahedron23 c,
 336                 --  tetrahedron24 c
 337     ]