{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
{-# LANGUAGE Safe #-}

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

This module defines some basic vector functionality.
It uses the same internal data representation as 'SimpleVec',
but declares 'Vec' to be an instance of 'VectorSpace'.
We import 'zeroV', 'negateV', 'sumV', '^+^', '^-^'
from 'AdditiveGroup', and
'*^', '^*', '^/', '<.>', 'magnitude'
from 'VectorSpace'.

'CarrotVec' exports exactly the same symbols as 'SimpleVec';
they are just defined differently.
-}

-- 2011 Apr 10
-- Definitions common to SimpleVec and CarrotVec have been put in CommonVec.

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

import Data.VectorSpace
    ( VectorSpace(..)
    , InnerSpace(..)
    , AdditiveGroup(..)
    , Scalar
    , (^+^)
    , (^-^)
    , (*^)
    , (^*)
    , (^/)
    , (<.>)
    , magnitude
    , zeroV
    , negateV
    , sumV
    )
import Physics.Learn.CommonVec
    ( Vec(..)
    , R
    , xComp
    , yComp
    , zComp
    , vec
    , (><)
    , iHat
    , jHat
    , kHat
    )

instance AdditiveGroup Vec where
    zeroV :: Vec
zeroV = R -> R -> R -> Vec
vec R
0 R
0 R
0
    negateV :: Vec -> Vec
negateV (Vec R
ax R
ay R
az) = R -> R -> R -> Vec
Vec (-R
ax) (-R
ay) (-R
az)
    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)

instance VectorSpace Vec where
    type Scalar Vec = R
    Scalar Vec
c *^ :: Scalar Vec -> Vec -> Vec
*^ Vec R
ax R
ay R
az = R -> R -> R -> Vec
Vec (Scalar Vec
cforall a. Num a => a -> a -> a
*R
ax) (Scalar Vec
cforall a. Num a => a -> a -> a
*R
ay) (Scalar Vec
cforall a. Num a => a -> a -> a
*R
az)

instance InnerSpace Vec where
    Vec R
ax R
ay R
az <.> :: Vec -> Vec -> Scalar Vec
<.> 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