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

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

This module defines some common vector operations.
It is intended that this module not be imported directly, but that its
functionality be gained by importing either 'SimpleVec' or 'CarrotVec',
but not both.  Choose 'SimpleVec' for vector operations
(such as vector addition) with simple concrete types,
which work only with the type 'Vec' of three-dimensional vectors.
Choose 'CarrotVec' for vector operations that work with any type in the
appropriate type class.
-}

-- The definitions that are common to SimpleVec and CarrotVec.
-- We need to export the data constructor Vec for both SimpleVec and CarrotVec.

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

infixl 7 ><

type R = Double

-- | A type for vectors.
data Vec = Vec { Vec -> R
xComp :: R  -- ^ x component
               , Vec -> R
yComp :: R  -- ^ y component
               , Vec -> R
zComp :: R  -- ^ z component
               } deriving (Vec -> Vec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vec -> Vec -> Bool
$c/= :: Vec -> Vec -> Bool
== :: Vec -> Vec -> Bool
$c== :: Vec -> Vec -> Bool
Eq)

instance Show Vec where
    show :: Vec -> String
show (Vec R
x R
y R
z) = String
"vec " forall a. [a] -> [a] -> [a]
++ R -> String
showDouble R
x forall a. [a] -> [a] -> [a]
++ String
" "
                              forall a. [a] -> [a] -> [a]
++ R -> String
showDouble R
y forall a. [a] -> [a] -> [a]
++ String
" "
                              forall a. [a] -> [a] -> [a]
++ R -> String
showDouble R
z

showDouble :: Double -> String
showDouble :: R -> String
showDouble R
x
    | R
x forall a. Ord a => a -> a -> Bool
< R
0      = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show R
x forall a. [a] -> [a] -> [a]
++ String
")"
    | Bool
otherwise  = forall a. Show a => a -> String
show R
x

-- | Form a vector by giving its x, y, and z components.
vec :: R  -- ^ x component
    -> R  -- ^ y component
    -> R  -- ^ z component
    -> Vec
vec :: R -> R -> R -> Vec
vec = R -> R -> R -> Vec
Vec

-- | Cross product.
(><) :: 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
ayforall a. Num a => a -> a -> a
*R
bz forall a. Num a => a -> a -> a
- R
azforall a. Num a => a -> a -> a
*R
by) (R
azforall a. Num a => a -> a -> a
*R
bx forall a. Num a => a -> a -> a
- R
axforall a. Num a => a -> a -> a
*R
bz) (R
axforall a. Num a => a -> a -> a
*R
by forall a. Num a => a -> a -> a
- R
ayforall a. Num a => a -> a -> a
*R
bx)

iHat, jHat, kHat :: Vec
-- | Unit vector in the x direction.
iHat :: Vec
iHat = R -> R -> R -> Vec
vec R
1 R
0 R
0
-- | Unit vector in the y direction.
jHat :: Vec
jHat = R -> R -> R -> Vec
vec R
0 R
1 R
0
-- | Unit vector in the z direction.
kHat :: Vec
kHat = R -> R -> R -> Vec
vec R
0 R
0 R
1