module Drasil.DblPend.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, refBy, refName, srs, typUnc)
import Data.Drasil.Quantities.PhysicalProperties as QPP (len, mass)
import Data.Drasil.SI_Units (metre, radian, kilogram, newton)
import qualified Data.Drasil.Quantities.Physics as QP (position, force, velocity,
  angularVelocity, angularAccel, gravitationalAccel, gravitationalMagnitude, 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.DblPend.Concepts (firstRod, secondRod, firstObject, secondObject, horizontalPos,
  verticalPos, horizontalVel, verticalVel, horizontalAccel, verticalAccel)
import Data.Drasil.Units.Physics (velU, accelU, angVelU, angAccelU)
import Data.Drasil.Quantities.Physics (gravitationalAccelConst)


symbols:: [QuantityDict]
symbols :: [QuantityDict]
symbols = forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [UnitalChunk]
unitalChunks forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [DefinedQuantityDict]
unitless forall a. [a] -> [a] -> [a]
++ [forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw ConstrConcept
pendDisAngle] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [ConstQDef]
constants

acronyms :: [CI]
acronyms :: [CI]
acronyms = [CI
twoD, CI
assumption, CI
dataDefn, CI
genDefn, CI
goalStmt, CI
inModel,
  CI
physSyst, CI
requirement, CI
refBy, CI
refName, CI
srs, CI
thModel, CI
typUnc]

inputs :: [QuantityDict]
inputs :: [QuantityDict]
inputs = forall a b. (a -> b) -> [a] -> [b]
map forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [UnitalChunk
lenRod_1, UnitalChunk
lenRod_2, UnitalChunk
massObj_1, UnitalChunk
massObj_2] 

outputs :: [QuantityDict]
outputs :: [QuantityDict]
outputs = [forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw ConstrConcept
pendDisAngle]

constants :: [ConstQDef]
constants :: [ConstQDef]
constants = [ConstQDef
gravitationalAccelConst]

units :: [UnitalChunk]
units :: [UnitalChunk]
units = forall a b. (a -> b) -> [a] -> [b]
map 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.gravitationalMagnitude, 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 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"l_1" (UnitalChunk
len forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
firstRod)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
len forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
firstRod)) -- Fix me, can have more information 
        (Symbol -> Symbol -> Symbol
sub Symbol
cL Symbol
label1) Space
Real UnitDefn
metre

lenRod_2 :: UnitalChunk
lenRod_2 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"l_2" (UnitalChunk
len forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
secondRod)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
len forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
secondRod))
        (Symbol -> Symbol -> Symbol
sub Symbol
cL Symbol
label2) Space
Real UnitDefn
metre

massObj_1 :: UnitalChunk
massObj_1 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"m_1" (UnitalChunk
mass forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
firstObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
mass forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
firstObject))
        (Symbol -> Symbol -> Symbol
sub Symbol
lM Symbol
label1) Space
Real UnitDefn
kilogram

massObj_2 :: UnitalChunk
massObj_2 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"m_2" (UnitalChunk
mass forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
secondObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
mass forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
secondObject))
        (Symbol -> Symbol -> Symbol
sub Symbol
lM Symbol
label2) Space
Real UnitDefn
kilogram

xPos_1 :: UnitalChunk
xPos_1 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"p_x1" (IdeaDict
horizontalPos forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
firstObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.position forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
firstObject) Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CM.xDir)
        (Symbol -> Symbol -> Symbol
sub Symbol
lP ([Symbol] -> Symbol
Concat [Symbol
labelx, Symbol
label1])) Space
Real UnitDefn
metre

xPos_2 :: UnitalChunk
xPos_2 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"p_x2" (IdeaDict
horizontalPos forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
secondObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.position forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
secondObject) Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CM.xDir)
        (Symbol -> Symbol -> Symbol
sub Symbol
lP ([Symbol] -> Symbol
Concat [Symbol
labelx, Symbol
label2])) Space
Real UnitDefn
metre

yPos_1 :: UnitalChunk
yPos_1 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"p_y1" (IdeaDict
verticalPos forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
firstObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.position forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
firstObject) Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CM.yDir)
        (Symbol -> Symbol -> Symbol
sub Symbol
lP ([Symbol] -> Symbol
Concat [Symbol
labely, Symbol
label1])) Space
Real UnitDefn
metre

yPos_2 :: UnitalChunk
yPos_2 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"p_y2" (IdeaDict
verticalPos forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
secondObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.position forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
secondObject) Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CM.yDir)
        (Symbol -> Symbol -> Symbol
sub Symbol
lP ([Symbol] -> Symbol
Concat [Symbol
labely, Symbol
label2])) Space
Real UnitDefn
metre

