module Drasil.GamePhysics.Unitals where

import Language.Drasil
import Language.Drasil.Display (Symbol(..), Decoration(Magnitude))
import Language.Drasil.ShortHands
import Language.Drasil.Chunk.Concept.NamedCombinators

import Data.Drasil.SI_Units(kilogram, metre, m_2, newton, second)
import qualified Data.Drasil.Concepts.Physics as CP (rigidBody)
import qualified Data.Drasil.Quantities.Physics as QP (acceleration, angularAccel,
  angularDisplacement, angularVelocity, chgInVelocity, chgMomentum, displacement, distance,
  final, force, gravitationalAccel, gravitationalConst, gravitationalConstValue,
  height, impulseS, impulseV, initial, kEnergy, linearAccel, linearDisplacement,
  linearVelocity, momentOfInertia, position, potEnergy, restitutionCoef, time,
  torque, velocity, fOfGravity, positionVec)

import qualified Data.Drasil.Quantities.Math as QM (euclidNorm, normalVect, 
  orientation, perpVect, pi_, unitVect)
import qualified Data.Drasil.Quantities.PhysicalProperties as QPP (len, mass)
import Data.Drasil.Units.Physics (accelU, angVelU, impulseU, momtInertU,
  torqueU, velU, angAccelU)

import Control.Lens((^.))
import Data.Drasil.Constraints (gtZeroConstr)

