################################################################################
#
# Server function
#
################################################################################
##
function(input, output, session) {
#
##############################################################################
## INPUTS
##############################################################################
## Header text for single child input
output$header1 <- renderText({
## If dataType == 1
if(input$dataType == 1){
"Enter child's age, sex and anthropometric measurements"
}
})
## Input for sex
output$sex1 <- renderUI({
## If user selects "wfa" or "wfh" and "Single child" options...
if(input$dataType == 1){
selectInput(inputId = "sex1",
label = "Sex",
choices = list("Select" = "", "Male" = 1, "Female" = 2),
selected = "")
}
})
## Input for weight
output$weight1 <- renderUI({
## If user selects "wfa" or "wfh" and "Single child" options...
if(input$dataType == 1){
numericInput(inputId = "weight1",
label = "Weight (kg)",
value = NULL,
min = 1,
max = 30,
step = 0.1)
}
})
## Input for height
output$height1 <- renderUI({
## If user selects "hfa" or "wfh" and "Single child" options...
if(input$dataType == 1){
numericInput(inputId = "height1",
label = "Height (cm)",
value = NULL,
min = 45,
max = 120,
step = 0.1)
}
})
## Input for head circumference
output$hc1 <- renderUI({
## If user selects "hcfa"
if(input$dataType == 1){
numericInput(inputId = "hc1",
label = "Head circumference (cm)",
value = NULL,
min = 30,
max = 60,
step = 0.1)
}
})
## Input for arm circumference
output$muac1 <- renderUI({
## If user selects "acfa"
if(input$dataType == 1){
numericInput(inputId = "muac1",
label = "Mid-upper arm circumference (cm)",
value = NULL,
min = 10,
max = 25,
step = 0.1)
}
})
## Input for subscapular skinfold
output$ss1 <- renderUI({
## If user selects "ssfa"
if(input$dataType == 1){
numericInput(inputId = "ss1",
label = "Subscapular skinfold (mm)",
value = NULL,
min = 3,
max = 20,
step = 0.1)
}
})
## Input for triceps skinfold
output$ts1 <- renderUI({
## If user selects "tsfa"
if(input$dataType == 1){
numericInput(inputId = "ts1",
label = "Triceps skinfold (cm)",
value = NULL,
min = 3,
max = 23,
step = 0.1)
}
})
## Input for age
output$age1 <- renderUI({
## If user selects "hfa" or "wfa" and "Single child" options...
if(input$dataType == 1){
numericInput(inputId = "age1",
label = "Age (months)",
value = NULL,
min = 0,
max = 60,
step = 0)
}
})
##
index.list <- reactive({
index.list <- NULL
if(!is.null(input$weight1) & input$dataType == 1) { index.list <- c(index.list, "wfa") }
if(!is.null(input$height1) & input$dataType == 1) { index.list <- c(index.list, "hfa") }
if(input$dataType == 2) { index.list <- c(index.list, "wfh", "wfa", "hfa", "bfa", "hcfa", "acfa", "ssfa", "tsfa") }
if(!is.null(input$weight1) & !is.null(input$height1) & input$dataType == 1) {
index.list <- c(index.list, "wfh")
}
##
full.index.list <- c("wfa", "hfa", "wfh", "bfa", "hcfa", "acfa", "ssfa", "tsfa")
names(full.index.list) <- c("Weight-for-age",
"Height-for-age",
"Weight-for-height",
"BMI-for-age",
"Head circumference-for-age",
"MUAC-for-age",
"Subscapular skinfold-for-age",
"Triceps skinfold-for-age")
##
sub.index.list <- full.index.list[full.index.list %in% index.list]
##
return(sub.index.list)
})
## Input for index type
output$index1 <- renderUI({
if(input$dataType == 2) {
selectInput(inputId = "index1",
label = "Select anthropometric index",
choices = index.list(),
multiple = TRUE,
size = 8,
selectize = FALSE)
}
})
##
output$header2 <- renderText({
## If dataType == 2...
if(input$dataType == 2){
"Upload anthropometric data from multiple children"
}
})
## File input
output$file1 <- renderUI({
## If user selects "Cohort/sample of children" option...
if(input$dataType == 2){
fileInput(inputId = "file1",
label = "Upload children cohort/sample data",
accept = c("text/csv", "text/comma-separated-values,text/plain", ".csv"),
placeholder = "Select anthro data file")
}
})
## Input for sex variable
output$sex2 <- renderUI({
## If file1 is present...
if(!is.null(input$file1) & input$dataType == 2){
## Select UI
selectInput(inputId = "sex2",
label = "Select sex variable",
choices = c(" ", names(anthroDF())),
selected = names(anthroDF())[names(anthroDF()) %in% c("sex", "SEX", "Sex", "Gender", "gender", "GENDER")])
}
})
## Input for weight variable
output$weight2 <- renderUI({
## If user selects "wfa" or "wfh" and "Cohort/sample data" and file1 is present...
if(input$dataType == 2 & !is.null(input$file1)){
## Select UI
selectInput(inputId = "weight2",
label = "Select weight variable",
choices = c(" ", names(anthroDF())),
selected = names(anthroDF())[names(anthroDF()) %in% c("wt", "WT", "Wt", "weight", "Weight", "WEIGHT")])
}
})
## Input for height variable
output$height2 <- renderUI({
## If user selects "hfa" or "wfh" and "Cohort/sample data" and file1 is present...
if(input$dataType == 2 & !is.null(input$file1)){
## Select UI
selectInput(inputId = "height2",
label = "Select height variable",
choices = c(" ", names(anthroDF())),
selected = names(anthroDF())[names(anthroDF()) %in% c("ht", "HT", "Ht", "height", "Height", "HEIGHT")])
}
})
## Input for age variable
output$age2 <- renderUI({
## If user selects "hfa" or "wfa" and "Cohort/sample data" and file1 is present...
if(input$dataType == 2 & !is.null(input$file1)){
## Select UI
selectInput(inputId = "age2",
label = "Select age variable",
choices = c(" ", names(anthroDF())),
selected = names(anthroDF())[names(anthroDF()) %in% c("age", "AGE")])
}
})
## Input for head circumference variable
output$hc2 <- renderUI({
## If user selects "hcfa" and "Cohort/sample data" and file1 is present...
if(input$dataType == 2 & !is.null(input$file1)){
## Select UI
selectInput(inputId = "hc2",
label = "Select head circumference variable",
choices = c(" ", names(anthroDF())),
selected = names(anthroDF())[names(anthroDF()) %in% c("hc", "headCircumference", "hcircumference", "headCirc", "hcirc")])
}
})
## Input for muac variable
output$muac2 <- renderUI({
## If user selects "acfa" and "Cohort/sample data" and file1 is present...
if(input$dataType == 2 & !is.null(input$file1)){
## Select UI
selectInput(inputId = "muac2",
label = "Select MUAC variable",
choices = c(" ", names(anthroDF())),
selected = names(anthroDF())[names(anthroDF()) %in% c("muac", "MUAC")])
}
})
## Input for sub-scapular skinfold variable
output$ss2 <- renderUI({
## If user selects "ssfa" and "Cohort/sample data" and file1 is present...
if(input$dataType == 2 & !is.null(input$file1)){
## Select UI
selectInput(inputId = "ss2",
label = "Select subscapular skinfold variable",
choices = c(" ", names(anthroDF())),
selected = names(anthroDF())[names(anthroDF()) %in% c("subscapularSkinfold", "ss")]
)
}
})
## Input for triceps skinfold variable
output$ts2 <- renderUI({
## If user selects "tsfa" and "Cohort/sample data" and file1 is present...
if(input$dataType == 2 & !is.null(input$file1)){
## Select UI
selectInput(inputId = "ts2",
label = "Select triceps skinfold variable",
choices = c(" ", names(anthroDF())),
selected = names(anthroDF())[names(anthroDF()) %in% c("tricepsSkinfold", "ts")])
}
})
## Calculate action button - cohort/sample
output$calculate2 <- renderUI({
if(input$dataType == 2 & !is.null(input$file1)){
##
div(style="display:inline-block; float:left;",
actionButton(inputId = "calculate2",
label = "Calculate",
class = "btn-primary",
icon = icon(name = "calculator", class = "fa-lg"),
width = "100%")
)
}
})
## Calculate action button - cohort/sample - download
output$download <- renderUI({
if(input$dataType == 2 & !is.null(input$file1)){
##
div(style="display:inline-block; float:right",
downloadButton(outputId = "downloadResults",
label = "Download",
class = "btn-primary",
icon = icon(name = "download", class = "fa-lg"))
)
}
})
## Calculate action button - single child
output$calculate1 <- renderUI({
if(input$dataType == 1){
##
actionButton(inputId = "calculate1",
label = "Calculate",
class = "btn-primary",
icon = icon(name = "calculator", class = "fa-lg"))
}
})
##############################################################################
#
# OUTPUTS
#
##############################################################################
## Read file1 data
anthroDF <- reactive({
## If user selects "Cohort/sample children"...
if(input$dataType == 2 & !is.null(input$file1)){
## Read anthro data
read.csv(input$file1$datapath, header = TRUE, sep = ",")
}
})
##############################################################################
#
# CALCULATIONS
#
##############################################################################
##
observeEvent(input$calculate1, {
## For single calculations
if(input$dataType == 1 & !is.null(input$weight1) & !is.null(input$height1)) {
##
req(input$sex1, input$weight1, input$age1, input$height1)
age <- input$age1 * (365.25 / 12)
waz <- getWGSR(sex = input$sex1, firstPart = input$weight1, secondPart = age, index = "wfa")
haz <- getWGSR(sex = input$sex1, firstPart = input$height1, secondPart = age, index = "hfa")
whz <- getWGSR(sex = input$sex1, firstPart = input$weight1, secondPart = input$height1, index = "wfh")
bfaz <- getWGSR(sex = input$sex1, firstPart = input$weight1, secondPart = input$height1, thirdPart = age, index = "bfa")
output$waz <- renderText({ waz })
output$haz <- renderText({ haz })
output$whz <- renderText({ whz })
output$bfaz <- renderText({ bfaz })
}
##
if(input$dataType == 1 & !is.null(input$muac1)) {
##
req(input$sex1, input$muac1, input$age1)
age <- input$age1 * (365.25 / 12)
mfaz <- getWGSR(sex = input$sex1, firstPart = input$muac1, secondPart = age, index = "mfa")
output$mfaz <- renderText({ mfaz })
}
##
if(input$dataType == 1 & !is.null(input$hc1)) {
##
req(input$sex1, input$hc1, input$age1)
age <- input$age1 * (365.25 / 12)
hcz <- getWGSR(sex = input$sex1, firstPart = input$hc1, secondPart = age, index = "hfa")
output$hcz <- renderText({ hcz })
}
##
if(input$dataType == 1 & !is.null(input$ss1)) {
##
req(input$sex1, input$ss1, input$age1)
age <- input$age1 * (365.25 / 12)
ssaz <- getWGSR(sex = input$sex1, firstPart = input$ss1, secondPart = age, index = "ssa")
output$ssaz <- renderText({ ssaz })
}
##
if(input$dataType == 1 & !is.null(input$ts1)) {
##
req(input$sex1, input$ts1, input$age1)
age <- input$age1 * (365.25 / 12)
ssaz <- getWGSR(sex = input$sex1, firstPart = input$ts1, secondPart = age, index = "tsa")
output$tsaz <- renderText({ tsaz })
}
})
##
observeEvent(input$calculate2, {
##
zScoreDF <- anthroDF()
## convert age into days
zScoreDF[[input$age2]] <- zScoreDF[[input$age2]] * (365.25 / 12)
## for cohort calculations
##if(input$dataType == 2) {
## BMI-for-age
if("bfa" %in% input$index1) {
zScoreDF <- addWGSR(data = zScoreDF,
sex = input$sex2,
firstPart = input$weight2,
secondPart = input$height2,
thirdPart = input$age2,
index = "bfa",
output = "bfa")
}
##
if("wfa" %in% input$index1) {
zScoreDF <- addWGSR(data = zScoreDF,
sex = input$sex2,
firstPart = input$weight2,
secondPart = input$age2,
index = "wfa",
output = "wfa")
}
##
if("hfa" %in% input$index1) {
zScoreDF <- addWGSR(data = zScoreDF,
sex = input$sex2,
firstPart = input$height2,
secondPart = input$age2,
index = "hfa",
output = "hfa")
}
##
if("hcfa" %in% input$index1) {
zScoreDF <- addWGSR(data = zScoreDF,
sex = input$sex2,
firstPart = input$hc2,
secondPart = input$age2,
index = "hca",
output = "hca")
}
##
if("acfa" %in% input$index1) {
zScoreDF <- addWGSR(data = zScoreDF,
sex = input$sex2,
firstPart = input$muac2,
secondPart = input$age2,
index = "mfa",
output = "mfa")
}
##
if("ssfa" %in% input$index1) {
zScoreDF <- addWGSR(data = zScoreDF,
sex = input$sex2,
firstPart = input$ss2,
secondPart = input$age2,
index = "ssa",
output = "ssa")
}
##
if("tsfa" %in% input$index1) {
zScoreDF <- addWGSR(data = zScoreDF,
sex = input$sex2,
firstPart = input$ts2,
secondPart = input$age2,
index = "tsa",
output = "tsa")
}
##
if("wfh" %in% input$index1) {
zScoreDF <- addWGSR(data = zScoreDF,
sex = input$sex2,
firstPart = input$weight2,
secondPart = input$height2,
index = "wfh",
output = "wfh")
}
##
output$zScoreTable <- DT::renderDataTable(zScoreDF,
options = list(pageLength = 15))
#}
##
output$downloadResults <- downloadHandler(
filename <- function() {
"zscoreResults.csv"
},
content <- function(file) {
write.csv(zScoreDF, file)
}
)
})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.