+-- | The Assertions module contains assertions for use in HUnit
+-- tests. They primarily fill the need for an equality test that
+-- works with floating point numbers.
module Assertions
where
import Point
-- | An HUnit assertion that wraps the almost_equals function. Stolen
--- from the definition of assertEqual in Test/HUnit/Base.hs.
+-- from the definition of 'assertEqual' in Test/HUnit/Base.hs.
assertAlmostEqual :: String -> Double -> Double -> Assertion
assertAlmostEqual preface expected actual =
unless (actual ~= expected) (assertFailure msg)
- where msg = (if null preface then "" else preface ++ "\n") ++
- "expected: " ++ show expected ++ "\n but got: " ++ show actual
+ where msg = (if null preface then "" else preface ++ "\n") ++
+ "expected: " ++ show expected ++ "\n but got: " ++ show actual
-- | An HUnit assertion that wraps the is_close function. Stolen
--- from the definition of assertEqual in Test/HUnit/Base.hs.
+-- from the definition of 'assertEqual' in Test/HUnit/Base.hs.
assertClose :: String -> Point -> Point -> Assertion
assertClose preface expected actual =
unless (actual `is_close` expected) (assertFailure msg)
- where msg = (if null preface then "" else preface ++ "\n") ++
- "expected: " ++ show expected ++ "\n but got: " ++ show actual
-
+ where msg = (if null preface then "" else preface ++ "\n") ++
+ "expected: " ++ show expected ++ "\n but got: " ++ show actual
deriving (Show, Eq)
--- | By making Cardinal an instance of Num, we gain the ability to
+-- | By making Cardinal an instance of 'Num', we gain the ability to
-- add, subtract, and multiply directions. The results of these
-- operations are never actually calculated; the types just keep
-- track of which operations were performed in which order.
+-- | Functions for comparing 'Double' values.
module Comparisons
where
very_positive x = x - epsilon > 0
--- | Takes a list of Doubles and returns the ones which are not very
+-- | Takes a list of 'Double' and returns the ones which are not very
-- positive.
non_very_positive_entries :: [Double] -> [Double]
non_very_positive_entries = filter (not . very_positive)
(show (i c)) ++ "," ++ (show (j c)) ++ "," ++ (show (k c))
+-- | Returns an empty 'Cube'.
empty_cube :: Cube
empty_cube = Cube 0 0 0 0 empty_values
instance ThreeDimensional Cube where
-- | The center of Cube_ijk coincides with v_ijk at
- -- (ih, jh, kh). See Sorokina and Zeilfelder, p. 76.
+ -- (ih, jh, kh). See Sorokina and Zeilfelder, p. 76.
center c = (x, y, z)
where
delta = h c
y = delta * j'
z = delta * k'
+ -- | It's easy to tell if a point is within a cube; just make sure
+ -- that it falls on the proper side of each of the cube's faces.
contains_point c p
| (x_coord p) < (xmin c) = False
| (x_coord p) > (xmax c) = False
+-- | The Face module just contains the definition of the 'Face' data
+-- type and its two typeclass instances.
module Face
where
" v2: " ++ (show (v2 f)) ++ "\n" ++
" v3: " ++ (show (v3 f)) ++ "\n"
+-- | The 'Face' type is an instance of 'ThreeDimensional' so that we
+-- can call the 'center' function on it. This is useful because the
+-- center of a face is always a vertex of a tetrahedron.
instance ThreeDimensional Face where
+ -- | Since a face is square, we can just average the four vertices
+ -- to find the center.
center f = ((v0 f) + (v1 f) + (v2 f) + (v3 f)) `scale` (1/4)
- -- Too lazy to implement this right now.
+
+ -- | It's possible to implement this, but it hasn't been done
+ -- yet. A face will contain a point if the point lies in the same
+ -- plane as the vertices of the face, and if it falls on the
+ -- correct side of the four sides of the face.
contains_point _ _ = False
+-- | The FunctionValues module contains the 'FunctionValues' type and
+-- the functions used to manipulate it.
module FunctionValues
where
import Cardinal
+-- | The FunctionValues type represents the value of our function f at
+-- the 27 points surrounding 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,
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 (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
| 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_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),
empty_grid = Grid 1 [[[]]]
-
--- This is how we do a 'for' loop in Haskell.
--- No, seriously.
+-- | Returns a three-dimensional list of cubes centered on the grid
+-- points of g with the appropriate 'FunctionValues'.
cubes :: Grid -> [[[Cube]]]
cubes g
| fvs == [[[]]] = [[[]]]
-- | Takes a grid and a position as an argument and returns the cube
-- centered on that position. If there is no cube there (i.e. the
--- position is outside of the grid), it will return Nothing.
+-- position is outside of the grid), it will return 'Nothing'.
cube_at :: Grid -> Int -> Int -> Int -> Maybe Cube
cube_at g i j k
| i < 0 = Nothing
fromInteger n = (fromInteger n, fromInteger n, fromInteger n)
+-- | Scale a point by a constant.
scale :: Point -> Double -> Point
scale (x, y, z) d = (x*d, y*d, z*d)
+-- | Returns the distance between p1 and p2.
distance :: Point -> Point -> Double
distance p1 p2 =
sqrt $ (x2 - x1)^(2::Int) + (y2 - y1)^(2::Int) + (z2 - z1)^(2::Int)
z2 = z_coord p2
+-- | Returns 'True' if p1 'is_close' to p2, 'False' otherwise.
is_close :: Point -> Point -> Bool
is_close p1 p2 = (distance p1 p2) ~= 0
type RealFunction a = (a -> Double)
+
+-- | A 'Show' instance is required to be a 'Num' instance.
instance Show (RealFunction a) where
- show _ = "Real Function"
+ -- | There is nothing of value that we can display about a
+ -- function, so simply print its type.
+ show _ = "RealFunction"
+
+-- | An 'Eq' instance is required to be a 'Num' instance.
instance Eq (RealFunction a) where
+ -- | Nothing else makes sense here; always return 'False'.
_ == _ = False
+
+-- | The 'Num' instance for RealFunction allows us to perform
+-- arithmetic on functions in the usual way.
instance Num (RealFunction a) where
(f1 + f2) x = (f1 x) + (f2 x)
(f1 - f2) x = (f1 x) - (f2 x)
fromInteger i _ = fromInteger i
--- Takes a constant, and a function as arguments. Returns a new
--- function representing the original function times the constant.
+-- | Takes a constant, and a function as arguments. Returns a new
+-- function representing the original function times the constant.
cmult :: Double -> (RealFunction a) -> (RealFunction a)
cmult coeff f = (*coeff) . f
--- Takes a function f and an exponent n. Returns a new function, f^n.
+
+-- | Takes a function f and an exponent n. Returns a new function,
+-- f^n.
fexp :: (RealFunction a) -> Int -> (RealFunction a)
fexp f n
| n == 0 = (\_ -> 1)
z3 = z_coord (v2 t)
z4 = z_coord (v3 t)
--- Computed using the formula from Lai & Schumaker, Definition 15.4,
--- page 436.
+-- | Computed using the formula from Lai & Schumaker, Definition 15.4,
+-- page 436.
volume :: Tetrahedron -> Double
volume t
| (v0 t) == (v1 t) = 0
| otherwise = (1/6)*(det (vol_matrix t))
+-- | The barycentric coordinates of a point with respect to v0.
b0 :: Tetrahedron -> (RealFunction Point)
b0 t point = (volume inner_tetrahedron) / (volume t)
where
inner_tetrahedron = t { v0 = point }
+
+-- | The barycentric coordinates of a point with respect to v1.
b1 :: Tetrahedron -> (RealFunction Point)
b1 t point = (volume inner_tetrahedron) / (volume t)
where
inner_tetrahedron = t { v1 = point }
+
+-- | The barycentric coordinates of a point with respect to v2.
b2 :: Tetrahedron -> (RealFunction Point)
b2 t point = (volume inner_tetrahedron) / (volume t)
where
inner_tetrahedron = t { v2 = point }
+
+-- | The barycentric coordinates of a point with respect to v3.
b3 :: Tetrahedron -> (RealFunction Point)
b3 t point = (volume inner_tetrahedron) / (volume t)
where
projects / spline3.git / commitdiff