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

newtonTLQD :: ModelQDef
newtonTLQD :: ModelQDef
newtonTLQD = 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") PExpr
newtonTLExpr

newtonTLExpr :: PExpr
newtonTLExpr :: PExpr
newtonTLExpr = forall r. ExprC r => r -> r
neg (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", forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force, forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
force_1, String -> Sentence
S String
"exerted on the second",
  forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
rigidBody, String -> Sentence
S String
"by the first is equal in magnitude and in the opposite direction" Sentence -> Sentence -> Sentence
`S.toThe`
  forall n. NamedIdea n => n -> Sentence
phrase UnitalChunk
force, forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
force_2, String -> Sentence
S String
"exerted on the first", 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 = forall e. MultiDefn e -> ModelKind e
equationalRealm' forall a b. (a -> b) -> a -> b
$ forall e.
QuantityDict
-> Sentence -> NonEmpty (DefiningExpr e) -> MultiDefn e
mkMultiDefnForQuant QuantityDict
newtonForceQuant Sentence
EmptyS forall a b. (a -> b) -> a -> b
$ forall a. [a] -> NonEmpty a
NE.fromList [
    forall e. String -> [UID] -> Sentence -> e -> DefiningExpr e
mkDefiningExpr String
"newtonLUGviaDeriv" [] Sentence
EmptyS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
gravitationalConst forall r. ExprC r => r -> r -> r
`mulRe` (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
mass_1 forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
mass_2 forall r. ExprC r => r -> r -> r
$/ forall r. (ExprC r, LiteralC r) => r -> r
square (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
dispNorm)) forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
dVect),
    forall e. String -> [UID] -> Sentence -> e -> DefiningExpr e
mkDefiningExpr String
"newtonLUGviaForm"  [] Sentence
EmptyS (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
gravitationalConst forall r. ExprC r => r -> r -> r
`mulRe` (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
mass_1 forall r. ExprC r => r -> r -> r
`mulRe` forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
mass_2 forall r. ExprC r => r -> r -> r
$/ forall r. (ExprC r, LiteralC r) => r -> r
square (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
dispNorm)) forall r. ExprC r => r -> r -> r
`mulRe` (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
distMass forall r. ExprC r => r -> r -> r
$/ forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy UnitalChunk
dispNorm))
  ]

newtonLUG :: TheoryModel
newtonLUG :: TheoryModel
newtonLUG = forall q c.
(Quantity q, MayHaveUnit q, Concept c) =>
ModelKind ModelExpr
-> [q]
-> [c]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> String
-> [Sentence]
-> TheoryModel
tmNoRefs ModelKind ModelExpr
newtonLUGModel
  [forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
force, forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
gravitationalConst, forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
mass_1, forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
mass_2,
  forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
dispNorm, forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
dVect, forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
distMass] ([] :: [ConceptChunk])
  [] [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") forall a. Maybe a
Nothing Space
Real (forall c. HasSymbol c => c -> Stage -> Symbol
symbol UnitalChunk
force) 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 `mulRe` 10^{-11} m/kgs^2" (line 187)).

newtonLUGNotes :: [Sentence]
newtonLUGNotes :: [Sentence]
newtonLUGNotes = [[Sentence] -> Sentence
foldlSent
  [String -> Sentence
S String
"Two", forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
rigidBody Sentence -> Sentence -> Sentence
`S.inThe` String -> Sentence
S String
"universe attract each other with a",
   forall a. Quantity a => a -> Sentence
getTandS UnitalChunk
force, String -> Sentence
S String
"that is directly proportional to the product of their",
   forall n. NamedIdea n => n -> Sentence
plural UnitalChunk
mass Sentence -> Sentence -> Sentence
`sC` forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch UnitalChunk
mass_1 Sentence -> Sentence -> Sentence
`S.and_` 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` 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 = forall q c.
(Quantity q, MayHaveUnit q, Concept c) =>
ModelKind ModelExpr
-> [q]
-> [c]
-> [ModelQDef]
-> [ModelExpr]
-> [ModelQDef]
-> String
-> [Sentence]
-> TheoryModel
tmNoRefs (forall e. String -> QDefinition e -> ModelKind e
equationalModelU String
"newtonSLR" ModelQDef
newtonSLRQD)
  [forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
torque, forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
momentOfInertia, forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw UnitalChunk
angularAccel]
  ([] :: [ConceptChunk]) [ModelQDef
newtonSLRQD] [] [] String
"NewtonSecLawRotMot" [Sentence]
newtonSLRNotes

newtonSLRQD :: ModelQDef
newtonSLRQD :: ModelQDef
newtonSLRQD = 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") PExpr
newtonSLRExpr

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

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