X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FFunctionValues.hs;h=f9111ad23f406a6768ff7e641ced1022a0af4835;hb=f9b29fb473cf7992b2b7375577e3cece3369892e;hp=d477a38f729cbbb99b970c9fe681848824fb5012;hpb=f97dbb52b73bd90a89940b9653ff274654aba9de;p=spline3.git diff --git a/src/FunctionValues.hs b/src/FunctionValues.hs index d477a38..f9111ad 100644 --- a/src/FunctionValues.hs +++ b/src/FunctionValues.hs @@ -1,8 +1,16 @@ +-- | The FunctionValues module contains the 'FunctionValues' type and +-- the functions used to manipulate it. module FunctionValues where +import Prelude hiding (LT) + import Cardinal +-- | The FunctionValues type represents the value of our function f at +-- the 27 points surrounding (and including) the center of a +-- cube. Each value of f can be accessed by the name of its +-- direction. data FunctionValues = FunctionValues { front :: Double, back :: Double, @@ -12,31 +20,38 @@ 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) +-- | Return a 'FunctionValues' with a bunch of zeros for data points. empty_values :: FunctionValues empty_values = FunctionValues 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +-- | The eval function is where the magic happens for the +-- FunctionValues type. Given a 'Cardinal' direction and a +-- 'FunctionValues' object, eval will return the value of the +-- function f in that 'Cardinal' direction. Note that 'Cardinal' can +-- be a composite type; eval is what performs the \"arithmetic\" on +-- 'Cardinal' directions. eval :: FunctionValues -> Cardinal -> Double eval f F = front f eval f B = back f @@ -44,7 +59,110 @@ eval f L = left f eval f R = right f eval f T = top f eval f D = down f +eval f FL = front_left f +eval f FR = front_right f +eval f FD = front_down f +eval f FT = front_top f +eval f BL = back_left f +eval f BR = back_right f +eval f BD = back_down f +eval f BT = back_top f +eval f LD = left_down f +eval f LT = left_top f +eval f RD = right_down f +eval f RT = right_top f +eval f FLD = front_left_down f +eval f FLT = front_left_top f +eval f FRD = front_right_down f +eval f FRT = front_right_top f +eval f BLD = back_left_down f +eval f BLT = back_left_top f +eval f BRD = back_right_down f +eval f BRT = back_right_top f +eval f I = interior f +eval _ (Scalar x) = x eval f (Sum x y) = (eval f x) + (eval f y) eval f (Difference x y) = (eval f x) - (eval f y) eval f (Product x y) = (eval f x) * (eval f y) -eval f (ScalarProduct x y) = x * (eval f y) +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 + + +-- | 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 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), + interior = value_at values i j k } + +-- | Takes a 'FunctionValues' and a function that transforms one +-- '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 = + FunctionValues { front = eval fv (rotation F), + back = eval fv (rotation B), + left = eval fv (rotation L), + right = eval fv (rotation R), + down = eval fv (rotation D), + top = eval fv (rotation T), + front_left = eval fv (rotation FL), + front_right = eval fv (rotation FR), + front_down = eval fv (rotation FD), + front_top = eval fv (rotation FT), + back_left = eval fv (rotation BL), + back_right = eval fv (rotation BR), + back_down = eval fv (rotation BD), + back_top = eval fv (rotation BT), + left_down = eval fv (rotation LD), + left_top = eval fv (rotation LT), + right_down = eval fv (rotation RD), + right_top = eval fv (rotation RT), + front_left_down = eval fv (rotation FLD), + front_left_top = eval fv (rotation FLT), + front_right_down = eval fv (rotation FRD), + front_right_top = eval fv (rotation FRT), + back_left_down = eval fv (rotation BLD), + back_left_top = eval fv (rotation BLT), + back_right_down = eval fv (rotation BRD), + back_right_top = eval fv (rotation BRT), + interior = interior fv }