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
{ V3 -> Double
v3x :: Double
, V3 -> Double
v3y :: Double
, V3 -> Double
v3z :: Double
}
deriving (V3 -> V3 -> Bool
(V3 -> V3 -> Bool) -> (V3 -> V3 -> Bool) -> Eq V3
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V3 -> V3 -> Bool
$c/= :: V3 -> V3 -> Bool
== :: V3 -> V3 -> Bool
$c== :: V3 -> V3 -> Bool
Eq, Int -> V3 -> ShowS
[V3] -> ShowS
V3 -> String
(Int -> V3 -> ShowS)
-> (V3 -> String) -> ([V3] -> ShowS) -> Show V3
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V3] -> ShowS
$cshowList :: [V3] -> ShowS
show :: V3 -> String
$cshow :: V3 -> String
showsPrec :: Int -> V3 -> ShowS
$cshowsPrec :: Int -> V3 -> ShowS
Show)
vec3 :: Double -> Double -> Double -> V3
vec3 :: Double -> Double -> Double -> V3
vec3 Double
x Double
y Double
z = Double -> Double -> Double -> V3
V3 (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.0) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.0) (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.0)
add :: V3 -> V3 -> V3
add :: V3 -> V3 -> V3
add (V3 Double
x1 Double
y1 Double
z1) (V3 Double
x2 Double
y2 Double
z2) = Double -> Double -> Double -> V3
vec3 (Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x2) (Double
y1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y2) (Double
z1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
z2)
subtract :: V3 -> V3 -> V3
subtract :: V3 -> V3 -> V3
subtract (V3 Double
x1 Double
y1 Double
z1) (V3 Double
x2 Double
y2 Double
z2) = Double -> Double -> Double -> V3
vec3 (Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x2) (Double
y1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y2) (Double
z1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
z2)
cross :: V3 -> V3 -> V3
cross :: V3 -> V3 -> V3
cross (V3 Double
x1 Double
y1 Double
z1) (V3 Double
x2 Double
y2 Double
z2) = Double -> Double -> Double -> V3
vec3 Double
x Double
y Double
z
where
x :: Double
x = Double
y1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
z2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
z1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y2
y :: Double
y = Double
z1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
z2
z :: Double
z = Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x2
squaredDistance :: V3 -> V3 -> Double
squaredDistance :: V3 -> V3 -> Double
squaredDistance (V3 Double
x1 Double
y1 Double
z1) (V3 Double
x2 Double
y2 Double
z2) = Double
dx Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dy Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dy Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dz Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dz
where
dx :: Double
dx = Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x2
dy :: Double
dy = Double
y1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y2
dz :: Double
dz = Double
z1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
z2
dot :: V3 -> V3 -> Double
dot :: V3 -> V3 -> Double
dot (V3 Double
x1 Double
y1 Double
z1) (V3 Double
x2 Double
y2 Double
z2) = Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
z1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
z2
norm :: V3 -> Double
norm :: V3 -> Double
norm (V3 Double
x Double
y Double
z) = Double -> Double
forall a. Floating a => a -> a
sqrt (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
z)
multM :: V3 -> [V3] -> V3
multM :: V3 -> [V3] -> V3
multM V3
v [V3]
rm
| [V3] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [V3]
rm Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
3 = String -> V3
forall a. HasCallStack => String -> a
error (String
"Invalid matrix" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [V3] -> String
forall a. Show a => a -> String
show [V3]
rm)
| Bool
otherwise = Double -> Double -> Double -> V3
vec3 Double
x Double
y Double
z
where
[Double
x, Double
y, Double
z] = (V3 -> Double) -> [V3] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (V3 -> V3 -> Double
dot V3
v) [V3]
rm
scale :: V3 -> Double -> V3
scale :: V3 -> Double -> V3
scale (V3 Double
x Double
y Double
z) Double
s = Double -> Double -> Double -> V3
vec3 (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s) (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s)
unit :: V3 -> V3
unit :: V3 -> V3
unit V3
v
| Double
s Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
1.0 = V3
v
| Bool
otherwise = V3 -> Double -> V3
scale V3
v Double
s
where
s :: Double
s = Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ V3 -> Double
norm V3
v
zero :: V3
zero :: V3
zero = Double -> Double -> Double -> V3
V3 Double
0.0 Double
0.0 Double
0.0
transposeM :: [V3] -> [V3]
transposeM :: [V3] -> [V3]
transposeM [V3]
m = ([Double] -> V3) -> [[Double]] -> [V3]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Double] -> V3
ds2v ([[Double]] -> [[Double]]
transpose' [[Double]]
xs)
where
xs :: [[Double]]
xs = (V3 -> [Double]) -> [V3] -> [[Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap V3 -> [Double]
v2ds [V3]
m
transpose' :: [[Double]] -> [[Double]]
transpose' :: [[Double]] -> [[Double]]
transpose' ([]:[[Double]]
_) = []
transpose' [[Double]]
x = ([Double] -> Double) -> [[Double]] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map [Double] -> Double
forall a. [a] -> a
head [[Double]]
x [Double] -> [[Double]] -> [[Double]]
forall a. a -> [a] -> [a]
: [[Double]] -> [[Double]]
transpose' (([Double] -> [Double]) -> [[Double]] -> [[Double]]
forall a b. (a -> b) -> [a] -> [b]
map [Double] -> [Double]
forall a. [a] -> [a]
tail [[Double]]
x)
dotM :: [V3] -> [V3] -> [V3]
dotM :: [V3] -> [V3] -> [V3]
dotM [V3]
a [V3]
b = ([Double] -> V3) -> [[Double]] -> [V3]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Double] -> V3
ds2v [[V3 -> V3 -> Double
dot V3
ar V3
bc | V3
bc <- [V3] -> [V3]
transposeM [V3]
b] | V3
ar <- [V3]
a]
v2ds :: V3 -> [Double]
v2ds :: V3 -> [Double]
v2ds (V3 Double
x Double
y Double
z) = [Double
x, Double
y, Double
z]
ds2v :: [Double] -> V3
ds2v :: [Double] -> V3
ds2v [Double
x, Double
y, Double
z] = Double -> Double -> Double -> V3
vec3 Double
x Double
y Double
z
ds2v [Double]
xs = String -> V3
forall a. HasCallStack => String -> a
error (String
"Invalid list: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Double] -> String
forall a. Show a => a -> String
show [Double]
xs)