defSymbols :: [DefinedQuantityDict]
defSymbols :: [DefinedQuantityDict]
defSymbols = (UnitalChunk -> DefinedQuantityDict)
-> [UnitalChunk] -> [DefinedQuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map UnitalChunk -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [UnitalChunk]
unitSymbs [DefinedQuantityDict]
-> [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a. [a] -> [a] -> [a]
++ (UncertQ -> DefinedQuantityDict)
-> [UncertQ] -> [DefinedQuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map UncertQ -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [UncertQ]
inputConstraints [DefinedQuantityDict]
-> [DefinedQuantityDict] -> [DefinedQuantityDict]
forall a. [a] -> [a] -> [a]
++
  (UncertQ -> DefinedQuantityDict)
-> [UncertQ] -> [DefinedQuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map UncertQ -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr [UncertQ]
outputConstraints

unitSymbs :: [UnitalChunk]
unitSymbs :: [UnitalChunk]
unitSymbs = (UnitalChunk -> UnitalChunk) -> [UnitalChunk] -> [UnitalChunk]
forall a b. (a -> b) -> [a] -> [b]
map UnitalChunk -> UnitalChunk
forall c. (Unitary c, Concept c, MayHaveUnit c) => c -> UnitalChunk
ucw [UnitalChunk]
unitalChunks [UnitalChunk] -> [UnitalChunk] -> [UnitalChunk]
forall a. [a] -> [a] -> [a]
++ (UnitalChunk -> UnitalChunk) -> [UnitalChunk] -> [UnitalChunk]
forall a b. (a -> b) -> [a] -> [b]
map UnitalChunk -> UnitalChunk
forall c. (Unitary c, Concept c, MayHaveUnit c) => c -> UnitalChunk
ucw [UnitalChunk
iVect, UnitalChunk
jVect, UnitalChunk
normalVect,
  UnitalChunk
force_1, UnitalChunk
force_2, UnitalChunk
forcej, UnitalChunk
mass_1, UnitalChunk
mass_2,
  UnitalChunk
dispNorm, UnitalChunk
sqrDist, UnitalChunk
velA, UnitalChunk
velB, UnitalChunk
velO, UnitalChunk
rOB, UnitalChunk
angVelA, UnitalChunk
angVelB,
  UnitalChunk
posCM, UnitalChunk
massj, UnitalChunk
posj, UnitalChunk
accj, UnitalChunk
angAccj, UnitalChunk
mTot, UnitalChunk
velj, UnitalChunk
torquej, UnitalChunk
timeC, UnitalChunk
initRelVel, 
  UnitalChunk
massA, UnitalChunk
massB, UnitalChunk
massIRigidBody, UnitalChunk
normalLen, UnitalChunk
contDispA, UnitalChunk
contDispB, 
  UnitalChunk
perpLenA, UnitalChunk
momtInertA, UnitalChunk
perpLenB, UnitalChunk
momtInertB, UnitalChunk
timeT, UnitalChunk
inittime, 
  UnitalChunk
momtInertK, UnitalChunk
pointOfCollision, UnitalChunk
contDispK, UnitalChunk
collisionImpulse, UnitalChunk
velAP,
  UnitalChunk
velBP, UnitalChunk
time_1, UnitalChunk
time_2, UnitalChunk
velo_1, UnitalChunk
velo_2, UnitalChunk
rRot, UnitalChunk
mLarger, UnitalChunk
distMass, UnitalChunk
dVect]

----------------------
-- TABLE OF SYMBOLS --
----------------------

symbols, symbolsAll, inputSymbols, outputSymbols :: [QuantityDict]

symbolsAll :: [QuantityDict]
symbolsAll = [QuantityDict]
symbols [QuantityDict] -> [QuantityDict] -> [QuantityDict]
forall a. [a] -> [a] -> [a]
++ [QuantityDict]
inputSymbols [QuantityDict] -> [QuantityDict] -> [QuantityDict]
forall a. [a] -> [a] -> [a]
++ [QuantityDict]
outputSymbols

symbols :: [QuantityDict]
symbols = (UnitalChunk -> QuantityDict) -> [UnitalChunk] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [UnitalChunk]
unitalChunks [QuantityDict] -> [QuantityDict] -> [QuantityDict]
forall a. [a] -> [a] -> [a]
++ 
  (QuantityDict -> QuantityDict) -> [QuantityDict] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map QuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [QuantityDict]
unitless [QuantityDict] -> [QuantityDict] -> [QuantityDict]
forall a. [a] -> [a] -> [a]
++ 
  (UncertQ -> QuantityDict) -> [UncertQ] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map UncertQ -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [UncertQ]
inputConstraints

inputSymbols :: [QuantityDict]
inputSymbols = (UnitalChunk -> QuantityDict) -> [UnitalChunk] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [UnitalChunk
QP.position, UnitalChunk
QP.velocity, UnitalChunk
QP.force, UnitalChunk
QM.orientation, 
  UnitalChunk
QP.angularVelocity, UnitalChunk
QP.linearVelocity, UnitalChunk
QP.gravitationalConst, UnitalChunk
QPP.mass, 
  UnitalChunk
QPP.len, UnitalChunk
QP.momentOfInertia, UnitalChunk
QP.torque, UnitalChunk
QP.kEnergy, UnitalChunk
QP.chgInVelocity, UnitalChunk
QP.potEnergy, UnitalChunk
QP.fOfGravity, UnitalChunk
QP.positionVec] [QuantityDict] -> [QuantityDict] -> [QuantityDict]
forall a. [a] -> [a] -> [a]
++
  [DefinedQuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw DefinedQuantityDict
QP.restitutionCoef]

outputSymbols :: [QuantityDict]
outputSymbols = (UnitalChunk -> QuantityDict) -> [UnitalChunk] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [UnitalChunk
QP.position, UnitalChunk
QP.velocity, UnitalChunk
QM.orientation, 
  UnitalChunk
QP.angularVelocity, UnitalChunk
QP.chgMomentum, UnitalChunk
QP.chgInVelocity]


unitalChunks :: [UnitalChunk]
unitalChunks :: [UnitalChunk]
unitalChunks = [UnitalChunk
QP.acceleration, UnitalChunk
QP.angularAccel, UnitalChunk
QP.gravitationalAccel, 
  UnitalChunk
QP.impulseV, UnitalChunk
QP.impulseS, UnitalChunk
iVect, UnitalChunk
jVect, UnitalChunk
normalVect, UnitalChunk
QP.distance, UnitalChunk
QP.displacement, 
  UnitalChunk
QP.time, UnitalChunk
QP.angularDisplacement, UnitalChunk
posCM, UnitalChunk
posj, UnitalChunk
massj, UnitalChunk
mTot, UnitalChunk
accj, UnitalChunk
velj,
  UnitalChunk
QP.linearDisplacement, UnitalChunk
QP.linearVelocity, UnitalChunk
QP.linearAccel, UnitalChunk
initRelVel, UnitalChunk
normalLen,
  UnitalChunk
perpLenA, UnitalChunk
perpLenB, UnitalChunk
forcej, UnitalChunk
torquej, UnitalChunk
timeC, UnitalChunk
velA, UnitalChunk
velB, UnitalChunk
massA, UnitalChunk
massB,
  UnitalChunk
angVelA, UnitalChunk
angVelB, UnitalChunk
force_1, UnitalChunk
force_2, UnitalChunk
mass_1, UnitalChunk
mass_2, 
  UnitalChunk
dispNorm, UnitalChunk
sqrDist, UnitalChunk
velO, UnitalChunk
rOB, UnitalChunk
massIRigidBody, UnitalChunk
contDispA, UnitalChunk
contDispB, 
  UnitalChunk
momtInertA, UnitalChunk
momtInertB, UnitalChunk
timeT, UnitalChunk
inittime, UnitalChunk
momtInertK, UnitalChunk
pointOfCollision, 
  UnitalChunk
contDispK, UnitalChunk
collisionImpulse, UnitalChunk
QP.kEnergy, UnitalChunk
finRelVel, UnitalChunk
velAP, UnitalChunk
velBP, UnitalChunk
time_1, UnitalChunk
time_2, UnitalChunk
velo_1, UnitalChunk
velo_2,
  UnitalChunk
QP.chgInVelocity, UnitalChunk
QP.potEnergy, UnitalChunk
QP.height, UnitalChunk
rRot, UnitalChunk
mLarger, UnitalChunk
QP.fOfGravity, UnitalChunk
QP.positionVec, UnitalChunk
distMass, 
  UnitalChunk
dVect, UnitalChunk
QP.chgMomentum,UnitalChunk
QP.chgInVelocity, UnitalChunk
time_1, UnitalChunk
time_2, UnitalChunk
velo_1, UnitalChunk
velo_2]

-----------------------
-- PARAMETRIZED HACK --
-----------------------
--FIXME: parametrized hack
--FIXME: "A" is not being capitalized when it should be.
forceParam, massParam, timeParam :: String -> String -> Symbol -> UnitalChunk
forceParam :: String -> String -> Symbol -> UnitalChunk
forceParam String
n String
w Symbol
s = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc
 (String -> NP -> Sentence -> ConceptChunk
dccWDS (String
"force" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n) (String -> NP
cn (String -> NP) -> String -> NP
forall a b. (a -> b) -> a -> b
$ String
"force exerted by the " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ 
  String
" body (on another body)") (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.force)) 
  (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.force) Symbol
s) Space
Real UnitDefn
newton

massParam :: String -> String -> Symbol -> UnitalChunk
massParam String
n String
w Symbol
s = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc
 (String -> NP -> Sentence -> ConceptChunk
dccWDS (String
"mass" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n) (String -> NP
cn (String -> NP) -> String -> NP
forall a b. (a -> b) -> a -> b
$ String
"mass of the " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" body") 
  (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QPP.mass)) (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QPP.mass) Symbol
s) Space
Real UnitDefn
kilogram

timeParam :: String -> String -> Symbol -> UnitalChunk
timeParam String
n String
w Symbol
s = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc
 (String -> NP -> Sentence -> ConceptChunk
dccWDS (String
"time" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n) (String -> NP
cn (String -> NP) -> String -> NP
forall a b. (a -> b) -> a -> b
$ String
"time at a point in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" body ") 
  (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.time)) (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.time) Symbol
s) Space
Real UnitDefn
second

contParam :: String -> String -> Symbol -> Symbol -> UnitalChunk
contParam :: String -> String -> Symbol -> Symbol -> UnitalChunk
contParam String
n String
m Symbol
w Symbol
s = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc
 (String -> NP -> Sentence -> ConceptChunk
dccWDS (String
"r_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
m) NP
contdispN (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.displacement))
  (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.displacement) ([Symbol] -> Symbol
Concat [Symbol
w, Symbol
s])) Space
Real UnitDefn
metre
  where contdispN :: NP
contdispN = String -> NP
cn (String -> NP) -> String -> NP
forall a b. (a -> b) -> a -> b
$ String
"displacement vector between the centre of mass of rigid body " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and contact point " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
m

angParam, momtParam, perpParam, rigidParam, velBodyParam, velParam :: String -> Symbol -> UnitalChunk

angParam :: String -> Symbol -> UnitalChunk
angParam String
n Symbol
w = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc
 (String -> NP -> Sentence -> ConceptChunk
dccWDS (String
"angular velocity" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n) (NP -> NP -> NP
compoundPhrase'
  (String -> NP
cn (String -> NP) -> String -> NP
forall a b. (a -> b) -> a -> b
$ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" body's") (UnitalChunk
QP.angularVelocity UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term))
  (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.angularVelocity)) (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.angularVelocity) Symbol
w) Space
Real UnitDefn
angVelU

