{-# OPTIONS -Wall #-}

{- | 
Module      :  LPFPCore.SimpleVec
Copyright   :  (c) Scott N. Walck 2023
License     :  BSD3 (see LICENSE)
Maintainer  :  Scott N. Walck <walck@lvc.edu>
Stability   :  stable

Code from chapter 10 of the book Learn Physics with Functional Programming
-}

module LPFPCore.SimpleVec where

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

-- | A vector derivative takes a vector-valued function of a real variable (usually time) as input,
--   and produces a vector-valued function of a real variable as output.
type VecDerivative = (R -> Vec) -> R -> Vec

-- | Given a step size, calculate the vector derivative of a vector-valued function of a real variable
--   (usually time).
vecDerivative :: R -> VecDerivative
vecDerivative :: R -> VecDerivative
vecDerivative R
dt R -> Vec
v R
t = (R -> Vec
v (R
t R -> R -> R
forall a. Num a => a -> a -> a
+ R
dtR -> R -> R
forall a. Fractional a => a -> a -> a
/R
2) Vec -> Vec -> Vec
^-^ R -> Vec
v (R
t R -> R -> R
forall a. Num a => a -> a -> a
- R
dtR -> R -> R
forall a. Fractional a => a -> a -> a
/R
2)) Vec -> R -> Vec
^/ R
dt

v1 :: R -> Vec
v1 :: R -> Vec
v1 R
t = R
2 R -> Vec -> Vec
*^ R
tR -> R -> R
forall a. Floating a => a -> a -> a
**R
2 R -> Vec -> Vec
*^ Vec
iHat Vec -> Vec -> Vec
^+^ R
3 R -> Vec -> Vec
*^ R
tR -> R -> R
forall a. Floating a => a -> a -> a
**R
3 R -> Vec -> Vec
*^ Vec
jHat Vec -> Vec -> Vec
^+^ R
tR -> R -> R
forall a. Floating a => a -> a -> a
**R
4 R -> Vec -> Vec
*^ Vec
kHat

xCompFunc :: (R -> Vec) -> R -> R
xCompFunc :: (R -> Vec) -> R -> R
xCompFunc R -> Vec
v R
t = Vec -> R
xComp (R -> Vec
v R
t)

-- | A derivative takes a real-valued function of a real variable (often time) as input,
--   and produces a real-valued function of a real variable as output.
type Derivative = (R -> R) -> R -> R

-- | Given a step size, calculate the derivative of a real-valued function of a real variable
--   (often time).
derivative :: R -> Derivative
derivative :: R -> Derivative
derivative R
dt R -> R
x R
t = (R -> R
x (R
t R -> R -> R
forall a. Num a => a -> a -> a
+ R
dtR -> R -> R
forall a. Fractional a => a -> a -> a
/R
2) R -> R -> R
forall a. Num a => a -> a -> a
- R -> R
x (R
t R -> R -> R
forall a. Num a => a -> a -> a
- R
dtR -> R -> R
forall a. Fractional a => a -> a -> a
/R
2)) R -> R -> R
forall a. Fractional a => a -> a -> a
/ R
dt

-- | Time is a real number.
type Time         = R
-- | The position of a particle can be represented as a vector.
type PosVec       = Vec
-- | Velocity is a vector.
type Velocity     = Vec
-- | Acceleration is a vector.
type Acceleration = Vec

-- | Given a time step and a position function, return a velocity function.
velFromPos :: R                   -- ^ dt
           -> (Time -> PosVec  )  -- ^ position function
           -> (Time -> Velocity)  -- ^ velocity function
velFromPos :: R -> VecDerivative
velFromPos = R -> VecDerivative
vecDerivative

-- | Given a time step and a velocity function, return an acceleration function.
accFromVel :: R                       -- dt
           -> (Time -> Velocity)      -- velocity function
           -> (Time -> Acceleration)  -- acceleration function
accFromVel :: R -> VecDerivative
accFromVel = R -> VecDerivative
vecDerivative

-- | Given initial position and a constant velocity, return a position function.
positionCV :: PosVec -> Velocity -> Time -> PosVec
positionCV :: Vec -> Vec -> R -> Vec
positionCV Vec
r0 Vec
v0 R
t = Vec
v0 Vec -> R -> Vec
^* R
t Vec -> Vec -> Vec
^+^ Vec
r0

-- | Given initial velocity and a constant acceleration, return a velocity function.
velocityCA :: Velocity -> Acceleration -> Time -> Velocity
velocityCA :: Vec -> Vec -> R -> Vec
velocityCA Vec
v0 Vec
a0 R
t = Vec
a0 Vec -> R -> Vec
^* R
t Vec -> Vec -> Vec
^+^ Vec
v0

-- | Given initial position, initial velocity, and a constant acceleration, return a position function.
positionCA :: PosVec -> Velocity -> Acceleration
           -> Time -> PosVec
positionCA :: Vec -> Vec -> Vec -> R -> Vec
positionCA Vec
r0 Vec
v0 Vec
a0 R
t = R
0.5 R -> Vec -> Vec
*^ R
tR -> R -> R
forall a. Floating a => a -> a -> a
**R
2 R -> Vec -> Vec
*^ Vec
a0 Vec -> Vec -> Vec
^+^ Vec
v0 Vec -> R -> Vec
^* R
t Vec -> Vec -> Vec
^+^ Vec
r0

-- | Given a nonzero velocity and an acceleration, return the component of acceleration
--   parallel to the velocity.
aParallel :: Vec -> Vec -> Vec
aParallel :: Vec -> Vec -> Vec
aParallel Vec
v Vec
a = let vHat :: Vec
vHat = Vec
v Vec -> R -> Vec
^/ Vec -> R
magnitude Vec
v
                in (Vec
vHat Vec -> Vec -> R
<.> Vec
a) R -> Vec -> Vec
*^ Vec
vHat

-- | Given a nonzero velocity and an acceleration, return the component of acceleration
--   perpendicular to the velocity.
aPerp :: Vec -> Vec -> Vec
aPerp :: Vec -> Vec -> Vec
aPerp Vec
v Vec
a = Vec
a Vec -> Vec -> Vec
^-^ Vec -> Vec -> Vec
aParallel Vec
v Vec
a

-- | Given velocity and acceleration, return the rate at which speed is changing.
speedRateChange :: Vec -> Vec -> R
speedRateChange :: Vec -> Vec -> R
speedRateChange Vec
v Vec
a = (Vec
v Vec -> Vec -> R
<.> Vec
a) R -> R -> R
forall a. Fractional a => a -> a -> a
/ Vec -> R
magnitude Vec
v

radiusOfCurvature :: Vec -> Vec -> R
radiusOfCurvature :: Vec -> Vec -> R
radiusOfCurvature Vec
v Vec
a = (Vec
v Vec -> Vec -> R
<.> Vec
v) R -> R -> R
forall a. Fractional a => a -> a -> a
/ Vec -> R
magnitude (Vec -> Vec -> Vec
aPerp Vec
v Vec
a)

projectilePos :: PosVec -> Velocity -> Time -> PosVec
projectilePos :: Vec -> Vec -> R -> Vec
projectilePos Vec
r0 Vec
v0 = Vec -> Vec -> Vec -> R -> Vec
positionCA Vec
r0 Vec
v0 (R
9.81 R -> Vec -> Vec
*^ Vec -> Vec
negateV Vec
kHat)

-- | An approximation to a real number.
type R = Double

data Mass = Mass R
            deriving (Mass -> Mass -> Bool
(Mass -> Mass -> Bool) -> (Mass -> Mass -> Bool) -> Eq Mass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mass -> Mass -> Bool
== :: Mass -> Mass -> Bool
$c/= :: Mass -> Mass -> Bool
/= :: Mass -> Mass -> Bool
Eq,Int -> Mass -> ShowS
[Mass] -> ShowS
Mass -> String
(Int -> Mass -> ShowS)
-> (Mass -> String) -> ([Mass] -> ShowS) -> Show Mass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mass -> ShowS
showsPrec :: Int -> Mass -> ShowS
$cshow :: Mass -> String
show :: Mass -> String
$cshowList :: [Mass] -> ShowS
showList :: [Mass] -> ShowS
Show)

data Grade = Grade String Int
             deriving (Grade -> Grade -> Bool
(Grade -> Grade -> Bool) -> (Grade -> Grade -> Bool) -> Eq Grade
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Grade -> Grade -> Bool
== :: Grade -> Grade -> Bool
$c/= :: Grade -> Grade -> Bool
/= :: Grade -> Grade -> Bool
Eq,Int -> Grade -> ShowS
[Grade] -> ShowS
Grade -> String
(Int -> Grade -> ShowS)
-> (Grade -> String) -> ([Grade] -> ShowS) -> Show Grade
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Grade -> ShowS
showsPrec :: Int -> Grade -> ShowS
$cshow :: Grade -> String
show :: Grade -> String
$cshowList :: [Grade] -> ShowS
showList :: [Grade] -> ShowS
Show)

grades :: [Grade]
grades :: [Grade]
grades = [String -> Int -> Grade
Grade String
"Albert Einstein" Int
89
         ,String -> Int -> Grade
Grade String
"Isaac Newton"    Int
95
         ,String -> Int -> Grade
Grade String
"Alan Turing"     Int
91
         ]

data GradeRecord = GradeRecord { GradeRecord -> String
name  :: String
                               , GradeRecord -> Int
grade :: Int
                               } deriving (GradeRecord -> GradeRecord -> Bool
(GradeRecord -> GradeRecord -> Bool)
-> (GradeRecord -> GradeRecord -> Bool) -> Eq GradeRecord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GradeRecord -> GradeRecord -> Bool
== :: GradeRecord -> GradeRecord -> Bool
$c/= :: GradeRecord -> GradeRecord -> Bool
/= :: GradeRecord -> GradeRecord -> Bool
Eq,Int -> GradeRecord -> ShowS
[GradeRecord] -> ShowS
GradeRecord -> String
(Int -> GradeRecord -> ShowS)
-> (GradeRecord -> String)
-> ([GradeRecord] -> ShowS)
-> Show GradeRecord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GradeRecord -> ShowS
showsPrec :: Int -> GradeRecord -> ShowS
$cshow :: GradeRecord -> String
show :: GradeRecord -> String
$cshowList :: [GradeRecord] -> ShowS
showList :: [GradeRecord] -> ShowS
Show)

gradeRecords1 :: [GradeRecord]
gradeRecords1 :: [GradeRecord]
gradeRecords1 = [String -> Int -> GradeRecord
GradeRecord String
"Albert Einstein" Int
89
                ,String -> Int -> GradeRecord
GradeRecord String
"Isaac Newton"    Int
95
                ,String -> Int -> GradeRecord
GradeRecord String
"Alan Turing"     Int
91
                ]

gradeRecords2 :: [GradeRecord]
gradeRecords2 :: [GradeRecord]
gradeRecords2 = [GradeRecord {name :: String
name = String
"Albert Einstein", grade :: Int
grade = Int
89}
                ,GradeRecord {name :: String
name = String
"Isaac Newton"   , grade :: Int
grade = Int
95}
                ,GradeRecord {name :: String
name = String
"Alan Turing"    , grade :: Int
grade = Int
91}
                ]

data MyBool = MyFalse | MyTrue
              deriving (MyBool -> MyBool -> Bool
(MyBool -> MyBool -> Bool)
-> (MyBool -> MyBool -> Bool) -> Eq MyBool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MyBool -> MyBool -> Bool
== :: MyBool -> MyBool -> Bool
$c/= :: MyBool -> MyBool -> Bool
/= :: MyBool -> MyBool -> Bool
Eq,Int -> MyBool -> ShowS
[MyBool] -> ShowS
MyBool -> String
(Int -> MyBool -> ShowS)
-> (MyBool -> String) -> ([MyBool] -> ShowS) -> Show MyBool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MyBool -> ShowS
showsPrec :: Int -> MyBool -> ShowS
$cshow :: MyBool -> String
show :: MyBool -> String
$cshowList :: [MyBool] -> ShowS
showList :: [MyBool] -> ShowS
Show)

data MyMaybe a = MyNothing
               | MyJust a
                deriving (MyMaybe a -> MyMaybe a -> Bool
(MyMaybe a -> MyMaybe a -> Bool)
-> (MyMaybe a -> MyMaybe a -> Bool) -> Eq (MyMaybe a)
forall a. Eq a => MyMaybe a -> MyMaybe a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => MyMaybe a -> MyMaybe a -> Bool
== :: MyMaybe a -> MyMaybe a -> Bool
$c/= :: forall a. Eq a => MyMaybe a -> MyMaybe a -> Bool
/= :: MyMaybe a -> MyMaybe a -> Bool
Eq,Int -> MyMaybe a -> ShowS
[MyMaybe a] -> ShowS
MyMaybe a -> String
(Int -> MyMaybe a -> ShowS)
-> (MyMaybe a -> String)
-> ([MyMaybe a] -> ShowS)
-> Show (MyMaybe a)
forall a. Show a => Int -> MyMaybe a -> ShowS
forall a. Show a => [MyMaybe a] -> ShowS
forall a. Show a => MyMaybe a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> MyMaybe a -> ShowS
showsPrec :: Int -> MyMaybe a -> ShowS
$cshow :: forall a. Show a => MyMaybe a -> String
show :: MyMaybe a -> String
$cshowList :: forall a. Show a => [MyMaybe a] -> ShowS
showList :: [MyMaybe a] -> ShowS
Show)

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

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

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

-- | A unit vector in the x direction.
iHat :: Vec
iHat :: Vec
iHat = R -> R -> R -> Vec
vec R
1 R
0 R
0

-- | A unit vector in the y direction.
jHat :: Vec
jHat :: Vec
jHat = R -> R -> R -> Vec
vec R
0 R
1 R
0

-- | A unit vector in the z direction.
kHat :: Vec
kHat :: Vec
kHat = R -> R -> R -> Vec
vec R
0 R
0 R
1

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

-- | Negate 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)

