X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FCube.hs;h=5b5f2af690d3230bf06595ae133a05b313b840a3;hb=374d036a09ca086d73dabd7196d888ff76b90610;hp=d873a379ddfca39eba80bf7cb3022b258addfacc;hpb=408f4da9058366cd8047592aa96f97bcc348d329;p=spline3.git

diff --git a/src/Cube.hs b/src/Cube.hs
index d873a37..5b5f2af 100644
--- a/src/Cube.hs
+++ b/src/Cube.hs
@@ -2,10 +2,10 @@ module Cube
 where
 
 import Cardinal
-import Face (Face(Face, v0, v1, v2, v3))
+import qualified Face (Face(Face, v0, v1, v2, v3))
 import FunctionValues
 import Point
-import Tetrahedron (Tetrahedron(Tetrahedron), fv)
+import Tetrahedron hiding (c)
 import ThreeDimensional
 
 data Cube = Cube { h :: Double,
@@ -18,15 +18,22 @@ data Cube = Cube { h :: Double,
 
 instance Show Cube where
     show c =
-        "Cube_" ++ (show (i c)) ++ "," ++ (show (j c)) ++ "," ++ (show (k 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)) ++ ")"
-
+        "Cube_" ++ subscript ++ "\n" ++
+        " h: " ++ (show (h c)) ++ "\n" ++
+        " Center: " ++ (show (center c)) ++ "\n" ++
+        " xmin: " ++ (show (xmin c)) ++ "\n" ++
+        " xmax: " ++ (show (xmax c)) ++ "\n" ++
+        " ymin: " ++ (show (ymin c)) ++ "\n" ++
+        " ymax: " ++ (show (ymax c)) ++ "\n" ++
+        " zmin: " ++ (show (zmin c)) ++ "\n" ++
+        " zmax: " ++ (show (zmax c)) ++ "\n" ++
+        " fv: " ++ (show (Cube.fv c)) ++ "\n"
+        where
+          subscript =
+              (show (i c)) ++ "," ++ (show (j c)) ++ "," ++ (show (k c))
+
+
+-- | Returns an empty 'Cube'.
 empty_cube :: Cube
 empty_cube = Cube 0 0 0 0 empty_values
 
@@ -81,7 +88,7 @@ zmax c = (2*k' + 1)*delta / 2
 
 instance ThreeDimensional Cube where
     -- | The center of Cube_ijk coincides with v_ijk at
-    --   (ih, jh, kh). See Sorokina and Zeilfelder, p. 76.
+    --   (ih, jh, kh). See Sorokina and Zeilfelder, p. 76.    
     center c = (x, y, z)
            where
              delta = h c
@@ -92,6 +99,8 @@ instance ThreeDimensional Cube where
              y = delta * j'
              z = delta * k'
 
+    -- | It's easy to tell if a point is within a cube; just make sure
+    --   that it falls on the proper side of each of the cube's faces.
     contains_point c p
         | (x_coord p) < (xmin c) = False
         | (x_coord p) > (xmax c) = False
@@ -102,94 +111,47 @@ 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)
-
---     (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)
-
---     signum (Cube g1 i1 j1 k1 d1) =
---         Cube g1 (signum i1) (signum j1) (signum k1) (signum d1)
-
---     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)
-
---     recip (Cube g1 i1 j1 k1 d1) =
---         Cube g1 i1 j1 k1 (recip d1)
-
---     fromRational q = empty_cube { datum = fromRational q }
-
-
-
--- | 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'
-
-
-
-
-
 
 -- 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'
+top_face :: Cube -> Face.Face
+top_face c = Face.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)
+      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'
+back_face :: Cube -> Face.Face
+back_face c = Face.Face v0' v1' v2' v3'
     where
       delta = (1/2)*(h c)
-      v0' = (center c) + (delta, delta, delta)
+      v0' = (center c) + (delta, -delta, -delta)
       v1' = (center c) + (delta, delta, -delta)
-      v2' = (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'
+down_face :: Cube -> Face.Face
+down_face c = Face.Face v0' v1' v2' v3'
     where
       delta = (1/2)*(h c)
-      v0' = (center c) + (delta, delta, -delta)
+      v0' = (center c) + (-delta, -delta, -delta)
       v1' = (center c) + (-delta, delta, -delta)
-      v2' = (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'
+front_face :: Cube -> Face.Face
+front_face c = Face.Face v0' v1' v2' v3'
     where
       delta = (1/2)*(h c)
       v0' = (center c) + (-delta, -delta, delta)
@@ -197,28 +159,26 @@ front_face c = Face v0' v1' v2' v3'
       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'