xVel_1 :: UnitalChunk
xVel_1 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"v_x1" (IdeaDict
horizontalVel forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
firstObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularVelocity forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
firstObject) Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CM.xDir)
        (Symbol -> Symbol -> Symbol
sub Symbol
lV ([Symbol] -> Symbol
Concat [Symbol
labelx, Symbol
label1])) Space
Real UnitDefn
velU

xVel_2 :: UnitalChunk
xVel_2 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"v_x2" (IdeaDict
horizontalVel forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
secondObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularVelocity forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
secondObject) Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CM.xDir)
        (Symbol -> Symbol -> Symbol
sub Symbol
lV ([Symbol] -> Symbol
Concat [Symbol
labelx, Symbol
label2])) Space
Real UnitDefn
velU

yVel_1 :: UnitalChunk
yVel_1 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"v_y1" (IdeaDict
verticalVel forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
firstObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularVelocity forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
firstObject) Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CM.yDir)
        (Symbol -> Symbol -> Symbol
sub Symbol
lV ([Symbol] -> Symbol
Concat [Symbol
labely, Symbol
label1])) Space
Real UnitDefn
velU

yVel_2 :: UnitalChunk
yVel_2 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"v_y2" (IdeaDict
verticalVel forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
secondObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularVelocity forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
secondObject) Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CM.yDir)
        (Symbol -> Symbol -> Symbol
sub Symbol
lV ([Symbol] -> Symbol
Concat [Symbol
labely, Symbol
label2])) Space
Real UnitDefn
velU

xAccel_1 :: UnitalChunk
xAccel_1 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"a_x1" (IdeaDict
horizontalAccel forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
firstObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.acceleration forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
firstObject) Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CM.xDir)
        (Symbol -> Symbol -> Symbol
sub Symbol
lA ([Symbol] -> Symbol
Concat [Symbol
labelx, Symbol
label1])) Space
Real UnitDefn
accelU

xAccel_2 :: UnitalChunk
xAccel_2 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"a_x2" (IdeaDict
horizontalAccel forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
secondObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.acceleration forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
secondObject) Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CM.xDir)
        (Symbol -> Symbol -> Symbol
sub Symbol
lA ([Symbol] -> Symbol
Concat [Symbol
labelx, Symbol
label2])) Space
Real UnitDefn
accelU

yAccel_1 :: UnitalChunk
yAccel_1 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"a_y1" (IdeaDict
verticalAccel forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
firstObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.acceleration forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
firstObject) Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CM.yDir)
        (Symbol -> Symbol -> Symbol
sub Symbol
lA ([Symbol] -> Symbol
Concat [Symbol
labely, Symbol
label1])) Space
Real UnitDefn
accelU

yAccel_2 :: UnitalChunk
yAccel_2 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"a_y2" (IdeaDict
verticalAccel forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
secondObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.acceleration forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
secondObject) Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CM.yDir)
        (Symbol -> Symbol -> Symbol
sub Symbol
lA ([Symbol] -> Symbol
Concat [Symbol
labely, Symbol
label2])) Space
Real UnitDefn
accelU

angularAccel_1 :: UnitalChunk
angularAccel_1 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"alpha_x1" (UnitalChunk
QP.angularAccel forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
firstObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularAccel forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
firstObject) Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CM.xDir)
        (Symbol -> Symbol -> Symbol
sub Symbol
lAlpha Symbol
label1) Space
Real UnitDefn
angAccelU

angularAccel_2 :: UnitalChunk
angularAccel_2 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"alpha_y1" (UnitalChunk
QP.angularAccel forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
secondObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularAccel forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
secondObject) Sentence -> Sentence -> Sentence
`S.inThe` forall n. NamedIdea n => n -> Sentence
phrase ConceptChunk
CM.yDir)
        (Symbol -> Symbol -> Symbol
sub Symbol
lAlpha Symbol
label2) Space
Real UnitDefn
angAccelU

tension_1 :: UnitalChunk
tension_1 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"T_1" (UnitalChunk
QP.tension forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
firstObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.tension forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
firstObject))
        (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
cT) Symbol
label1) Space
Real UnitDefn
newton

tension_2 :: UnitalChunk
tension_2 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"T_2" (UnitalChunk
QP.tension forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
secondObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.tension forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
secondObject))
        (Symbol -> Symbol -> Symbol
sub (Symbol -> Symbol
vec Symbol
cT) Symbol
label2) Space
Real UnitDefn
newton

angularVel_1 :: UnitalChunk
angularVel_1 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"w_1" (UnitalChunk
QP.angularVelocity forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
firstObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularVelocity forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
firstObject))
        (Symbol -> Symbol -> Symbol
sub Symbol
lW Symbol
label1) Space
Real UnitDefn
angVelU

