{-# LANGUAGE PostfixOperators #-}
module Drasil.GamePhysics.TMods (tMods, newtonSL, newtonSLR, newtonTL, newtonLUG) where

import qualified Data.List.NonEmpty as NE

import Language.Drasil
import Theory.Drasil
import qualified Language.Drasil.Sentence.Combinators as S

import Drasil.GamePhysics.Assumptions (assumpOD)
import Drasil.GamePhysics.Unitals (dispNorm, dVect, force_1, force_2,
  mass_1, mass_2, sqrDist, distMass)

import Data.Drasil.Concepts.Documentation (constant)
import Data.Drasil.Concepts.Physics (rigidBody, twoD)
import Data.Drasil.Quantities.PhysicalProperties (mass)
import Data.Drasil.Quantities.Physics (angularAccel,
  force, gravitationalConst, momentOfInertia, torque)
import Data.Drasil.Theories.Physics (newtonSL)

----- Theoretical Models -----

tMods :: [TheoryModel]
tMods :: [TheoryModel]
tMods = [TheoryModel
newtonSL, TheoryModel
newtonTL, TheoryModel
newtonLUG, TheoryModel
newtonSLR]

-- T1 : Newton's second law of motion --

-- T2 : Newton's third law of motion --

newtonTL :: TheoryModel
newtonTL :: TheoryModel
newtonTL = ModelKind ModelExpr
-> [QuantityDict]
-> [ConceptChunk]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> String
-> [Sentence]
-> TheoryModel
forall q c.
(Quantity q, MayHaveUnit q, Concept c) =>
ModelKind ModelExpr
-> [q]
-> [c]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> String
-> [Sentence]
-> TheoryModel
tmNoRefs (ModelQDef -> ModelKind ModelExpr
forall e. QDefinition e -> ModelKind e
equationalModel' ModelQDef
newtonTLQD) [UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
force_1, UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
force_2]
  ([] :: [ConceptChunk]) [ModelQDef
newtonTLQD] [] [] String
"NewtonThirdLawMot" [Sentence
newtonTLNote]

newtonTLQD :: ModelQDef
newtonTLQD :: ModelQDef
newtonTLQD = UnitalChunk -> NP -> ModelExpr -> ModelQDef
forall c e.
(Quantity c, MayHaveUnit c) =>
c -> NP -> e -> QDefinition e
mkQuantDef' UnitalChunk
force_1 (String -> NP
nounPhraseSP String
"Newton's third law of motion") ModelExpr
PExpr
newtonTLExpr

newtonTLExpr :: PExpr
newtonTLExpr :: PExpr
newtonTLExpr = r -> r
forall r. ExprC r => r -> r
neg (UnitalChunk -> r
forall c. (HasUID c, HasSymbol c) => c -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
force_2)

newtonTLNote :: Sentence
newtonTLNote :: Sentence
newtonTLNote = [Sentence] -> Sentence
foldlSent [(String -> Sentence
S String
"Every action has an equal and opposite reaction" !.),
  String -> Sentence
S String
"In other words, the", UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force, UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
force_1, String -> Sentence
S String
"exerted on the second",
  ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
rigidBody, String -> Sentence
S String
"by the first is equal in magnitude and" Sentence -> Sentence -> Sentence
`S.inThe` String -> Sentence
S String
"opposite direction" Sentence -> Sentence -> Sentence
`S.toThe`
  UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force, UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
force_2, String -> Sentence
S String
"exerted on the first", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
rigidBody, String -> Sentence
S String
"by the second"]

-- T3 : Newton's law of universal gravitation --

-- FIXME: Missing ConceptDomain!
newtonLUGModel :: ModelKind ModelExpr
newtonLUGModel :: ModelKind ModelExpr
newtonLUGModel = MultiDefn ModelExpr -> ModelKind ModelExpr
forall e. MultiDefn e -> ModelKind e
equationalRealm' (MultiDefn ModelExpr -> ModelKind ModelExpr)
-> MultiDefn ModelExpr -> ModelKind ModelExpr
forall a b. (a -> b) -> a -> b
$ QuantityDict
-> Sentence
-> NonEmpty (DefiningExpr ModelExpr)
-> MultiDefn ModelExpr
forall e.
QuantityDict
-> Sentence -> NonEmpty (DefiningExpr e) -> MultiDefn e
mkMultiDefnForQuant QuantityDict
newtonForceQuant Sentence
EmptyS (NonEmpty (DefiningExpr ModelExpr) -> MultiDefn ModelExpr)
-> NonEmpty (DefiningExpr ModelExpr) -> MultiDefn ModelExpr
forall a b. (a -> b) -> a -> b
$ [DefiningExpr ModelExpr] -> NonEmpty (DefiningExpr ModelExpr)
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [
    String -> [UID] -> Sentence -> ModelExpr -> DefiningExpr ModelExpr
forall e. String -> [UID] -> Sentence -> e -> DefiningExpr e
mkDefiningExpr String
"newtonLUGviaDeriv" [] Sentence
EmptyS (UnitalChunk -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
gravitationalConst ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$* (UnitalChunk -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
mass_1 ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$* UnitalChunk -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
mass_2 ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$/ ModelExpr -> ModelExpr
forall r. (ExprC r, LiteralC r) => r -> r
square (UnitalChunk -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
dispNorm)) ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$* UnitalChunk -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
dVect),
    String -> [UID] -> Sentence -> ModelExpr -> DefiningExpr ModelExpr
forall e. String -> [UID] -> Sentence -> e -> DefiningExpr e
mkDefiningExpr String
"newtonLUGviaForm"  [] Sentence
EmptyS (UnitalChunk -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
gravitationalConst ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$* (UnitalChunk -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
mass_1 ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$* UnitalChunk -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
mass_2 ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$/ ModelExpr -> ModelExpr
forall r. (ExprC r, LiteralC r) => r -> r
square (UnitalChunk -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
dispNorm)) ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$* (UnitalChunk -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
distMass ModelExpr -> ModelExpr -> ModelExpr
forall r. ExprC r => r -> r -> r
$/ UnitalChunk -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
dispNorm))
  ]

newtonLUG :: TheoryModel
newtonLUG :: TheoryModel
newtonLUG = ModelKind ModelExpr
-> [QuantityDict]
-> [ConceptChunk]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> String
-> [Sentence]
-> TheoryModel
forall q c.
(Quantity q, MayHaveUnit q, Concept c) =>
ModelKind ModelExpr
-> [q]
-> [c]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> String
-> [Sentence]
-> TheoryModel
tmNoRefs ModelKind ModelExpr
newtonLUGModel
  [UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
force, UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
gravitationalConst, UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
mass_1, UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
mass_2,
  UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
dispNorm, UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
dVect, UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
distMass] ([] :: [ConceptChunk])
  [] [ModelKind ModelExpr -> ModelExpr
forall c. Express c => c -> ModelExpr
express ModelKind ModelExpr
newtonLUGModel] [] String
"UniversalGravLaw" [Sentence]
newtonLUGNotes

newtonForceQuant :: QuantityDict
newtonForceQuant :: QuantityDict
newtonForceQuant = String
-> NP
-> Maybe String
-> Space
-> (Stage -> Symbol)
-> Maybe UnitDefn
-> QuantityDict
mkQuant' String
"force" (String -> NP
nounPhraseSP String
"Newton's law of universal gravitation") Maybe String
forall a. Maybe a
Nothing Space
Real (UnitalChunk -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol UnitalChunk
force) Maybe UnitDefn
forall a. Maybe a
Nothing

-- Can't include fractions within a sentence (in the part where 'r denotes the
-- unit displacement vector, equivalent to r/||r||' (line 184)). Changed to a
-- verbal description instead.

-- Can't properly include the gravitational constant in a sentence (in the last
-- sentence, supposed to include "6.673 $* 10^{-11} m/kgs^2" (line 187)).