momtParam :: String -> Symbol -> UnitalChunk
momtParam String
n Symbol
w = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc
 (String -> NP -> Sentence -> ConceptChunk
dccWDS (String
"momentOfInertia" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n) (NP -> NP -> NP
compoundPhrase'
  (UnitalChunk
QP.momentOfInertia UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term) (String -> NP
cn (String -> NP) -> String -> NP
forall a b. (a -> b) -> a -> b
$ String
"of rigid body " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n))
  (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.momentOfInertia)) (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.momentOfInertia) Symbol
w) Space
Real UnitDefn
momtInertU

perpParam :: String -> Symbol -> UnitalChunk
perpParam String
n Symbol
w = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc
 (String -> NP -> Sentence -> ConceptChunk
dccWDS (String
"|| r_A" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" x n ||") 
  (NP -> NP -> NP
compoundPhrase' (UnitalChunk
QPP.len UnitalChunk -> DefinedQuantityDict -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` DefinedQuantityDict
QM.perpVect)
  (String -> NP
cn (String -> NP) -> String -> NP
forall a b. (a -> b) -> a -> b
$ String
"to the contact displacement vector of rigid body " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n)) 
  (DefinedQuantityDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase DefinedQuantityDict
QM.perpVect)) (Decoration -> Symbol -> Symbol
Atop Decoration
Magnitude (Symbol -> Symbol) -> Symbol -> Symbol
forall a b. (a -> b) -> a -> b
$ [Symbol] -> Symbol
Concat [Symbol
w, String -> Symbol
label String
"*", --should be x for cross
  DefinedQuantityDict -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb DefinedQuantityDict
QM.perpVect]) Space
Real UnitDefn
metre

rigidParam :: String -> Symbol -> UnitalChunk
rigidParam String
n Symbol
w = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc
 (String -> NP -> Sentence -> ConceptChunk
dccWDS (String
"rig_mass" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n) (NP -> NP -> NP
compoundPhrase' (UnitalChunk
QPP.mass UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term)
  (String -> NP
cn (String -> NP) -> String -> NP
forall a b. (a -> b) -> a -> b
$ String
"of rigid body " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n)) (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QPP.mass)) (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QPP.mass) Symbol
w) Space
Real UnitDefn
kilogram

velBodyParam :: String -> Symbol -> UnitalChunk
velBodyParam String
n Symbol
w = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc
 (String -> NP -> Sentence -> ConceptChunk
dccWDS (String
"velocity" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n) (NP -> NP -> NP
compoundPhrase' (UnitalChunk
QP.velocity UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term)
  (String -> NP
cn (String -> NP) -> String -> NP
forall a b. (a -> b) -> a -> b
$ String
"of the  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" body")) (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.velocity)) (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.velocity) Symbol
w) Space
Real UnitDefn
velU

velParam :: String -> Symbol -> UnitalChunk
velParam String
n Symbol
w = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc
 (String -> NP -> Sentence -> ConceptChunk
dccWDS (String
"velocity" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n) (NP -> NP -> NP
compoundPhrase' (UnitalChunk
QP.velocity UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term)
  (String -> NP
cn (String -> NP) -> String -> NP
forall a b. (a -> b) -> a -> b
$ String
"at point " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n)) (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.velocity)) (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.velocity) Symbol
w) Space
Real UnitDefn
velU

-----------------------
-- CHUNKS WITH UNITS --
-----------------------

iVect, jVect, normalVect, force_1, force_2, forcej, mass_1, mass_2, 
  dispNorm, sqrDist, velA, velB, velO, rOB, angVelA, angVelB,
  posCM, massj, posj, accj, angAccj, mTot, velj, torquej, timeC, initRelVel, 
  massA, massB, massIRigidBody, normalLen, contDispA, contDispB, 
  perpLenA, momtInertA, perpLenB, momtInertB, timeT, inittime, 
  momtInertK, pointOfCollision, contDispK, collisionImpulse, finRelVel,
  velAP, velBP, time_1, time_2, velo_1, velo_2, rRot, mLarger, distMass, dVect :: UnitalChunk

iVect :: UnitalChunk
iVect = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"unitVect" (NP -> NP -> NP
compoundPhrase' (String -> NP
cn String
"horizontal")
               (DefinedQuantityDict
QM.unitVect DefinedQuantityDict -> Getting NP DefinedQuantityDict NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP DefinedQuantityDict NP
forall c. NamedIdea c => Lens' c NP
Lens' DefinedQuantityDict NP
term)) (DefinedQuantityDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase DefinedQuantityDict
QM.unitVect)) 
               (DefinedQuantityDict -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb DefinedQuantityDict
QM.unitVect) Space
Real UnitDefn
metre
jVect :: UnitalChunk
jVect       = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"unitVectJ" (NP -> NP -> NP
compoundPhrase' (String -> NP
cn String
"vertical")
               (DefinedQuantityDict
QM.unitVect DefinedQuantityDict -> Getting NP DefinedQuantityDict NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP DefinedQuantityDict NP
forall c. NamedIdea c => Lens' c NP
Lens' DefinedQuantityDict NP
term)) (DefinedQuantityDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase DefinedQuantityDict
QM.unitVect)) (Symbol -> Symbol
vec (Symbol -> Symbol) -> Symbol -> Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol
hat Symbol
lJ) Space
Real UnitDefn
metre
normalVect :: UnitalChunk
normalVect  = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"normalVect" (Sentence -> NP
nounPhraseSent (String -> Sentence
S String
"collision" Sentence -> Sentence -> Sentence
+:+
                   DefinedQuantityDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase DefinedQuantityDict
QM.normalVect)) (DefinedQuantityDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase DefinedQuantityDict
QM.normalVect)) 
                   (DefinedQuantityDict -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb DefinedQuantityDict
QM.normalVect) (Space -> Space
Vect Space
Real) UnitDefn
metre

dVect :: UnitalChunk
dVect = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"unitVect" 
          (String -> NP
cn String
"unit vector directed from the center of the large mass to the center of the smaller mass") 
                   (DefinedQuantityDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase DefinedQuantityDict
QM.unitVect)) (Symbol -> Symbol
vec (Symbol -> Symbol
hat Symbol
lD)) Space
Real UnitDefn
metre

dispNorm :: UnitalChunk
dispNorm = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"euclideanNormDisp" (String -> NP
cn String
"Euclidean norm of the distance between the center of mass of two bodies")
               (DefinedQuantityDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase DefinedQuantityDict
QM.euclidNorm) ) (DefinedQuantityDict -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb DefinedQuantityDict
QM.euclidNorm) Space
Real UnitDefn
metre

distMass :: UnitalChunk
distMass = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"distMass" (String -> NP
cn String
"distance between the center of mass of the rigid bodies") 
                 (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.distance)) (Symbol -> Symbol
vec Symbol
lD) Space
Real UnitDefn
metre

sqrDist :: UnitalChunk
sqrDist = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"euclideanNorm" (String -> NP
cn' String
"squared distance")
               (DefinedQuantityDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase DefinedQuantityDict
QM.euclidNorm)) (Symbol -> Symbol -> Symbol
sup (DefinedQuantityDict -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb DefinedQuantityDict
QM.euclidNorm) 
               Symbol
label2) Space
Real UnitDefn
m_2
             
rOB :: UnitalChunk
rOB    = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"rOB" 
  (String -> NP
nounPhraseSP String
"displacement vector between the origin and point B")
  (String -> Sentence
S String
"FIXME: Define this or remove the need for definitions")
  (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.displacement) ([Symbol] -> Symbol
Concat [Symbol
lOrigin, Symbol
lBodyB])) Space
Real UnitDefn
metre
  
posCM :: UnitalChunk
posCM = String
-> NP -> Sentence -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"p_CM" (String -> NP
nounPhraseSP String
"Center of Mass")
 --"mass-weighted average position of a rigid " ++
 -- "body's particles") 
  (String -> Sentence
S String
"FIXME: Define this or remove the need for definitions")
  (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.position) Symbol
lCMass) Space
Real UnitDefn
metre

massj :: UnitalChunk
massj = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"m_j" (NP -> NP -> NP
compoundPhrase' (UnitalChunk
QPP.mass UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term)
                (String -> NP
cn String
"of the j-th particle")) (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QPP.mass)) 
                (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QPP.mass) Symbol
lJ) Space
Real UnitDefn
kilogram

posj :: UnitalChunk
posj = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"p_j" (NP -> NP -> NP
compoundPhrase' (UnitalChunk
QP.position UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term) 
               (String -> NP
cn String
"vector of the j-th particle")) (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.position))
               (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.position) Symbol
lJ) Space
Real UnitDefn
metre

accj :: UnitalChunk
accj = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"accj" (NP -> NP -> NP
compoundPhrase' (String -> NP
cn String
"j-th body's")
               (UnitalChunk
QP.acceleration UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term)) (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.acceleration))
               (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.acceleration) Symbol
lJ) Space
Real UnitDefn
accelU

-- FIXME: Using the titleized version in the same style as 'accj' above does not render properly.
--        Oddly, stable breaks differently when trying to use 'nounPhraseSent' or 'combineNPNI'. See #2650.
angAccj :: UnitalChunk
angAccj = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"angAccj" (Sentence
-> Sentence -> CapitalizationRule -> CapitalizationRule -> NP
nounPhrase'' (String -> Sentence
S String
"j-th body's" Sentence -> Sentence -> Sentence
+:+
               UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.angularAccel) (String -> Sentence
S String
"j-th body's" Sentence -> Sentence -> Sentence
+:+
               UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.angularAccel) CapitalizationRule
CapWords CapitalizationRule
CapWords) (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.angularAccel))
               (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.angularAccel) Symbol
lJ) Space
Real UnitDefn
angAccelU

velj :: UnitalChunk
velj = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"velj" (NP -> NP -> NP
compoundPhrase' (UnitalChunk
QP.velocity UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term)
               (String -> NP
cn String
"of the j-th body")) (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.velocity))
               (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.velocity) Symbol
lJ) Space
Real UnitDefn
velU

torquej :: UnitalChunk
torquej = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"torquej" 
               (String -> NP
cn String
"torque applied to the j-th body")
               (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.torque)) (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.torque) Symbol
lJ) Space
Real UnitDefn
torqueU

mTot :: UnitalChunk
mTot = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"M_T" (NP -> NP -> NP
compoundPhrase' (String -> NP
cn String
"total mass of the") 
                 (ConceptChunk
CP.rigidBody ConceptChunk -> Getting NP ConceptChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP ConceptChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' ConceptChunk NP
term)) (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QPP.mass))
                 (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QPP.mass) Symbol
cT) Space
Real UnitDefn
kilogram

mLarger :: UnitalChunk
mLarger = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"mLarger" (NP -> NP -> NP
compoundPhrase' (String -> NP
cn String
"mass of the larger") 
                 (ConceptChunk
CP.rigidBody ConceptChunk -> Getting NP ConceptChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP ConceptChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' ConceptChunk NP
term)) (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QPP.mass)) Symbol
cM Space
Real UnitDefn
kilogram

timeC :: UnitalChunk
timeC = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"timeC" (String -> NP
cn String
"denotes the time at collision") 
                (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.time)) (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.time) Symbol
lColl) Space
Real UnitDefn
second

initRelVel :: UnitalChunk
initRelVel = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"v_i^AB" (NP -> NP -> NP
compoundPhrase'
                 (NP -> NP -> NP
compoundPhrase' (String -> NP
cn String
"initial relative") (UnitalChunk
QP.velocity UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term))
                 (String -> NP
cn String
"between rigid bodies of A and B")) (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.velocity))
                 (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.velocity) Symbol
QP.initial) ([Symbol] -> Symbol
Concat [Symbol
lBodyA, Symbol
lBodyB])) (Space -> Space
Vect Space
Real) UnitDefn
velU

finRelVel :: UnitalChunk
finRelVel = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"v_f^AB" (NP -> NP -> NP
compoundPhrase'
                 (NP -> NP -> NP
compoundPhrase' (String -> NP
cn String
"final relative") (UnitalChunk
QP.velocity UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term))
                 (String -> NP
cn String
"between rigid bodies of A and B")) (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.velocity))
                 (Symbol -> Symbol -> Symbol
sup (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.velocity) Symbol
QP.final) ([Symbol] -> Symbol
Concat [Symbol
lBodyA, Symbol
lBodyB])) (Space -> Space
Vect Space
Real) UnitDefn
velU

massIRigidBody :: UnitalChunk
massIRigidBody = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"massj" (NP -> NP -> NP
compoundPhrase' (UnitalChunk
QPP.mass UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term) 
                (String -> NP
cn String
"of the j-th rigid body")) (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QPP.mass)) 
                (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QPP.mass) Symbol
lJ) Space
Real UnitDefn
kilogram
normalLen :: UnitalChunk
normalLen = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"length of the normal vector" (
                  UnitalChunk
QPP.len UnitalChunk -> DefinedQuantityDict -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` DefinedQuantityDict
QM.normalVect) 
                  (DefinedQuantityDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase DefinedQuantityDict
QM.normalVect))
                  (Decoration -> Symbol -> Symbol
Atop Decoration
Magnitude (Symbol -> Symbol) -> Symbol -> Symbol
forall a b. (a -> b) -> a -> b
$ DefinedQuantityDict -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb DefinedQuantityDict
QM.normalVect) Space
Real UnitDefn
metre

