X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FGrid.hs;h=269b37cec68d5c2f6211971dc1af32316b86c7ae;hb=c1f5bcdd6e978da6fe2182c69c6155d4b134646c;hp=26f44251d4a5f08612317788afa223cb723a24e2;hpb=d9eed953bd810f6928de536617dc21121a8a645b;p=spline3.git

diff --git a/src/Grid.hs b/src/Grid.hs
index 26f4425..269b37c 100644
--- a/src/Grid.hs
+++ b/src/Grid.hs
@@ -10,6 +10,7 @@ module Grid (
 where
 
 import qualified Data.Array.Repa as R
+import qualified Data.Array.Repa.Operators.Traversal as R (unsafeTraverse)
 import Test.HUnit (Assertion, assertEqual)
 import Test.Framework (Test, testGroup)
 import Test.Framework.Providers.HUnit (testCase)
@@ -18,7 +19,8 @@ import Test.QuickCheck ((==>),
                         Arbitrary(..),
                         Gen,
                         Property,
-                        choose)
+                        choose,
+                        vectorOf)
 import Assertions (assertAlmostEqual, assertTrue)
 import Comparisons ((~=))
 import Cube (Cube(Cube),
@@ -48,7 +50,12 @@ data Grid = Grid { function_values :: Values3D }
 
 instance Arbitrary Grid where
     arbitrary = do
-      fvs <- arbitrary :: Gen Values3D
+      x_dim <- choose (1, 27)
+      y_dim <- choose (1, 27)
+      z_dim <- choose (1, 27)
+      elements <- vectorOf (x_dim * y_dim * z_dim) (arbitrary :: Gen Double)
+      let new_shape = (R.Z R.:. x_dim R.:. y_dim R.:. z_dim)
+      let fvs = R.fromListUnboxed new_shape elements
       return $ Grid fvs
 
 
@@ -117,15 +124,19 @@ zoom_result v3d (sfx, sfy, sfz) (R.Z R.:. m R.:. n R.:. o) =
     f = polynomial t
 
 
-zoom :: Values3D -> ScaleFactor -> Values3D
+--
+-- Instead of IO, we could get away with a generic monad 'm'
+-- here. However, /we/ only call this function from within IO.
+--
+zoom :: Values3D -> ScaleFactor -> IO Values3D
 zoom v3d scale_factor
-    | xsize == 0 || ysize == 0 || zsize == 0 = empty3d
+    | xsize == 0 || ysize == 0 || zsize == 0 = return empty3d
     | otherwise =
-        R.compute $ R.unsafeTraverse v3d transExtent f
-          where
-            (xsize, ysize, zsize) = dims v3d
-            transExtent = zoom_shape scale_factor
-            f = zoom_lookup v3d scale_factor
+        R.computeUnboxedP $ R.unsafeTraverse v3d transExtent f
+        where
+          (xsize, ysize, zsize) = dims v3d
+          transExtent = zoom_shape scale_factor
+          f = zoom_lookup v3d scale_factor
 
 
 -- | Check all coefficients of tetrahedron0 belonging to the cube