module Data.Geo.Jord.Math3d
( V3
, v3x
, v3y
, v3z
, vec3
, add
, subtract
, squaredDistance
, dot
, norm
, cross
, scale
, unit
, zero
, transposeM
, dotM
, multM
) where
import Prelude hiding (subtract)
data V3 =
V3
{ v3x :: Double
, v3y :: Double
, v3z :: Double
}
deriving (Eq, Show)
vec3 :: Double -> Double -> Double -> V3
vec3 x y z = V3 (x + 0.0) (y + 0.0) (z + 0.0)
add :: V3 -> V3 -> V3
add (V3 x1 y1 z1) (V3 x2 y2 z2) = vec3 (x1 + x2) (y1 + y2) (z1 + z2)
subtract :: V3 -> V3 -> V3
subtract (V3 x1 y1 z1) (V3 x2 y2 z2) = vec3 (x1 - x2) (y1 - y2) (z1 - z2)
cross :: V3 -> V3 -> V3
cross (V3 x1 y1 z1) (V3 x2 y2 z2) = vec3 x y z
where
x = y1 * z2 - z1 * y2
y = z1 * x2 - x1 * z2
z = x1 * y2 - y1 * x2
squaredDistance :: V3 -> V3 -> Double
squaredDistance (V3 x1 y1 z1) (V3 x2 y2 z2) = dx * dx + dy * dy + dz * dz
where
dx = x1 - x2
dy = y1 - y2
dz = z1 - z2
dot :: V3 -> V3 -> Double
dot (V3 x1 y1 z1) (V3 x2 y2 z2) = x1 * x2 + y1 * y2 + z1 * z2
norm :: V3 -> Double
norm (V3 x y z) = sqrt (x * x + y * y + z * z)
multM :: V3 -> [V3] -> V3
multM v rm
| length rm /= 3 = error ("Invalid matrix" ++ show rm)
| otherwise = vec3 x y z
where
[x, y, z] = map (dot v) rm
scale :: V3 -> Double -> V3
scale (V3 x y z) s = vec3 (x * s) (y * s) (z * s)
unit :: V3 -> V3
unit v
| s == 1.0 = v
| otherwise = scale v s
where
s = 1.0 / norm v
zero :: V3
zero = V3 0.0 0.0 0.0
transposeM :: [V3] -> [V3]
transposeM m = fmap ds2v (transpose' xs)
where
xs = fmap v2ds m
transpose' :: [[Double]] -> [[Double]]
transpose' ([]:_) = []
transpose' x = map head x : transpose' (map tail x)
dotM :: [V3] -> [V3] -> [V3]
dotM a b = fmap ds2v [[dot ar bc | bc <- transposeM b] | ar <- a]
v2ds :: V3 -> [Double]
v2ds (V3 x y z) = [x, y, z]
ds2v :: [Double] -> V3
ds2v [x, y, z] = vec3 x y z
ds2v xs = error ("Invalid list: " ++ show xs)