-- | 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
axR -> R -> R
forall a. Num a => a -> a -> a
+R
bx) (R
ayR -> R -> R
forall a. Num a => a -> a -> a
+R
by) (R
azR -> R -> R
forall 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
axR -> R -> R
forall a. Num a => a -> a -> a
-R
bx) (R
ayR -> R -> R
forall a. Num a => a -> a -> a
-R
by) (R
azR -> R -> R
forall a. Num a => a -> a -> a
-R
bz)

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

-- | Scalar multiplication of a number and a vector.
(*^)  :: R   -> Vec -> Vec
R
c *^ :: R -> Vec -> Vec
*^ Vec R
ax R
ay R
az = R -> R -> R -> Vec
Vec (R
cR -> R -> R
forall a. Num a => a -> a -> a
*R
ax) (R
cR -> R -> R
forall a. Num a => a -> a -> a
*R
ay) (R
cR -> R -> R
forall a. Num a => a -> a -> a
*R
az)

-- | Scalar multiplication of a vector and a number.
(^*)  :: Vec -> R   -> Vec
Vec R
ax R
ay R
az ^* :: Vec -> R -> Vec
^* R
c = R -> R -> R -> Vec
Vec (R
cR -> R -> R
forall a. Num a => a -> a -> a
*R
ax) (R
cR -> R -> R
forall a. Num a => a -> a -> a
*R
ay) (R
cR -> R -> R
forall a. Num a => a -> a -> a
*R
az)

