module Drasil.DblPendulum.Unitals where
import Language.Drasil
import Language.Drasil.Display (Symbol(..))
import Language.Drasil.ShortHands
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S
import Data.Drasil.Constraints (gtZeroConstr)
import Data.Drasil.TheoryConcepts (dataDefn, genDefn, inModel, thModel)
import Data.Drasil.Concepts.Documentation (assumption, goalStmt, physSyst, requirement, srs, typUnc)
import Data.Drasil.Quantities.PhysicalProperties as QPP (len, mass)
import Data.Drasil.SI_Units (metre, degree, kilogram, newton)
import qualified Data.Drasil.Quantities.Physics as QP (position, force, velocity,
angularVelocity, angularAccel, gravitationalAccel, tension, acceleration, time)
import Data.Drasil.Concepts.Physics (twoD)
import Data.Drasil.Concepts.Math as CM (angle, xDir, yDir)
import Data.Drasil.Quantities.Math as QM (unitVect, unitVectj, pi_)
import Drasil.DblPendulum.Concepts (firstRod, secondRod, firstObject, secondObject, horizontalPos,
verticalPos, horizontalVel, verticalVel, horizontalAccel, verticalAccel)
import Data.Drasil.Units.Physics (velU, accelU, angVelU, angAccelU)
symbols:: [QuantityDict]
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]
++ (DefinedQuantityDict -> QuantityDict)
-> [DefinedQuantityDict] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map DefinedQuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [DefinedQuantityDict]
unitless
acronyms :: [CI]
acronyms :: [CI]
acronyms = [CI
twoD, CI
assumption, CI
dataDefn, CI
genDefn, CI
goalStmt, CI
inModel,
CI
physSyst, CI
requirement, CI
srs, CI
thModel, CI
typUnc]
inputs :: [QuantityDict]
inputs :: [QuantityDict]
inputs = (UnitalChunk -> QuantityDict) -> [UnitalChunk] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [UnitalChunk
lenRod_1, UnitalChunk
lenRod_2, UnitalChunk
pendDisAngle_1, UnitalChunk
pendDisAngle_2, UnitalChunk
massObj_1, UnitalChunk
massObj_2]
outputs :: [QuantityDict]
outputs :: [QuantityDict]
outputs = (UnitalChunk -> QuantityDict) -> [UnitalChunk] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map UnitalChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [UnitalChunk
angularAccel_1, UnitalChunk
angularAccel_2]
units :: [UnitalChunk]
units :: [UnitalChunk]
units = (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
unitalChunks :: [UnitalChunk]
unitalChunks :: [UnitalChunk]
unitalChunks = [
UnitalChunk
lenRod_1, UnitalChunk
lenRod_2, UnitalChunk
massObj_1, UnitalChunk
massObj_2, UnitalChunk
angularVel_1, UnitalChunk
angularVel_2,
UnitalChunk
pendDisAngle_1, UnitalChunk
pendDisAngle_2, UnitalChunk
xVel_1, UnitalChunk
xVel_2, UnitalChunk
yVel_1, UnitalChunk
yVel_2,
UnitalChunk
xPos_1, UnitalChunk
xPos_2, UnitalChunk
yPos_1, UnitalChunk
yPos_2, UnitalChunk
xAccel_1, UnitalChunk
yAccel_1, UnitalChunk
xAccel_2, UnitalChunk
yAccel_2,
UnitalChunk
angularAccel_1, UnitalChunk
angularAccel_2, UnitalChunk
tension_1, UnitalChunk
tension_2,
UnitalChunk
QPP.mass, UnitalChunk
QP.force, UnitalChunk
QP.gravitationalAccel, UnitalChunk
QP.tension, UnitalChunk
QP.acceleration,
UnitalChunk
QP.time, UnitalChunk
QP.velocity, UnitalChunk
QP.position]
lenRod_1, lenRod_2, massObj_1, massObj_2, angularVel_1, angularVel_2,
pendDisAngle_1, pendDisAngle_2,
xPos_1, xPos_2, yPos_1, yPos_2, xVel_1, yVel_1, xVel_2, yVel_2, xAccel_1,
yAccel_1, xAccel_2, yAccel_2,
angularAccel_1, angularAccel_2, tension_1, tension_2 :: UnitalChunk
lenRod_1 :: UnitalChunk
lenRod_1 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "l_1" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP(UnitalChunk
len UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstRod))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
len UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstRod))
(Symbol -> Symbol -> Symbol
sub Symbol
cL Symbol
label1) UnitDefn
metre
lenRod_2 :: UnitalChunk
lenRod_2 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "l_2" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP(UnitalChunk
len UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondRod))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
len UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondRod))
(Symbol -> Symbol -> Symbol
sub Symbol
cL Symbol
label2) UnitDefn
metre
massObj_1 :: UnitalChunk
massObj_1 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "m_1" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
mass UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
mass UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject))
(Symbol -> Symbol -> Symbol
sub Symbol
lM Symbol
label1) UnitDefn
kilogram
massObj_2 :: UnitalChunk
massObj_2 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "m_2" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
mass UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
mass UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject))
(Symbol -> Symbol -> Symbol
sub Symbol
lM Symbol
label2) UnitDefn
kilogram
xPos_1 :: UnitalChunk
xPos_1 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "p_x1" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
horizontalPos NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.position UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject) Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CM.xDir)
(Symbol -> Symbol -> Symbol
sub Symbol
lP ([Symbol] -> Symbol
Concat [Symbol
labelx, Symbol
label1])) UnitDefn
metre
xPos_2 :: UnitalChunk
xPos_2 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "p_x2" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
horizontalPos NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.position UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject) Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CM.xDir)
(Symbol -> Symbol -> Symbol
sub Symbol
lP ([Symbol] -> Symbol
Concat [Symbol
labelx, Symbol
label2])) UnitDefn
metre
yPos_1 :: UnitalChunk
yPos_1 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "p_y1" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
verticalPos NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.position UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject) Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CM.yDir)
(Symbol -> Symbol -> Symbol
sub Symbol
lP ([Symbol] -> Symbol
Concat [Symbol
labely, Symbol
label1])) UnitDefn
metre
yPos_2 :: UnitalChunk
yPos_2 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "p_y2" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
verticalPos NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.position UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject) Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CM.yDir)
(Symbol -> Symbol -> Symbol
sub Symbol
lP ([Symbol] -> Symbol
Concat [Symbol
labely, Symbol
label2])) UnitDefn
metre
xVel_1 :: UnitalChunk
xVel_1 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "v_x1" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
horizontalVel NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularVelocity UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject) Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CM.xDir)
(Symbol -> Symbol -> Symbol
sub Symbol
lV ([Symbol] -> Symbol
Concat [Symbol
labelx, Symbol
label1])) UnitDefn
velU
xVel_2 :: UnitalChunk
xVel_2 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "v_x2" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
horizontalVel NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularVelocity UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject) Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CM.xDir)
(Symbol -> Symbol -> Symbol
sub Symbol
lV ([Symbol] -> Symbol
Concat [Symbol
labelx, Symbol
label2])) UnitDefn
velU
yVel_1 :: UnitalChunk
yVel_1 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "v_y1" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
verticalVel NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularVelocity UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject) Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CM.yDir)
(Symbol -> Symbol -> Symbol
sub Symbol
lV ([Symbol] -> Symbol
Concat [Symbol
labely, Symbol
label1])) UnitDefn
velU
yVel_2 :: UnitalChunk
yVel_2 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "v_y2" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
verticalVel NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularVelocity UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject) Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CM.yDir)
(Symbol -> Symbol -> Symbol
sub Symbol
lV ([Symbol] -> Symbol
Concat [Symbol
labely, Symbol
label2])) UnitDefn
velU
xAccel_1 :: UnitalChunk
xAccel_1 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "a_x1" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
horizontalAccel NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.acceleration UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject) Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CM.xDir)
(Symbol -> Symbol -> Symbol
sub Symbol
lA ([Symbol] -> Symbol
Concat [Symbol
labelx, Symbol
label1])) UnitDefn
accelU
xAccel_2 :: UnitalChunk
xAccel_2 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "a_x2" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
horizontalAccel NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.acceleration UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject) Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CM.xDir)
(Symbol -> Symbol -> Symbol
sub Symbol
lA ([Symbol] -> Symbol
Concat [Symbol
labelx, Symbol
label2])) UnitDefn
accelU
yAccel_1 :: UnitalChunk
yAccel_1 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "a_y1" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
verticalAccel NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.acceleration UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject) Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CM.yDir)
(Symbol -> Symbol -> Symbol
sub Symbol
lA ([Symbol] -> Symbol
Concat [Symbol
labely, Symbol
label1])) UnitDefn
accelU
yAccel_2 :: UnitalChunk
yAccel_2 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "a_y2" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NamedChunk
verticalAccel NamedChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.acceleration UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject) Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CM.yDir)
(Symbol -> Symbol -> Symbol
sub Symbol
lA ([Symbol] -> Symbol
Concat [Symbol
labely, Symbol
label2])) UnitDefn
accelU
angularAccel_1 :: UnitalChunk
angularAccel_1 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "alpha_x1" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularAccel UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularAccel UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject) Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CM.xDir)
(Symbol -> Symbol -> Symbol
sub Symbol
lAlpha Symbol
label1) UnitDefn
angAccelU
angularAccel_2 :: UnitalChunk
angularAccel_2 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "alpha_y1" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularAccel UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularAccel UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject) Sentence -> Sentence -> Sentence
`S.inThe` ConceptChunk -> Sentence
forall n. (HasUID n, NamedIdea n) => n -> Sentence
phrase ConceptChunk
CM.yDir)
(Symbol -> Symbol -> Symbol
sub Symbol
lAlpha Symbol
label2) UnitDefn
angAccelU
tension_1 :: UnitalChunk
tension_1 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "T_1" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.tension UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.tension UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject))
(Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
cT) Symbol
label1) UnitDefn
newton
tension_2 :: UnitalChunk
tension_2 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "T_2" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.tension UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.tension UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject))
(Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
cT) Symbol
label2) UnitDefn
newton
angularVel_1 :: UnitalChunk
angularVel_1 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "w_1" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularVelocity UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularVelocity UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstObject))
(Symbol -> Symbol -> Symbol
sub Symbol
lW Symbol
label1) UnitDefn
angVelU
angularVel_2 :: UnitalChunk
angularVel_2 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "w_2" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularVelocity UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularVelocity UnitalChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondObject))
(Symbol -> Symbol -> Symbol
sub Symbol
lW Symbol
label2) UnitDefn
angVelU
pendDisAngle_1 :: UnitalChunk
pendDisAngle_1 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "theta_1" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
angle ConceptChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstRod))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
angle ConceptChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
firstRod))
(Symbol -> Symbol -> Symbol
sub Symbol
lTheta Symbol
label1) UnitDefn
degree
pendDisAngle_2 :: UnitalChunk
pendDisAngle_2 = String -> NP -> Sentence -> Symbol -> UnitDefn -> UnitalChunk
forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS "theta_2" (Sentence -> NP
nounPhraseSent (Sentence -> NP) -> Sentence -> NP
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
angle ConceptChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondRod))
(String -> Sentence
S "The" Sentence -> Sentence -> Sentence
+:+ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
angle ConceptChunk -> NamedChunk -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` NamedChunk
secondRod))
(Symbol -> Symbol -> Symbol
sub Symbol
lTheta Symbol
label2) UnitDefn
degree
unitless :: [DefinedQuantityDict]
unitless :: [DefinedQuantityDict]
unitless = [DefinedQuantityDict
QM.unitVect, DefinedQuantityDict
QM.unitVectj, DefinedQuantityDict
QM.pi_]
lRod, label1, label2, labelx, labely, initial:: Symbol
lRod :: Symbol
lRod = String -> Symbol
label "rod"
labelx :: Symbol
labelx = String -> Symbol
label "x"
labely :: Symbol
labely = String -> Symbol
label "y"
initial :: Symbol
initial = String -> Symbol
label "i"
label1 :: Symbol
label1 = Int -> Symbol
Integ 1
label2 :: Symbol
label2 = Int -> Symbol
Integ 2
lenRodCon_1, lenRodCon_2, pendDisAngleCon_1, pendDisAngleCon_2, massCon_1, massCon_2,
angAccelOutCon_1, angAccelOutCon_2 :: ConstrConcept
lenRodCon_1 :: ConstrConcept
lenRodCon_1 = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
lenRod_1 [ConstraintE
gtZeroConstr] (Double -> Expr
forall r. LiteralC r => Double -> r
dbl 1)
lenRodCon_2 :: ConstrConcept
lenRodCon_2 = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
lenRod_2 [ConstraintE
gtZeroConstr] (Double -> Expr
forall r. LiteralC r => Double -> r
dbl 1)
pendDisAngleCon_1 :: ConstrConcept
pendDisAngleCon_1 = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
pendDisAngle_1 [ConstraintE
gtZeroConstr] (Double -> Expr
forall r. LiteralC r => Double -> r
dbl 30)
pendDisAngleCon_2 :: ConstrConcept
pendDisAngleCon_2 = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
pendDisAngle_2 [ConstraintE
gtZeroConstr] (Double -> Expr
forall r. LiteralC r => Double -> r
dbl 30)
massCon_1 :: ConstrConcept
massCon_1 = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
massObj_1 [ConstraintE
gtZeroConstr] (Double -> Expr
forall r. LiteralC r => Double -> r
dbl 0.5)
massCon_2 :: ConstrConcept
massCon_2 = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
massObj_2 [ConstraintE
gtZeroConstr] (Double -> Expr
forall r. LiteralC r => Double -> r
dbl 0.5)
angAccelOutCon_1 :: ConstrConcept
angAccelOutCon_1 = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
angularAccel_1 [ConstraintE
gtZeroConstr] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl 0)
angAccelOutCon_2 :: ConstrConcept
angAccelOutCon_2 = UnitalChunk -> [ConstraintE] -> Expr -> ConstrConcept
forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
angularAccel_2 [ConstraintE
gtZeroConstr] (Integer -> Expr
forall r. LiteralC r => Integer -> r
exactDbl 0)
inConstraints :: [UncertQ]
inConstraints :: [UncertQ]
inConstraints = (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
lenRodCon_1, ConstrConcept
lenRodCon_2, ConstrConcept
pendDisAngleCon_1, ConstrConcept
pendDisAngleCon_2,
ConstrConcept
massCon_1, ConstrConcept
massCon_2]
outConstraints :: [UncertQ]
outConstraints :: [UncertQ]
outConstraints = (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
angAccelOutCon_1, ConstrConcept
angAccelOutCon_2]