{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE Safe #-}

{- | 
Module      :  Physics.Learn.SimpleVec
Copyright   :  (c) Scott N. Walck 2012-2019
License     :  BSD3 (see LICENSE)
Maintainer  :  Scott N. Walck <walck@lvc.edu>
Stability   :  experimental

Basic operations on the vector type 'Vec', such as vector addition
and scalar multiplication.
This module is simple in the sense that the operations
on vectors all have simple, concrete types,
without the need for type classes.
This makes using and reasoning about vector operations
easier for a person just learning Haskell.
-}

module Physics.Learn.SimpleVec
    ( Vec
    , R
    , xComp
    , yComp
    , zComp
    , vec
    , (^+^)
    , (^-^)
    , (*^)
    , (^*)
    , (^/)
    , (<.>)
    , (><)
    , magnitude
    , zeroV
    , negateV
    , sumV
    , iHat
    , jHat
    , kHat
    )
    where

import Physics.Learn.CommonVec
    ( Vec(..)
    , R
    , vec
    , iHat
    , jHat
    , kHat
    , (><)
    )

infixl 6 ^+^
infixl 6 ^-^
infixl 7 *^
infixl 7 ^*
infixl 7 ^/
infixl 7 <.>

-- | The zero vector.
zeroV :: Vec
zeroV :: Vec
zeroV = R -> R -> R -> Vec
vec R
0 R
0 R
0

-- | The additive inverse of a vector.
negateV :: Vec -> Vec
negateV :: Vec -> Vec
negateV (Vec R
ax R
ay R
az) = R -> R -> R -> Vec
Vec (-R
ax) (-R
ay) (-R
az)

-- | Sum of a list of vectors.
sumV :: [Vec] -> Vec
sumV :: [Vec] -> Vec
sumV = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Vec -> Vec -> Vec
(^+^) Vec
zeroV

-- | Vector addition.
(^+^) :: Vec -> Vec -> Vec
Vec R
ax R
ay R
az ^+^ :: Vec -> Vec -> Vec
^+^ Vec R
bx R
by R
bz
    = R -> R -> R -> Vec
Vec (R
axforall a. Num a => a -> a -> a
+R
bx) (R
ayforall a. Num a => a -> a -> a
+R
by) (R
azforall a. Num a => a -> a -> a
+R
bz)

-- | Vector subtraction.
(^-^) :: Vec -> Vec -> Vec
Vec R
ax R
ay R
az ^-^ :: Vec -> Vec -> Vec
^-^ Vec R
bx R
by R
bz = R -> R -> R -> Vec
Vec (R
axforall a. Num a => a -> a -> a
-R
bx) (R
ayforall a. Num a => a -> a -> a
-R
by) (R
azforall a. Num a => a -> a -> a
-R
bz)

-- | Scalar multiplication, where the scalar is on the left
--   and the vector is on the right.
(*^) :: R -> Vec -> Vec
R
c *^ :: R -> Vec -> Vec
*^ Vec R
ax R
ay R
az = R -> R -> R -> Vec
Vec (R
cforall a. Num a => a -> a -> a
*R
ax) (R
cforall a. Num a => a -> a -> a
*R
ay) (R
cforall a. Num a => a -> a -> a
*R
az)

-- | Scalar multiplication, where the scalar is on the right
--   and the vector is on the left.
(^*) :: Vec -> R -> Vec
Vec R
ax R
ay R
az ^* :: Vec -> R -> Vec
^* R
c = R -> R -> R -> Vec
Vec (R
cforall a. Num a => a -> a -> a
*R
ax) (R
cforall a. Num a => a -> a -> a
*R
ay) (R
cforall a. Num a => a -> a -> a
*R
az)

-- | Division of a vector by a scalar.
(^/) :: Vec -> R -> Vec
Vec R
ax R
ay R
az ^/ :: Vec -> R -> Vec
^/ R
c = R -> R -> R -> Vec
Vec (R
axforall a. Fractional a => a -> a -> a
/R
c) (R
ayforall a. Fractional a => a -> a -> a
/R
c) (R
azforall a. Fractional a => a -> a -> a
/R
c)

-- | Dot product of two vectors.
(<.>) :: Vec -> Vec -> R
Vec R
ax R
ay R
az <.> :: Vec -> Vec -> R
<.> Vec R
bx R
by R
bz = R
axforall a. Num a => a -> a -> a
*R
bx forall a. Num a => a -> a -> a
+ R
ayforall a. Num a => a -> a -> a
*R
by forall a. Num a => a -> a -> a
+ R
azforall a. Num a => a -> a -> a
*R
bz

-- | Magnitude of a vector.
magnitude :: Vec -> R
magnitude :: Vec -> R
magnitude Vec
v = forall a. Floating a => a -> a
sqrt(Vec
v Vec -> Vec -> R
<.> Vec
v)