rRot :: UnitalChunk
rRot = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"r_j" (NP -> NP -> NP
compoundPhrase' (UnitalChunk
QP.distance UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term)
                (String -> NP
cn String
"between the j-th particle and the axis of rotation")) (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.distance)) 
                (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.distance) Symbol
lJ) Space
Real UnitDefn
metre

timeT :: UnitalChunk
timeT = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"t" (String -> NP
cn String
"point in time") (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.time))
                (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.time) Space
Real UnitDefn
second

inittime :: UnitalChunk
inittime = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"t_0" (String -> NP
cn String
"denotes the initial time") 
                (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.time)) (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.time) Symbol
label0) Space
Real UnitDefn
second

pointOfCollision :: UnitalChunk
pointOfCollision = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"point_c" (String -> NP
cn String
"point of collision") 
                 (String -> Sentence
S String
"point")) Symbol
cP Space
Real UnitDefn
metre

collisionImpulse :: UnitalChunk
collisionImpulse = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"collisionImp" (NP -> NP -> NP
compoundPhrase' 
                (String -> NP
cn String
"collision") (UnitalChunk
QP.impulseS UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term)) (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.impulseS)) 
                (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.impulseS) Space
Real UnitDefn
impulseU

forcej :: UnitalChunk
forcej = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"forcej" (NP -> NP -> NP
compoundPhrase' 
      (UnitalChunk
QP.force UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term) (String -> NP
cn String
"applied to the j-th body at time t")) 
      (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.force)) (Symbol -> Symbol -> Symbol
sub (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.force) Symbol
lJ) Space
Real UnitDefn
newton

