{-# LANGUAGE PostfixOperators #-}
module Drasil.GamePhysics.IMods (iMods, instModIntro) where

import Language.Drasil
import Language.Drasil.ShortHands (lJ)
import Theory.Drasil
import Utils.Drasil (weave)
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S

import Drasil.GamePhysics.Assumptions (assumpDI, assumpCAJI)
import Drasil.GamePhysics.Concepts (centreMass)
import Drasil.GamePhysics.DataDefs (ctrOfMassDD, linDispDD, linVelDD, linAccDD,
  angDispDD, angVelDD, angAccelDD, collisionAssump, rightHandAssump,
  rigidTwoDAssump)
import Drasil.GamePhysics.Expressions
import Drasil.GamePhysics.GenDefs (accelGravityGD, impulseGD)
import Drasil.GamePhysics.Goals (linearGS, angularGS)
import Drasil.GamePhysics.TMods (newtonSL, newtonSLR)
import Drasil.GamePhysics.Unitals (accj, forcej, massA, massj, normalVect,
  timeC, torquej, velA, velj, angAccj)

import Data.Drasil.TheoryConcepts (inModel)

import Data.Drasil.Concepts.Documentation (condition, goal, output_)
import Data.Drasil.Concepts.Math (equation, ode)
import Data.Drasil.Concepts.Physics (rigidBody, motion)
import Data.Drasil.Quantities.Math (orientation)
import Data.Drasil.Quantities.Physics (acceleration, angularAccel, angularVelocity,
  force, gravitationalAccel, impulseS, momentOfInertia, position, time, velocity)

iMods :: [InstanceModel]
iMods :: [InstanceModel]
iMods = [InstanceModel
transMot, InstanceModel
rotMot, InstanceModel
col2D]

{-- Force on the translational motion  --}
transMot :: InstanceModel
transMot :: InstanceModel
transMot = ModelKind Expr
-> Inputs
-> Output
-> OutputConstraints
-> Maybe Derivation
-> String
-> [Sentence]
-> InstanceModel
imNoRefs (forall e. QDefinition e -> ModelKind e
equationalModel' SimpleQDef
transMotQD) 
  [ forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
velj               forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  , forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
time               forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  , forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
gravitationalAccel forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  , forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
forcej             forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  , forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
massj              forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  ]
  (forall q. (Quantity q, MayHaveUnit q) => q -> Output
qw UnitalChunk
accj) [] (forall a. a -> Maybe a
Just Derivation
transMotDeriv)
  String
"transMot" [Sentence
transMotDesc, Sentence
transMotOutputs, Sentence
rigidTwoDAssump, Sentence
noDampConsAssumps]

transMotQD :: SimpleQDef
transMotQD :: SimpleQDef
transMotQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
accj PExpr
transMotExpr

transMotDesc, transMotOutputs :: Sentence
transMotDesc :: Sentence
transMotDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"The above", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"expresses the total",
  forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
acceleration forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` ConceptChunk
rigidBody), Symbol -> Sentence
P Symbol
lJ,
  String -> Sentence
S String
"as the sum" Sentence -> Sentence -> Sentence
`S.of_` forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
gravitationalAccel, forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource GenDefn
accelGravityGD Sentence -> Sentence -> Sentence
`S.and_`
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
acceleration, String -> Sentence
S String
"due to applied", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force, ModelExpr -> Sentence
eS (forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 UnitalChunk
forcej UnitalChunk
time) Sentence -> Sentence -> Sentence
+:+.
  forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource TheoryModel
newtonSL, String -> Sentence
S String
"The resultant", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
output_ Sentence -> Sentence -> Sentence
`S.are`
  String -> Sentence
S String
"then obtained from this", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"using",
  SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List (forall a b. (a -> b) -> [a] -> [b]
map forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS [DataDefinition
linDispDD, DataDefinition
linVelDD, DataDefinition
linAccDD])]
transMotOutputs :: Sentence
transMotOutputs = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (IdeaDict
output_ forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` CI
inModel),
 String -> Sentence
S String
"will be the functions" Sentence -> Sentence -> Sentence
`S.of_` forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
position forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` UnitalChunk
velocity),
 String -> Sentence
S String
"over time that satisfy the", CI -> Sentence
getAcc CI
ode Sentence -> Sentence -> Sentence
`S.for` forall n. NounPhrase n => n -> Sentence
phraseNP (forall t. NamedIdea t => t -> NP
the UnitalChunk
acceleration) Sentence -> Sentence -> Sentence
`sC`
 String -> Sentence
S String
"with the given initial", (forall n. NamedIdea n => n -> Sentence
plural IdeaDict
condition Sentence -> Sentence -> Sentence
`S.for` forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
position forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_`
 UnitalChunk
velocity) !.), forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
motion), String -> Sentence
S String
"is translational" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"so the",
 forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
position forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` UnitalChunk
velocity), String -> Sentence
S String
"functions are for the",
 forall n. NamedIdea n => n -> Sentence
phrase CI
centreMass, forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource DataDefinition
ctrOfMassDD]

transMotDeriv :: Derivation 
transMotDeriv :: Derivation
transMotDeriv = Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NamedIdea n => n -> Sentence
phrase InstanceModel
transMot)
      (forall a. [[a]] -> [a]
weave [[Sentence]
transMotDerivStmts, [Sentence]
transMotDerivEqns])

transMotDerivStmts :: [Sentence]
transMotDerivStmts :: [Sentence]
transMotDerivStmts = [
    [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"We may calculate the total acceleration of rigid body", 
      Symbol -> Sentence
P Symbol
lJ, String -> Sentence
S String
"by calculating the derivative of it's velocity with respect to time", forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource DataDefinition
linAccDD],
    String -> Sentence
S String
"Performing the derivative, we obtain:"
  ]

transMotDerivEqns :: [Sentence]
transMotDerivEqns :: [Sentence]
transMotDerivEqns = forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [forall r. (ModelExprC r, ExprC r) => r
transMotExprDeriv1, forall c. Express c => c -> ModelExpr
express SimpleQDef
transMotQD]

{-- Rotational Motion --}

rotMot :: InstanceModel
rotMot :: InstanceModel
rotMot = ModelKind Expr
-> Inputs
-> Output
-> OutputConstraints
-> Maybe Derivation
-> String
-> [Sentence]
-> InstanceModel
imNoRefs (forall e. QDefinition e -> ModelKind e
equationalModel' SimpleQDef
rotMotQD) 
  [ forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
angularVelocity forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  , forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
time            forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  , forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
torquej         forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  , forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
momentOfInertia forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  ]
  (forall q. (Quantity q, MayHaveUnit q) => q -> Output
qw UnitalChunk
angAccj) [forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)] 
  (forall a. a -> Maybe a
Just Derivation
rotMotDeriv) String
"rotMot"
  [Sentence
rotMotDesc, Sentence
rigidTwoDAssump, Sentence
rightHandAssump]

rotMotQD :: SimpleQDef
rotMotQD :: SimpleQDef
rotMotQD = forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef UnitalChunk
angAccj PExpr
rotMotExpr

rotMotDesc :: Sentence
rotMotDesc :: Sentence
rotMotDesc = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"The above", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"for the total",
  forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
angularAccel forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` ConceptChunk
rigidBody), Symbol -> Sentence
P Symbol
lJ Sentence -> Sentence -> Sentence
`S.is`
  String -> Sentence
S String
"derived from", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS TheoryModel
newtonSLR Sentence -> Sentence -> Sentence
`sC` Sentence
EmptyS Sentence -> Sentence -> Sentence
`S.andThe` String -> Sentence
S String
"resultant",
  forall n. NamedIdea n => n -> Sentence
plural IdeaDict
output_ Sentence -> Sentence -> Sentence
`S.are` String -> Sentence
S String
"then obtained from this", forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
equation, String -> Sentence
S String
"using",
  SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List (forall a b. (a -> b) -> [a] -> [b]
map forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS [DataDefinition
angDispDD, DataDefinition
angVelDD, DataDefinition
angAccelDD])]

rotMotDeriv :: Derivation 
rotMotDeriv :: Derivation
rotMotDeriv = Sentence -> [Sentence] -> Derivation
mkDerivName (forall n. NamedIdea n => n -> Sentence
phrase InstanceModel
rotMot)
      (forall a. [[a]] -> [a]
weave [[Sentence]
rotMotDerivStmts, [Sentence]
rotMotDerivEqns])

rotMotDerivStmts :: [Sentence]
rotMotDerivStmts :: [Sentence]
rotMotDerivStmts = [
    [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"We may calculate the total angular acceleration of rigid body", 
      Symbol -> Sentence
P Symbol
lJ, String -> Sentence
S String
"by calculating the derivative of its angular velocity with respect to time", forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource DataDefinition
angAccelDD],
    String -> Sentence
S String
"Performing the derivative, we obtain:"
  ]

rotMotDerivEqns :: [Sentence]
rotMotDerivEqns :: [Sentence]
rotMotDerivEqns = forall a b. (a -> b) -> [a] -> [b]
map ModelExpr -> Sentence
eS [forall r. (ModelExprC r, ExprC r) => r
rotMotExprDeriv1, forall c. Express c => c -> ModelExpr
express SimpleQDef
rotMotQD]

{-- 2D Collision --}

