Begin updating everything to use Repa arrays (Values3D).

[spline3.git] / src / FunctionValues.hs

diff --git a/src/FunctionValues.hs b/src/FunctionValues.hs
index f9111ad23f406a6768ff7e641ced1022a0af4835..1d722b12b0f3132d028cbf53d01a9e584be977dd 100644 (file)
--- a/src/FunctionValues.hs
+++ b/src/FunctionValues.hs
@@ -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
@@ -41,6 +43,78 @@ data FunctionValues =
                      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 =
@@ -89,21 +163,23 @@ 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 :: Values3D -> 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
+         | xsize <= i = 0
+         | ysize <= j = 0
+         | zsize <= k = 0
+         | otherwise = idx values i j k
+  where
+    (xsize, ysize, zsize) = dims values
 
 
 -- | 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,
@@ -137,8 +213,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),