velAP :: UnitalChunk
velAP = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"v^AP" (NP -> NP -> NP
compoundPhrase' (UnitalChunk
QP.velocity UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term)
              (String -> NP
cn String
"of the point of collision P in body A")) 
              (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.velocity)) (Symbol -> Symbol -> Symbol
sup (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.velocity)([Symbol] -> Symbol
Concat [Symbol
lBodyA, Symbol
lPoint])) 
              (Space -> Space
Vect Space
Real) UnitDefn
velU
velBP :: UnitalChunk
velBP = ConceptChunk -> Symbol -> Space -> UnitDefn -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
uc (String -> NP -> Sentence -> ConceptChunk
dccWDS String
"v^BP" (NP -> NP -> NP
compoundPhrase' (UnitalChunk
QP.velocity UnitalChunk -> Getting NP UnitalChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP UnitalChunk NP
forall c. NamedIdea c => Lens' c NP
Lens' UnitalChunk NP
term)
              (String -> NP
cn String
"of the point of collision P in body B")) 
              (UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
QP.velocity)) (Symbol -> Symbol -> Symbol
sup (UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
QP.velocity)([Symbol] -> Symbol
Concat [Symbol
lBodyB, Symbol
lPoint]))
              (Space -> Space
Vect Space
Real) UnitDefn
velU

