X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FFunctionValues.hs;h=bc1414630a6ca44b64e7667cf08423e388634a99;hb=HEAD;hp=5c44dc53902b503c8a71f0da431d36effa565de7;hpb=a499efdb0e215ac424fe7c38a52430daebefc22b;p=spline3.git diff --git a/src/FunctionValues.hs b/src/FunctionValues.hs index 5c44dc5..bc14146 100644 --- a/src/FunctionValues.hs +++ b/src/FunctionValues.hs @@ -1,3 +1,6 @@ +-- The "value_at" function pattern matches on some integers, but +-- doesn't handle the "otherwise" case, for performance reasons. +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} {-# LANGUAGE BangPatterns #-} -- | The FunctionValues module contains the 'FunctionValues' type and @@ -14,13 +17,31 @@ module FunctionValues ( value_at ) where -import Prelude hiding ( LT ) +import Prelude( + Bool, + Double, + Eq( (==) ), + Fractional( (/) ), + Int, + Num( (+), (-), (*) ), + Ord ( (>=), (<) ), + Show, + (&&), + and, + not, + return ) import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.HUnit ( Assertion, testCase ) -import Test.Tasty.QuickCheck ( Arbitrary(..), choose, testProperty ) +import Test.Tasty.QuickCheck ( Arbitrary( arbitrary ), choose, testProperty ) import Assertions ( assertTrue ) -import Cardinal ( Cardinal(..), cwx, cwy, cwz ) +import Cardinal ( + Cardinal(F, B, L, R, D, T, FL, FR, FD, FT, BL, BR, BD, BT, LD, LT, RD, + RT, FLD, FLT, FRD, FRT, BLD, BLT, BRD, BRT, I, Scalar, Sum, + Difference, Product, Quotient ), + cwx, + cwy, + cwz ) import Examples ( trilinear ) import Values ( Values3D, dims, idx ) @@ -269,32 +290,32 @@ value_at v3d !i !j !k -- object centered at (i,j,k) make_values :: Values3D -> Int -> Int -> Int -> FunctionValues make_values values !i !j !k = - empty_values { front = value_at values (i-1) j k, - back = value_at values (i+1) j k, - left = value_at values i (j-1) k, - right = value_at values i (j+1) k, - down = value_at values i j (k-1), - top = value_at values i j (k+1), - front_left = value_at values (i-1) (j-1) k, - front_right = value_at values (i-1) (j+1) k, - front_down =value_at values (i-1) j (k-1), - front_top = value_at values (i-1) j (k+1), - back_left = value_at values (i+1) (j-1) k, - back_right = value_at values (i+1) (j+1) k, - back_down = value_at values (i+1) j (k-1), - back_top = value_at values (i+1) j (k+1), - left_down = value_at values i (j-1) (k-1), - left_top = value_at values i (j-1) (k+1), - right_down = value_at values i (j+1) (k-1), - right_top = value_at values i (j+1) (k+1), - front_left_down = value_at values (i-1) (j-1) (k-1), - front_left_top = value_at values (i-1) (j-1) (k+1), - front_right_down = value_at values (i-1) (j+1) (k-1), - front_right_top = value_at values (i-1) (j+1) (k+1), - back_left_down = value_at values (i+1) (j-1) (k-1), - back_left_top = value_at values (i+1) (j-1) (k+1), - back_right_down = value_at values (i+1) (j+1) (k-1), - back_right_top = value_at values (i+1) (j+1) (k+1), + empty_values { front = value_at values (i - 1) j k, + back = value_at values (i + 1) j k, + left = value_at values i (j - 1) k, + right = value_at values i (j + 1) k, + down = value_at values i j (k - 1), + top = value_at values i j (k + 1), + front_left = value_at values (i - 1) (j - 1) k, + front_right = value_at values (i - 1) (j + 1) k, + front_down =value_at values (i - 1) j (k - 1), + front_top = value_at values (i - 1) j (k + 1), + back_left = value_at values (i + 1) (j - 1) k, + back_right = value_at values (i + 1) (j + 1) k, + back_down = value_at values (i + 1) j (k - 1), + back_top = value_at values (i + 1) j (k + 1), + left_down = value_at values i (j - 1) (k - 1), + left_top = value_at values i (j - 1) (k + 1), + right_down = value_at values i (j + 1) (k - 1), + right_top = value_at values i (j + 1) (k + 1), + front_left_down = value_at values (i - 1) (j - 1) (k - 1), + front_left_top = value_at values (i - 1) (j - 1) (k + 1), + front_right_down = value_at values (i - 1) (j + 1) (k - 1), + front_right_top = value_at values (i - 1) (j + 1) (k + 1), + back_left_down = value_at values (i + 1) (j - 1) (k - 1), + back_left_top = value_at values (i + 1) (j - 1) (k + 1), + back_right_down = value_at values (i + 1) (j + 1) (k - 1), + back_right_top = value_at values (i + 1) (j + 1) (k + 1), interior = value_at values i j k } -- | Takes a 'FunctionValues' and a function that transforms one @@ -429,12 +450,22 @@ prop_z_rotation_doesnt_affect_top fv0 = function_values_properties :: TestTree function_values_properties = - let tp = testProperty - in - testGroup "FunctionValues properties" [ - tp "x rotation doesn't affect front" prop_x_rotation_doesnt_affect_front, - tp "x rotation doesn't affect back" prop_x_rotation_doesnt_affect_back, - tp "y rotation doesn't affect left" prop_y_rotation_doesnt_affect_left, - tp "y rotation doesn't affect right" prop_y_rotation_doesnt_affect_right, - tp "z rotation doesn't affect top" prop_z_rotation_doesnt_affect_top, - tp "z rotation doesn't affect down" prop_z_rotation_doesnt_affect_down ] + testGroup "FunctionValues properties" [ + testProperty + "x rotation doesn't affect front" + prop_x_rotation_doesnt_affect_front, + testProperty + "x rotation doesn't affect back" + prop_x_rotation_doesnt_affect_back, + testProperty + "y rotation doesn't affect left" + prop_y_rotation_doesnt_affect_left, + testProperty + "y rotation doesn't affect right" + prop_y_rotation_doesnt_affect_right, + testProperty + "z rotation doesn't affect top" + prop_z_rotation_doesnt_affect_top, + testProperty + "z rotation doesn't affect down" + prop_z_rotation_doesnt_affect_down ]