]> gitweb.michael.orlitzky.com - spline3.git/blobdiff - src/FunctionValues.hs
Choose a nearby value instead of zero when asked for a nonexistent function value.
[spline3.git] / src / FunctionValues.hs
index ed83f73336eac561b7d2450061ecd2bcf5709051..8eb5bdb0d375ffdfe72eabb81097cc99c121e563 100644 (file)
@@ -4,8 +4,10 @@ module FunctionValues
 where
 
 import Prelude hiding (LT)
+import Test.QuickCheck (Arbitrary(..), choose)
 
 import Cardinal
+import Values (Values3D, dims, idx)
 
 -- | The FunctionValues type represents the value of our function f at
 --   the 27 points surrounding (and including) the center of a
@@ -20,27 +22,99 @@ data FunctionValues =
                      down   :: Double,
                      front_left :: Double,
                      front_right :: Double,
-                     front_top :: Double,
                      front_down :: Double,
+                     front_top :: Double,
                      back_left :: Double,
                      back_right :: Double,
-                     back_top :: Double,
                      back_down :: Double,
-                     left_top :: Double,
+                     back_top :: Double,
                      left_down :: Double,
-                     right_top :: Double,
+                     left_top :: Double,
                      right_down :: Double,
-                     front_left_top :: Double,
+                     right_top :: Double,
                      front_left_down :: Double,
-                     front_right_top :: Double,
+                     front_left_top :: Double,
                      front_right_down :: Double,
-                     back_left_top :: Double,
+                     front_right_top :: Double,
                      back_left_down :: Double,
-                     back_right_top :: Double,
+                     back_left_top :: Double,
                      back_right_down :: Double,
+                     back_right_top :: Double,
                      interior :: Double }
       deriving (Eq, Show)
 
+
+instance Arbitrary FunctionValues where
+    arbitrary = do
+      front'  <- choose (min_double, max_double)
+      back'   <- choose (min_double, max_double)
+      left'   <- choose (min_double, max_double)
+      right'  <- choose (min_double, max_double)
+      top'    <- choose (min_double, max_double)
+      down'   <- choose (min_double, max_double)
+      front_left' <- choose (min_double, max_double)
+      front_right' <- choose (min_double, max_double)
+      front_top' <- choose (min_double, max_double)
+      front_down' <- choose (min_double, max_double)
+      back_left' <- choose (min_double, max_double)
+      back_right' <- choose (min_double, max_double)
+      back_top' <- choose (min_double, max_double)
+      back_down' <- choose (min_double, max_double)
+      left_top' <- choose (min_double, max_double)
+      left_down' <- choose (min_double, max_double)
+      right_top' <- choose (min_double, max_double)
+      right_down' <- choose (min_double, max_double)
+      front_left_top' <- choose (min_double, max_double)
+      front_left_down' <- choose (min_double, max_double)
+      front_right_top' <- choose (min_double, max_double)
+      front_right_down' <- choose (min_double, max_double)
+      back_left_top' <- choose (min_double, max_double)
+      back_left_down' <- choose (min_double, max_double)
+      back_right_top' <- choose (min_double, max_double)
+      back_right_down' <- choose (min_double, max_double)
+      interior' <- choose (min_double, max_double)
+
+      return empty_values { front = front',
+                            back  = back',
+                            left  = left',
+                            right = right',
+                            top   = top',
+                            down  = down',
+                            front_left = front_left',
+                            front_right = front_right',
+                            front_top = front_top',
+                            front_down = front_down',
+                            back_left = back_left',
+                            back_right = back_right',
+                            back_top = back_top',
+                            back_down = back_down',
+                            left_top = left_top',
+                            left_down = left_down',
+                            right_top = right_top',
+                            right_down = right_down',
+                            front_left_top = front_left_top',
+                            front_left_down = front_left_down',
+                            front_right_top = front_right_top',
+                            front_right_down = front_right_down',
+                            back_left_top = back_left_top',
+                            back_left_down = back_left_down',
+                            back_right_top = back_right_top',
+                            back_right_down = back_right_down',
+                            interior = interior' }
+      where
+        -- | We perform addition with the function values contained in a
+        --   FunctionValues object. If we choose random doubles near the machine
+        --   min/max, we risk overflowing or underflowing the 'Double'. This
+        --   places a reasonably safe limit on the maximum size of our generated
+        --   'Double' members.
+        max_double :: Double
+        max_double = 10000.0
+
+        -- | See 'max_double'.
+        min_double :: Double
+        min_double = (-1) * max_double
+
+
 -- | Return a 'FunctionValues' with a bunch of zeros for data points.
 empty_values :: FunctionValues
 empty_values =
@@ -88,22 +162,25 @@ eval f (Quotient x y) = (eval f x) / (eval f y)
 
 -- | Takes a three-dimensional list of 'Double' and a set of 3D
 --   coordinates (i,j,k), and returns the value at (i,j,k) in the
---   supplied list. If there is no such value, zero is returned.
-value_at :: [[[Double]]] -> Int -> Int -> Int -> Double
-value_at values i j k
-         | i < 0 = 0
-         | j < 0 = 0
-         | k < 0 = 0
-         | length values <= k = 0
-         | length (values !! k) <= j = 0
-         | length ((values !! k) !! j) <= i = 0
-         | otherwise = ((values !! k) !! j) !! i
+--   supplied list. If there is no such value, we choose a nearby
+--   point and use its value.
+value_at :: Values3D -> Int -> Int -> Int -> Double
+value_at v3d i j k
+         | i < 0 = value_at v3d 0 j k
+         | j < 0 = value_at v3d i 0 k
+         | k < 0 = value_at v3d i j 0
+         | xsize <= i = value_at v3d xsize j k
+         | ysize <= j = value_at v3d i ysize k
+         | zsize <= k = value_at v3d i j zsize
+         | otherwise = idx v3d i j k
+  where
+    (xsize, ysize, zsize) = dims v3d
 
 
 -- | Given a three-dimensional list of 'Double' and a set of 3D
 --   coordinates (i,j,k), constructs and returns the 'FunctionValues'
 --   object centered at (i,j,k)
-make_values :: [[[Double]]] -> Int -> Int -> Int -> FunctionValues
+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,
@@ -121,13 +198,13 @@ make_values values i j k =
                    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_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_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),
@@ -137,8 +214,8 @@ make_values values i j k =
 --   'Cardinal' to another (called a rotation). Then it applies the
 --   rotation to each element of the 'FunctionValues' object, and
 --   returns the result.
-rotate :: FunctionValues -> (Cardinal -> Cardinal) -> FunctionValues
-rotate fv rotation =
+rotate :: (Cardinal -> Cardinal) -> FunctionValues -> FunctionValues
+rotate rotation fv =
     FunctionValues { front  = eval fv (rotation F),
                      back   = eval fv (rotation B),
                      left   = eval fv (rotation L),