force_1 :: UnitalChunk
force_1    = String -> String -> Symbol -> UnitalChunk
forceParam String
"1" String
"first"  Symbol
label1
force_2 :: UnitalChunk
force_2    = String -> String -> Symbol -> UnitalChunk
forceParam String
"2" String
"second" Symbol
label2
mass_1 :: UnitalChunk
mass_1     = String -> String -> Symbol -> UnitalChunk
massParam  String
"1" String
"first"  Symbol
label1
mass_2 :: UnitalChunk
mass_2     = String -> String -> Symbol -> UnitalChunk
massParam  String
"2" String
"second" Symbol
label2
velA :: UnitalChunk
velA       = String -> Symbol -> UnitalChunk
velParam   String
"A" Symbol
lBodyA
velB :: UnitalChunk
velB       = String -> Symbol -> UnitalChunk
velParam   String
"B" Symbol
lBodyB
velO :: UnitalChunk
velO       = String -> Symbol -> UnitalChunk
velParam   String
"origin" Symbol
lOrigin
angVelA :: UnitalChunk
angVelA    = String -> Symbol -> UnitalChunk
angParam   String
"A" Symbol
lBodyA
angVelB :: UnitalChunk
angVelB    = String -> Symbol -> UnitalChunk
angParam   String
"B" Symbol
lBodyB
perpLenA :: UnitalChunk
perpLenA   = String -> Symbol -> UnitalChunk
perpParam  String
"A" (Symbol -> UnitalChunk) -> Symbol -> UnitalChunk
forall a b. (a -> b) -> a -> b
$ UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
contDispA
perpLenB :: UnitalChunk
perpLenB   = String -> Symbol -> UnitalChunk
perpParam  String
"B" (Symbol -> UnitalChunk) -> Symbol -> UnitalChunk
forall a b. (a -> b) -> a -> b
$ UnitalChunk -> Symbol
forall q. HasSymbol q => q -> Symbol
eqSymb UnitalChunk
contDispB
momtInertA :: UnitalChunk
momtInertA = String -> Symbol -> UnitalChunk
momtParam  String
"A" Symbol
lBodyA
momtInertB :: UnitalChunk
momtInertB = String -> Symbol -> UnitalChunk
momtParam  String
"B" Symbol
lBodyB
momtInertK :: UnitalChunk
momtInertK = String -> Symbol -> UnitalChunk
momtParam  String
"k" Symbol
lK
contDispA :: UnitalChunk
contDispA  = String -> String -> Symbol -> Symbol -> UnitalChunk
contParam  String
"A" String
"P" Symbol
lBodyA Symbol
lPoint
contDispB :: UnitalChunk
contDispB  = String -> String -> Symbol -> Symbol -> UnitalChunk
contParam  String
"B" String
"P" Symbol
lBodyB Symbol
lPoint
contDispK :: UnitalChunk
contDispK  = String -> String -> Symbol -> Symbol -> UnitalChunk
contParam  String
"k" String
"P" Symbol
lK     Symbol
lPoint
massA :: UnitalChunk
massA      = String -> Symbol -> UnitalChunk
rigidParam String
"A" Symbol
lBodyA
massB :: UnitalChunk
massB      = String -> Symbol -> UnitalChunk
rigidParam String
"B" Symbol
lBodyB
velo_1 :: UnitalChunk
velo_1     = String -> Symbol -> UnitalChunk
velBodyParam  String
"first"  Symbol
label1
velo_2 :: UnitalChunk
velo_2     = String -> Symbol -> UnitalChunk
velBodyParam  String
"second" Symbol
label2
time_1 :: UnitalChunk
time_1     = String -> String -> Symbol -> UnitalChunk
timeParam String
"1" String
"first"  Symbol
label1
time_2 :: UnitalChunk
time_2     = String -> String -> Symbol -> UnitalChunk
timeParam String
"2" String
"second" Symbol
label2

