-- |
-- Module:      Data.Geo.Jord.Math3d
-- Copyright:   (c) 2020 Cedric Liegeois
-- License:     BSD3
-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
-- Stability:   experimental
-- Portability: portable
--
-- 3-element vector and associated math functions.
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)

-- | 3-element vector.
data V3 =
    V3
        { V3 -> Double
v3x :: Double -- ^ x-coordinate
        , V3 -> Double
v3y :: Double -- ^ y-coordinate
        , V3 -> Double
v3z :: Double -- ^ z-coordinate
        }
    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)

-- | Vector 3d from given coordinates.
-- 0.0 is added to each component to avoid @-0.0@.
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)

-- | Adds 2 vectors.
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)

-- | Subtracts 2 vectors.
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)

-- | Computes the cross product of 2 vectors: the vector perpendicular to given vectors.
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

-- | Computes the square of the straight line distance (or geometrical distance)
-- between 2 vectors.
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

-- | Computes the dot product of 2 vectors.
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

-- | Computes the norm of a vector.
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)

-- | Multiplies vector by __3x3__ matrix (rows).
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 v s@ multiplies each component of @v@ by @s@.
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)

-- | Normalises a vector. The 'norm' of the produced vector is @1@.
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

-- | vector of norm 0.
zero :: V3
zero :: V3
zero = Double -> Double -> Double -> V3
V3 Double
0.0 Double
0.0 Double
0.0

-- | transpose __square (3x3)__ matrix of 'V3'.
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 matrix.
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)

-- | multiplies 2 __3x3__ matrices.
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]

-- | 'V3' to list of doubles.
v2ds :: V3 -> [Double]
v2ds :: V3 -> [Double]
v2ds (V3 Double
x Double
y Double
z) = [Double
x, Double
y, Double
z]

-- | list of doubles to 'V3'.
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)