X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTetrahedron.hs;h=4bc86581bf0491cf7d8a66bfbcf7f019b66aa3b7;hb=f10cdab8ffeb93b3d36fe8140321c8a94ceb4825;hp=52e9266d992cdc3901104b967361d147d8a4a6ce;hpb=b088e499540a1ccd0ee5acbaf5dc1556fd3ec404;p=spline3.git

diff --git a/src/Tetrahedron.hs b/src/Tetrahedron.hs
index 52e9266..4bc8658 100644
--- a/src/Tetrahedron.hs
+++ b/src/Tetrahedron.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+
 module Tetrahedron (
   Tetrahedron(..),
   b0, -- Cube test
@@ -10,27 +11,25 @@ module Tetrahedron (
   polynomial,
   tetrahedron_properties,
   tetrahedron_tests,
-  volume -- Cube test
-  )
+  volume ) -- Cube test
 where
 
-import qualified Data.Vector as V (
-  singleton,
-  snoc,
-  sum
-  )
-
-import Test.Framework (Test, testGroup)
-import Test.Framework.Providers.HUnit (testCase)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.HUnit (Assertion, assertEqual)
-import Test.QuickCheck (Arbitrary(..), Gen, Property, (==>))
-
-import Comparisons ((~=))
-import FunctionValues (FunctionValues(..), empty_values)
-import Misc (factorial)
-import Point (Point(..), scale)
-import RealFunction (RealFunction, cmult, fexp)
+import Data.Vector ( singleton, snoc )
+import qualified Data.Vector as V ( sum )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( Assertion, assertEqual, testCase )
+import Test.Tasty.QuickCheck (
+  Arbitrary( arbitrary ),
+  Gen,
+  Property,
+  (==>),
+  testProperty )
+
+import Comparisons ( (~=) )
+import FunctionValues ( FunctionValues(..), empty_values )
+import Misc ( factorial )
+import Point ( Point(Point), scale )
+import RealFunction ( RealFunction, cmult, fexp )
 
 data Tetrahedron =
   Tetrahedron { function_values :: FunctionValues,
@@ -78,25 +77,25 @@ barycenter (Tetrahedron _ v0' v1' v2' v3' _) =
 {-# INLINE polynomial #-}
 polynomial :: Tetrahedron -> (RealFunction Point)
 polynomial t =
-    V.sum $ V.singleton ((c t 0 0 0 3) `cmult` (beta t 0 0 0 3)) `V.snoc`
-            ((c t 0 0 1 2) `cmult` (beta t 0 0 1 2)) `V.snoc`
-            ((c t 0 0 2 1) `cmult` (beta t 0 0 2 1)) `V.snoc`
-            ((c t 0 0 3 0) `cmult` (beta t 0 0 3 0)) `V.snoc`
-            ((c t 0 1 0 2) `cmult` (beta t 0 1 0 2)) `V.snoc`
-            ((c t 0 1 1 1) `cmult` (beta t 0 1 1 1)) `V.snoc`
-            ((c t 0 1 2 0) `cmult` (beta t 0 1 2 0)) `V.snoc`
-            ((c t 0 2 0 1) `cmult` (beta t 0 2 0 1)) `V.snoc`
-            ((c t 0 2 1 0) `cmult` (beta t 0 2 1 0)) `V.snoc`
-            ((c t 0 3 0 0) `cmult` (beta t 0 3 0 0)) `V.snoc`
-            ((c t 1 0 0 2) `cmult` (beta t 1 0 0 2)) `V.snoc`
-            ((c t 1 0 1 1) `cmult` (beta t 1 0 1 1)) `V.snoc`
-            ((c t 1 0 2 0) `cmult` (beta t 1 0 2 0)) `V.snoc`
-            ((c t 1 1 0 1) `cmult` (beta t 1 1 0 1)) `V.snoc`
-            ((c t 1 1 1 0) `cmult` (beta t 1 1 1 0)) `V.snoc`
-            ((c t 1 2 0 0) `cmult` (beta t 1 2 0 0)) `V.snoc`
-            ((c t 2 0 0 1) `cmult` (beta t 2 0 0 1)) `V.snoc`
-            ((c t 2 0 1 0) `cmult` (beta t 2 0 1 0)) `V.snoc`
-            ((c t 2 1 0 0) `cmult` (beta t 2 1 0 0)) `V.snoc`
+    V.sum $ singleton ((c t 0 0 0 3) `cmult` (beta t 0 0 0 3)) `snoc`
+            ((c t 0 0 1 2) `cmult` (beta t 0 0 1 2)) `snoc`
+            ((c t 0 0 2 1) `cmult` (beta t 0 0 2 1)) `snoc`
+            ((c t 0 0 3 0) `cmult` (beta t 0 0 3 0)) `snoc`
+            ((c t 0 1 0 2) `cmult` (beta t 0 1 0 2)) `snoc`
+            ((c t 0 1 1 1) `cmult` (beta t 0 1 1 1)) `snoc`
+            ((c t 0 1 2 0) `cmult` (beta t 0 1 2 0)) `snoc`
+            ((c t 0 2 0 1) `cmult` (beta t 0 2 0 1)) `snoc`
+            ((c t 0 2 1 0) `cmult` (beta t 0 2 1 0)) `snoc`
+            ((c t 0 3 0 0) `cmult` (beta t 0 3 0 0)) `snoc`
+            ((c t 1 0 0 2) `cmult` (beta t 1 0 0 2)) `snoc`
+            ((c t 1 0 1 1) `cmult` (beta t 1 0 1 1)) `snoc`
+            ((c t 1 0 2 0) `cmult` (beta t 1 0 2 0)) `snoc`
+            ((c t 1 1 0 1) `cmult` (beta t 1 1 0 1)) `snoc`
+            ((c t 1 1 1 0) `cmult` (beta t 1 1 1 0)) `snoc`
+            ((c t 1 2 0 0) `cmult` (beta t 1 2 0 0)) `snoc`
+            ((c t 2 0 0 1) `cmult` (beta t 2 0 0 1)) `snoc`
+            ((c t 2 0 1 0) `cmult` (beta t 2 0 1 0)) `snoc`
+            ((c t 2 1 0 0) `cmult` (beta t 2 1 0 0)) `snoc`
             ((c t 3 0 0 0) `cmult` (beta t 3 0 0 0))
 
 
@@ -108,7 +107,7 @@ beta t i j k l =
   coefficient `cmult` (b0_term * b1_term * b2_term * b3_term)
   where
     denominator = (factorial i)*(factorial j)*(factorial k)*(factorial l)
-    coefficient = 6 / (fromIntegral denominator)
+    coefficient = (6 / (fromIntegral denominator)) :: Double
     b0_term = (b0 t) `fexp` i
     b1_term = (b1 t) `fexp` j
     b2_term = (b2 t) `fexp` k
@@ -325,7 +324,7 @@ b3 t point = (volume inner_tetrahedron) / (precomputed_volume t)
 -- | Check the volume of a particular tetrahedron (computed by hand)
 --   Its vertices are in clockwise order, so the volume should be
 --   negative.
-tetrahedron1_geometry_tests :: Test.Framework.Test
+tetrahedron1_geometry_tests :: TestTree
 tetrahedron1_geometry_tests =
   testGroup "tetrahedron1 geometry"
               [ testCase "volume1" volume1 ]
@@ -351,7 +350,7 @@ tetrahedron1_geometry_tests =
 -- | Check the volume of a particular tetrahedron (computed by hand)
 --   Its vertices are in counter-clockwise order, so the volume should
 --   be positive.
-tetrahedron2_geometry_tests :: Test.Framework.Test
+tetrahedron2_geometry_tests :: TestTree
 tetrahedron2_geometry_tests =
   testGroup "tetrahedron2 geometry"
               [ testCase "volume1" volume1 ]
@@ -498,17 +497,17 @@ prop_swapping_vertices_doesnt_affect_coefficients4 t =
 
 
 
-tetrahedron_tests :: Test.Framework.Test
+tetrahedron_tests :: TestTree
 tetrahedron_tests =
-    testGroup "Tetrahedron Tests" [
+    testGroup "Tetrahedron tests" [
       tetrahedron1_geometry_tests,
       tetrahedron2_geometry_tests ]
 
 
 
-p78_24_properties :: Test.Framework.Test
+p78_24_properties :: TestTree
 p78_24_properties =
-  testGroup "p. 78, Section (2.4) Properties" [
+  testGroup "p. 78, Section (2.4) properties" [
     testProperty "c3000 identity" prop_c3000_identity,
     testProperty "c2100 identity" prop_c2100_identity,
     testProperty "c1110 identity" prop_c1110_identity]
@@ -560,9 +559,9 @@ p78_24_properties =
 
 
 
-tetrahedron_properties :: Test.Framework.Test
+tetrahedron_properties :: TestTree
 tetrahedron_properties =
-  testGroup "Tetrahedron Properties" [
+  testGroup "Tetrahedron properties" [
     p78_24_properties,
     testProperty "b0_v0_always_unity" prop_b0_v0_always_unity,
     testProperty "b0_v1_always_zero" prop_b0_v1_always_zero,
@@ -580,11 +579,11 @@ tetrahedron_properties =
     testProperty "b3_v0_always_zero" prop_b3_v0_always_zero,
     testProperty "b3_v1_always_zero" prop_b3_v1_always_zero,
     testProperty "b3_v2_always_zero" prop_b3_v2_always_zero,
-    testProperty "swapping_vertices_doesnt_affect_coefficients1" $
+    testProperty "swapping_vertices_doesnt_affect_coefficients1"
       prop_swapping_vertices_doesnt_affect_coefficients1,
-    testProperty "swapping_vertices_doesnt_affect_coefficients2" $
+    testProperty "swapping_vertices_doesnt_affect_coefficients2"
       prop_swapping_vertices_doesnt_affect_coefficients2,
-    testProperty "swapping_vertices_doesnt_affect_coefficients3" $
+    testProperty "swapping_vertices_doesnt_affect_coefficients3"
       prop_swapping_vertices_doesnt_affect_coefficients3,
-    testProperty "swapping_vertices_doesnt_affect_coefficients4" $
+    testProperty "swapping_vertices_doesnt_affect_coefficients4"
       prop_swapping_vertices_doesnt_affect_coefficients4 ]