label0, label1, label2, lBodyA, lBodyB, lCMass, lColl, lOrigin, lPoint :: Symbol
label0 :: Symbol
label0  = Int -> Symbol
Integ Int
0
label1 :: Symbol
label1  = Int -> Symbol
Integ Int
1
label2 :: Symbol
label2  = Int -> Symbol
Integ Int
2
lBodyA :: Symbol
lBodyA  = String -> Symbol
label String
"A"
lBodyB :: Symbol
lBodyB  = String -> Symbol
label String
"B"
lCMass :: Symbol
lCMass  = String -> Symbol
label String
"CM"
lColl :: Symbol
lColl   = String -> Symbol
label String
"c"
lOrigin :: Symbol
lOrigin = String -> Symbol
label String
"O"
lPoint :: Symbol
lPoint  = String -> Symbol
label String
"P"

--------------------------
-- CHUNKS WITHOUT UNITS --
--------------------------

unitless :: [QuantityDict]
unitless :: [QuantityDict]
unitless = DefinedQuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw DefinedQuantityDict
QM.pi_ QuantityDict -> [QuantityDict] -> [QuantityDict]
forall a. a -> [a] -> [a]
: [QuantityDict
numParticles]

numParticles :: QuantityDict
numParticles :: QuantityDict
numParticles = String -> NP -> Symbol -> Space -> QuantityDict
vc String
"n" (String -> NP
nounPhraseSP String
"number of particles in a rigid body") Symbol
lN Space
Integer

-----------------------
-- CONSTRAINT CHUNKS --
-----------------------

lengthCons, massCons, mmntOfInCons, gravAccelCons, posCons, orientCons,
  angVeloCons, forceCons, torqueCons, veloCons, restCoefCons, veloOutCons,
  angVeloOutCons, orientOutCons, posOutCons :: ConstrConcept