-- | 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
axR -> R -> R
forall a. Num a => a -> a -> a
*R
bx R -> R -> R
forall a. Num a => a -> a -> a
+ R
ayR -> R -> R
forall a. Num a => a -> a -> a
*R
by R -> R -> R
forall a. Num a => a -> a -> a
+ R
azR -> R -> R
forall a. Num a => a -> a -> a
*R
bz

-- | Cross product of two vectors.
(><)  :: 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
ayR -> R -> R
forall a. Num a => a -> a -> a
*R
bz R -> R -> R
forall a. Num a => a -> a -> a
- R
azR -> R -> R
forall a. Num a => a -> a -> a
*R
by) (R
azR -> R -> R
forall a. Num a => a -> a -> a
*R
bx R -> R -> R
forall a. Num a => a -> a -> a
- R
axR -> R -> R
forall a. Num a => a -> a -> a
*R
bz) (R
axR -> R -> R
forall a. Num a => a -> a -> a
*R
by R -> R -> R
forall a. Num a => a -> a -> a
- R
ayR -> R -> R
forall a. Num a => a -> a -> a
*R
bx)

-- | Division of a vector by a number.
(^/) :: Vec -> R -> Vec
Vec R
ax R
ay R
az ^/ :: Vec -> R -> Vec
^/ R
c = R -> R -> R -> Vec
Vec (R
axR -> R -> R
forall a. Fractional a => a -> a -> a
/R
c) (R
ayR -> R -> R
forall a. Fractional a => a -> a -> a
/R
c) (R
azR -> R -> R
forall a. Fractional a => a -> a -> a
/R
c)

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