newtonLUGNotes :: [Sentence]
newtonLUGNotes :: [Sentence]
newtonLUGNotes = [[Sentence] -> Sentence
foldlSent
  [String -> Sentence
S String
"Two", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
rigidBody Sentence -> Sentence -> Sentence
`S.inThe` String -> Sentence
S String
"universe attract each other with a",
   UnitalChunk -> Sentence
forall a. Quantity a => a -> Sentence
getTandS UnitalChunk
force, String -> Sentence
S String
"that is directly proportional" Sentence -> Sentence -> Sentence
`S.toThe` String -> Sentence
S String
"product of their",
   UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
mass Sentence -> Sentence -> Sentence
`sC` UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
mass_1 Sentence -> Sentence -> Sentence
`S.and_` UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
mass_2 Sentence -> Sentence -> Sentence
`sC` Sentence
EmptyS Sentence -> Sentence -> Sentence
`S.and_`
   String -> Sentence
S String
"inversely proportional" Sentence -> Sentence -> Sentence
`S.toThe` UnitalChunk -> Sentence
forall a. Quantity a => a -> Sentence
getTandS UnitalChunk
sqrDist, String -> Sentence
S String
"between them"]]

-- T4 : Newton's second law for rotational motion --

newtonSLR :: TheoryModel
newtonSLR :: TheoryModel
newtonSLR = ModelKind ModelExpr
-> [QuantityDict]
-> [ConceptChunk]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> String
-> [Sentence]
-> TheoryModel
forall q c.
(Quantity q, MayHaveUnit q, Concept c) =>
ModelKind ModelExpr
-> [q]
-> [c]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> String
-> [Sentence]
-> TheoryModel
tmNoRefs (String -> ModelQDef -> ModelKind ModelExpr
forall e. String -> QDefinition e -> ModelKind e
equationalModelU String
"newtonSLR" ModelQDef
newtonSLRQD)
  [UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
torque, UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
momentOfInertia, UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
angularAccel]
  ([] :: [ConceptChunk]) [ModelQDef
newtonSLRQD] [] [] String
"NewtonSecLawRotMot" [Sentence]
newtonSLRNotes