inputConstraints :: [UncertQ]
inputConstraints :: [UncertQ]
inputConstraints = (ConstrConcept -> UncertQ) -> [ConstrConcept] -> [UncertQ]
forall a b. (a -> b) -> [a] -> [b]
map (ConstrConcept -> Uncertainty -> UncertQ
forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
`uq` Uncertainty
defaultUncrt)
  [ConstrConcept
lengthCons, ConstrConcept
massCons, ConstrConcept
mmntOfInCons, ConstrConcept
gravAccelCons, ConstrConcept
orientCons,
  ConstrConcept
veloCons, ConstrConcept
angVeloCons, ConstrConcept
forceCons, ConstrConcept
torqueCons, ConstrConcept
restCoefCons, ConstrConcept
posCons]

outputConstraints :: [UncertQ]
outputConstraints :: [UncertQ]
outputConstraints = (ConstrConcept -> UncertQ) -> [ConstrConcept] -> [UncertQ]
forall a b. (a -> b) -> [a] -> [b]
map (ConstrConcept -> Uncertainty -> UncertQ
forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
`uq` Uncertainty
defaultUncrt) 
  [ConstrConcept
posOutCons, ConstrConcept
veloOutCons, ConstrConcept
orientOutCons, ConstrConcept
angVeloOutCons]

lengthCons :: ConstrConcept
lengthCons     = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
QPP.len               [ConstraintE
gtZeroConstr] (Double -> Expr
forall r. LiteralC r => Double -> r
dbl Double
44.2)
massCons :: ConstrConcept
massCons       = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
QPP.mass              [ConstraintE
gtZeroConstr] (Double -> Expr
forall r. LiteralC r => Double -> r
dbl Double
56.2)
mmntOfInCons :: ConstrConcept
mmntOfInCons   = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
QP.momentOfInertia    [ConstraintE
gtZeroConstr] (Double -> Expr
forall r. LiteralC r => Double -> r
dbl Double
74.5)
gravAccelCons :: ConstrConcept
gravAccelCons  = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
QP.gravitationalConst [] (Literal -> Expr
forall r. ExprC r => Literal -> r
lit (Literal -> Expr) -> Literal -> Expr
forall a b. (a -> b) -> a -> b
$ ConstQDef
QP.gravitationalConstValue ConstQDef -> Getting Literal ConstQDef Literal -> Literal
forall s a. s -> Getting a s a -> a
^. Getting Literal ConstQDef Literal
forall e. Lens' (QDefinition e) e
forall (c :: * -> *) e. DefiningExpr c => Lens' (c e) e
defnExpr)
posCons :: ConstrConcept
posCons        = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
QP.position           [] (Double -> Expr
forall r. LiteralC r => Double -> r
dbl Double
0.412) --FIXME: should be (0.412, 0.502) vector
veloCons :: ConstrConcept
veloCons       = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
QP.velocity           [] (Double -> Expr
forall r. LiteralC r => Double -> r
dbl Double
2.51)
orientCons :: ConstrConcept
orientCons     = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
QM.orientation        [RealInterval Expr Expr -> ConstraintE
sfwrRange (RealInterval Expr Expr -> ConstraintE)
-> RealInterval Expr Expr -> ConstraintE
forall a b. (a -> b) -> a -> b
$ (Inclusive, Expr) -> (Inclusive, Expr) -> RealInterval Expr Expr
forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Inc, Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Inc, Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
2 Expr -> Expr -> Expr
forall r. ExprC r => r -> r -> r
$* DefinedQuantityDict -> Expr
forall c. (HasUID c, HasSymbol c) => c -> Expr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
QM.pi_)] (Expr -> Expr
forall r. (ExprC r, LiteralC r) => r -> r
half (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ DefinedQuantityDict -> Expr
forall c. (HasUID c, HasSymbol c) => c -> Expr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy DefinedQuantityDict
QM.pi_) -- physical constraint not needed space is radians
angVeloCons :: ConstrConcept
angVeloCons    = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
QP.angularVelocity    [] (Double -> Expr
forall r. LiteralC r => Double -> r
dbl Double
2.1)
forceCons :: ConstrConcept
forceCons      = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
QP.force              [] (Double -> Expr
forall r. LiteralC r => Double -> r
dbl Double
98.1)
torqueCons :: ConstrConcept
torqueCons     = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
QP.torque             [] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
200)
restCoefCons :: ConstrConcept
restCoefCons   = DefinedQuantityDict -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' DefinedQuantityDict
QP.restitutionCoef    [RealInterval Expr Expr -> ConstraintE
physRange (RealInterval Expr Expr -> ConstraintE)
-> RealInterval Expr Expr -> ConstraintE
forall a b. (a -> b) -> a -> b
$ (Inclusive, Expr) -> (Inclusive, Expr) -> RealInterval Expr Expr
forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
Inc, Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0) (Inclusive
Inc, Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
1)] (Double -> Expr
forall r. LiteralC r => Double -> r
dbl Double
0.8)

posOutCons :: ConstrConcept
posOutCons        = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
QP.position           [] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
veloOutCons :: ConstrConcept
veloOutCons       = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
QP.velocity           [] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
orientOutCons :: ConstrConcept
orientOutCons     = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
QM.orientation        [] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0)
angVeloOutCons :: ConstrConcept
angVeloOutCons    = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
QP.angularVelocity    [] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl Integer
0)

---------------------
-- INSTANCE MODELS --
---------------------

---------------------
-- GOAL STATEMENTS --
---------------------