+left_face :: Cube -> Face.Face
+left_face c = Face.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)
+      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'
+right_face :: Cube -> Face.Face
+right_face c = Face.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)
-
+      v0' = (center c) + (-delta, delta, delta)
+      v1' = (center c) + (delta, delta, delta)
+      v2' = (center c) + (delta, delta, -delta)
+      v3' = (center c) + (-delta, delta, -delta)
 
 
 tetrahedron0 :: Cube -> Tetrahedron
@@ -227,8 +187,8 @@ tetrahedron0 c =
     where
       v0' = center c
       v1' = center (front_face c)
-      v2' = v0 (front_face c)
-      v3' = v1 (front_face c)
+      v2' = Face.v0 (front_face c)
+      v3' = Face.v1 (front_face c)
 
 tetrahedron1 :: Cube -> Tetrahedron
 tetrahedron1 c =
@@ -236,9 +196,9 @@ tetrahedron1 c =
     where
       v0' = center c
       v1' = center (front_face c)
-      v2' = v1 (front_face c)
-      v3' = v2 (front_face c)
-      fv' = rotate (Cube.fv c) ccwx
+      v2' = Face.v1 (front_face c)
+      v3' = Face.v2 (front_face c)
+      fv' = rotate (Cube.fv c) cwx
 
 tetrahedron2 :: Cube -> Tetrahedron
 tetrahedron2 c =
@@ -246,9 +206,9 @@ tetrahedron2 c =
     where
       v0' = center c
       v1' = center (front_face c)
-      v2' = v2 (front_face c)
-      v3' = v3 (front_face c)
-      fv' = rotate (Cube.fv c) (ccwx . ccwx)
+      v2' = Face.v2 (front_face c)
+      v3' = Face.v3 (front_face c)
+      fv' = rotate (Cube.fv c) (cwx . cwx)
 
 tetrahedron3 :: Cube -> Tetrahedron
 tetrahedron3 c =
@@ -256,9 +216,9 @@ tetrahedron3 c =
     where
       v0' = center c
       v1' = center (front_face c)
-      v2' = v3 (front_face c)
-      v3' = v1 (front_face c)
-      fv' = rotate (Cube.fv c) cwx
+      v2' = Face.v3 (front_face c)
+      v3' = Face.v0 (front_face c)
+      fv' = rotate (Cube.fv c) ccwx
 
 tetrahedron4 :: Cube -> Tetrahedron
 tetrahedron4 c =
@@ -266,9 +226,9 @@ tetrahedron4 c =
     where
       v0' = center c
       v1' = center (top_face c)
-      v2' = v0 (front_face c)
-      v3' = v1 (front_face c)
-      fv' = rotate (Cube.fv c) cwy
+      v2' = Face.v0 (top_face c)
+      v3' = Face.v1 (top_face c)
+      fv' = rotate (Cube.fv c) ccwy
 
 tetrahedron5 :: Cube -> Tetrahedron
 tetrahedron5 c =
@@ -276,27 +236,203 @@ tetrahedron5 c =
     where
       v0' = center c
       v1' = center (top_face c)
-      v2' = v1 (top_face c)
-      v3' = v2 (top_face c)
-      fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) ccwx
+      v2' = Face.v1 (top_face c)
+      v3' = Face.v2 (top_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron4 c)) cwz
 
+tetrahedron6 :: Cube -> Tetrahedron
 tetrahedron6 c =
     Tetrahedron fv' v0' v1' v2' v3'
     where
       v0' = center c
       v1' = center (top_face c)
-      v2' = v2 (top_face c)
-      v3' = v3 (top_face c)
-      fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) (ccwx . ccwx)
+      v2' = Face.v2 (top_face c)
+      v3' = Face.v3 (top_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron4 c)) (cwz . cwz)
 
+tetrahedron7 :: Cube -> Tetrahedron
 tetrahedron7 c =
     Tetrahedron fv' v0' v1' v2' v3'
     where
       v0' = center c
       v1' = center (top_face c)
