src/Cube.hs

   1 module Cube
   2 where
   3
   4 import Cardinal
   5 import qualified Face (Face(Face, v0, v1, v2, v3))
   6 import FunctionValues
   7 import Point
   8 import Tetrahedron hiding (c)
   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         " fv: " ++ (show (Cube.fv c)) ++ "\n"
  31         where
  32           subscript =
  33               (show (i c)) ++ "," ++ (show (j c)) ++ "," ++ (show (k c))
  34
  35
  36 -- | Returns an empty 'Cube'.
  37 empty_cube :: Cube
  38 empty_cube = Cube 0 0 0 0 empty_values
  39
  40
  41 -- | The left-side boundary of the cube. See Sorokina and Zeilfelder,
  42 --   p. 76.
  43 xmin :: Cube -> Double
  44 xmin c = (2*i' - 1)*delta / 2
  45     where
  46       i' = fromIntegral (i c) :: Double
  47       delta = h c
  48
  49 -- | The right-side boundary of the cube. See Sorokina and Zeilfelder,
  50 --   p. 76.
  51 xmax :: Cube -> Double
  52 xmax c = (2*i' + 1)*delta / 2
  53     where
  54       i' = fromIntegral (i c) :: Double
  55       delta = h c
  56
  57 -- | The front boundary of the cube. See Sorokina and Zeilfelder,
  58 --   p. 76.
  59 ymin :: Cube -> Double
  60 ymin c = (2*j' - 1)*delta / 2
  61     where
  62       j' = fromIntegral (j c) :: Double
  63       delta = h c
  64
  65 -- | The back boundary of the cube. See Sorokina and Zeilfelder,
  66 --   p. 76.
  67 ymax :: Cube -> Double
  68 ymax c = (2*j' + 1)*delta / 2
  69     where
  70       j' = fromIntegral (j c) :: Double
  71       delta = h c
  72
  73 -- | The bottom boundary of the cube. See Sorokina and Zeilfelder,
  74 --   p. 76.
  75 zmin :: Cube -> Double
  76 zmin c = (2*k' - 1)*delta / 2
  77     where
  78       k' = fromIntegral (k c) :: Double
  79       delta = h c
  80
  81 -- | The top boundary of the cube. See Sorokina and Zeilfelder,
  82 --   p. 76.
  83 zmax :: Cube -> Double
  84 zmax c = (2*k' + 1)*delta / 2
  85     where
  86       k' = fromIntegral (k c) :: Double
  87       delta = h c
  88
  89 instance ThreeDimensional Cube where
  90     -- | The center of Cube_ijk coincides with v_ijk at
  91     --   (ih, jh, kh). See Sorokina and Zeilfelder, p. 76.
  92     center c = (x, y, z)
  93            where
  94              delta = h c
  95              i' = fromIntegral (i c) :: Double
  96              j' = fromIntegral (j c) :: Double
  97              k' = fromIntegral (k c) :: Double
  98              x = delta * i'
  99              y = delta * j'
 100              z = delta * k'
 101
 102     -- | It's easy to tell if a point is within a cube; just make sure
 103     --   that it falls on the proper side of each of the cube's faces.
 104     contains_point c p
 105         | (x_coord p) < (xmin c) = False
 106         | (x_coord p) > (xmax c) = False
 107         | (y_coord p) < (ymin c) = False
 108         | (y_coord p) > (ymax c) = False
 109         | (z_coord p) < (zmin c) = False
 110         | (z_coord p) > (zmax c) = False
 111         | otherwise = True
 112
 113
 114
 115 -- Face stuff.
 116
 117 -- | The top (in the direction of z) face of the cube.
 118 top_face :: Cube -> Face.Face
 119 top_face c = Face.Face v0' v1' v2' v3'
 120     where
 121       delta = (1/2)*(h c)
 122       v0' = (center c) + (delta, -delta, delta)
 123       v1' = (center c) + (delta, delta, delta)
 124       v2' = (center c) + (-delta, delta, delta)
 125       v3' = (center c) + (-delta, -delta, delta)
 126
 127
 128
 129 -- | The back (in the direction of x) face of the cube.
 130 back_face :: Cube -> Face.Face
 131 back_face c = Face.Face v0' v1' v2' v3'
 132     where
 133       delta = (1/2)*(h c)
 134       v0' = (center c) + (delta, -delta, -delta)
 135       v1' = (center c) + (delta, delta, -delta)
 136       v2' = (center c) + (delta, delta, delta)
 137       v3' = (center c) + (delta, -delta, delta)
 138
 139
 140 -- The bottom face (in the direction of -z) of the cube.
 141 down_face :: Cube -> Face.Face
 142 down_face c = Face.Face v0' v1' v2' v3'
 143     where
 144       delta = (1/2)*(h c)
 145       v0' = (center c) + (-delta, -delta, -delta)
 146       v1' = (center c) + (-delta, delta, -delta)
 147       v2' = (center c) + (delta, delta, -delta)
 148       v3' = (center c) + (delta, -delta, -delta)
 149
 150
 151
 152 -- | The front (in the direction of -x) face of the cube.
 153 front_face :: Cube -> Face.Face
 154 front_face c = Face.Face v0' v1' v2' v3'
 155     where
 156       delta = (1/2)*(h c)
 157       v0' = (center c) + (-delta, -delta, delta)
 158       v1' = (center c) + (-delta, delta, delta)
 159       v2' = (center c) + (-delta, delta, -delta)
 160       v3' = (center c) + (-delta, -delta, -delta)
 161
 162 -- | The left (in the direction of -y) face of the cube.
 163 left_face :: Cube -> Face.Face
 164 left_face c = Face.Face v0' v1' v2' v3'
 165     where
 166       delta = (1/2)*(h c)
 167       v0' = (center c) + (delta, -delta, delta)
 168       v1' = (center c) + (-delta, -delta, delta)
 169       v2' = (center c) + (-delta, -delta, -delta)
 170       v3' = (center c) + (delta, -delta, -delta)
 171
 172
 173 -- | The right (in the direction of y) face of the cube.
 174 right_face :: Cube -> Face.Face
 175 right_face c = Face.Face v0' v1' v2' v3'
 176     where
 177       delta = (1/2)*(h c)
 178       v0' = (center c) + (-delta, delta, delta)
 179       v1' = (center c) + (delta, delta, delta)
 180       v2' = (center c) + (delta, delta, -delta)
 181       v3' = (center c) + (-delta, delta, -delta)
 182
 183
 184 tetrahedron0 :: Cube -> Tetrahedron
 185 tetrahedron0 c =
 186     Tetrahedron (Cube.fv c) v0' v1' v2' v3'
 187     where
 188       v0' = center c
 189       v1' = center (front_face c)
 190       v2' = Face.v0 (front_face c)
 191       v3' = Face.v1 (front_face c)
 192
 193 tetrahedron1 :: Cube -> Tetrahedron
 194 tetrahedron1 c =
 195     Tetrahedron fv' v0' v1' v2' v3'
 196     where
 197       v0' = center c
 198       v1' = center (front_face c)
 199       v2' = Face.v1 (front_face c)
 200       v3' = Face.v2 (front_face c)
 201       fv' = rotate (Cube.fv c) ccwx
 202
 203 tetrahedron2 :: Cube -> Tetrahedron
 204 tetrahedron2 c =
 205     Tetrahedron fv' v0' v1' v2' v3'
 206     where
 207       v0' = center c
 208       v1' = center (front_face c)
 209       v2' = Face.v2 (front_face c)
 210       v3' = Face.v3 (front_face c)
 211       fv' = rotate (Cube.fv c) (ccwx . ccwx)
 212
 213 tetrahedron3 :: Cube -> Tetrahedron
 214 tetrahedron3 c =
 215     Tetrahedron fv' v0' v1' v2' v3'
 216     where
 217       v0' = center c
 218       v1' = center (front_face c)
 219       v2' = Face.v3 (front_face c)
 220       v3' = Face.v0 (front_face c)
 221       fv' = rotate (Cube.fv c) cwx
 222
 223 tetrahedron4 :: Cube -> Tetrahedron
 224 tetrahedron4 c =
 225     Tetrahedron fv' v0' v1' v2' v3'
 226     where
 227       v0' = center c
 228       v1' = center (top_face c)
 229       v2' = Face.v0 (top_face c)
 230       v3' = Face.v1 (top_face c)
 231       fv' = rotate (Cube.fv c) cwy
 232
 233 tetrahedron5 :: Cube -> Tetrahedron
 234 tetrahedron5 c =
 235     Tetrahedron fv' v0' v1' v2' v3'
 236     where
 237       v0' = center c
 238       v1' = center (top_face c)
 239       v2' = Face.v1 (top_face c)
 240       v3' = Face.v2 (top_face c)
 241       fv' = rotate (Tetrahedron.fv (tetrahedron4 c)) ccwz
 242
 243 tetrahedron6 :: Cube -> Tetrahedron
 244 tetrahedron6 c =
 245     Tetrahedron fv' v0' v1' v2' v3'
 246     where
 247       v0' = center c
 248       v1' = center (top_face c)
 249       v2' = Face.v2 (top_face c)
 250       v3' = Face.v3 (top_face c)
 251       fv' = rotate (Tetrahedron.fv (tetrahedron4 c)) (ccwz . ccwz)
 252
 253 tetrahedron7 :: Cube -> Tetrahedron
 254 tetrahedron7 c =
 255     Tetrahedron fv' v0' v1' v2' v3'
 256     where
 257       v0' = center c
 258       v1' = center (top_face c)
 259       v2' = Face.v3 (top_face c)
 260       v3' = Face.v0 (top_face c)
 261       fv' = rotate (Tetrahedron.fv (tetrahedron4 c)) cwz
 262
 263 tetrahedron8 :: Cube -> Tetrahedron
 264 tetrahedron8 c =
 265     Tetrahedron fv' v0' v1' v2' v3'
 266     where
 267       v0' = center c
 268       v1' = center (back_face c)
 269       v2' = Face.v0 (back_face c)
 270       v3' = Face.v1 (back_face c)
 271       fv' = rotate (Tetrahedron.fv (tetrahedron4 c)) cwy
 272
 273 tetrahedron9 :: Cube -> Tetrahedron
 274 tetrahedron9 c =
 275     Tetrahedron fv' v0' v1' v2' v3'
 276     where
 277       v0' = center c
 278       v1' = center (back_face c)
 279       v2' = Face.v1 (back_face c)
 280       v3' = Face.v2 (back_face c)
 281       fv' = rotate (Tetrahedron.fv (tetrahedron8 c)) ccwx
 282
 283 tetrahedron10 :: Cube -> Tetrahedron
 284 tetrahedron10 c =
 285     Tetrahedron fv' v0' v1' v2' v3'
 286     where
 287       v0' = center c
 288       v1' = center (back_face c)
 289       v2' = Face.v2 (back_face c)
 290       v3' = Face.v3 (back_face c)
 291       fv' = rotate (Tetrahedron.fv (tetrahedron8 c)) (ccwx . ccwx)
 292
 293
 294 tetrahedron11 :: Cube -> Tetrahedron
 295 tetrahedron11 c =
 296     Tetrahedron fv' v0' v1' v2' v3'
 297     where
 298       v0' = center c
 299       v1' = center (back_face c)
 300       v2' = Face.v3 (back_face c)
 301       v3' = Face.v0 (back_face c)
 302       fv' = rotate (Tetrahedron.fv (tetrahedron8 c)) cwx
 303
 304
 305 tetrahedron12 :: Cube -> Tetrahedron
 306 tetrahedron12 c =
 307     Tetrahedron fv' v0' v1' v2' v3'
 308     where
 309       v0' = center c
 310       v1' = center (down_face c)
 311       v2' = Face.v0 (down_face c)
 312       v3' = Face.v1 (down_face c)
 313       fv' = rotate (Tetrahedron.fv (tetrahedron8 c)) cwy
 314
 315
 316 tetrahedron13 :: Cube -> Tetrahedron
 317 tetrahedron13 c =
 318     Tetrahedron fv' v0' v1' v2' v3'
 319     where
 320       v0' = center c
 321       v1' = center (down_face c)
 322       v2' = Face.v1 (down_face c)
 323       v3' = Face.v2 (down_face c)
 324       fv' = rotate (Tetrahedron.fv (tetrahedron12 c)) ccwz
 325
 326
 327 tetrahedron14 :: Cube -> Tetrahedron
 328 tetrahedron14 c =
 329     Tetrahedron fv' v0' v1' v2' v3'
 330     where
 331       v0' = center c
 332       v1' = center (down_face c)
 333       v2' = Face.v2 (down_face c)
 334       v3' = Face.v3 (down_face c)
 335       fv' = rotate (Tetrahedron.fv (tetrahedron13 c)) (ccwz . ccwz)
 336
 337
 338 tetrahedron15 :: Cube -> Tetrahedron
 339 tetrahedron15 c =
 340     Tetrahedron fv' v0' v1' v2' v3'
 341     where
 342       v0' = center c
 343       v1' = center (down_face c)
 344       v2' = Face.v3 (down_face c)
 345       v3' = Face.v0 (down_face c)
 346       fv' = rotate (Tetrahedron.fv (tetrahedron12 c)) cwz
 347
 348
 349 tetrahedron16 :: Cube -> Tetrahedron
 350 tetrahedron16 c =
 351     Tetrahedron fv' v0' v1' v2' v3'
 352     where
 353       v0' = center c
 354       v1' = center (right_face c)
 355       v2' = Face.v0 (right_face c)
 356       v3' = Face.v1 (right_face c)
 357       fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) ccwz
 358
 359
 360 tetrahedron17 :: Cube -> Tetrahedron
 361 tetrahedron17 c =
 362     Tetrahedron fv' v0' v1' v2' v3'
 363     where
 364       v0' = center c
 365       v1' = center (right_face c)
 366       v2' = Face.v1 (right_face c)
 367       v3' = Face.v2 (right_face c)
 368       fv' = rotate (Tetrahedron.fv (tetrahedron16 c)) cwy
 369
 370
 371 tetrahedron18 :: Cube -> Tetrahedron
 372 tetrahedron18 c =
 373     Tetrahedron fv' v0' v1' v2' v3'
 374     where
 375       v0' = center c
 376       v1' = center (right_face c)
 377       v2' = Face.v2 (right_face c)
 378       v3' = Face.v3 (right_face c)
 379       fv' = rotate (Tetrahedron.fv (tetrahedron16 c)) (cwy . cwy)
 380
 381
 382 tetrahedron19 :: Cube -> Tetrahedron
 383 tetrahedron19 c =
 384     Tetrahedron fv' v0' v1' v2' v3'
 385     where
 386       v0' = center c
 387       v1' = center (right_face c)
 388       v2' = Face.v3 (right_face c)
 389       v3' = Face.v0 (right_face c)
 390       fv' = rotate (Tetrahedron.fv (tetrahedron16 c)) ccwy
 391
 392
 393 tetrahedron20 :: Cube -> Tetrahedron
 394 tetrahedron20 c =
 395     Tetrahedron fv' v0' v1' v2' v3'
 396     where
 397       v0' = center c
 398       v1' = center (left_face c)
 399       v2' = Face.v0 (left_face c)
 400       v3' = Face.v1 (left_face c)
 401       fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) cwz
 402
 403
 404 tetrahedron21 :: Cube -> Tetrahedron
 405 tetrahedron21 c =
 406     Tetrahedron fv' v0' v1' v2' v3'
 407     where
 408       v0' = center c
 409       v1' = center (left_face c)
 410       v2' = Face.v1 (left_face c)
 411       v3' = Face.v2 (left_face c)
 412       fv' = rotate (Tetrahedron.fv (tetrahedron20 c)) ccwy
 413
 414
 415 tetrahedron22 :: Cube -> Tetrahedron
 416 tetrahedron22 c =
 417     Tetrahedron fv' v0' v1' v2' v3'
 418     where
 419       v0' = center c
 420       v1' = center (left_face c)
 421       v2' = Face.v2 (left_face c)
 422       v3' = Face.v3 (left_face c)
 423       fv' = rotate (Tetrahedron.fv (tetrahedron20 c)) ccwy
 424
 425
 426 tetrahedron23 :: Cube -> Tetrahedron
 427 tetrahedron23 c =
 428     Tetrahedron fv' v0' v1' v2' v3'
 429     where
 430       v0' = center c
 431       v1' = center (left_face c)
 432       v2' = Face.v3 (left_face c)
 433       v3' = Face.v0 (left_face c)
 434       fv' = rotate (Tetrahedron.fv (tetrahedron20 c)) ccwy
 435
 436
 437 tetrahedrons :: Cube -> [Tetrahedron]
 438 tetrahedrons c =
 439     [tetrahedron0 c,
 440      tetrahedron1 c,
 441      tetrahedron2 c,
 442      tetrahedron3 c,
 443      tetrahedron4 c,
 444      tetrahedron5 c,
 445      tetrahedron6 c,
 446      tetrahedron7 c,
 447      tetrahedron8 c,
 448      tetrahedron9 c,
 449      tetrahedron10 c,
 450      tetrahedron11 c,
 451      tetrahedron12 c,
 452      tetrahedron13 c,
 453      tetrahedron14 c,
 454      tetrahedron15 c,
 455      tetrahedron16 c,
 456      tetrahedron17 c,
 457      tetrahedron18 c,
 458      tetrahedron19 c,
 459      tetrahedron20 c,
 460      tetrahedron21 c,
 461      tetrahedron22 c,
 462      tetrahedron23 c]