Tetrahedron.hs

   1 module Tests.Tetrahedron
   2 where
   3
   4 import Test.HUnit
   5 import Test.QuickCheck
   6
   7 import Comparisons
   8 import Point
   9 import FunctionValues
  10 import Tests.FunctionValues()
  11 import Tetrahedron
  12 import ThreeDimensional
  13
  14 instance Arbitrary Tetrahedron where
  15     arbitrary = do
  16       rnd_v0 <- arbitrary :: Gen Point
  17       rnd_v1 <- arbitrary :: Gen Point
  18       rnd_v2 <- arbitrary :: Gen Point
  19       rnd_v3 <- arbitrary :: Gen Point
  20       rnd_fv <- arbitrary :: Gen FunctionValues
  21       return (Tetrahedron rnd_fv 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 { v0 = p0,
  36                         v1 = p1,
  37                         v2 = p2,
  38                         v3 = p3,
  39                         fv = empty_values }
  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 { v0 = p0,
  54                         v1 = p1,
  55                         v2 = p2,
  56                         v3 = p3,
  57                         fv = empty_values }
  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 { v0 = p0,
  70                         v1 = p1,
  71                         v2 = p2,
  72                         v3 = p3,
  73                         fv = empty_values }
  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       t = Tetrahedron { v0 = p0,
  86                         v1 = p1,
  87                         v2 = p2,
  88                         v3 = p3,
  89                         fv = empty_values }
  90
  91
  92 test_doesnt_contain_point2 :: Test
  93 test_doesnt_contain_point2 =
  94     TestCase $ assertEqual "doesn't contain an exterior point" False (contains_point t exterior_point)
  95     where
  96       p0 = (0, 1, 1)
  97       p1 = (1, 1, 1)
  98       p2 = (0.5, 0.5, 1)
  99       p3 = (0.5, 0.5, 0.5)
 100       exterior_point = (0, 0, 0)
 101       t = Tetrahedron { v0 = p0,
 102                         v1 = p1,
 103                         v2 = p2,
 104                         v3 = p3,
 105                         fv = empty_values }
 106
 107 test_doesnt_contain_point3 :: Test
 108 test_doesnt_contain_point3 =
 109     TestCase $ assertEqual "doesn't contain an exterior point" False (contains_point t exterior_point)
 110     where
 111       p0 = (1, 1, 1)
 112       p1 = (1, 0, 1)
 113       p2 = (0.5, 0.5, 1)
 114       p3 = (0.5, 0.5, 0.5)
 115       exterior_point = (0, 0, 0)
 116       t = Tetrahedron { v0 = p0,
 117                         v1 = p1,
 118                         v2 = p2,
 119                         v3 = p3,
 120                         fv = empty_values }
 121
 122 test_doesnt_contain_point4 :: Test
 123 test_doesnt_contain_point4 =
 124     TestCase $ assertEqual "doesn't contain an exterior point" False (contains_point t exterior_point)
 125     where
 126       p0 = (1, 0, 1)
 127       p1 = (0, 0, 1)
 128       p2 = (0.5, 0.5, 1)
 129       p3 = (0.5, 0.5, 0.5)
 130       exterior_point = (0, 0, 0)
 131       t = Tetrahedron { v0 = p0,
 132                         v1 = p1,
 133                         v2 = p2,
 134                         v3 = p3,
 135                         fv = empty_values }
 136
 137 test_doesnt_contain_point5 :: Test
 138 test_doesnt_contain_point5 =
 139     TestCase $ assertEqual "doesn't contain an exterior point" False (contains_point t exterior_point)
 140     where
 141       p0 = (0, 0, 1)
 142       p1 = (0, 1, 1)
 143       p2 = (0.5, 0.5, 1)
 144       p3 = (0.5, 0.5, 0.5)
 145       exterior_point = (0, 0, 0)
 146       t = Tetrahedron { v0 = p0,
 147                         v1 = p1,
 148                         v2 = p2,
 149                         v3 = p3,
 150                         fv = empty_values }
 151
 152 tetrahedron_tests :: [Test]
 153 tetrahedron_tests = [test_volume1,
 154                      test_volume2,
 155                      test_contains_point1,
 156                      test_doesnt_contain_point1,
 157                      test_doesnt_contain_point2,
 158                      test_doesnt_contain_point3,
 159                      test_doesnt_contain_point4,
 160                      test_doesnt_contain_point5 ]
 161
 162 prop_b0_v0_always_unity :: Tetrahedron -> Property
 163 prop_b0_v0_always_unity t =
 164     (volume t) > 0 ==> (b0 t) (v0 t) ~= 1.0
 165
 166 prop_b0_v1_always_zero :: Tetrahedron -> Property
 167 prop_b0_v1_always_zero t =
 168     (volume t) > 0 ==> (b0 t) (v1 t) ~= 0
 169
 170 prop_b0_v2_always_zero :: Tetrahedron -> Property
 171 prop_b0_v2_always_zero t =
 172     (volume t) > 0 ==> (b0 t) (v2 t) ~= 0
 173
 174 prop_b0_v3_always_zero :: Tetrahedron -> Property
 175 prop_b0_v3_always_zero t =
 176     (volume t) > 0 ==> (b0 t) (v3 t) ~= 0
 177
 178 prop_b1_v1_always_unity :: Tetrahedron -> Property
 179 prop_b1_v1_always_unity t =
 180     (volume t) > 0 ==> (b1 t) (v1 t) ~= 1.0
 181
 182 prop_b1_v0_always_zero :: Tetrahedron -> Property
 183 prop_b1_v0_always_zero t =
 184     (volume t) > 0 ==> (b1 t) (v0 t) ~= 0
 185
 186 prop_b1_v2_always_zero :: Tetrahedron -> Property
 187 prop_b1_v2_always_zero t =
 188     (volume t) > 0 ==> (b1 t) (v2 t) ~= 0
 189
 190 prop_b1_v3_always_zero :: Tetrahedron -> Property
 191 prop_b1_v3_always_zero t =
 192     (volume t) > 0 ==> (b1 t) (v3 t) ~= 0
 193
 194 prop_b2_v2_always_unity :: Tetrahedron -> Property
 195 prop_b2_v2_always_unity t =
 196     (volume t) > 0 ==> (b2 t) (v2 t) ~= 1.0
 197
 198 prop_b2_v0_always_zero :: Tetrahedron -> Property
 199 prop_b2_v0_always_zero t =
 200     (volume t) > 0 ==> (b2 t) (v0 t) ~= 0
 201
 202 prop_b2_v1_always_zero :: Tetrahedron -> Property
 203 prop_b2_v1_always_zero t =
 204     (volume t) > 0 ==> (b2 t) (v1 t) ~= 0
 205
 206 prop_b2_v3_always_zero :: Tetrahedron -> Property
 207 prop_b2_v3_always_zero t =
 208     (volume t) > 0 ==> (b2 t) (v3 t) ~= 0
 209
 210 prop_b3_v3_always_unity :: Tetrahedron -> Property
 211 prop_b3_v3_always_unity t =
 212     (volume t) > 0 ==> (b3 t) (v3 t) ~= 1.0
 213
 214 prop_b3_v0_always_zero :: Tetrahedron -> Property
 215 prop_b3_v0_always_zero t =
 216     (volume t) > 0 ==> (b3 t) (v0 t) ~= 0
 217
 218 prop_b3_v1_always_zero :: Tetrahedron -> Property
 219 prop_b3_v1_always_zero t =
 220     (volume t) > 0 ==> (b3 t) (v1 t) ~= 0
 221
 222 prop_b3_v2_always_zero :: Tetrahedron -> Property
 223 prop_b3_v2_always_zero t =
 224     (volume t) > 0 ==> (b3 t) (v2 t) ~= 0
 225
 226
 227 -- Used for convenience in the next few tests.
 228 p :: Tetrahedron -> Int -> Int -> Int -> Int -> Double
 229 p t i j k l = (polynomial t) (xi t i j k l)
 230
 231 -- | Given in Sorokina and Zeilfelder, p. 78.
 232 prop_c3000_identity :: Tetrahedron -> Property
 233 prop_c3000_identity t =
 234     (volume t) > 0 ==>
 235                c t 3 0 0 0 ~= p t 3 0 0 0
 236
 237 -- | Given in Sorokina and Zeilfelder, p. 78.
 238 prop_c2100_identity :: Tetrahedron -> Property
 239 prop_c2100_identity t =
 240     (volume t) > 0 ==>
 241       c t 2 1 0 0 ~= (term1 - term2 + term3 - term4)
 242         where
 243           term1 = (1/3)*(p t 0 3 0 0)
 244           term2 = (5/6)*(p t 3 0 0 0)
 245           term3 = 3*(p t 2 1 0 0)
 246           term4 = (3/2)*(p t 1 2 0 0)
 247
 248 -- | Given in Sorokina and Zeilfelder, p. 78.
 249 prop_c1110_identity :: Tetrahedron -> Property
 250 prop_c1110_identity t =
 251     (volume t) > 0 ==>
 252        c t 1 1 1 0 ~= (term1 + term2 - term3 - term4)
 253         where
 254           term1 = (1/3)*((p t 3 0 0 0) + (p t 0 3 0 0) + (p t 0 0 3 0))
 255           term2 = (9/2)*(p t 1 1 1 0)
 256           term3 = (3/4)*((p t 2 1 0 0) + (p t 1 2 0 0) + (p t 2 0 1 0))
 257           term4 = (3/4)*((p t 1 0 2 0) + (p t 0 2 1 0) + (p t 0 1 2 0))