-- | Definite integral of a vector-valued function of a real number.
vecIntegral :: R           -- ^ step size dt
            -> (R -> Vec)  -- ^ vector-valued function
            -> R           -- ^ lower limit
            -> R           -- ^ upper limit
            -> Vec         -- ^ result
vecIntegral :: R -> (R -> Vec) -> R -> R -> Vec
vecIntegral = R -> (R -> Vec) -> R -> R -> Vec
forall a. HasCallStack => a
undefined

maxHeight :: PosVec -> Velocity -> R
maxHeight :: Vec -> Vec -> R
maxHeight = Vec -> Vec -> R
forall a. HasCallStack => a
undefined

speedCA :: Velocity -> Acceleration -> Time -> R
speedCA :: Vec -> Vec -> R -> R
speedCA = Vec -> Vec -> R -> R
forall a. HasCallStack => a
undefined

xyProj :: Vec -> Vec
xyProj :: Vec -> Vec
xyProj = Vec -> Vec
forall a. HasCallStack => a
undefined

magAngles :: Vec -> (R,R,R)
magAngles :: Vec -> (R, R, R)
magAngles = Vec -> (R, R, R)
forall a. HasCallStack => a
undefined

gEarth :: Vec
gEarth :: Vec
gEarth = Vec
forall a. HasCallStack => a
undefined

vBall :: R -> Vec
vBall :: R -> Vec
vBall R
t = R -> Vec
forall a. HasCallStack => a
undefined R
t

speedRateChangeBall :: R -> R
speedRateChangeBall :: R -> R
speedRateChangeBall R
t = R -> R
forall a. HasCallStack => a
undefined R
t

rNCM :: (R, R -> R) -> R -> Vec
rNCM :: (R, R -> R) -> R -> Vec
rNCM (R
radius, R -> R
theta) R
t = R -> (R -> R) -> R -> Vec
forall a. HasCallStack => a
undefined R
radius R -> R
theta R
t

aPerpFromPosition :: R -> (R -> Vec) -> R -> Vec
aPerpFromPosition :: R -> VecDerivative
aPerpFromPosition R
epsilon R -> Vec
r R
t
    = let v :: R -> Vec
v = R -> VecDerivative
vecDerivative R
epsilon R -> Vec
r
          a :: R -> Vec
a = R -> VecDerivative
vecDerivative R
epsilon R -> Vec
v
      in Vec -> Vec -> Vec
aPerp (R -> Vec
v R
t) (R -> Vec
a R
t)