-- | 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, left :: Double, right :: Double, top :: Double, down :: Double, front_left :: Double, front_right :: Double, front_top :: Double, front_down :: Double, back_left :: Double, back_right :: Double, back_top :: Double, back_down :: Double, left_top :: Double, left_down :: Double, right_top :: Double, right_down :: Double, front_left_top :: Double, front_left_down :: Double, front_right_top :: Double, front_right_down :: Double, back_left_top :: Double, back_left_down :: Double, back_right_top :: Double, back_right_down :: 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 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 (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_top = value_at values i (j+1) (k+1), right_down = 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 }