col2D :: InstanceModel
col2D :: InstanceModel
col2D = ModelKind Expr
-> Inputs
-> Output
-> OutputConstraints
-> String
-> [Sentence]
-> InstanceModel
imNoDerivNoRefs (forall e. String -> NP -> QDefinition e -> ModelKind e
equationalModel String
"col2DIM" NP
col2DNP SimpleQDef
col2DFD)
  [forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
time forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  ,forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
impulseS forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  ,forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
massA forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  ,forall q.
(Quantity q, MayHaveUnit q) =>
q -> RealInterval Expr Expr -> Input
qwC UnitalChunk
normalVect forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
  ]
  -- why a constraint on velA if velA is not an output?
  -- (qw timeC) [sy velA $> 0, sy timeC $> 0] "col2D"
  (forall q. (Quantity q, MayHaveUnit q) => q -> Output
qw UnitalChunk
timeC) [forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Exc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)] String
"col2D"
  [Sentence
col2DOutputs, Sentence
rigidTwoDAssump, Sentence
rightHandAssump, Sentence
collisionAssump,
    Sentence
noDampConsAssumps, Sentence
impulseNote]

col2DFD :: SimpleQDef
col2DFD :: SimpleQDef
col2DFD = forall c i e.
(Quantity c, MayHaveUnit c, HasSpace c, Quantity i, HasSpace i) =>
c -> [i] -> e -> QDefinition e
mkFuncDefByQ UnitalChunk
velA [UnitalChunk
timeC] Expr
col2DExpr

col2DNP :: NP
col2DNP :: NP
col2DNP =  String -> NP
nounPhraseSP String
"Collisions on 2D rigid bodies"

col2DExpr {-, im3Rel2, im3Rel3, im3Rel4 -} :: Expr -- FIXME: add proper equation
col2DExpr :: Expr
col2DExpr = forall r f a.
(ExprC r, HasUID f, HasSymbol f, HasUID a, HasSymbol a) =>
f -> a -> r
apply1 UnitalChunk
velA UnitalChunk
time forall r. ExprC r => r -> r -> r
`addRe`
  ((forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
impulseS forall r. ExprC r => r -> r -> r
$/ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
massA) forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
normalVect)


col2DOutputs, impulseNote :: Sentence
col2DOutputs :: Sentence
col2DOutputs = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (IdeaDict
output_ forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` CI
inModel),
  String -> Sentence
S String
"will be the functions" Sentence -> Sentence -> Sentence
`S.of_` Sentence
vals,  String -> Sentence
S String
"over time that satisfy the",
  forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
equation, String -> Sentence
S String
"for the", forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
velocity forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`and_` UnitalChunk
angularAccel) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"with the given initial", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
condition, String -> Sentence
S String
"for" Sentence -> Sentence -> Sentence
+:+. Sentence
vals, forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the ConceptChunk
motion),
  String -> Sentence
S String
"is translational" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"so the", Sentence
vals, String -> Sentence
S String
"functions are for the",
  forall n. NamedIdea n => n -> Sentence
phrase CI
centreMass, forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource DataDefinition
ctrOfMassDD]
    where vals :: Sentence
vals = SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List (forall a b. (a -> b) -> [a] -> [b]
map forall n. NamedIdea n => n -> Sentence
phrase [UnitalChunk
position, UnitalChunk
velocity,
                                                   UnitalChunk
orientation, UnitalChunk
angularAccel])
impulseNote :: Sentence
impulseNote = forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
impulseS Sentence -> Sentence -> Sentence
`S.is` forall r. (Referable r, HasShortName r) => r -> Sentence
definedIn'' GenDefn
impulseGD

{--S "Ik is the moment of inertia of the k-th rigid body (kg m2)",
  S "t is a point in time, t0 denotes the initial time" `sC` 
  S "and tc denotes the time at collision (s)",
  S "P is the point of collision (m)"
--}

{--displaceVectBtw  = cvR (ddcWDS "dispBtwVect" (compoundPhrase' 
  (displacement ^. term) (cn "vector between the centre of mass of the k-th
  body and point P"))) (sub (displacement ^. symbol) ) 
--}

{- Intro -}

instModIntro :: Sentence
instModIntro :: Sentence
instModIntro = [Sentence] -> Sentence
foldlSent [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
goal), forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
linearGS, 
  String -> Sentence
S String
"is met by" Sentence -> Sentence -> Sentence
+:+. (forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
transMot Sentence -> Sentence -> Sentence
`S.and_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
col2D),
  forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
goal), forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS ConceptInstance
angularGS, String -> Sentence
S String
"is met by",
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
rotMot Sentence -> Sentence -> Sentence
`S.and_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS InstanceModel
col2D]

{- Notes -}
noDampConsAssumps :: Sentence
noDampConsAssumps :: Sentence
noDampConsAssumps = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"It is currently assumed that no damping",
  String -> Sentence
S String
"occurs during the simulation", forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource ConceptInstance
assumpDI Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"that no", 
  String -> Sentence
S String
"constraints are involved", forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource ConceptInstance
assumpCAJI]