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 reorient :: Tetrahedron -> Tetrahedron
 182 reorient t = t
 183 --         | volume t > 0 = t
 184 --         | otherwise = t { v2 = (v3 t),
 185 --                           v3 = (v2 t) }
 186
 187 tetrahedron0 :: Cube -> Tetrahedron
 188 tetrahedron0 c =
 189     reorient $ Tetrahedron (Cube.fv c) v0' v1' v2' v3'
 190     where
 191       v0' = center c
 192       v1' = center (front_face c)
 193       v2' = Face.v0 (front_face c)
 194       v3' = Face.v1 (front_face c)
 195
 196 tetrahedron1 :: Cube -> Tetrahedron
 197 tetrahedron1 c =
 198     reorient $ Tetrahedron fv' v0' v1' v2' v3'
 199     where
 200       v0' = center c
 201       v1' = center (front_face c)
 202       v2' = Face.v1 (front_face c)
 203       v3' = Face.v2 (front_face c)
 204       fv' = rotate (Cube.fv c) ccwx
 205
 206 tetrahedron2 :: Cube -> Tetrahedron
 207 tetrahedron2 c =
 208     reorient $ Tetrahedron fv' v0' v1' v2' v3'
 209     where
 210       v0' = center c
 211       v1' = center (front_face c)
 212       v2' = Face.v2 (front_face c)
 213       v3' = Face.v3 (front_face c)
 214       fv' = rotate (Cube.fv c) (ccwx . ccwx)
 215
 216 tetrahedron3 :: Cube -> Tetrahedron
 217 tetrahedron3 c =
 218     reorient $ Tetrahedron fv' v0' v1' v2' v3'
 219     where
 220       v0' = center c
 221       v1' = center (front_face c)
 222       v2' = Face.v3 (front_face c)
 223       v3' = Face.v0 (front_face c)
 224       fv' = rotate (Cube.fv c) cwx
 225
 226 tetrahedron4 :: Cube -> Tetrahedron
 227 tetrahedron4 c =
 228     reorient $ Tetrahedron fv' v0' v1' v2' v3'
 229     where
 230       v0' = center c
 231       v1' = center (top_face c)
 232       v2' = Face.v0 (top_face c)
 233       v3' = Face.v1 (top_face c)
 234       fv' = rotate (Cube.fv c) cwy
 235
 236 tetrahedron5 :: Cube -> Tetrahedron
 237 tetrahedron5 c =
 238     reorient $ Tetrahedron fv' v0' v1' v2' v3'
 239     where
 240       v0' = center c
 241       v1' = center (top_face c)
 242       v2' = Face.v1 (top_face c)
 243       v3' = Face.v2 (top_face c)
 244       fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) ccwx
 245
 246 tetrahedron6 :: Cube -> Tetrahedron
 247 tetrahedron6 c =
 248     reorient $ Tetrahedron fv' v0' v1' v2' v3'
 249     where
 250       v0' = center c
 251       v1' = center (top_face c)
 252       v2' = Face.v2 (top_face c)
 253       v3' = Face.v3 (top_face c)
 254       fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) (ccwx . ccwx)
 255
 256 tetrahedron7 :: Cube -> Tetrahedron
 257 tetrahedron7 c =
 258     reorient $ Tetrahedron fv' v0' v1' v2' v3'
 259     where
 260       v0' = center c
 261       v1' = center (top_face c)
 262       v2' = Face.v3 (top_face c)
 263       v3' = Face.v0 (top_face c)
 264       fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) cwx
 265
 266 tetrahedrons :: Cube -> [Tetrahedron]
 267 tetrahedrons c =
 268     [tetrahedron0 c,
 269      tetrahedron1 c,
 270      tetrahedron2 c,
 271      tetrahedron3 c,
 272      tetrahedron4 c,
 273      tetrahedron5 c,
 274      tetrahedron6 c,
 275      tetrahedron7 c
 276                 -- ,
 277                 --  tetrahedron8 c,
 278                 --  tetrahedron9 c,
 279                 --  tetrahedron10 c,
 280                 --  tetrahedron11 c,
 281                 --  tetrahedron12 c,
 282                 --  tetrahedron13 c,
 283                 --  tetrahedron14 c,
 284                 --  tetrahedron15 c,
 285                 --  tetrahedron16 c,
 286                 --  tetrahedron17 c,
 287                 --  tetrahedron18 c,
 288                 --  tetrahedron19 c,
 289                 --  tetrahedron20 c,
 290                 --  tetrahedron21 c,
 291                 --  tetrahedron21 c,
 292                 --  tetrahedron22 c,
 293                 --  tetrahedron23 c,
 294                 --  tetrahedron24 c
 295     ]