# load packages
library(here)
library(shiny)
library(shinyjs)
library(tidyverse)
# load WHS function
source("WHSdepression.R")
# create a vector of questions DA1-23
# NOTE: questions need to be updated as in BLR survey, as they contain "During this period"
da_questions <-
c("DA1. Have you ever been told by a doctor or other health worker that you have depression?",
"DA2. When were you diagnosed?",
"DA3. How many years passed since your doctor or health care provider told you for the first time that you have depression?",
"DA4. Have you been taking any medications or other treatment, like counseling or psychotherapy, either alone or in group, for depression in the last 12 months?",
"DA5. Have you been taking any medications or other treatment, like counseling or psychotherapy, either alone or in group, for depression in the last 2 weeks?",
"DA6. During the last 12 months, have you had a period lasting several days when you felt sad, empty or depressed?",
"DA7. During the last 12 months, have you had a period lasting several days when you lost interest in most things you usually enjoy such as personal relationships, work or hobbies/recreation?",
"DA8. During the last 12 months, have you had a period lasting several days when you have been feeling your energy decreased or that you are tired all the time?",
"DA9. Was this period of sadness, loss of interest or low energy for more than 2 weeks?",
"DA10. Was this period of sadness, loss of interest or low energy most of the day, nearly every day?",
"DA11. During this period, did you lose your appetite?",
"DA12. Did you notice any slowing down in your thinking?",
"DA13. Did you notice any problems falling asleep?",
"DA14. Did you notice any problems waking up too early?",
"DA15. Did you have any difficulties concentrating; for example, listening to others, working, watching TV, listening to the radio?",
"DA16. Did you notice any slowing down in your moving around?",
"DA17. Did you feel anxious and worried most days?",
"DA18. Were you so restless or jittery nearly every day that you paced up and down and couldn’t sit still?",
"DA19. Did you feel negative about yourself or like you had lost confidence?",
"DA20. Did you frequently feel hopeless - that there was no way to improve things?",
"DA21. Did your interest in sex decrease?",
"DA22. Did you think of death, or wish you were dead?",
"DA23. During this period, did you ever try to end your life?")
# vector with only question codes
da_codes <- c("da1","da2","da3","da4","da5","da6","da7","da8","da9",
"da10","da11","da12","da13","da14","da15","da16","da17",
"da18","da19","da20","da21","da22","da23")
# vector with required questions for WHS depression function
required_vec <- c("da1","da5","da6","da7","da8","da9","da10","da11",
"da12","da13","da14","da15","da16","da17",
"da18","da19","da20","da21","da22","da23")
# vector of answer choices for DA1, DA4-23
answer_choices <- c("Yes","No","Don't know","Refuse")
# TRUE/FALSE for mandatory questions
# required_df <- as.data.frame(required_vec) %>% mutate(required = TRUE)
################################################################################
ui <- fluidPage(
# set up shinyjs
useShinyjs(),
# main title
#title = 'WHO STEPS Depression Self-assessment Tool',
tags$h3("WHO STEPS Depression Self-assessment Tool"),
# create select inputs (radio buttons) for 23 questions
lapply(1:23, function(i) {
radioButtons(paste0('da', i), paste0(da_questions[i]),
choices = answer_choices, selected = character(0), inline = TRUE)
}),
# print answer choices in real time
verbatimTextOutput('da_out'),
# submit button for survey
actionButton(inputId = "submit", label = "submit")
)
################################################################################
server <- function(input, output, session) {
# disable Submit button on start-up
disable("submit")
# hide conditioned questions on start-up
hideElement("da2")
hideElement("da3")
hideElement("da4")
toggleElement("da5")
hideElement("da9")
hideElement("da10")
hideElement("da11")
hideElement("da12")
hideElement("da13")
hideElement("da14")
hideElement("da15")
hideElement("da16")
hideElement("da17")
hideElement("da18")
hideElement("da19")
hideElement("da20")
hideElement("da21")
hideElement("da22")
hideElement("da23")
# show (toggle) questions per relevant answer choice
# alternate between hiding and showing
observeEvent(input$da1, {
toggleElement("da5", condition = input$da1==answer_choices[1])
})
observeEvent(ignoreInit = TRUE, c(input$da6, input$da7, input$da8), {
if ((!is.null(input$da6) && input$da6 == "Yes") ||
(!is.null(input$da7) && input$da7 == "Yes") ||
(!is.null(input$da8) && input$da8 == "Yes")) {
showElement("da9")
showElement("da10")
showElement("da11")
showElement("da12")
showElement("da13")
showElement("da14")
showElement("da15")
showElement("da16")
showElement("da17")
showElement("da18")
showElement("da19")
showElement("da20")
showElement("da21")
showElement("da22")
showElement("da23")
}
else if ((!is.null(input$da6) && input$da6 != "Yes") ||
(!is.null(input$da7) && input$da7 != "Yes") ||
(!is.null(input$da8) && input$da8 != "Yes")) {
hideElement("da9")
hideElement("da10")
hideElement("da11")
hideElement("da12")
hideElement("da13")
hideElement("da14")
hideElement("da15")
hideElement("da16")
hideElement("da17")
hideElement("da18")
hideElement("da19")
hideElement("da20")
hideElement("da21")
hideElement("da22")
hideElement("da23")
}
})
# note we use the syntax input[['foo']] instead of input$foo, because we have
# to construct the id as a character string, then use it to access the value;
# same thing applies to the output object below
output$da_out <- renderPrint({
res <<- lapply(1:23, function(i) input[[paste0('da', i)]])
str(setNames(res, paste0('da', 1:23)))
})
# what happens on clicking submit
observeEvent(
input$submit,{
# write a matrix called responses
responses <<- matrix(ncol = length(da_codes), nrow=0)
# add column names from vector
colnames(responses) <<- da_codes
# OR a one-liner:
#responses <<- setNames(data.frame(matrix(ncol = length(da_codes), nrow = 0)), responses)
# list values from table
listed_responses <<- lapply(1:23, function(i) input[[paste0('da', i)]])
# function for potential NULL values in the list, converting them to NA
# when there are skipped questions
nullToNA <- function(x) {
x[sapply(x, is.null)] <- NA
return(x)
}
listed_responses <<- nullToNA(listed_responses)
# create one row matrix with unlisted responses
unlisted_responses <<- t(as.matrix(unlist(listed_responses)))
# combine it with preexisting df responses
responses <<- rbind(responses, unlisted_responses)
df_flat <<- as.data.frame(responses)
colnames(df_flat) <<- da_codes
# recode character values to numbers for using with WHS function
# base R approach:
# nm1 <<- setNames(c(1,2,77,88), answer_choices)
# df_flat[] <<- lapply(df_flat, function(x) nm1[x])
# OR dplyr approach:
df_flat <<- df_flat %>%
mutate(across(everything(), ~dplyr::recode(., 'Yes'= 1, 'No'= 2, "Don't know" = 77, 'Refuse'= 88)))
# produce depression results
depression_results <<- whs_depression(df_flat) %>% mutate(across(everything(), as.character))
# show a modal pop-up with result message
showModal(modalDialog(
title = "Completed! Your result:",
paste(if(is.na(depression_results$depression) || depression_results$depression==0){ paste("No, you don't have symptoms of depression.") }
else if(depression_results$depression==1){ paste("Yes, you have symptoms of depression. It is advisable to consult with your family doctor or general practitioner for a thorough exam and screening.") }
else { paste("No, you don't have symptoms of depression.") }
)
))
# save response if needed
# write.table(responses, sep = ",", file = "responses.csv", append = TRUE, quote = FALSE)
}
)
# activate submit button only when radios are selected
# 1st version, using observe and toggleState functions
# works basically as the 2nd version below but with ifelse inside condition argument
# observe({
# toggleState(
# id = "submit",
# condition =
# # 1
# ((!is.null(input$da1) && input$da1 == "Yes") &&
# (!is.null(input$da5) && input$da5 != "") && # must NOT be empty
# (!is.null(input$da6) && input$da6 != "Yes") &&
# (!is.null(input$da7) && input$da7 != "Yes") &&
# (!is.null(input$da8) && input$da8 != "Yes") &&
# # then the rest of da9 to da23
# (is.null(input$da9)) && # must BE empty da9-da23
# (is.null(input$da10)) &&
# (is.null(input$da11)) &&
# (is.null(input$da12)) &&
# (is.null(input$da13)) &&
# (is.null(input$da14)) &&
# (is.null(input$da15)) &&
# (is.null(input$da16)) &&
# (is.null(input$da17)) &&
# (is.null(input$da18)) &&
# (is.null(input$da19)) &&
# (is.null(input$da20)) &&
# (is.null(input$da21)) &&
# (is.null(input$da22)) &&
# (is.null(input$da23))) ||
# # 2
# ((!is.null(input$da1) && input$da1 != "Yes") &&
# (is.null(input$da5)) && # must BE empty
# (!is.null(input$da6) && input$da6 != "Yes") &&
# (!is.null(input$da7) && input$da7 != "Yes") &&
# (!is.null(input$da8) && input$da8 != "Yes") &&
# # then the rest of da9 to da23
# (is.null(input$da9)) && # must BE empty da9-da23
# (is.null(input$da10)) &&
# (is.null(input$da11)) &&
# (is.null(input$da12)) &&
# (is.null(input$da13)) &&
# (is.null(input$da14)) &&
# (is.null(input$da15)) &&
# (is.null(input$da16)) &&
# (is.null(input$da17)) &&
# (is.null(input$da18)) &&
# (is.null(input$da19)) &&
# (is.null(input$da20)) &&
# (is.null(input$da21)) &&
# (is.null(input$da22)) &&
# (is.null(input$da23))) ||
# # 3 (stems from #1)
# ((!is.null(input$da1) && input$da1 == "Yes") &&
# (!is.null(input$da5) && input$da5 != "") && # must NOT be empty
# ((!is.null(input$da6) && input$da6 == "Yes") ||
# (!is.null(input$da7) && input$da7 == "Yes") ||
# (!is.null(input$da8) && input$da8 == "Yes")) &&
# # then the rest of da9 to da23
# (!is.null(input$da9) && input$da9 != "") && # must NOT be empty up to da23
# (!is.null(input$da10) && input$da10 != "") &&
# (!is.null(input$da11) && input$da11 != "") &&
# (!is.null(input$da12) && input$da12 != "") &&
# (!is.null(input$da13) && input$da13 != "") &&
# (!is.null(input$da14) && input$da14 != "") &&
# (!is.null(input$da15) && input$da15 != "") &&
# (!is.null(input$da16) && input$da16 != "") &&
# (!is.null(input$da17) && input$da17 != "") &&
# (!is.null(input$da18) && input$da18 != "") &&
# (!is.null(input$da19) && input$da19 != "") &&
# (!is.null(input$da20) && input$da20 != "") &&
# (!is.null(input$da21) && input$da21 != "") &&
# (!is.null(input$da22) && input$da22 != "") &&
# (!is.null(input$da23) && input$da23 != "")) ||
# # 4 (stems from #2)
# ((!is.null(input$da1) && input$da1 != "Yes") &&
# (is.null(input$da5)) && # must BE empty
# ((!is.null(input$da6) && input$da6 == "Yes") ||
# (!is.null(input$da7) && input$da7 == "Yes") ||
# (!is.null(input$da8) && input$da8 == "Yes")) &&
# # then the rest of da9 to da23
# (!is.null(input$da9) && input$da9 != "") && # must NOT be empty da9-da23
# (!is.null(input$da10) && input$da10 != "") &&
# (!is.null(input$da11) && input$da11 != "") &&
# (!is.null(input$da12) && input$da12 != "") &&
# (!is.null(input$da13) && input$da13 != "") &&
# (!is.null(input$da14) && input$da14 != "") &&
# (!is.null(input$da15) && input$da15 != "") &&
# (!is.null(input$da16) && input$da16 != "") &&
# (!is.null(input$da17) && input$da17 != "") &&
# (!is.null(input$da18) && input$da18 != "") &&
# (!is.null(input$da19) && input$da19 != "") &&
# (!is.null(input$da20) && input$da20 != "") &&
# (!is.null(input$da21) && input$da21 != "") &&
# (!is.null(input$da22) && input$da22 != "") &&
# (!is.null(input$da23) && input$da23 != ""))
#
# )
#
# })
# 2nd version, using observeEvent function and if else statements
observeEvent(ignoreInit = TRUE, c(input$da1, input$da5, input$da6, input$da7, input$da8), {
# 1
if ((!is.null(input$da1) && input$da1 == "Yes") &&
(!is.null(input$da5) && input$da5 != "") && # must NOT be empty
(!is.null(input$da6) && input$da6 != "Yes") &&
(!is.null(input$da7) && input$da7 != "Yes") &&
(!is.null(input$da8) && input$da8 != "Yes") &&
# then the rest of da9 to da23
(is.null(input$da9)) && # must BE empty da9-da23
(is.null(input$da10)) &&
(is.null(input$da11)) &&
(is.null(input$da12)) &&
(is.null(input$da13)) &&
(is.null(input$da14)) &&
(is.null(input$da15)) &&
(is.null(input$da16)) &&
(is.null(input$da17)) &&
(is.null(input$da18)) &&
(is.null(input$da19)) &&
(is.null(input$da20)) &&
(is.null(input$da21)) &&
(is.null(input$da22)) &&
(is.null(input$da23))) {
enable("submit")
}
# 2
else if ((!is.null(input$da1) && input$da1 != "Yes") &&
(is.null(input$da5)) && # must BE empty
(!is.null(input$da6) && input$da6 != "Yes") &&
(!is.null(input$da7) && input$da7 != "Yes") &&
(!is.null(input$da8) && input$da8 != "Yes") &&
# then the rest of da9 to da23
(is.null(input$da9)) && # must BE empty da9-da23
(is.null(input$da10)) &&
(is.null(input$da11)) &&
(is.null(input$da12)) &&
(is.null(input$da13)) &&
(is.null(input$da14)) &&
(is.null(input$da15)) &&
(is.null(input$da16)) &&
(is.null(input$da17)) &&
(is.null(input$da18)) &&
(is.null(input$da19)) &&
(is.null(input$da20)) &&
(is.null(input$da21)) &&
(is.null(input$da22)) &&
(is.null(input$da23))) {
enable("submit")
}
# 3
else if ((!is.null(input$da1) && input$da1 == "Yes") &&
(!is.null(input$da5) && input$da5 != "") && # must NOT be empty
((!is.null(input$da6) && input$da6 == "Yes") ||
(!is.null(input$da7) && input$da7 == "Yes") ||
(!is.null(input$da8) && input$da8 == "Yes")) &&
# then the rest of da9 to da23
(!is.null(input$da9) && input$da9 != "") && # must NOT be empty da9-da23
(!is.null(input$da10) && input$da10 != "") &&
(!is.null(input$da11) && input$da11 != "") &&
(!is.null(input$da12) && input$da12 != "") &&
(!is.null(input$da13) && input$da13 != "") &&
(!is.null(input$da14) && input$da14 != "") &&
(!is.null(input$da15) && input$da15 != "") &&
(!is.null(input$da16) && input$da16 != "") &&
(!is.null(input$da17) && input$da17 != "") &&
(!is.null(input$da18) && input$da18 != "") &&
(!is.null(input$da19) && input$da19 != "") &&
(!is.null(input$da20) && input$da20 != "") &&
(!is.null(input$da21) && input$da21 != "") &&
(!is.null(input$da22) && input$da22 != "") &&
(!is.null(input$da23) && input$da23 != "")) {
enable("submit")
}
# 4
else if ((!is.null(input$da1) && input$da1 != "Yes") &&
(is.null(input$da5)) && # must BE empty
((!is.null(input$da6) && input$da6 == "Yes") ||
(!is.null(input$da7) && input$da7 == "Yes") ||
(!is.null(input$da8) && input$da8 == "Yes")) &&
# then the rest of da9 to da23
(!is.null(input$da9) && input$da9 != "") && # must NOT be empty da9-da23
(!is.null(input$da10) && input$da10 != "") &&
(!is.null(input$da11) && input$da11 != "") &&
(!is.null(input$da12) && input$da12 != "") &&
(!is.null(input$da13) && input$da13 != "") &&
(!is.null(input$da14) && input$da14 != "") &&
(!is.null(input$da15) && input$da15 != "") &&
(!is.null(input$da16) && input$da16 != "") &&
(!is.null(input$da17) && input$da17 != "") &&
(!is.null(input$da18) && input$da18 != "") &&
(!is.null(input$da19) && input$da19 != "") &&
(!is.null(input$da20) && input$da20 != "") &&
(!is.null(input$da21) && input$da21 != "") &&
(!is.null(input$da22) && input$da22 != "") &&
(!is.null(input$da23) && input$da23 != "")) {
enable("submit")
} else {
disable("submit")
}
})
}
################################################################################
shinyApp(ui, server)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.