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 empty_cube :: Cube
  37 empty_cube = Cube 0 0 0 0 empty_values
  38
  39
  40 -- | The left-side boundary of the cube. See Sorokina and Zeilfelder,
  41 --   p. 76.
  42 xmin :: Cube -> Double
  43 xmin c = (2*i' - 1)*delta / 2
  44     where
  45       i' = fromIntegral (i c) :: Double
  46       delta = h c
  47
  48 -- | The right-side boundary of the cube. See Sorokina and Zeilfelder,
  49 --   p. 76.
  50 xmax :: Cube -> Double
  51 xmax c = (2*i' + 1)*delta / 2
  52     where
  53       i' = fromIntegral (i c) :: Double
  54       delta = h c
  55
  56 -- | The front boundary of the cube. See Sorokina and Zeilfelder,
  57 --   p. 76.
  58 ymin :: Cube -> Double
  59 ymin c = (2*j' - 1)*delta / 2
  60     where
  61       j' = fromIntegral (j c) :: Double
  62       delta = h c
  63
  64 -- | The back boundary of the cube. See Sorokina and Zeilfelder,
  65 --   p. 76.
  66 ymax :: Cube -> Double
  67 ymax c = (2*j' + 1)*delta / 2
  68     where
  69       j' = fromIntegral (j c) :: Double
  70       delta = h c
  71
  72 -- | The bottom boundary of the cube. See Sorokina and Zeilfelder,
  73 --   p. 76.
  74 zmin :: Cube -> Double
  75 zmin c = (2*k' - 1)*delta / 2
  76     where
  77       k' = fromIntegral (k c) :: Double
  78       delta = h c
  79
  80 -- | The top boundary of the cube. See Sorokina and Zeilfelder,
  81 --   p. 76.
  82 zmax :: Cube -> Double
  83 zmax c = (2*k' + 1)*delta / 2
  84     where
  85       k' = fromIntegral (k c) :: Double
  86       delta = h c
  87
  88 instance ThreeDimensional Cube where
  89     -- | The center of Cube_ijk coincides with v_ijk at
  90     --   (ih, jh, kh). See Sorokina and Zeilfelder, p. 76.
  91     center c = (x, y, z)
  92            where
  93              delta = h c
  94              i' = fromIntegral (i c) :: Double
  95              j' = fromIntegral (j c) :: Double
  96              k' = fromIntegral (k c) :: Double
  97              x = delta * i'
  98              y = delta * j'
  99              z = delta * k'
 100
 101     contains_point c p
 102         | (x_coord p) < (xmin c) = False
 103         | (x_coord p) > (xmax c) = False
 104         | (y_coord p) < (ymin c) = False
 105         | (y_coord p) > (ymax c) = False
 106         | (z_coord p) < (zmin c) = False
 107         | (z_coord p) > (zmax c) = False
 108         | otherwise = True
 109
 110
 111
 112 -- Face stuff.
 113
 114 -- | The top (in the direction of z) face of the cube.
 115 top_face :: Cube -> Face.Face
 116 top_face c = Face.Face v0' v1' v2' v3'
 117     where
 118       delta = (1/2)*(h c)
 119       v0' = (center c) + (delta, -delta, delta)
 120       v1' = (center c) + (delta, delta, delta)
 121       v2' = (center c) + (-delta, delta, delta)
 122       v3' = (center c) + (-delta, -delta, delta)
 123
 124
 125
 126 -- | The back (in the direction of x) face of the cube.
 127 back_face :: Cube -> Face.Face
 128 back_face c = Face.Face v0' v1' v2' v3'
 129     where
 130       delta = (1/2)*(h c)
 131       v0' = (center c) + (delta, -delta, -delta)
 132       v1' = (center c) + (delta, delta, -delta)
 133       v2' = (center c) + (delta, delta, delta)
 134       v3' = (center c) + (delta, -delta, delta)
 135
 136
 137 -- The bottom face (in the direction of -z) of the cube.
 138 down_face :: Cube -> Face.Face
 139 down_face c = Face.Face v0' v1' v2' v3'
 140     where
 141       delta = (1/2)*(h c)
 142       v0' = (center c) + (-delta, -delta, -delta)
 143       v1' = (center c) + (-delta, delta, -delta)
 144       v2' = (center c) + (delta, delta, -delta)
 145       v3' = (center c) + (delta, -delta, -delta)
 146
 147
 148
 149 -- | The front (in the direction of -x) face of the cube.
 150 front_face :: Cube -> Face.Face
 151 front_face c = Face.Face v0' v1' v2' v3'
 152     where
 153       delta = (1/2)*(h c)
 154       v0' = (center c) + (-delta, -delta, delta)
 155       v1' = (center c) + (-delta, delta, delta)
 156       v2' = (center c) + (-delta, delta, -delta)
 157       v3' = (center c) + (-delta, -delta, -delta)
 158
 159 -- | The left (in the direction of -y) face of the cube.
 160 left_face :: Cube -> Face.Face
 161 left_face c = Face.Face v0' v1' v2' v3'
 162     where
 163       delta = (1/2)*(h c)
 164       v0' = (center c) + (-delta, -delta, delta)
 165       v1' = (center c) + (delta, -delta, delta)
 166       v2' = (center c) + (delta, -delta, -delta)
 167       v3' = (center c) + (-delta, -delta, -delta)
 168
 169
 170 -- | The right (in the direction of y) face of the cube.
 171 right_face :: Cube -> Face.Face
 172 right_face c = Face.Face v0' v1' v2' v3'
 173     where
 174       delta = (1/2)*(h c)
 175       v0' = (center c) + (-delta, delta, -delta)
 176       v1' = (center c) + (delta, delta, -delta)
 177       v2' = (center c) + (delta, delta, delta)
 178       v3' = (center c) + (-delta, delta, delta)
 179
 180
 181 tetrahedron0 :: Cube -> Tetrahedron
 182 tetrahedron0 c =
 183     Tetrahedron (Cube.fv c) v0' v1' v2' v3'
 184     where
 185       v0' = center c
 186       v1' = center (front_face c)
 187       v2' = Face.v0 (front_face c)
 188       v3' = Face.v1 (front_face c)
 189
 190 tetrahedron1 :: Cube -> Tetrahedron
 191 tetrahedron1 c =
 192     Tetrahedron fv' v0' v1' v2' v3'
 193     where
 194       v0' = center c
 195       v1' = center (front_face c)
 196       v2' = Face.v1 (front_face c)
 197       v3' = Face.v2 (front_face c)
 198       fv' = rotate (Cube.fv c) ccwx
 199
 200 tetrahedron2 :: Cube -> Tetrahedron
 201 tetrahedron2 c =
 202     Tetrahedron fv' v0' v1' v2' v3'
 203     where
 204       v0' = center c
 205       v1' = center (front_face c)
 206       v2' = Face.v2 (front_face c)
 207       v3' = Face.v3 (front_face c)
 208       fv' = rotate (Cube.fv c) (ccwx . ccwx)
 209
 210 tetrahedron3 :: Cube -> Tetrahedron
 211 tetrahedron3 c =
 212     Tetrahedron fv' v0' v1' v2' v3'
 213     where
 214       v0' = center c
 215       v1' = center (front_face c)
 216       v2' = Face.v3 (front_face c)
 217       v3' = Face.v0 (front_face c)
 218       fv' = rotate (Cube.fv c) cwx
 219
 220 tetrahedron4 :: Cube -> Tetrahedron
 221 tetrahedron4 c =
 222     Tetrahedron fv' v0' v1' v2' v3'
 223     where
 224       v0' = center c
 225       v1' = center (top_face c)
 226       v2' = Face.v0 (top_face c)
 227       v3' = Face.v1 (top_face c)
 228       fv' = rotate (Cube.fv c) cwy
 229
 230 tetrahedron5 :: Cube -> Tetrahedron
 231 tetrahedron5 c =
 232     Tetrahedron fv' v0' v1' v2' v3'
 233     where
 234       v0' = center c
 235       v1' = center (top_face c)
 236       v2' = Face.v1 (top_face c)
 237       v3' = Face.v2 (top_face c)
 238       fv' = rotate (Tetrahedron.fv (tetrahedron4 c)) ccwz
 239
 240 tetrahedron6 :: Cube -> Tetrahedron
 241 tetrahedron6 c =
 242     Tetrahedron fv' v0' v1' v2' v3'
 243     where
 244       v0' = center c
 245       v1' = center (top_face c)
 246       v2' = Face.v2 (top_face c)
 247       v3' = Face.v3 (top_face c)
 248       fv' = rotate (Tetrahedron.fv (tetrahedron4 c)) (ccwz . ccwz)
 249
 250 tetrahedron7 :: Cube -> Tetrahedron
 251 tetrahedron7 c =
 252     Tetrahedron fv' v0' v1' v2' v3'
 253     where
 254       v0' = center c
 255       v1' = center (top_face c)
 256       v2' = Face.v3 (top_face c)
 257       v3' = Face.v0 (top_face c)
 258       fv' = rotate (Tetrahedron.fv (tetrahedron4 c)) cwz
 259
 260 tetrahedron8 :: Cube -> Tetrahedron
 261 tetrahedron8 c =
 262     Tetrahedron fv' v0' v1' v2' v3'
 263     where
 264       v0' = center c
 265       v1' = center (back_face c)
 266       v2' = Face.v0 (back_face c)
 267       v3' = Face.v1 (back_face c)
 268       fv' = rotate (Tetrahedron.fv (tetrahedron4 c)) cwy
 269
 270 tetrahedron9 :: Cube -> Tetrahedron
 271 tetrahedron9 c =
 272     Tetrahedron fv' v0' v1' v2' v3'
 273     where
 274       v0' = center c
 275       v1' = center (back_face c)
 276       v2' = Face.v1 (back_face c)
 277       v3' = Face.v2 (back_face c)
 278       fv' = rotate (Tetrahedron.fv (tetrahedron8 c)) ccwx
 279
 280 tetrahedron10 :: Cube -> Tetrahedron
 281 tetrahedron10 c =
 282     Tetrahedron fv' v0' v1' v2' v3'
 283     where
 284       v0' = center c
 285       v1' = center (back_face c)
 286       v2' = Face.v2 (back_face c)
 287       v3' = Face.v3 (back_face c)
 288       fv' = rotate (Tetrahedron.fv (tetrahedron8 c)) (ccwx . ccwx)
 289
 290
 291 tetrahedron11 :: Cube -> Tetrahedron
 292 tetrahedron11 c =
 293     Tetrahedron fv' v0' v1' v2' v3'
 294     where
 295       v0' = center c
 296       v1' = center (back_face c)
 297       v2' = Face.v3 (back_face c)
 298       v3' = Face.v0 (back_face c)
 299       fv' = rotate (Tetrahedron.fv (tetrahedron8 c)) cwx
 300
 301
 302 tetrahedron12 :: Cube -> Tetrahedron
 303 tetrahedron12 c =
 304     Tetrahedron fv' v0' v1' v2' v3'
 305     where
 306       v0' = center c
 307       v1' = center (down_face c)
 308       v2' = Face.v0 (down_face c)
 309       v3' = Face.v1 (down_face c)
 310       fv' = rotate (Tetrahedron.fv (tetrahedron8 c)) cwy
 311
 312
 313 tetrahedron13 :: Cube -> Tetrahedron
 314 tetrahedron13 c =
 315     Tetrahedron fv' v0' v1' v2' v3'
 316     where
 317       v0' = center c
 318       v1' = center (down_face c)
 319       v2' = Face.v1 (down_face c)
 320       v3' = Face.v2 (down_face c)
 321       fv' = rotate (Tetrahedron.fv (tetrahedron12 c)) ccwz
 322
 323
 324 tetrahedron14 :: Cube -> Tetrahedron
 325 tetrahedron14 c =
 326     Tetrahedron fv' v0' v1' v2' v3'
 327     where
 328       v0' = center c
 329       v1' = center (down_face c)
 330       v2' = Face.v2 (down_face c)
 331       v3' = Face.v3 (down_face c)
 332       fv' = rotate (Tetrahedron.fv (tetrahedron13 c)) (ccwz . ccwz)
 333
 334
 335 tetrahedron15 :: Cube -> Tetrahedron
 336 tetrahedron15 c =
 337     Tetrahedron fv' v0' v1' v2' v3'
 338     where
 339       v0' = center c
 340       v1' = center (down_face c)
 341       v2' = Face.v3 (down_face c)
 342       v3' = Face.v0 (down_face c)
 343       fv' = rotate (Tetrahedron.fv (tetrahedron12 c)) cwz
 344
 345
 346 tetrahedrons :: Cube -> [Tetrahedron]
 347 tetrahedrons c =
 348     [tetrahedron0 c,
 349      tetrahedron1 c,
 350      tetrahedron2 c,
 351      tetrahedron3 c,
 352      tetrahedron4 c,
 353      tetrahedron5 c,
 354      tetrahedron6 c,
 355      tetrahedron7 c,
 356      tetrahedron8 c,
 357      tetrahedron9 c,
 358      tetrahedron10 c,
 359      tetrahedron11 c,
 360      tetrahedron12 c,
 361      tetrahedron13 c,
 362      tetrahedron14 c,
 363      tetrahedron15 c
 364                 --  tetrahedron16 c,
 365                 --  tetrahedron17 c,
 366                 --  tetrahedron18 c,
 367                 --  tetrahedron19 c,
 368                 --  tetrahedron20 c,
 369                 --  tetrahedron21 c,
 370                 --  tetrahedron21 c,
 371                 --  tetrahedron22 c,
 372                 --  tetrahedron23 c,
 373                 --  tetrahedron24 c
 374     ]