angularVel_2 :: UnitalChunk
angularVel_2 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"w_2" (UnitalChunk
QP.angularVelocity forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
secondObject)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (UnitalChunk
QP.angularVelocity forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
secondObject))
        (Symbol -> Symbol -> Symbol
sub Symbol
lW Symbol
label2) Space
Real UnitDefn
angVelU

pendDisAngle_1 :: UnitalChunk
pendDisAngle_1 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"theta_1" (ConceptChunk
angle forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
firstRod)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
angle forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
firstRod))
        (Symbol -> Symbol -> Symbol
sub Symbol
lTheta Symbol
label1) Space
Real UnitDefn
radian

pendDisAngle_2 :: UnitalChunk
pendDisAngle_2 = forall u.
IsUnit u =>
String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
uc' String
"theta_2" (ConceptChunk
angle forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`ofThe` IdeaDict
secondRod)
        (forall n. NounPhrase n => n -> Sentence
phraseNP (ConceptChunk
angle forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`the_ofThe` IdeaDict
secondRod))
        (Symbol -> Symbol -> Symbol
sub Symbol
lTheta Symbol
label2) Space
Real UnitDefn
radian

unitless :: [DefinedQuantityDict]
unitless :: [DefinedQuantityDict]
unitless = [DefinedQuantityDict
QM.unitVect, DefinedQuantityDict
QM.unitVectj, DefinedQuantityDict
QM.pi_]

lRod, label1, label2, labelx, labely, initial, lTheta':: Symbol
lRod :: Symbol
lRod = String -> Symbol
label String
"rod"
labelx :: Symbol
labelx = String -> Symbol
label String
"x"
labely :: Symbol
labely = String -> Symbol
label String
"y"
initial :: Symbol
initial = String -> Symbol
label String
"i"
label1 :: Symbol
label1  = Int -> Symbol
Integ Int
1
label2 :: Symbol
label2  = Int -> Symbol
Integ Int
2
lTheta' :: Symbol
lTheta'  = String -> Symbol
label String
"theta"

----------------
-- CONSTRAINT --
----------------
lenRodCon_1, lenRodCon_2, pendDisAngleCon_1, pendDisAngleCon_2, massCon_1, massCon_2 
  :: ConstrConcept
lenRodCon_1 :: ConstrConcept
lenRodCon_1       = forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
lenRod_1 [ConstraintE
gtZeroConstr] (forall r. LiteralC r => Double -> r
dbl Double
1)
lenRodCon_2 :: ConstrConcept
lenRodCon_2       = forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
lenRod_2 [ConstraintE
gtZeroConstr] (forall r. LiteralC r => Double -> r
dbl Double
1)
pendDisAngleCon_1 :: ConstrConcept
pendDisAngleCon_1 = forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
pendDisAngle_1 [ConstraintE
gtZeroConstr] (forall r. LiteralC r => Double -> r
dbl Double
30)
pendDisAngleCon_2 :: ConstrConcept
pendDisAngleCon_2 = forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
pendDisAngle_2 [ConstraintE
gtZeroConstr] (forall r. LiteralC r => Double -> r
dbl Double
30)
massCon_1 :: ConstrConcept
massCon_1         = forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
massObj_1 [ConstraintE
gtZeroConstr] (forall r. LiteralC r => Double -> r
dbl Double
0.5)
massCon_2 :: ConstrConcept
massCon_2         = forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' UnitalChunk
massObj_2 [ConstraintE
gtZeroConstr] (forall r. LiteralC r => Double -> r
dbl Double
0.5)

inConstraints :: [UncertQ]
inConstraints :: [UncertQ]
inConstraints = forall a b. (a -> b) -> [a] -> [b]
map (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
massCon_1, ConstrConcept
massCon_2]

outConstraints :: [UncertQ]
outConstraints :: [UncertQ]
outConstraints = forall a b. (a -> b) -> [a] -> [b]
map (forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
`uq` Uncertainty
defaultUncrt) [ConstrConcept
pendDisAngleCon_1, ConstrConcept
pendDisAngleCon_2]

pendDisAngle :: ConstrConcept
pendDisAngle :: ConstrConcept
pendDisAngle = forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> ConstrConcept
cuc' String
"pendDisAngle"
  (String -> NP
nounPhraseSP String
"dependent variables")
  String
"column vector of displacement of rods with its derivatives"
  Symbol
lTheta' UnitDefn
radian (Space -> Space
Vect Space
Real)
  [RealInterval Expr Expr -> ConstraintE
physc forall a b. (a -> b) -> a -> b
$ forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
Inc, forall r. LiteralC r => Integer -> r
exactDbl Integer
0)] (forall r. LiteralC r => Integer -> r
exactDbl Integer
0)