-      v2' = v3 (top_face c)
-      v3' = v1 (top_face c)
-      fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) cwx
+      v2' = Face.v3 (top_face c)
+      v3' = Face.v0 (top_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron4 c)) ccwz
+
+tetrahedron8 :: Cube -> Tetrahedron
+tetrahedron8 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (back_face c)
+      v2' = Face.v0 (back_face c)
+      v3' = Face.v1 (back_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron4 c)) ccwy
+
+tetrahedron9 :: Cube -> Tetrahedron
+tetrahedron9 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (back_face c)
+      v2' = Face.v1 (back_face c)
+      v3' = Face.v2 (back_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron8 c)) cwx
+
+tetrahedron10 :: Cube -> Tetrahedron
+tetrahedron10 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (back_face c)
+      v2' = Face.v2 (back_face c)
+      v3' = Face.v3 (back_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron8 c)) (cwx . cwx)
+
+
+tetrahedron11 :: Cube -> Tetrahedron
+tetrahedron11 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (back_face c)
+      v2' = Face.v3 (back_face c)
+      v3' = Face.v0 (back_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron8 c)) ccwx
+
+
+tetrahedron12 :: Cube -> Tetrahedron
+tetrahedron12 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (down_face c)
+      v2' = Face.v0 (down_face c)
+      v3' = Face.v1 (down_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron8 c)) ccwy
+
+
+tetrahedron13 :: Cube -> Tetrahedron
+tetrahedron13 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (down_face c)
+      v2' = Face.v1 (down_face c)
+      v3' = Face.v2 (down_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron12 c)) cwz
+
+
+tetrahedron14 :: Cube -> Tetrahedron
+tetrahedron14 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (down_face c)
+      v2' = Face.v2 (down_face c)
+      v3' = Face.v3 (down_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron13 c)) (cwz . cwz)
+
+
+tetrahedron15 :: Cube -> Tetrahedron
+tetrahedron15 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (down_face c)
+      v2' = Face.v3 (down_face c)
+      v3' = Face.v0 (down_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron12 c)) ccwz
+
+
+tetrahedron16 :: Cube -> Tetrahedron
+tetrahedron16 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (right_face c)
+      v2' = Face.v0 (right_face c)
+      v3' = Face.v1 (right_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) cwz
+
+
+tetrahedron17 :: Cube -> Tetrahedron
+tetrahedron17 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (right_face c)
+      v2' = Face.v1 (right_face c)
+      v3' = Face.v2 (right_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron16 c)) cwy
+
+
+tetrahedron18 :: Cube -> Tetrahedron
+tetrahedron18 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (right_face c)
+      v2' = Face.v2 (right_face c)
+      v3' = Face.v3 (right_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron16 c)) (cwy . cwy)
+
+
+tetrahedron19 :: Cube -> Tetrahedron
+tetrahedron19 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (right_face c)
+      v2' = Face.v3 (right_face c)
+      v3' = Face.v0 (right_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron16 c)) ccwy
+
+
+tetrahedron20 :: Cube -> Tetrahedron
+tetrahedron20 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (left_face c)
+      v2' = Face.v0 (left_face c)
+      v3' = Face.v1 (left_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) ccwz
+
+
+tetrahedron21 :: Cube -> Tetrahedron
+tetrahedron21 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (left_face c)
+      v2' = Face.v1 (left_face c)
+      v3' = Face.v2 (left_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron20 c)) cwy
+
+
+tetrahedron22 :: Cube -> Tetrahedron
+tetrahedron22 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (left_face c)
+      v2' = Face.v2 (left_face c)
+      v3' = Face.v3 (left_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron20 c)) (cwy . cwy)
+
+
+tetrahedron23 :: Cube -> Tetrahedron
+tetrahedron23 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (left_face c)
+      v2' = Face.v3 (left_face c)
+      v3' = Face.v0 (left_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron20 c)) ccwy
+
 
 tetrahedrons :: Cube -> [Tetrahedron]
 tetrahedrons c =
@@ -307,24 +443,20 @@ tetrahedrons c =
      tetrahedron4 c,
      tetrahedron5 c,
      tetrahedron6 c,
-     tetrahedron7 c
-                -- ,
-                --  tetrahedron8 c,
-                --  tetrahedron9 c,
-                --  tetrahedron10 c,
-                --  tetrahedron11 c,
-                --  tetrahedron12 c,
-                --  tetrahedron13 c,
-                --  tetrahedron14 c,
-                --  tetrahedron15 c,
-                --  tetrahedron16 c,
-                --  tetrahedron17 c,
-                --  tetrahedron18 c,
-                --  tetrahedron19 c,
-                --  tetrahedron20 c,
-                --  tetrahedron21 c,
-                --  tetrahedron21 c,
-                --  tetrahedron22 c,
-                --  tetrahedron23 c,
-                --  tetrahedron24 c
-    ]
+     tetrahedron7 c,
+     tetrahedron8 c,
+     tetrahedron9 c,
+     tetrahedron10 c,
+     tetrahedron11 c,
+     tetrahedron12 c,
+     tetrahedron13 c,
+     tetrahedron14 c,
+     tetrahedron15 c,
+     tetrahedron16 c,
+     tetrahedron17 c,
+     tetrahedron18 c,
+     tetrahedron19 c,
+     tetrahedron20 c,
+     tetrahedron21 c,
+     tetrahedron22 c,
+     tetrahedron23 c]