#PLEASE HELP ME. I CAN'T FIGURE OUT WHAT IS WRONG
#THANK YOU GUYS IN ADVANCE!
#install.packages("plotrix")
#install.packages("shinyWidgets")
#install.packages("rsconnect")
#install.packages("shinydashboard")
library("plotrix")
library(shiny)
library(shinydashboard)
# DEFINE RULA TABLE (REDUCED VERSION)
tableA <- matrix(c(2,3,4,4,2,3,4,4,3,4,4,4),nrow=4,ncol=3)
RULA <- c(2,2,3,3,4,4,5)
# UPLOAD DRIVER FILE FROM DESKTOP - CHANGE DIRECTRY IF NEEDED
#drivers <- read.delim("C:/Users/Songlin/Desktop/Spyder Files/drivers_Class_B_full.txt")
drivers <- read.delim("drivers_Class_B_full.txt")
# EXTRACT DESIRED INFORMATION FROM FILE
stature <- t(drivers[3])
erectSitting <- t(drivers[4])
bmi <- t(drivers[6])
SWangle <- t(drivers[9])
SWheight <- t(drivers[10])
# DIVIDE INFORMATION INTO MALE AND FEMALE
statureM <- stature[1:500]
statureF <- stature[501:1000]
erectSittingM <- erectSitting[1:500]
erectSittingF <- erectSitting[501:1000]
bmiM <- bmi[1:500]
bmiF <- bmi[501:1000]
SWangleM <- SWangle[1:500]
SWangleF <- SWangle[501:1000]
SWheightM <- SWheight[1:500]
SWheightF <- SWheight[501:1000]
# ESTIMATE BODY MEASUREMENTS BASED ON "STATURE"
upperLegM <- statureM * 0.257
upperLegF <- statureF * 0.257
lowerLegM <- statureM * 0.247
lowerLegF <- statureF * 0.247
upperArmM <- statureM * 0.162
upperArmF <- statureF * 0.16
foreArmM <- statureM * 0.147
foreArmF <- statureF * 0.147
handLenM <- statureM * 0.046
handLenF <- statureF * 0.046
lowerArmM <- foreArmM + handLenM
lowerArmF <- foreArmF + handLenF
ratioM <- erectSittingM / statureM
ratioF <- erectSittingF / statureF
diffM = statureM - erectSittingM
diffF = statureF - erectSittingF
# ONE FUNCTION THAT 1) PREDICTS POSTURE 2) ASSESS ACCOMMODATION
accommodationModel <- function(myData)
{
# ALL POSTURE/CORRECTION/ACCOMMODATION INFORMATION FOR EACH DRIVER IS SAVED HERE
posture <- data.frame(matrix(ncol=30,nrow=500))
# STEERING WHEEL PREDICTION AND ASSESSMENT
ZM = 524 + 0.1613 * statureM + SWheightM
Z1M = ZM - 0.559 * 100
angleDesireM = ((myData$AngleMin + myData$AngleMax) / 2 + SWangleM) * 3.14 / 180
SWPX1M = myData$SWPX + sin(angleDesireM)
SWPZ1M = myData$SWPZ + cos(angleDesireM)
A1M = SWPZ1M - myData$SWPZ
B1M = myData$SWPX - SWPX1M
C1M = A1M * myData$SWPX + B1M * myData$SWPZ
A2M = Z1M - ZM
B2M = -100
C2M = A2M * 175 + B2M * ZM
deterM = A1M * B2M - A2M * B1M
posture$SWprefXM = (B2M * C1M - B1M * C2M) / deterM
posture$SWprefZM = (A1M * C2M - A2M * C1M) / deterM
ZF = 524 + 0.1613 * statureF + SWheightF
Z1F = ZF - 0.559 * 100
angleDesireF = ((myData$AngleMin + myData$AngleMax) / 2 + SWangleF) * 3.14 / 180
SWPX1F = myData$SWPX + sin(angleDesireF)
SWPZ1F = myData$SWPZ + cos(angleDesireF)
A1F = SWPZ1F - myData$SWPZ
B1F = myData$SWPX - SWPX1F
C1F = A1F * myData$SWPX + B1F * myData$SWPZ
A2F = Z1F - ZF
B2F = -100
C2F = A2F * 175 + B2F * ZF
deterF = A1F * B2F - A2F * B1F
posture$SWprefXF = (B2F * C1F - B1F * C2F) / deterF
posture$SWprefZF = (A1F * C2F - A2F * C1F) / deterF
SWdistM <- sqrt((posture$SWprefXM - myData$SWPX) ^ 2 + (posture$SWprefZM - myData$SWPZ) ^ 2)
SWdistF <- sqrt((posture$SWprefXF - myData$SWPX) ^ 2 + (posture$SWprefZF - myData$SWPZ) ^ 2)
posture$count[1] = 0 # Male; SW
posture$count[2] = 0 # Female; SW
for (i in 1:500)
{
a = 0
b = 0
c = 0
d = 0
if (angleDesireM[i] < myData$AngleMin / 180 * 3.14)
{
angleDesireM[i] <- myData$AngleMin / 180 * 3.14
}
else if (angleDesireM[i] > myData$AngleMax / 180 * 3.14)
{
angleDesireM[i] <- myData$AngleMax / 180 * 3.14
}
else
{
a = 1
}
if (SWdistM[i] < myData$TeleMin)
{
SWdistM[i] <- myData$TeleMin
}
else if (SWdistM[i] > myData$TeleMax)
{
SWdistM[i] <- myData$TeleMax
}
else
{
b = 1
}
if ( a==1 && b==1)
{
posture$accomSWM[i] = 1
posture$count[1] = posture$count[1] + 1
}
else
{
posture$accomSWM[i] = 0
}
if (angleDesireF[i] < myData$AngleMin / 180 * 3.14)
{
angleDesireF[i] <- myData$AngleMin / 180 * 3.14
}
else if (angleDesireF[i] > myData$AngleMax / 180 * 3.14)
{
angleDesireF[i] <- myData$AngleMax / 180 * 3.14
}
else
{
c = 1
}
if (SWdistF[i] < myData$TeleMin)
{
SWdistF[i] <- myData$TeleMin
}
else if (SWdistF[i] > myData$TeleMax)
{
SWdistF[i] <- myData$TeleMax
}
else
{
d = 1
}
if (c == 1 && d == 1)
{
posture$accomSWF[i] = 1
posture$count[2] = posture$count[2] + 1
}
else
{
posture$accomSWF[i] = 0
}
}
posture$SWadjustXM <- myData$SWPX + SWdistM * sin(angleDesireM)
posture$SWadjustZM <- myData$SWPZ + SWdistM * cos(angleDesireM)
posture$SWadjustXF <- myData$SWPX + SWdistF * sin(angleDesireF)
posture$SWadjustZF <- myData$SWPZ + SWdistF * cos(angleDesireF)
posture$gripXM <- posture$SWadjustXM
posture$gripZM <- posture$SWadjustZM - 0.25 * myData$SWD * sin(angleDesireM)
posture$gripXF <- posture$SWadjustXF
posture$gripZF <- posture$SWadjustZF - 0.25 * myData$SWD * sin(angleDesireF)
# H POINT PREDICTION AND ASSESSMENT
posture$HprefXM <- 30 + 78.3 + 0.6244 * diffM + 3.3391 * bmiM + 0.6448 * posture$SWadjustXM - 0.283 * posture$SWadjustZM
posture$HprefZM <- -249.7 + 0.0855 * diffM - 0.679 * bmiM + 0.8507 * posture$SWadjustZM
posture$HprefXF <- 30 + 78.3 + 0.6244 * diffF + 3.3391 * bmiF + 0.6448 * posture$SWadjustXF - 0.283 * posture$SWadjustZF
posture$HprefZF <- -249.7 + 0.0855 * diffF - 0.679 * bmiF + 0.8507 * posture$SWadjustZF
posture$count[3] = 0 # Male; H
posture$count[4] = 0 # Female; H
for (i in 1:500)
{
a = 0
b = 0
c = 0
d = 0
if (posture$HprefXM[i] < myData$STX1)
{
posture$HadjustXM[i] <- myData$STX1
}
else if (posture$HprefXM[i] > myData$STX2)
{
posture$HadjustXM[i] <- myData$STX2
}
else
{
posture$HadjustXM[i] <- posture$HprefXM[i]
a = 1
}
if (posture$HprefZM[i] < myData$STZ1)
{
posture$HadjustZM[i] <- myData$STZ1
}
else if (posture$HprefZM[i] > myData$STZ2)
{
posture$HadjustZM[i] <- myData$STZ2
}
else
{
posture$HadjustZM[i] <- posture$HprefZM[i]
b = 1
}
if (a == 1 && b == 1)
{
posture$accomHM[i] = 1
posture$count[3] = posture$count[3] + 1
}
else
{
posture$accomHM[i] = 0
}
if (posture$HprefXF[i] < myData$STX1)
{
posture$HadjustXF[i] = myData$STX1
}
else if (posture$HprefXF[i] > myData$STX2)
{
posture$HadjustXF[i] = myData$STX2
}
else
{
posture$HadjustXF[i] = posture$HprefXF[i]
c = 1
}
if (posture$HprefZF[i] < myData$STZ1)
{
posture$HadjustXF[i] = myData$STZ1
}
else if (posture$HprefZF[i] > myData$STZ2)
{
posture$HadjustZF[i] = myData$STZ2
}
else
{
posture$HadjustZF[i] = posture$HprefZF[i]
d = 1
}
if (c == 1 && d == 1)
{
posture$accomHF[i] = 1
posture$count[4] = posture$count[4] + 1
}
else
{
posture$accomHF[i] = 0
}
}
posture$HadjustXF[47] = posture$HprefXF[47]
posture$HadjustXF[129] = posture$HprefXF[129]
posture$HadjustXF[252] = posture$HprefXF[252]
posture$HadjustXF[262] = posture$HprefXF[262]
posture$HadjustXF[300] = posture$HprefXF[300]
posture$HadjustXF[435] = posture$HprefXF[435]
posture$HadjustXF[457] = posture$HprefXF[457]
posture$HadjustXF[460] = posture$HprefXF[460]
# posture$accomHF[47] = 1
# posture$accomHF[129] = 1
# posture$accomHF[252] = 1
# posture$accomHF[262] = 1
# posture$accomHF[300] = 1
# posture$accomHF[435] = 1
# posture$accomHF[457] = 1
# posture$accomHF[460] = 1
posture$hipXM <- posture$HadjustXM + 90.2 - 5.27 * bmiM
posture$hipZM <- posture$HadjustZM -109.9 + 1.51 * bmiM + 0.0813 * erectSittingM
posture$hipXF <- posture$HadjustXF + 90.2 - 5.27 * bmiF
posture$hipZF <- posture$HadjustZF -109.9 + 1.51 * bmiF + 0.0813 * erectSittingF
# EYE/SHOULDER LOCATION PREDICTION
eyeAngleM <- -38 + 0.297 * bmiM + 67.6 * ratioM - 2.5
eyeAngleF <- -38 + 0.297 * bmiF + 67.6 * ratioF - 2.5
posture$eyeXM <- posture$hipXM + 0.7262 * erectSittingM * sin(eyeAngleM * 3.14 / 180)
posture$eyeZM <- posture$hipZM + 0.7262 * erectSittingM * cos(eyeAngleM * 3.14 / 180)
posture$eyeXF <- posture$hipXF + 0.7262 * erectSittingF * sin(eyeAngleF * 3.14 / 180)
posture$eyeZF <- posture$hipZF + 0.7262 * erectSittingF * cos(eyeAngleF * 3.14 / 180)
shoulderAngleM <- eyeAngleM + 15.4
shoulderAngleF <- eyeAngleF + 15.4
posture$shoulderXM <- posture$hipXM + 0.49 * erectSittingM * sin(shoulderAngleM * 3.14 / 180)
posture$shoulderZM <- posture$hipZM + 0.49 * erectSittingM * cos(shoulderAngleM * 3.14 / 180)
posture$shoulderXF <- posture$hipXF + 0.49 * erectSittingF * sin(shoulderAngleF * 3.14 / 180)
posture$shoulderZF <- posture$hipZF + 0.49 * erectSittingF * cos(shoulderAngleF * 3.14 / 180)
# USE REVERSE TRIGONOMETRY TO FIND ELBOW LOCATION
XM <- posture$shoulderXM - posture$gripXM
YM <- posture$shoulderZM - posture$gripZM
rotateM <- atan(YM / XM)
ZM <- sqrt((XM) ^ 2 + (YM) ^ 2)
CXM <- ((lowerArmM) ^ 2 + (ZM) ^ 2 - (upperArmM) ^ 2) / (2 * ZM)
CYM <- -0.5 / ZM * sqrt((upperArmM + lowerArmM + ZM) * (-upperArmM + lowerArmM + ZM) * (upperArmM + lowerArmM - ZM) * (upperArmM - lowerArmM + ZM))
posture$elbowXM <- cos(rotateM) * CXM - sin(rotateM) * CYM + posture$gripXM
posture$elbowZM <- sin(rotateM) * CXM + cos(rotateM) * CYM + posture$gripZM
posture$elbowAngleM <- acos(((upperArmM) ^ 2 + (lowerArmM) ^ 2 - (ZM) ^ 2) / (2 * upperArmM * lowerArmM)) / 3.14 * 180
XF <- posture$shoulderXF - posture$gripXF
YF <- posture$shoulderZF - posture$gripZF
rotateF <- atan(YF / XF)
ZF <- sqrt((XF) ^ 2 + (YF) ^ 2)
CXF <- ((lowerArmF) ^ 2 + (ZF) ^ 2 - (upperArmF) ^ 2) / (2 * ZF)
CYF <- -0.5 / ZF * sqrt((upperArmF + lowerArmF + ZF) * (-upperArmF + lowerArmF + ZF) * (upperArmF + lowerArmF - ZF) * (upperArmF - lowerArmF + ZF))
posture$elbowXF <- cos(rotateF) * CXF - sin(rotateF) * CYF + posture$gripXF
posture$elbowZF <- sin(rotateF) * CXF + cos(rotateF) * CYF + posture$gripZF
posture$elbowAngleF <- acos(((upperArmF) ^ 2 + (lowerArmF) ^ 2 - (ZF) ^ 2) / (2 * upperArmF * lowerArmF)) / 3.14 * 180
# USE REVERSE TRIGONOMETRY TO FIND KNEE LOCATION
XXM <- posture$hipXM - 32
YYM <- posture$hipZM - 128
rrotateM <- atan(YYM / XXM)
ZZM <- sqrt((XXM) ^ 2 + (YYM) ^ 2)
CCXM <- ((lowerLegM) ^ 2 + (ZZM) ^ 2 - (upperLegM) ^ 2) / (2 * ZZM)
CCYM <- 0.5 / ZZM * sqrt((upperLegM + lowerLegM + ZZM) * (-upperLegM + lowerLegM + ZZM) * (upperLegM + lowerLegM - ZZM) * (upperLegM - lowerLegM + ZZM))
posture$kneeXM <- cos(rrotateM) * CCXM - sin(rrotateM) * CCYM + 32
posture$kneeZM <- sin(rrotateM) * CCXM + cos(rrotateM) * CCYM + 128
posture$kneeAngleM <- acos(((upperLegM) ^ 2 + (lowerLegM) ^ 2 - (ZZM) ^ 2) / (2 * upperLegM * lowerLegM)) / 3.14 * 180
XXF <- posture$hipXF - 32
YYF <- posture$hipZF - 128
rrotateF <- atan(YYF / XXF)
ZZF <- sqrt((XXF) ^ 2 + (YYF) ^ 2)
CCXF <- ((lowerLegF) ^ 2 + (ZZF) ^ 2 - (upperLegF) ^ 2) / (2 * ZZF)
CCYF <- 0.5 / ZZF * sqrt((upperLegF + lowerLegF + ZZF) * (-upperLegF + lowerLegF + ZZF) * (upperLegF + lowerLegF - ZZF) * (upperLegF - lowerLegF + ZZF))
posture$kneeXF <- cos(rrotateF) * CCXF - sin(rrotateF) * CCYF + 32
posture$kneeZF <- sin(rrotateF) * CCXF + cos(rrotateF) * CCYF + 128
posture$kneeAngleF <- acos(((upperLegF) ^ 2 + (lowerLegF) ^ 2 - (ZZF) ^ 2) / (2 * upperLegF * lowerLegF)) / 3.14 * 180
posture$armAngleM = atan((posture$shoulderXM - posture$elbowXM) / (posture$shoulderZM - posture$elbowZM)) / 3.14 * 180
posture$armAngleF = atan((posture$shoulderXF - posture$elbowXF) / (posture$shoulderZF - posture$elbowZF)) / 3.14 * 180
# VISION ASSESSMENT (UP VISION AND DOWN VISION)
posture$count[5] = 0 # Male; Upvision
posture$count[6] = 0 # Female; Upvision
posture$count[7] = 0 # Male; Downvision
posture$count[8] = 0 # Female; Downvision
posture$count[9] = 0 # Male; Total Accommodation
posture$count[10] = 0 # Female; Total Accommodation
for (i in 1:500)
{
# UP VISION
upVisionAngleM = atan((myData$UDLOZ - myData$AHPZ - posture$eyeZM[i]) / (posture$eyeXM[i] - myData$UDLOX)) / 3.14 * 180
if (upVisionAngleM > 14)
{
posture$accomUpM[i] = 1
posture$count[5] = posture$count[5] + 1
}
else
{
posture$accomUpM[i] = 0
}
upVisionAngleF = atan((myData$UDLOZ - myData$AHPZ - posture$eyeZF[i]) / (posture$eyeXF[i] - myData$UDLOX)) / 3.14 * 180
if (upVisionAngleF > 14)
{
posture$accomUpF[i] = 1
posture$count[6] = posture$count[6] + 1
}
else
{
posture$accomUpF[i] = 0
}
# DOWN VISION
CowlTestM = (609.6 - myData$BpX + myData$CowlX) / (posture$eyeXM[i] + 609.6 - myData$BpX) * (myData$AHPZ + posture$eyeZM[i] - 1066.9) + 1066.9
DbTestM = (609.6 - myData$BpX + myData$DbX) / (posture$eyeXM[i] + 609.6 - myData$BpX) * (myData$AHPZ + posture$eyeZM[i] - 1066.9) + 1066.9
if (CowlTestM >= myData$CowlZ && DbTestM >= myData$DbZ)
{
posture$accomDownM[i] = 1
posture$count[7] = posture$count[7] + 1
}
else
{
posture$accomDownM[i] = 0
}
CowlTestF = (609.6 - myData$BpX + myData$CowlX) / (posture$eyeXF[i] + 609.6 - myData$BpX) * (myData$AHPZ + posture$eyeZF[i] - 1066.9) + 1066.9
DbTestF = (609.6 - myData$BpX + myData$DbX) / (posture$eyeXF[i] + 609.6 - myData$BpX) * (myData$AHPZ + posture$eyeZF[i] - 1066.9) + 1066.9
if (CowlTestF >= myData$CowlZ && DbTestF >= myData$DbZ)
{
posture$accomDownF[i] = 1
posture$count[8] = posture$count[8] + 1
}
else
{
posture$accomDownF[i] = 0
}
# TOTAL ASSESSMENT
if (posture$accomSWM[i] == 1 && posture$accomHM[i] == 1 && posture$accomUpM[i] == 1 && posture$accomDownM[i] == 1)
{
posture$accomTotalM[i] = 1
posture$count[9] = posture$count[9] + 1
}
else
{
posture$accomTotalM[i] = 0
}
if (posture$accomSWF[i] == 1 && posture$accomHF[i] == 1 && posture$accomUpF[i] == 1 && posture$accomDownF[i] == 1)
{
posture$accomTotalF[i] = 1
posture$count[10] = posture$count[10] + 1
}
else
{
posture$accomTotalF[i] = 0
}
}
# RULA TEST
for (i in 1:500)
{
upperM = 0
lowerM = 0
if (posture$armAngleM[i] <= 20)
{
upperM = 1
}
else if (posture$armAngleM[i] <= 45)
{
upperM = 2
}
else if (posture$armAngleM[i] <= 90)
{
upperM = 3
}
else
{
upperM = 4
}
if (posture$elbowAngleM[i] >= 80 && posture$elbowAngleM[i] <= 120)
{
lowerM = 1
}
else
{
lowerM = 2
}
AM = tableA[upperM,lowerM] + 1
posture$RULAM[i] = RULA[AM]
upperF = 0
lowerF = 0
if (posture$armAngleF[i] <= 20)
{
upperF = 1
}
else if (posture$armAngleF[i] <= 45)
{
upperF = 2
}
else if (posture$armAngleF[i] <= 90)
{
upperF = 3
}
else
{
upperF = 4
}
if (posture$elbowAngleF[i] >= 80 && posture$elbowAngleF[i] <= 120)
{
lowerF = 1
}
else
{
lowerF = 2
}
AF = tableA[upperF,lowerF] + 1
posture$RULAF[i] = RULA[AF]
}
return(posture)
}
percent <- function(x, digits = 1, format = "f") {
paste0(formatC(100 * x, format = format, digits = digits), "%")
}
# USER INTERFACE DESIGN: DISPLAY STYLE AND USER INPUT
ui <- withTags(dashboardPage(
skin = "purple",
dashboardHeader(title = "Bus Packaging - WU 2020", titleWidth = 400),
dashboardSidebar(
# tags$head(
# tags$style(HTML("
# .content-wrapper {
# background-color: linen !important;
# }
# .main-sidebar {
# background-color: powderblue !important;
# }
# "))),
# tags$style(type='text/css', "
# .form-control {
# padding: 0px 6px 0px 6px;
# height: 22px;
# font-size: 12px;}
# label { font-size: 12px; }
# label.control-label { font-size: 12px; }
# .selectize-input {
# padding: 5px 6px;
# min-height: 22px;
# max-height: 22px;
# font-size: 12px;
# line-height: 1.2;}
# .selectize-dropdown {
# font-size: 12px;
# line-height: 1.2;}
# "
# ),
width = 400,
menuItem(
width = 300,
h4("Choose a population (click to expand)"),
selectInput(inputId = "Population", label = "Select driver file", c("Class B Drivers", "ANSUR II Drivers", "NHANES Drivers"), selected = "Class B Drivers", selectize = FALSE),
numericInput(inputId = "Ratio", label = "Proportion of Male", value = 0.5, min = 0.001, max = 0.999)
#,style = "font-size: 80%;"
),
menuItem(
width = 300,
h4("Bus geometric layout in mm. (X:AHP Z:GND)"),
numericInput(inputId = "AHPZ", label = "Accelerator Heel Point Z", value = 850, min = 700, max = 1000),
numericInput(inputId = "CowlX", label = "Cowl Point X", value = -250, min = -500, max = 0),
numericInput(inputId = "CowlZ", label = "Cowl Point Z", value = 1400, min = 1000, max = 1800),
numericInput(inputId = "DbX", label = "Dashboard Tip X", value = -60, min = -300, max = 300),
numericInput(inputId = "DbZ", label = "Dashboard Tip Z", value = 1530, min = 1000, max = 2000),
numericInput(inputId = "BpX", label = "Front Bumper Tip X", value = -400, min = -1000, max = 0),
numericInput(inputId = "BpZ", label = "Front Bumper Tip Z", value = 650, min = 0, max = 600),
numericInput(inputId = "UDLOX", label = "Upper Daylight Opening X", value = -150, min = -500, max = 200),
numericInput(inputId = "UDLOZ", label = "Upper Daylight Opening Z", value = 2250, min = 1500, max = 3000)
#,style = "font-size: 80%;"
),
menuItem(
width = 300,
h4("Seat track in mm. (X:AHP Z:GND)"),
numericInput(inputId = "STX1", label = "Seat Track X front", value = 500, min = 400, max = 550),
numericInput(inputId = "STX2", label = "Seat Track X back", value = 700, min = 600, max = 800),
numericInput(inputId = "STZ1", label = "Seat Track Z down", value = 400, min = 300, max = 500),
numericInput(inputId = "STZ2", label = "Seat Track Z up", value = 530, min = 500, max = 600)
#,style = "font-size: 80%;"
),
menuItem(
width = 300,
h4("Steering wheel in mm/degree. (X:AHP Z:GND)"),
numericInput(inputId = "SWPX", label = "Steering Wheel Pivot X", value = 20, min = 0, max = 100),
numericInput(inputId = "SWPZ", label = "Steering Wheel Pivot Z", value = 500, min = 400, max = 600),
numericInput(inputId = "SWD", label = "Steering Wheel Diameter", value = 450, min = 350, max = 550),
numericInput(inputId = "TeleMin", label = "Telescope from pivot Min", value = 275, min = 200, max = 350),
numericInput(inputId = "TeleMax", label = "Telescope from pivot Max", value = 385, min = 350, max = 450),
numericInput(inputId = "AngleMin", label = "Tilt from Vertical Min", value = 20, min = 0, max = 40),
numericInput(inputId = "AngleMax", label = "Tilt from Vertical Max", value = 50, min = 30, max = 70)
#,style = "font-size: 80%;"
)
),
dashboardBody(
# tags$head(tags$style(HTML('
# /* body */
# .content-wrapper, .right-side {
# background-color: #ffd82b;
# }
# '))),
div(align="center",style="width:800px;",fluidRow(tableOutput("table"), placeholder = TRUE)),
plotOutput("plot",
height = 800, width = 800,
hover = hoverOpts(
id = "plot_hover",
delay = 100,
delayType = "throttle"
)),
div(style="width:800px;",fluidRow(verbatimTextOutput("plot_hoverinfo"), placeholder = TRUE))
)
))
# SERVER CODE: FINAL PLOT AND SUMMARY TABLE
server <- function(input, output, session) {
# FINAL PLOT: MALE AND FEMALE AND BUS GEOMETRY
output$plot <- renderPlot({
postureData <- accommodationModel(input)
par(pty="s")
par(mar=c(0,0,0,0))
plot(postureData$SWprefXM, postureData$SWprefZM, pch = 20, cex = 0.5, col = ifelse(postureData$accomSWM!=1,"red1","darkviolet"), asp=1, xlim=c(-1200,1300), ylim=c(-900,1600),
ann=FALSE, xaxt="n", yaxt="n")
points(postureData$HprefXM, postureData$HprefZM, pch = 20, cex = 0.5, col = ifelse(postureData$accomHM!=1,"red1","darkviolet"))
points(postureData$eyeXM, postureData$eyeZM, pch = 20, cex = 0.5, col = ifelse(((postureData$accomUpM+postureData$accomDownM)!=2),"red1","darkviolet"))
points(postureData$shoulderXM, postureData$shoulderZM, pch = 20, cex = 0.5, col = "darkviolet")
points(postureData$elbowXM, postureData$elbowZM, pch = 20, cex = 0.5, col = "darkviolet")
points(postureData$kneeXM, postureData$kneeZM, pch = 20, cex = 0.5, col = "darkviolet")
points(postureData$SWprefXF, postureData$SWprefZF, pch = 20, cex = 0.5, col = ifelse(postureData$accomSWF!=1,"red1","gold"))
points(postureData$HprefXF, postureData$HprefZF, pch = 20, cex = 0.5, col = ifelse(postureData$accomHF!=1,"red1","gold"))
points(postureData$eyeXF, postureData$eyeZF, pch = 20, cex = 0.5, col = ifelse(((postureData$accomUpF+postureData$accomDownF)!=2),"red1","gold"))
points(postureData$shoulderXF, postureData$shoulderZF, pch = 20, cex = 0.5, col = "gold")
points(postureData$elbowXF, postureData$elbowZF, pch = 20, cex = 0.5, col = "gold")
points(postureData$kneeXF, postureData$kneeZF, pch = 20, cex = 0.5, col = "gold")
lines(c(input$STX1,input$STX2,input$STX2,input$STX1,input$STX1),c(input$STZ1,input$STZ1,input$STZ2,input$STZ2,input$STZ1),col="gray10",lwd=1.5)
lines(c(input$SWPX+input$TeleMin*sin(input$AngleMin*pi/180),input$SWPX+input$TeleMax*sin(input$AngleMin*pi/180)),c(input$SWPZ+input$TeleMin*cos(input$AngleMin*pi/180),input$SWPZ+input$TeleMax*cos(input$AngleMin*pi/180)),col="gray10",lwd=1.5)
lines(c(input$SWPX+input$TeleMin*sin(input$AngleMax*pi/180),input$SWPX+input$TeleMax*sin(input$AngleMax*pi/180)),c(input$SWPZ+input$TeleMin*cos(input$AngleMax*pi/180),input$SWPZ+input$TeleMax*cos(input$AngleMax*pi/180)),col="gray10",lwd=1.5)
draw.arc(x=input$SWPX,y=input$SWPZ,radius=input$TeleMin,angle1=(90-input$AngleMax)*pi/180,angle2=(90-input$AngleMin)*pi/180,col="gray10",lwd=1.5)
draw.arc(x=input$SWPX,y=input$SWPZ,radius=input$TeleMax,angle1=(90-input$AngleMax)*pi/180,angle2=(90-input$AngleMin)*pi/180,col="gray10",lwd=1.5)
draw.circle(800,-400,450,nv=500,lty=1,lwd=2)
lines(c(input$UDLOX+1200,input$UDLOX,input$CowlX,input$CowlX),c(input$UDLOZ-input$AHPZ,input$UDLOZ-input$AHPZ,input$CowlZ-input$AHPZ,input$BpZ-input$AHPZ),lwd=2)
lines(c(input$CowlX,input$CowlX+500),c(-input$AHPZ+400,-input$AHPZ+400),lwd=2)
lines(c(input$CowlX,input$DbX),c(input$CowlZ-input$AHPZ,input$DbZ-input$AHPZ),lwd=2)
lines(c(input$CowlX+500,input$BpX,input$BpX,input$CowlX),c(input$BpZ-input$AHPZ,input$BpZ-input$AHPZ,-input$AHPZ+450,-input$AHPZ+400),lwd=2)
lines(c(32,mean(postureData$kneeXM),mean(postureData$HadjustXM),mean(postureData$eyeXM)),c(128,mean(postureData$kneeZM),mean(postureData$HadjustZM),mean(postureData$eyeZM)),col="green3",lwd=3)
lines(c(32,mean(postureData$kneeXF),mean(postureData$HadjustXF),mean(postureData$eyeXF)),c(128,mean(postureData$kneeZF),mean(postureData$HadjustZF),mean(postureData$eyeZF)),col="orangered",lwd=3)
lines(c(mean(postureData$shoulderXM),mean(postureData$elbowXM),mean(postureData$gripXM)),c(mean(postureData$shoulderZM),mean(postureData$elbowZM),mean(postureData$gripZM)),col="green3",lwd=3)
lines(c(mean(postureData$shoulderXF),mean(postureData$elbowXF),mean(postureData$gripXF)),c(mean(postureData$shoulderZF),mean(postureData$elbowZF),mean(postureData$gripZF)),col="orangered",lwd=3)
lines(c(input$BpX-610,input$BpX-610),c(-input$AHPZ,-input$AHPZ+1067),col="red4",lwd=3)
points(c(input$CowlX,input$UDLOX,input$DbX,input$BpX,input$BpX-610),c(input$CowlZ-input$AHPZ,input$UDLOZ-input$AHPZ,input$DbZ-input$AHPZ,input$BpZ-input$AHPZ-100,-input$AHPZ+1067),col="orange4",cex=2)
points(c(0,0),c(0,-input$AHPZ),col="red4",cex=2,pch=12)
lines(c(0,0,100),c(100,0,0),lwd=1,col="red1")
lines(c(0,0,100),c(100-input$AHPZ,-input$AHPZ,-input$AHPZ),lwd=1,col="red1")
legend(-1200, 1600, legend=c("Average Male", "Average Female", "Landmarks Male", "Landmarks Female"), col=c("green3", "orangered", "darkviolet", "gold"), lty=c(1,1,3,3), cex=1, lwd=2)
})
output$plot_hoverinfo <- renderPrint({
cat("Message Box: \n")
if(!is.null(input$plot_hover$x) && !is.null(input$plot_hover$y))
{
if(input$plot_hover$x<(input$UDLOX+30)&&input$plot_hover$x>(input$UDLOX-30) && input$plot_hover$y<(input$UDLOZ-input$AHPZ+30)&&input$plot_hover$y>(input$UDLOZ-input$AHPZ-30))
{
"Upper Daylight Opening (Ensure 14 degrees upward vision)"
}
else if(input$plot_hover$x<(input$CowlX+30)&&input$plot_hover$x>(input$CowlX-30) && input$plot_hover$y<(input$CowlZ-input$AHPZ+30)&&input$plot_hover$y>(input$CowlZ-input$AHPZ-30))
{
"Cowl Point (Ensure downward vision, must see tip of the stick)"
}
else if(input$plot_hover$x<(input$DbX+30)&&input$plot_hover$x>(input$DbX-30) && input$plot_hover$y<(input$DbZ-input$AHPZ+30)&&input$plot_hover$y>(input$DbZ-input$AHPZ-30))
{
"Top of Dashboard (Ensure downward vision, must see tip of the stick)"
}
else if(input$plot_hover$x<(input$BpX+30)&&input$plot_hover$x>(input$BpX-30) && input$plot_hover$y<(input$BpZ-input$AHPZ+30)&&input$plot_hover$y>(input$BpZ-input$AHPZ-200))
{
"Bumper (Bus front)"
}
else if(input$plot_hover$x<(input$BpX-579.6)&&input$plot_hover$x>(input$BpX-639.6) && input$plot_hover$y<(1096.9-input$AHPZ)&&input$plot_hover$y>(-input$AHPZ))
{
"Must see a 3.5 ft stick, 2 ft in front of bus"
}
else if(input$plot_hover$x<input$STX2&&input$plot_hover$x>input$STX1 && input$plot_hover$y<input$STZ2&&input$plot_hover$y>input$STZ1)
{
"Hip Accommodation, see summary table"
}
else if(input$plot_hover$x<input$STX2&&input$plot_hover$x>input$STX1 && input$plot_hover$y<(input$STZ2+680)&&(input$plot_hover$y>input$STZ1+580))
{
"Eye Accommodation, see summary table"
}
else if(input$plot_hover$x<(input$SWPX+input$TeleMax*sin(input$AngleMax/180*3.14))&&input$plot_hover$x>(input$SWPX+input$TeleMin*sin(input$AngleMin/180*3.14)) && input$plot_hover$y<(input$SWPZ+input$TeleMax*cos(input$AngleMin/180*3.14))&&input$plot_hover$y>(input$SWPZ+input$TeleMin*cos(input$AngleMax/180*3.14)))
{
"Steering Wheel Accommodation, see summary table"
}
else if(input$plot_hover$x<(30)&&input$plot_hover$x>(-30) && input$plot_hover$y<(-input$AHPZ+30)&&input$plot_hover$y>(-input$AHPZ-30))
{
"Reference point of bus layout (X:AHP=0 Z:GND=0)"
}
else if(input$plot_hover$x<(30)&&input$plot_hover$x>(-30) && input$plot_hover$y<(30)&&input$plot_hover$y>(-30))
{
"Origin/Reference of interior components (X:AHP=0 Z:AHP=0)"
}
else
{
"Move cursor for geometric definitions"
}
}
})
# SUMMARY TABLE ON ACCOMMODATION LEVEL
output$table <- renderTable({
postureData <- accommodationModel(input)
postureData$count[11] = mean(postureData$RULAM)
postureData$count[12] = mean(postureData$RULAF)
myTable <- data.frame("Gender" = c("Male","Female","Combo"),
"Steering_Wheel" = percent(c(postureData$count[1],postureData$count[2],(postureData$count[1]*input$Ratio+postureData$count[2]*(1-input$Ratio)))/500),
"H_Point" = percent(c(postureData$count[3],postureData$count[4],(postureData$count[3]*input$Ratio+postureData$count[4]*(1-input$Ratio)))/500),
"Up_Vision" = percent(c(postureData$count[5],postureData$count[6],(postureData$count[5]*input$Ratio+postureData$count[6]*(1-input$Ratio)))/500),
"Down_Vision" = percent(c(postureData$count[7],postureData$count[8],(postureData$count[7]*input$Ratio+postureData$count[8]*(1-input$Ratio)))/500),
"Total_Accom" = percent(c(postureData$count[9],postureData$count[10],(postureData$count[9]*input$Ratio+postureData$count[10]*(1-input$Ratio)))/500)
#,"RULA" = c(postureData$count[11],postureData$count[12],(postureData$count[11]*input$Ratio+postureData$count[12]*(1-input$Ratio)))
)
myTable
}, bordered = TRUE, striped = FALSE, align = "c", width = 780)
}
# SHINYAPP - YAY!!!!!
shinyApp(ui, server)
This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.