src/Tests/Tetrahedron.hs

   1 module Tests.Tetrahedron
   2 where
   3
   4 import Test.HUnit
   5 import Test.QuickCheck
   6
   7 import Comparisons
   8 import Cube
   9 import Point
  10 import Tests.Cube()
  11 import Tetrahedron
  12 import ThreeDimensional
  13
  14 instance Arbitrary Tetrahedron where
  15     arbitrary = do
  16       rnd_c0 <- arbitrary :: Gen Cube
  17       rnd_v0 <- arbitrary :: Gen Point
  18       rnd_v1 <- arbitrary :: Gen Point
  19       rnd_v2 <- arbitrary :: Gen Point
  20       rnd_v3 <- arbitrary :: Gen Point
  21       return (Tetrahedron rnd_c0 rnd_v0 rnd_v1 rnd_v2 rnd_v3)
  22
  23 -- HUnit Tests
  24
  25 -- Since p0, p1, p2 are in clockwise order, we expect the volume here
  26 -- to be negative.
  27 test_volume1 :: Test
  28 test_volume1 =
  29     TestCase $ assertEqual "volume is correct" True (vol ~= (-1/3))
  30     where
  31       p0 = (0, -0.5, 0)
  32       p1 = (0, 0.5, 0)
  33       p2 = (2, 0, 0)
  34       p3 = (1, 0, 1)
  35       t = Tetrahedron { cube = empty_cube,
  36                         v0 = p0,
  37                         v1 = p1,
  38                         v2 = p2,
  39                         v3 = p3 }
  40       vol = volume t
  41
  42
  43 -- Now, p0, p1, and p2 are in counter-clockwise order. The volume
  44 -- should therefore be positive.
  45 test_volume2 :: Test
  46 test_volume2 =
  47     TestCase $ assertEqual "volume is correct" True (vol ~= (1/3))
  48     where
  49       p0 = (0, -0.5, 0)
  50       p1 = (2, 0, 0)
  51       p2 = (0, 0.5, 0)
  52       p3 = (1, 0, 1)
  53       t = Tetrahedron { cube = empty_cube,
  54                         v0 = p0,
  55                         v1 = p1,
  56                         v2 = p2,
  57                         v3 = p3 }
  58       vol = volume t
  59
  60 test_contains_point1 :: Test
  61 test_contains_point1 =
  62     TestCase $ assertEqual "contains an inner point" True (contains_point t inner_point)
  63     where
  64       p0 = (0, -0.5, 0)
  65       p1 = (0, 0.5, 0)
  66       p2 = (2, 0, 0)
  67       p3 = (1, 0, 1)
  68       inner_point = (1, 0, 0.5)
  69       t = Tetrahedron { cube = empty_cube,
  70                         v0 = p0,
  71                         v1 = p1,
  72                         v2 = p2,
  73                         v3 = p3 }
  74
  75
  76 test_doesnt_contain_point1 :: Test
  77 test_doesnt_contain_point1 =
  78     TestCase $ assertEqual "doesn't contain an exterior point" False (contains_point t exterior_point)
  79     where
  80       p0 = (0, -0.5, 0)
  81       p1 = (0, 0.5, 0)
  82       p2 = (2, 0, 0)
  83       p3 = (1, 0, 1)
  84       exterior_point = (5, 2, -9.0212)
  85       c_empty = empty_cube
  86       t = Tetrahedron { cube = c_empty,
  87                         v0 = p0,
  88                         v1 = p1,
  89                         v2 = p2,
  90                         v3 = p3 }
  91
  92
  93 test_doesnt_contain_point2 :: Test
  94 test_doesnt_contain_point2 =
  95     TestCase $ assertEqual "doesn't contain an exterior point" False (contains_point t exterior_point)
  96     where
  97       p0 = (0, 1, 1)
  98       p1 = (1, 1, 1)
  99       p2 = (0.5, 0.5, 1)
 100       p3 = (0.5, 0.5, 0.5)
 101       exterior_point = (0, 0, 0)
 102       c_empty = empty_cube
 103       t = Tetrahedron { cube = c_empty,
 104                         v0 = p0,
 105                         v1 = p1,
 106                         v2 = p2,
 107                         v3 = p3 }
 108
 109 test_doesnt_contain_point3 :: Test
 110 test_doesnt_contain_point3 =
 111     TestCase $ assertEqual "doesn't contain an exterior point" False (contains_point t exterior_point)
 112     where
 113       p0 = (1, 1, 1)
 114       p1 = (1, 0, 1)
 115       p2 = (0.5, 0.5, 1)
 116       p3 = (0.5, 0.5, 0.5)
 117       exterior_point = (0, 0, 0)
 118       c_empty = empty_cube
 119       t = Tetrahedron { cube = c_empty,
 120                         v0 = p0,
 121                         v1 = p1,
 122                         v2 = p2,
 123                         v3 = p3 }
 124
 125 test_doesnt_contain_point4 :: Test
 126 test_doesnt_contain_point4 =
 127     TestCase $ assertEqual "doesn't contain an exterior point" False (contains_point t exterior_point)
 128     where
 129       p0 = (1, 0, 1)
 130       p1 = (0, 0, 1)
 131       p2 = (0.5, 0.5, 1)
 132       p3 = (0.5, 0.5, 0.5)
 133       exterior_point = (0, 0, 0)
 134       c_empty = empty_cube
 135       t = Tetrahedron { cube = c_empty,
 136                         v0 = p0,
 137                         v1 = p1,
 138                         v2 = p2,
 139                         v3 = p3 }
 140
 141 test_doesnt_contain_point5 :: Test
 142 test_doesnt_contain_point5 =
 143     TestCase $ assertEqual "doesn't contain an exterior point" False (contains_point t exterior_point)
 144     where
 145       p0 = (0, 0, 1)
 146       p1 = (0, 1, 1)
 147       p2 = (0.5, 0.5, 1)
 148       p3 = (0.5, 0.5, 0.5)
 149       exterior_point = (0, 0, 0)
 150       c_empty = empty_cube
 151       t = Tetrahedron { cube = c_empty,
 152                         v0 = p0,
 153                         v1 = p1,
 154                         v2 = p2,
 155                         v3 = p3 }
 156
 157 tetrahedron_tests :: [Test]
 158 tetrahedron_tests = [test_volume1,
 159                      test_volume2,
 160                      test_contains_point1,
 161                      test_doesnt_contain_point1,
 162                      test_doesnt_contain_point2,
 163                      test_doesnt_contain_point3,
 164                      test_doesnt_contain_point4,
 165                      test_doesnt_contain_point5 ]
 166
 167 prop_b0_v0_always_unity :: Tetrahedron -> Property
 168 prop_b0_v0_always_unity t =
 169     (volume t) > 0 ==> (b0 t) (v0 t) ~= 1.0
 170
 171 prop_b0_v1_always_zero :: Tetrahedron -> Property
 172 prop_b0_v1_always_zero t =
 173     (volume t) > 0 ==> (b0 t) (v1 t) ~= 0
 174
 175 prop_b0_v2_always_zero :: Tetrahedron -> Property
 176 prop_b0_v2_always_zero t =
 177     (volume t) > 0 ==> (b0 t) (v2 t) ~= 0
 178
 179 prop_b0_v3_always_zero :: Tetrahedron -> Property
 180 prop_b0_v3_always_zero t =
 181     (volume t) > 0 ==> (b0 t) (v3 t) ~= 0
 182
 183 prop_b1_v1_always_unity :: Tetrahedron -> Property
 184 prop_b1_v1_always_unity t =
 185     (volume t) > 0 ==> (b1 t) (v1 t) ~= 1.0
 186
 187 prop_b1_v0_always_zero :: Tetrahedron -> Property
 188 prop_b1_v0_always_zero t =
 189     (volume t) > 0 ==> (b1 t) (v0 t) ~= 0
 190
 191 prop_b1_v2_always_zero :: Tetrahedron -> Property
 192 prop_b1_v2_always_zero t =
 193     (volume t) > 0 ==> (b1 t) (v2 t) ~= 0
 194
 195 prop_b1_v3_always_zero :: Tetrahedron -> Property
 196 prop_b1_v3_always_zero t =
 197     (volume t) > 0 ==> (b1 t) (v3 t) ~= 0
 198
 199 prop_b2_v2_always_unity :: Tetrahedron -> Property
 200 prop_b2_v2_always_unity t =
 201     (volume t) > 0 ==> (b2 t) (v2 t) ~= 1.0
 202
 203 prop_b2_v0_always_zero :: Tetrahedron -> Property
 204 prop_b2_v0_always_zero t =
 205     (volume t) > 0 ==> (b2 t) (v0 t) ~= 0
 206
 207 prop_b2_v1_always_zero :: Tetrahedron -> Property
 208 prop_b2_v1_always_zero t =
 209     (volume t) > 0 ==> (b2 t) (v1 t) ~= 0
 210
 211 prop_b2_v3_always_zero :: Tetrahedron -> Property
 212 prop_b2_v3_always_zero t =
 213     (volume t) > 0 ==> (b2 t) (v3 t) ~= 0
 214
 215 prop_b3_v3_always_unity :: Tetrahedron -> Property
 216 prop_b3_v3_always_unity t =
 217     (volume t) > 0 ==> (b3 t) (v3 t) ~= 1.0
 218
 219 prop_b3_v0_always_zero :: Tetrahedron -> Property
 220 prop_b3_v0_always_zero t =
 221     (volume t) > 0 ==> (b3 t) (v0 t) ~= 0
 222
 223 prop_b3_v1_always_zero :: Tetrahedron -> Property
 224 prop_b3_v1_always_zero t =
 225     (volume t) > 0 ==> (b3 t) (v1 t) ~= 0
 226
 227 prop_b3_v2_always_zero :: Tetrahedron -> Property
 228 prop_b3_v2_always_zero t =
 229     (volume t) > 0 ==> (b3 t) (v2 t) ~= 0
 230
 231
 232 -- Used for convenience in the next few tests.
 233 p :: Tetrahedron -> Int -> Int -> Int -> Int -> Double
 234 p t i j k l = (polynomial t) (xi t i j k l)
 235
 236 -- | Given in Sorokina and Zeilfelder, p. 78.
 237 prop_c3000_identity :: Tetrahedron -> Property
 238 prop_c3000_identity t =
 239     (volume t) > 0 ==>
 240                c t 3 0 0 0 ~= p t 3 0 0 0
 241
 242 -- | Given in Sorokina and Zeilfelder, p. 78.
 243 prop_c2100_identity :: Tetrahedron -> Property
 244 prop_c2100_identity t =
 245     (volume t) > 0 ==>
 246       c t 2 1 0 0 ~= (term1 - term2 + term3 - term4)
 247         where
 248           term1 = (1/3)*(p t 0 3 0 0)
 249           term2 = (5/6)*(p t 3 0 0 0)
 250           term3 = 3*(p t 2 1 0 0)
 251           term4 = (3/2)*(p t 1 2 0 0)
 252
 253 -- | Given in Sorokina and Zeilfelder, p. 78.
 254 prop_c1110_identity :: Tetrahedron -> Property
 255 prop_c1110_identity t =
 256     (volume t) > 0 ==>
 257        c t 1 1 1 0 ~= (term1 + term2 - term3 - term4)
 258         where
 259           term1 = (1/3)*((p t 3 0 0 0) + (p t 0 3 0 0) + (p t 0 0 3 0))
 260           term2 = (9/2)*(p t 1 1 1 0)
 261           term3 = (3/4)*((p t 2 1 0 0) + (p t 1 2 0 0) + (p t 2 0 1 0))
 262           term4 = (3/4)*((p t 1 0 2 0) + (p t 0 2 1 0) + (p t 0 1 2 0))