From 3cf6c69c9c7fed364b13fa54ee78209f7485d304 Mon Sep 17 00:00:00 2001
From: Michael Orlitzky <michael@orlitzky.com>
Date: Tue, 23 Aug 2011 16:24:32 -0400
Subject: [PATCH] Convert the zoom function to use Values3D.

---
 src/Grid.hs   | 46 ++++++++++++++++++++++------------------------
 src/Values.hs | 10 ++++++++++
 2 files changed, 32 insertions(+), 24 deletions(-)

diff --git a/src/Grid.hs b/src/Grid.hs
index 1a01ab7..3d636b5 100644
--- a/src/Grid.hs
+++ b/src/Grid.hs
@@ -12,7 +12,9 @@ import Misc (flatten)
 import Point (Point)
 import Tetrahedron (polynomial)
 import ThreeDimensional (contains_point)
-import Values (Values3D, dims, empty3d)
+import Values (Values3D, dims, empty3d, zoom_shape)
+
+import qualified Data.Array.Repa as R
 
 -- | Our problem is defined on a Grid. The grid size is given by the
 --   positive number h. The function values are the values of the
@@ -81,28 +83,24 @@ find_containing_cubes g p =
       contains_our_point = flip contains_point p
 
 
-
-zoom :: Grid -> Int -> [[[Double]]]
+zoom :: Grid -> Int -> Values3D
 zoom g scale_factor
-    | xsize == 0 || ysize == 0 || zsize == 0 = []
+    | xsize == 0 || ysize == 0 || zsize == 0 = empty3d
     | otherwise =
-        [[[f p | i <- [0..scaled_zsize],
-                 let i' = scale_dimension i,
-                 let j' = scale_dimension j,
-                 let k' = scale_dimension k,
-                 let p = (i', j', k') :: Point,
-                 let c = (find_containing_cubes g p) !! 0,
-                 let t = (find_containing_tetrahedra c p) !! 0,
-                 let f = polynomial t]
-                 | j <- [0..scaled_ysize]]
-                   | k <- [0..scaled_xsize]]
-  where
-    scale_dimension :: Int -> Double
-    scale_dimension x = (fromIntegral x) / (fromIntegral scale_factor)
-
-    fvs = function_values g
-    (xsize, ysize, zsize) = dims fvs
-    scaled_xsize = xsize * scale_factor
-    scaled_ysize = ysize * scale_factor
-    scaled_zsize = zsize * scale_factor
-
+        R.traverse arr transExtent (\_ -> newlookup)
+          where
+            fvs = function_values g
+            (xsize, ysize, zsize) = dims fvs
+            arr = fvs
+            transExtent = zoom_shape scale_factor
+            newlookup :: R.DIM3 -> Double
+            newlookup (R.Z R.:. i R.:. j R.:. k) =
+                f p
+                  where
+                    i' = fromIntegral i
+                    j' = fromIntegral j
+                    k' = fromIntegral k
+                    p = (i', j', k') :: Point
+                    c = head (find_containing_cubes g p)
+                    t = head (find_containing_tetrahedra c p)
+                    f = polynomial t
diff --git a/src/Values.hs b/src/Values.hs
index a33bbba..1b8548e 100644
--- a/src/Values.hs
+++ b/src/Values.hs
@@ -80,3 +80,13 @@ idx v3d i j k =
     where
       shape :: DIM3
       shape = (Z :. i :. j :. k)
+
+
+zoom_shape :: Int -> DIM3 -> DIM3
+zoom_shape scale_factor sh =
+    let (Z :. x :. y :. z) = sh
+        x' = x * scale_factor
+        y' = y * scale_factor
+        z' = z * scale_factor
+    in
+      (Z :. x' :. y' :. z')
-- 
2.43.2