newtonSLRQD :: ModelQDef
newtonSLRQD :: ModelQDef
newtonSLRQD = UnitalChunk -> NP -> ModelExpr -> ModelQDef
forall c e.
(Quantity c, MayHaveUnit c) =>
c -> NP -> e -> QDefinition e
mkQuantDef' UnitalChunk
torque (String -> NP
nounPhraseSP String
"Newton's second law for rotational motion") ModelExpr
PExpr
newtonSLRExpr

newtonSLRExpr :: PExpr
newtonSLRExpr :: PExpr
newtonSLRExpr = UnitalChunk -> r
forall c. (HasUID c, HasSymbol c) => c -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
momentOfInertia r -> r -> r
forall r. ExprC r => r -> r -> r
$* UnitalChunk -> r
forall c. (HasUID c, HasSymbol c) => c -> r
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
angularAccel

newtonSLRNotes :: [Sentence]
newtonSLRNotes :: [Sentence]
newtonSLRNotes = ([Sentence] -> Sentence) -> [[Sentence]] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map [Sentence] -> Sentence
foldlSent [
  [String -> Sentence
S String
"The net", UnitalChunk -> Sentence
forall a. Quantity a => a -> Sentence
getTandS UnitalChunk
torque, String -> Sentence
S String
"on a", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
rigidBody Sentence -> Sentence -> Sentence
`S.is`
   String -> Sentence
S String
"proportional to its", UnitalChunk -> Sentence
forall a. Quantity a => a -> Sentence
getTandS UnitalChunk
angularAccel Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"where",
   UnitalChunk -> Sentence
forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
momentOfInertia, String -> Sentence
S String
"denotes", UnitalChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
momentOfInertia Sentence -> Sentence -> Sentence
`S.the_ofThe`
   ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
rigidBody, String -> Sentence
S String
"as the", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
constant Sentence -> Sentence -> Sentence
`S.of_` String -> Sentence
S String
"proportionality"],
  [String -> Sentence
S String
"We also assume that all", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
rigidBody, String -> Sentence
S String
"involved" Sentence -> Sentence -> Sentence
`S.are`
   CI -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase CI
twoD, ConceptInstance -> Sentence
forall r. (Referable r, HasShortName r) => r -> Sentence
fromSource ConceptInstance
assumpOD]]